274 lines
9.6 KiB
Diff
274 lines
9.6 KiB
Diff
|
Subject: [PATCH 13/23] test: evaluate Fortran dynamic arrays of types.
|
||
|
|
Message-Id: <1401861266-6240-14-git-send-email-keven.boell@intel.com>
|
||
|
|
|
||
|
|
Tests ensure that dynamic arrays of various Fortran
|
||
|
|
datatypes can be evaluated correctly.
|
||
|
|
|
||
|
|
2014-05-28 Keven Boell <keven.boell@intel.com>
|
||
|
|
Sanimir Agovic <sanimir.agovic@intel.com>
|
||
|
|
|
||
|
|
testsuite/gdb.fortran/:
|
||
|
|
|
||
|
|
* vla-type.exp: New file.
|
||
|
|
* vla-type.f90: New file.
|
||
|
|
|
||
|
|
Change-Id: I7c1a381c5cb0ad48872b77993e7c7fdac85bc756
|
||
|
|
|
||
|
|
Signed-off-by: Keven Boell <keven.boell@intel.com>
|
||
|
|
---
|
||
|
|
gdb/testsuite/gdb.fortran/vla-type.exp | 127 ++++++++++++++++++++++++++++++++
|
||
|
|
gdb/testsuite/gdb.fortran/vla-type.f90 | 107 +++++++++++++++++++++++++++
|
||
|
|
2 files changed, 234 insertions(+)
|
||
|
|
create mode 100644 gdb/testsuite/gdb.fortran/vla-type.exp
|
||
|
|
create mode 100644 gdb/testsuite/gdb.fortran/vla-type.f90
|
||
|
|
|
||
|
|
diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
|
||
|
|
new file mode 100644
|
||
|
|
index 0000000..ad50d9c
|
||
|
|
--- /dev/null
|
||
|
|
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
|
||
|
|
@@ -0,0 +1,127 @@
|
||
|
|
+# Copyright 2014 Free Software Foundation, Inc.
|
||
|
|
+
|
||
|
|
+# This program is free software; you can redistribute it and/or modify
|
||
|
|
+# it under the terms of the GNU General Public License as published by
|
||
|
|
+# the Free Software Foundation; either version 3 of the License, or
|
||
|
|
+# (at your option) any later version.
|
||
|
|
+#
|
||
|
|
+# This program is distributed in the hope that it will be useful,
|
||
|
|
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
+# GNU General Public License for more details.
|
||
|
|
+#
|
||
|
|
+# You should have received a copy of the GNU General Public License
|
||
|
|
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
|
+
|
||
|
|
+standard_testfile ".f90"
|
||
|
|
+
|
||
|
|
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
|
||
|
|
+ {debug f90 quiet}] } {
|
||
|
|
+ return -1
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
+if ![runto MAIN__] then {
|
||
|
|
+ perror "couldn't run to breakpoint MAIN__"
|
||
|
|
+ continue
|
||
|
|
+}
|
||
|
|
+
|
||
|
|
+# Check if not allocated VLA in type does not break
|
||
|
|
+# the debugger when accessing it.
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "before-allocated"]
|
||
|
|
+gdb_continue_to_breakpoint "before-allocated"
|
||
|
|
+gdb_test "print twov" " = \\\( <not allocated>, <not allocated> \\\)" \
|
||
|
|
+ "print twov before allocated"
|
||
|
|
+gdb_test "print twov%ivla1" " = <not allocated>" \
|
||
|
|
+ "print twov%ivla1 before allocated"
|
||
|
|
+
|
||
|
|
+# Check type with one VLA's inside
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "onev-filled"]
|
||
|
|
+gdb_continue_to_breakpoint "onev-filled"
|
||
|
|
+gdb_test "print onev%ivla(5, 11, 23)" " = 1" "print onev%ivla(5, 11, 23)"
|
||
|
|
+gdb_test "print onev%ivla(1, 2, 3)" " = 123" "print onev%ivla(1, 2, 3)"
|
||
|
|
+gdb_test "print onev%ivla(3, 2, 1)" " = 321" "print onev%ivla(3, 2, 1)"
|
||
|
|
+gdb_test "ptype onev" \
|
||
|
|
+ "type = Type one\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\)\r\nEnd Type one" \
|
||
|
|
+ "ptype onev"
|
||
|
|
+
|
||
|
|
+# Check type with two VLA's inside
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "twov-filled"]
|
||
|
|
+gdb_continue_to_breakpoint "twov-filled"
|
||
|
|
+gdb_test "print twov%ivla1(5, 11, 23)" " = 1" \
|
||
|
|
+ "print twov%ivla1(5, 11, 23)"
|
||
|
|
+gdb_test "print twov%ivla1(1, 2, 3)" " = 123" \
|
||
|
|
+ "print twov%ivla1(1, 2, 3)"
|
||
|
|
+gdb_test "print twov%ivla1(3, 2, 1)" " = 321" \
|
||
|
|
+ "print twov%ivla1(3, 2, 1)"
|
||
|
|
+gdb_test "ptype twov" \
|
||
|
|
+ "type = Type two\r\n\\s+real\\\(kind=4\\\) :: ivla1\\\(5,12,99\\\)\r\n\\s+real\\\(kind=4\\\) :: ivla2\\\(9,12\\\)\r\nEnd Type two" \
|
||
|
|
+ "ptype twov"
|
||
|
|
+
|
||
|
|
+# Check type with attribute at beginn of type
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "threev-filled"]
|
||
|
|
+gdb_continue_to_breakpoint "threev-filled"
|
||
|
|
+gdb_test "print threev%ivla(1)" " = 1" "print threev%ivla(1)"
|
||
|
|
+gdb_test "print threev%ivla(5)" " = 42" "print threev%ivla(5)"
|
||
|
|
+gdb_test "print threev%ivla(14)" " = 24" "print threev%ivla(14)"
|
||
|
|
+gdb_test "print threev%ivar" " = 3.14\\d+?" "print threev%ivar"
|
||
|
|
+gdb_test "ptype threev" \
|
||
|
|
+ "type = Type three\r\n\\s+real\\\(kind=4\\\) :: ivar\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(20\\\)\r\nEnd Type three" \
|
||
|
|
+ "ptype threev"
|
||
|
|
+
|
||
|
|
+# Check type with attribute at end of type
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "fourv-filled"]
|
||
|
|
+gdb_continue_to_breakpoint "fourv-filled"
|
||
|
|
+gdb_test "print fourv%ivla(1)" " = 1" "print fourv%ivla(1)"
|
||
|
|
+gdb_test "print fourv%ivla(2)" " = 2" "print fourv%ivla(2)"
|
||
|
|
+gdb_test "print fourv%ivla(7)" " = 7" "print fourv%ivla(7)"
|
||
|
|
+gdb_test "print fourv%ivla(12)" "no such vector element" "print fourv%ivla(12)"
|
||
|
|
+gdb_test "print fourv%ivar" " = 3.14\\d+?" "print fourv%ivar"
|
||
|
|
+gdb_test "ptype fourv" \
|
||
|
|
+ "type = Type four\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(10\\\)\r\n\\s+real\\\(kind=4\\\) :: ivar\r\nEnd Type four" \
|
||
|
|
+ "ptype fourv"
|
||
|
|
+
|
||
|
|
+# Check VLA of types
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "onevla-filled"]
|
||
|
|
+gdb_continue_to_breakpoint "onevla-filled"
|
||
|
|
+gdb_test "print onevla(2,2)%ivla(3, 6, 9)" \
|
||
|
|
+ " = 369" "print onevla(2,2)%ivla(3, 6, 9)"
|
||
|
|
+gdb_test "print onevla(2,2)%ivla(9, 3, 6)" \
|
||
|
|
+ " = 936" "print onevla(2,2)%ivla(9, 3, 6)"
|
||
|
|
+
|
||
|
|
+# Check nested types containing a VLA
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "fivev-filled"]
|
||
|
|
+gdb_continue_to_breakpoint "fivev-filled"
|
||
|
|
+gdb_test "print fivev%tone%ivla(5, 5, 1)" " = 1" \
|
||
|
|
+ "print fivev%tone%ivla(5, 5, 1)"
|
||
|
|
+gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123" \
|
||
|
|
+ "print fivev%tone%ivla(1, 2, 3)"
|
||
|
|
+gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321" \
|
||
|
|
+ "print fivev%tone%ivla(3, 2, 1)"
|
||
|
|
+gdb_test "ptype fivev" \
|
||
|
|
+ "type = Type five\r\n\\s+Type one\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(10,10,10\\\)\r\n\\s+End Type one :: tone\r\nEnd Type five" \
|
||
|
|
+ "ptype fivev"
|
||
|
|
+
|
||
|
|
+# Check pointer to type, containing a VLA
|
||
|
|
+gdb_breakpoint [gdb_get_line_number "onep-associated"]
|
||
|
|
+gdb_continue_to_breakpoint "onep-associated"
|
||
|
|
+gdb_test "ptype onev" ".*real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\).*" \
|
||
|
|
+ "ptype onev"
|
||
|
|
+gdb_test "ptype onep" ".*real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\).*" \
|
||
|
|
+ "ptype onep"
|
||
|
|
+
|
||
|
|
+gdb_test "print onev%ivla" " = \\( *\\( *\\( *2, *2, *2,\[()2, .\]*\\)" \
|
||
|
|
+ "print onev%ivla"
|
||
|
|
+gdb_test "print onev" " = \\( *\\( *\\( *\\( *2, *2, *2,\[()2, .\]*\\)" \
|
||
|
|
+ "print onev"
|
||
|
|
+gdb_test "print onep" ".*real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\).*" \
|
||
|
|
+ "print onep"
|
||
|
|
+
|
||
|
|
+gdb_test "ptype onev%ivla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \
|
||
|
|
+ "ptype onev%ivla"
|
||
|
|
+gdb_test "ptype onep%ivla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \
|
||
|
|
+ "ptype onep%ivla"
|
||
|
|
+
|
||
|
|
+gdb_test "ptype onev%ivla(1,1,1)" "type = real\\\(kind=4\\\)" \
|
||
|
|
+ "ptype onev%ivla(1,1,1)"
|
||
|
|
+gdb_test "ptype onep%ivla(1,1,1)" "type = real\\\(kind=4\\\)" \
|
||
|
|
+ "ptype onep%ivla(1,1,1)"
|
||
|
|
diff --git a/gdb/testsuite/gdb.fortran/vla-type.f90 b/gdb/testsuite/gdb.fortran/vla-type.f90
|
||
|
|
new file mode 100644
|
||
|
|
index 0000000..06600c9
|
||
|
|
--- /dev/null
|
||
|
|
+++ b/gdb/testsuite/gdb.fortran/vla-type.f90
|
||
|
|
@@ -0,0 +1,107 @@
|
||
|
|
+! Copyright 2014 Free Software Foundation, Inc.
|
||
|
|
+!
|
||
|
|
+! This program is free software; you can redistribute it and/or modify
|
||
|
|
+! it under the terms of the GNU General Public License as published by
|
||
|
|
+! the Free Software Foundation; either version 2 of the License, or
|
||
|
|
+! (at your option) any later version.
|
||
|
|
+!
|
||
|
|
+! This program is distributed in the hope that it will be useful,
|
||
|
|
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
+! GNU General Public License for more details.
|
||
|
|
+!
|
||
|
|
+! You should have received a copy of the GNU General Public License
|
||
|
|
+! along with this program; if not, write to the Free Software
|
||
|
|
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||
|
|
+
|
||
|
|
+program vla_struct
|
||
|
|
+ type :: one
|
||
|
|
+ real, allocatable :: ivla (:, :, :)
|
||
|
|
+ end type one
|
||
|
|
+ type :: two
|
||
|
|
+ real, allocatable :: ivla1 (:, :, :)
|
||
|
|
+ real, allocatable :: ivla2 (:, :)
|
||
|
|
+ end type two
|
||
|
|
+ type :: three
|
||
|
|
+ real :: ivar
|
||
|
|
+ real, allocatable :: ivla (:)
|
||
|
|
+ end type three
|
||
|
|
+ type :: four
|
||
|
|
+ real, allocatable :: ivla (:)
|
||
|
|
+ real :: ivar
|
||
|
|
+ end type four
|
||
|
|
+ type :: five
|
||
|
|
+ type(one) :: tone
|
||
|
|
+ end type five
|
||
|
|
+
|
||
|
|
+ type(one), target :: onev
|
||
|
|
+ type(two) :: twov
|
||
|
|
+ type(three) :: threev
|
||
|
|
+ type(four) :: fourv
|
||
|
|
+ type(five) :: fivev
|
||
|
|
+ type(one), allocatable :: onevla(:, :)
|
||
|
|
+ type(one), pointer :: onep
|
||
|
|
+ logical :: l
|
||
|
|
+ integer :: i, j
|
||
|
|
+
|
||
|
|
+ allocate (onev%ivla (11,22,33)) ! before-allocated
|
||
|
|
+ l = allocated(onev%ivla)
|
||
|
|
+
|
||
|
|
+ onev%ivla(:, :, :) = 1
|
||
|
|
+ onev%ivla(1, 2, 3) = 123
|
||
|
|
+ onev%ivla(3, 2, 1) = 321
|
||
|
|
+
|
||
|
|
+ allocate (twov%ivla1 (5,12,99)) ! onev-filled
|
||
|
|
+ l = allocated(twov%ivla1)
|
||
|
|
+ allocate (twov%ivla2 (9,12))
|
||
|
|
+ l = allocated(twov%ivla2)
|
||
|
|
+
|
||
|
|
+ twov%ivla1(:, :, :) = 1
|
||
|
|
+ twov%ivla1(1, 2, 3) = 123
|
||
|
|
+ twov%ivla1(3, 2, 1) = 321
|
||
|
|
+
|
||
|
|
+ twov%ivla2(:, :) = 1
|
||
|
|
+ twov%ivla2(1, 2) = 12
|
||
|
|
+ twov%ivla2(2, 1) = 21
|
||
|
|
+
|
||
|
|
+ threev%ivar = 3.14 ! twov-filled
|
||
|
|
+ allocate (threev%ivla (20))
|
||
|
|
+ l = allocated(threev%ivla)
|
||
|
|
+
|
||
|
|
+ threev%ivla(:) = 1
|
||
|
|
+ threev%ivla(5) = 42
|
||
|
|
+ threev%ivla(14) = 24
|
||
|
|
+
|
||
|
|
+ allocate (fourv%ivla (10)) ! threev-filled
|
||
|
|
+ l = allocated(fourv%ivla)
|
||
|
|
+
|
||
|
|
+ fourv%ivar = 3.14
|
||
|
|
+ fourv%ivla(:) = 1
|
||
|
|
+ fourv%ivla(2) = 2
|
||
|
|
+ fourv%ivla(7) = 7
|
||
|
|
+
|
||
|
|
+
|
||
|
|
+ allocate (onevla (10, 10)) ! fourv-filled
|
||
|
|
+ do i = 1, 10
|
||
|
|
+ do j = 1, 10
|
||
|
|
+ allocate (onevla(i,j)%ivla(10,10,10))
|
||
|
|
+ l = allocated(onevla(i,j)%ivla)
|
||
|
|
+
|
||
|
|
+ onevla(i,j)%ivla(3, 6, 9) = 369
|
||
|
|
+ onevla(i,j)%ivla(9, 3, 6) = 936
|
||
|
|
+ end do
|
||
|
|
+ end do
|
||
|
|
+
|
||
|
|
+ allocate (fivev%tone%ivla (10, 10, 10)) ! onevla-filled
|
||
|
|
+ l = allocated(fivev%tone%ivla)
|
||
|
|
+ fivev%tone%ivla(:, :, :) = 1
|
||
|
|
+ fivev%tone%ivla(1, 2, 3) = 123
|
||
|
|
+ fivev%tone%ivla(3, 2, 1) = 321
|
||
|
|
+
|
||
|
|
+
|
||
|
|
+ onev%ivla(:,:,:) = 2 ! fivev-filled
|
||
|
|
+ onep => onev
|
||
|
|
+
|
||
|
|
+ ! dummy statement for bp
|
||
|
|
+ l = allocated(fivev%tone%ivla) ! onep-associated
|
||
|
|
+end program vla_struct
|
||
|
|
--
|
||
|
|
1.7.9.5
|
||
|
|
|