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 Sanimir Agovic testsuite/gdb.fortran/: * vla-type.exp: New file. * vla-type.f90: New file. Change-Id: I7c1a381c5cb0ad48872b77993e7c7fdac85bc756 Signed-off-by: Keven Boell --- 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 . + +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" " = \\\( , \\\)" \ + "print twov before allocated" +gdb_test "print twov%ivla1" " = " \ + "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