Subject: [PATCH 12/23] test: basic tests for dynamic array evaluations in Fortran. Message-Id: <1401861266-6240-13-git-send-email-keven.boell@intel.com> Tests ensure that values of Fortran dynamic arrays can be evaluated correctly in various ways and states. 2014-05-28 Keven Boell Sanimir Agovic testsuite/gdb.fortran/: * vla.f90: New file. * vla-value.exp: New file. Change-Id: I0229c3b58f72ae89c2ee42d1219e4538cb6bf023 Signed-off-by: Keven Boell --- gdb/testsuite/gdb.fortran/vla-value.exp | 148 +++++++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++++++++ 2 files changed, 204 insertions(+) create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp new file mode 100644 index 0000000..d7b8a1e --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value.exp @@ -0,0 +1,148 @@ +# 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 "vla.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 +} + +# Try to access values in non allocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = " "print non-allocated vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $hex" \ + "print non-allocated &vla1" +gdb_test "print vla1(1,1,1)" "no such vector element because not allocated" \ + "print member in non-allocated vla1 (1)" +gdb_test "print vla1(101,202,303)" \ + "no such vector element because not allocated" \ + "print member in non-allocated vla1 (2)" +gdb_test "print vla1(5,2,18)=1" "no such vector element because not allocated" \ + "set member in non-allocated vla1" + +# Try to access value in allocated VLA +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+(\\t|\\s)+vla1\\\(3, 6, 9\\\) = 42" \ + "step over value assignment of vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print allocated &vla1" +gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)" +gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)" +gdb_test "print vla1(9, 9, 9) = 999" " = 999" \ + "print allocated vla1(9,9,9)=1" + +# Try to access values in allocated VLA after specific assignment +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1(3, 6, 9)" " = 42" \ + "print allocated vla1(3,6,9) after specific assignment (filled)" +gdb_test "print vla1(1, 3, 8)" " = 1001" \ + "print allocated vla1(1,3,8) after specific assignment (filled)" +gdb_test "print vla1(9, 9, 9)" " = 999" \ + "print allocated vla1(9,9,9) after assignment in debugger (filled)" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_test "print pvla" " = " "print undefined pvla" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $hex" \ + "print non-associated &pvla" +gdb_test "print pvla(1, 3, 8)" "no such vector element because not associated" \ + "print undefined pvla(1,3,8)" + +# Try to access values in pointer to VLA and compare them +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \ + "print associated &pvla" +gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)" +gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)" +gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)" + +# Fill values to VLA using pointer and check +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print pvla(5, 45, 20)" \ + " = 1" "print pvla(5, 45, 20) after filled using pointer" +gdb_test "print vla2(5, 45, 20)" \ + " = 1" "print vla2(5, 45, 20) after filled using pointer" +gdb_test "print pvla(7, 45, 14)" " = 2" \ + "print pvla(7, 45, 14) after filled using pointer" +gdb_test "print vla2(7, 45, 14)" " = 2" \ + "print vla2(7, 45, 14) after filled using pointer" + +# Try to access values of deassociated VLA pointer +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print pvla(5, 45, 20)" \ + "no such vector element because not associated" \ + "print pvla(5, 45, 20) after deassociated" +gdb_test "print pvla(7, 45, 14)" \ + "no such vector element because not associated" \ + "print pvla(7, 45, 14) after dissasociated" +gdb_test "print pvla" " = " \ + "print vla1 after deassociated" + +# Try to access values of deallocated VLA +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print vla1(3, 6, 9)" "no such vector element because not allocated" \ + "print allocated vla1(3,6,9) after specific assignment (deallocated)" +gdb_test "print vla1(1, 3, 8)" "no such vector element because not allocated" \ + "print allocated vla1(1,3,8) after specific assignment (deallocated)" +gdb_test "print vla1(9, 9, 9)" "no such vector element because not allocated" \ + "print allocated vla1(9,9,9) after assignment in debugger (deallocated)" + + +# Try to assign VLA to user variable +clean_restart ${testfile} + +if ![runto MAIN__] then { + perror "couldn't run to breakpoint MAIN__" + continue +} +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "next" "\\d+.*vla1\\(3, 6, 9\\) = 42" "next (1)" + +gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1" +gdb_test "print \$myvar" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print \$myvar set to vla1" + +gdb_test "next" "\\d+.*vla1\\(1, 3, 8\\) = 1001" "next (2)" +gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla" +gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)" + +# deallocate pointer and make sure user defined variable still has the +# right value. +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print \$mypvar(1,3,8)" " = 1001" \ + "print \$mypvar(1,3,8) after deallocated" diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90 new file mode 100644 index 0000000..73425f3 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla.f90 @@ -0,0 +1,56 @@ +! 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 . + +program vla + real, target, allocatable :: vla1 (:, :, :) + real, target, allocatable :: vla2 (:, :, :) + real, target, allocatable :: vla3 (:, :) + real, pointer :: pvla (:, :, :) + logical :: l + + allocate (vla1 (10,10,10)) ! vla1-init + l = allocated(vla1) + + allocate (vla2 (1:7,42:50,13:35)) ! vla1-allocated + l = allocated(vla2) + + vla1(:, :, :) = 1311 ! vla2-allocated + vla1(3, 6, 9) = 42 + vla1(1, 3, 8) = 1001 + vla1(6, 2, 7) = 13 + + vla2(:, :, :) = 1311 ! vla1-filled + vla2(5, 45, 20) = 42 + + pvla => vla1 ! vla2-filled + l = associated(pvla) + + pvla => vla2 ! pvla-associated + l = associated(pvla) + pvla(5, 45, 20) = 1 + pvla(7, 45, 14) = 2 + + pvla => null() ! pvla-re-associated + l = associated(pvla) + + deallocate (vla1) ! pvla-deassociated + l = allocated(vla1) + + deallocate (vla2) ! vla1-deallocated + l = allocated(vla2) + + allocate (vla3 (2,2)) ! vla2-deallocated + vla3(:,:) = 13 +end program vla -- 1.7.9.5