| Message ID | 1435754532-17922-3-git-send-email-keven.boell@intel.com |
|---|---|
| State | New |
| Headers | show |
On Wed, Jul 01, 2015 at 02:42:12PM +0200, Keven Boell wrote: > Add basic test coverage for most dynamic array use-cases > in Fortran. > The commit contains the following tests: > * Ensure that values of Fortran dynamic arrays > can be evaluated correctly in various ways and states. > * Ensure that Fortran primitives can be evaluated > correctly when used as a dynamic array. > * Dynamic arrays passed to subroutines and handled > in different ways inside the routine. > * Ensure that the ptype of dynamic arrays in > Fortran can be printed in GDB correctly. > * Ensure that dynamic arrays in different states > (allocated/associated) can be evaluated. > * Dynamic arrays passed to functions and returned from > functions. > * History values of dynamic arrays can be accessed and > printed again with the correct values. > * Dynamic array evaluations using MI protocol. > * Sizeof output of dynamic arrays in various states. > > 2015-03-13 Keven Boell <keven.boell@intel.com> > Sanimir Agovic <sanimir.agovic@intel.com> > > testsuite/gdb.fortran: > > * vla-alloc-assoc.exp: New file. > * vla-datatypes.exp: New file. > * vla-datatypes.f90: New file. > * vla-history.exp: New file. > * vla-ptype-sub.exp: New file. > * vla-ptype.exp: New file. > * vla-sizeof.exp: New file. > * vla-sub.f90: New file. > * vla-value-sub-arbitrary.exp: New file. > * vla-value-sub-finish.exp: New file. > * vla-value-sub.exp: New file. > * vla-value.exp: New file. > * vla-ptr-info.exp: New file. > * vla.f90: New file. > > testsuite/gdb.mi: > > * mi-vla-fortran.exp: New file. > * vla.f90: New file. I only quickly scanned this patch, as it's really huge (huge is good, in this case). One general comment is that we avoid re-using the same code for each test. See: https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Make_sure_test_executables_are_unique Even if all testcases end up using the same code, I suggest making one source file for each testcase, and naming the source file the same as the .exp files (modulo the extension, of course). That's a fairly standard practice that makes it easier to associate testcase and code. > --- > gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ > gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ > gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ > gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ > gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ > gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ > gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ > gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ > gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ > .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ > gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ > gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ > gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ > gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ > gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 ++++++++++++++++++++ > gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ > 16 files changed, 1205 insertions(+) > create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 > create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 > create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp > create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 > create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp > create mode 100644 gdb/testsuite/gdb.mi/vla.f90 > > diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > new file mode 100644 > index 0000000..542b65c > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp > @@ -0,0 +1,65 @@ > +# Copyright 2015 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 "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 > +} Let's try to standardize a bit on how we write testcases. We have a "cookbook" for testcases at... https://sourceware.org/gdb/wiki/GDBTestcaseCookbook ... and it shows how to handle runto failures: untested "could not run to main" return -1 > + > +# Check the association status of various types of VLA's > +# and pointer to VLA's. > +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] > +gdb_continue_to_breakpoint "vla1-allocated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print vla1 allocation status (allocated)" > + > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print vla2 allocation status (allocated)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print pvla associated status (associated)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] > +gdb_continue_to_breakpoint "pvla-re-associated" > +gdb_test "print l" " = \\.TRUE\\." \ > + "print pvla associated status (re-associated)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] > +gdb_continue_to_breakpoint "pvla-deassociated" > +gdb_test "print l" " = \\.FALSE\\." \ > + "print pvla allocation status (deassociated)" > + > +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] > +gdb_continue_to_breakpoint "vla1-deallocated" > +gdb_test "print l" " = \\.FALSE\\." \ > + "print vla1 allocation status (deallocated)" > +gdb_test "print vla1" " = <not allocated>" \ > + "print deallocated vla1" > + > +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] > +gdb_continue_to_breakpoint "vla2-deallocated" > +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated" > +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2" > diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp > new file mode 100644 > index 0000000..a61cb70 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp > @@ -0,0 +1,82 @@ > +# Copyright 2015 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 > +} > + > +# check that all fortran standard datatypes will be > +# handled correctly when using as VLA's > + > +if ![runto MAIN__] then { > + perror "couldn't run to breakpoint MAIN__" > + continue > +} Same as above. > + > +gdb_breakpoint [gdb_get_line_number "vlas-allocated"] > +gdb_continue_to_breakpoint "vlas-allocated" > +gdb_test "next" " = allocated\\\(realvla\\\)" \ > + "next to allocation status of intvla" > +gdb_test "print l" " = \\.TRUE\\." "intvla allocated" > +gdb_test "next" " = allocated\\\(complexvla\\\)" \ > + "next to allocation status of realvla" > +gdb_test "print l" " = \\.TRUE\\." "realvla allocated" > +gdb_test "next" " = allocated\\\(logicalvla\\\)" \ > + "next to allocation status of complexvla" > +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" > +gdb_test "next" " = allocated\\\(charactervla\\\)" \ > + "next to allocation status of logicalvla" > +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" > +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ > + "next to allocation status of charactervla" > +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" > + > +gdb_breakpoint [gdb_get_line_number "vlas-initialized"] > +gdb_continue_to_breakpoint "vlas-initialized" > +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \ > + "ptype intvla" > +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ > + "ptype realvla" > +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \ > + "ptype complexvla" > +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \ > + "ptype logicalvla" > +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \ > + "ptype charactervla" > + > +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" > +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ > + "print realvla(5,5,5) (1st)" > +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ > + "print complexvla(5,5,5) (1st)" > +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ > + "print logicalvla(5,5,5) (1st)" > +gdb_test "print charactervla(5,5,5)" " = 'K'" \ > + "print charactervla(5,5,5) (1st)" > + > +gdb_breakpoint [gdb_get_line_number "vlas-modified"] > +gdb_continue_to_breakpoint "vlas-modified" > +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" > +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ > + "print realvla(5,5,5) (2nd)" > +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ > + "print complexvla(5,5,5) (2nd)" > +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ > + "print logicalvla(5,5,5) (2nd)" > +gdb_test "print charactervla(5,5,5)" " = 'X'" \ > + "print charactervla(5,5,5) (2nd)" > diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 > new file mode 100644 > index 0000000..db25695 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 > @@ -0,0 +1,51 @@ > +! Copyright 2015 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_primitives > + integer, allocatable :: intvla(:, :, :) > + real, allocatable :: realvla(:, :, :) > + complex, allocatable :: complexvla(:, :, :) > + logical, allocatable :: logicalvla(:, :, :) > + character, allocatable :: charactervla(:, :, :) > + logical :: l > + > + allocate (intvla (11,22,33)) > + allocate (realvla (11,22,33)) > + allocate (complexvla (11,22,33)) > + allocate (logicalvla (11,22,33)) > + allocate (charactervla (11,22,33)) > + > + l = allocated(intvla) ! vlas-allocated > + l = allocated(realvla) > + l = allocated(complexvla) > + l = allocated(logicalvla) > + l = allocated(charactervla) > + > + intvla(:,:,:) = 1 > + realvla(:,:,:) = 3.14 > + complexvla(:,:,:) = cmplx(2.0,-3.0) > + logicalvla(:,:,:) = .TRUE. > + charactervla(:,:,:) = char(75) > + > + intvla(5,5,5) = 42 ! vlas-initialized > + realvla(5,5,5) = 4.13 > + complexvla(5,5,5) = cmplx(-3.0,2.0) > + logicalvla(5,5,5) = .FALSE. > + charactervla(5,5,5) = 'X' > + > + ! dummy statement for bp > + l = .FALSE. ! vlas-modified > +end program vla_primitives > diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp > new file mode 100644 > index 0000000..d56519c > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-history.exp > @@ -0,0 +1,62 @@ > +# Copyright 2015 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 "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 > +} Same as above. > + > +# Set some breakpoints and print complete vla. > +gdb_breakpoint [gdb_get_line_number "vla1-init"] > +gdb_continue_to_breakpoint "vla1-init" > +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" > + > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print vla1 allocated" > +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print vla2 allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla1-filled"] > +gdb_continue_to_breakpoint "vla1-filled" > +gdb_test "print vla1" \ > + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ > + "print vla1 filled" > + > +# Try to access history values for full vla prints. > +gdb_test "print \$1" " = <not allocated>" "print \$1" > +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print \$2" > +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ > + "print \$3" > +gdb_test "print \$4" \ > + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4" > + > +gdb_breakpoint [gdb_get_line_number "vla2-filled"] > +gdb_continue_to_breakpoint "vla2-filled" > +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)" > +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)" > + > +# Try to access history values for vla values. > +gdb_test "print \$9" " = 1311" "print \$9" > +gdb_test "print \$10" " = 1001" "print \$10" > diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp > new file mode 100644 > index 0000000..b2d8f00 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp > @@ -0,0 +1,32 @@ > +# Copyright 2015 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 "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 Same remark as above. > +} > + > +# Check the status of a pointer to a dynamic array. > +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 pvla pointer information" > diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp > new file mode 100644 > index 0000000..98fd663 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp > @@ -0,0 +1,87 @@ > +# Copyright 2015 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 "vla-sub.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 > +} Same as above. > + > +# Pass fixed array to function and handle them as vla in function. > +gdb_breakpoint [gdb_get_line_number "not-filled"] > +gdb_continue_to_breakpoint "not-filled (1st)" > +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \ > + "ptype array1 (passed fixed)" > +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \ > + "ptype array2 (passed fixed)" > +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(40, 10) (passed fixed)" > +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \ > + "ptype array2(13, 11, 5) (passed fixed)" > + > +# Pass sub arrays to function and handle them as vla in function. > +gdb_continue_to_breakpoint "not-filled (2nd)" > +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \ > + "ptype array1 (passed sub-array)" > +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \ > + "ptype array2 (passed sub-array)" > +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(3, 3) (passed sub-array)" > +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ > + "ptype array2(4, 4, 4) (passed sub-array)" > + > +# Check ptype outside of bounds. This should not crash GDB. Missing second space after a period. > +gdb_test "ptype array1(100, 100)" "no such vector element" \ > + "ptype array1(100, 100) subarray do not crash (passed sub-array)" > +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ > + "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)" > + > +# Pass vla to function. > +gdb_continue_to_breakpoint "not-filled (3rd)" > +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \ > + "ptype array1 (passed vla)" > +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype array2 (passed vla)" > +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(3, 3) (passed vla)" > +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ > + "ptype array2(4, 4, 4) (passed vla)" > + > +# Check ptype outside of bounds. This should not crash GDB. Same here. > +gdb_test "ptype array1(100, 100)" "no such vector element" \ > + "ptype array1(100, 100) VLA do not crash (passed vla)" > +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ > + "ptype array2(100, 100, 100) VLA do not crash (passed vla)" > + > +# Pass fixed array to function and handle it as VLA of arbitrary length in > +# function. > +gdb_breakpoint [gdb_get_line_number "end-of-bar"] > +gdb_continue_to_breakpoint "end-of-bar" > +gdb_test "ptype array1" \ > + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \ > + "ptype array1 (arbitrary length)" > +gdb_test "ptype array2" \ > + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \ > + "ptype array2 (arbitrary length)" > +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \ > + "ptype array1(100) (arbitrary length)" > +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \ > + "ptype array2(4,100) (arbitrary length)" > diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp > new file mode 100644 > index 0000000..cd47bbe > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp > @@ -0,0 +1,96 @@ > +# Copyright 2015 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 "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 Same remark as before. > +} > + > +# Check the ptype of various VLA states and pointer to VLA's. > +gdb_breakpoint [gdb_get_line_number "vla1-init"] > +gdb_continue_to_breakpoint "vla1-init" > +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" > +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" > +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" > +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \ > + "ptype vla1(3, 6, 9) not initialized" > +gdb_test "ptype vla2(5, 45, 20)" \ > + "no such vector element because not allocated" \ > + "ptype vla1(5, 45, 20) not initialized" > + > +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] > +gdb_continue_to_breakpoint "vla1-allocated" > +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype vla1 allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] > +gdb_continue_to_breakpoint "vla2-allocated" > +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ > + "ptype vla2 allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla1-filled"] > +gdb_continue_to_breakpoint "vla1-filled" > +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype vla1 filled" > +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \ > + "ptype vla1(3, 6, 9)" > + > +gdb_breakpoint [gdb_get_line_number "vla2-filled"] > +gdb_continue_to_breakpoint "vla2-filled" > +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ > + "ptype vla2 filled" > +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ > + "ptype vla1(5, 45, 20) filled" > + > +gdb_breakpoint [gdb_get_line_number "pvla-associated"] > +gdb_continue_to_breakpoint "pvla-associated" > +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ > + "ptype pvla associated" > +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \ > + "ptype pvla(3, 6, 9)" > + > +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] > +gdb_continue_to_breakpoint "pvla-re-associated" > +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ > + "ptype pvla re-associated" > +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ > + "ptype vla1(5, 45, 20) re-associated" > + > +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] > +gdb_continue_to_breakpoint "pvla-deassociated" > +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" > +gdb_test "ptype pvla(5, 45, 20)" \ > + "no such vector element because not associated" \ > + "ptype pvla(5, 45, 20) not associated" > + > +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] > +gdb_continue_to_breakpoint "vla1-deallocated" > +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" > +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \ > + "ptype vla1(3, 6, 9) not allocated" > + > +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] > +gdb_continue_to_breakpoint "vla2-deallocated" > +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" > +gdb_test "ptype vla2(5, 45, 20)" \ > + "no such vector element because not allocated" \ > + "ptype vla2(5, 45, 20) not allocated" > diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp > new file mode 100644 > index 0000000..8281425 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp > @@ -0,0 +1,46 @@ > +# Copyright 2015 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 "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 Same remark as before. > +} > + > +# 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 sizeof(vla1)" " = 0" "print sizeof 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 "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" > + > +# Try to access values in undefined pointer to VLA (dangling) > +gdb_breakpoint [gdb_get_line_number "vla1-filled"] > +gdb_continue_to_breakpoint "vla1-filled" > +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" > + > +# 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 sizeof(pvla)" " = 4000" "print sizeof associated pvla" > diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90 > new file mode 100644 > index 0000000..dfda411 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-sub.f90 > @@ -0,0 +1,82 @@ > +! Copyright 2015 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. > +! > +! Original file written by Jakub Jelinek <jakub@redhat.com> and > +! Jan Kratochvil <jan.kratochvil@redhat.com>. > +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>. > + > +subroutine foo (array1, array2) > + integer :: array1 (:, :) > + real :: array2 (:, :, :) > + > + array1(:,:) = 5 ! not-filled > + array1(1, 1) = 30 > + > + array2(:,:,:) = 6 ! array1-filled > + array2(:,:,:) = 3 > + array2(1,1,1) = 30 > + array2(3,3,3) = 90 ! array2-almost-filled > +end subroutine > + > +subroutine bar (array1, array2) > + integer :: array1 (*) > + integer :: array2 (4:9, 10:*) > + > + array1(5:10) = 1311 > + array1(7) = 1 > + array1(100) = 100 > + array2(4,10) = array1(7) > + array2(4,100) = array1(7) > + return ! end-of-bar > +end subroutine > + > +program vla_sub > + interface > + subroutine foo (array1, array2) > + integer :: array1 (:, :) > + real :: array2 (:, :, :) > + end subroutine > + end interface > + interface > + subroutine bar (array1, array2) > + integer :: array1 (*) > + integer :: array2 (4:9, 10:*) > + end subroutine > + end interface > + > + real, allocatable :: vla1 (:, :, :) > + integer, allocatable :: vla2 (:, :) > + > + ! used for subroutine > + integer :: sub_arr1(42, 42) > + real :: sub_arr2(42, 42, 42) > + integer :: sub_arr3(42) > + > + sub_arr1(:,:) = 1 ! vla2-deallocated > + sub_arr2(:,:,:) = 2 > + sub_arr3(:) = 3 > + > + call foo(sub_arr1, sub_arr2) > + call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15)) > + > + allocate (vla1 (10,10,10)) > + allocate (vla2 (20,20)) > + vla1(:,:,:) = 1311 > + vla2(:,:) = 42 > + call foo(vla2, vla1) > + > + call bar(sub_arr3, sub_arr1) > +end program vla_sub > diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp > new file mode 100644 > index 0000000..88defda > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp > @@ -0,0 +1,35 @@ > +# Copyright 2015 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 "vla-sub.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 Same remark as before. > +} > + > +# Check VLA with arbitary length and check that elements outside of > +# bounds of the passed VLA can be accessed correctly. > +gdb_breakpoint [gdb_get_line_number "end-of-bar"] > +gdb_continue_to_breakpoint "end-of-bar" > +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)" > +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)" > +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)" > +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)" > diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp > new file mode 100644 > index 0000000..6738875 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp > @@ -0,0 +1,49 @@ > +# Copyright 2015 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 "vla-sub.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 > +} Same Remark as before. > + > +# "up" works with GCC but other Fortran compilers may copy the values into the > +# outer function only on the exit of the inner function. > +# We need both variants as depending on the arch we optionally may still be > +# executing the caller line or not after `finish'. > + > +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] > +gdb_continue_to_breakpoint "array2-almost-filled" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger" > + > +gdb_test "finish" \ > + ".*(foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)|foo \\\(array1=..., array2=...\\\).*)" \ > + "finish function" > +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish" > +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish" > +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish" > +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish" > + > diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp > new file mode 100644 > index 0000000..de88333 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp > @@ -0,0 +1,90 @@ > +# Copyright 2015 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 "vla-sub.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 > +} Same remark as before. > + > +# Check the values of VLA's in subroutine can be evaluated correctly > + > +# Try to access values from a fixed array handled as VLA in subroutine. > +gdb_breakpoint [gdb_get_line_number "not-filled"] > +gdb_continue_to_breakpoint "not-filled (1st)" > +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \ > + "print passed array1 in foo (passed fixed array)" > + > +gdb_breakpoint [gdb_get_line_number "array1-filled"] > +gdb_continue_to_breakpoint "array1-filled (1st)" > +gdb_test "print array1(5, 7)" " = 5" \ > + "print array1(5, 7) after filled in foo (passed fixed array)" > +gdb_test "print array1(1, 1)" " = 30" \ > + "print array1(1, 1) after filled in foo (passed fixed array)" > + > +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] > +gdb_continue_to_breakpoint "array2-almost-filled (1st)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled (passed fixed array)" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine (passed fixed array)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger (passed fixed array)" > + > + > +# Try to access values from a fixed sub-array handled as VLA in subroutine. > +gdb_continue_to_breakpoint "not-filled (2nd)" > +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \ > + "print passed array1 in foo (passed sub-array)" > + > +gdb_continue_to_breakpoint "array1-filled (2nd)" > +gdb_test "print array1(5, 5)" " = 5" \ > + "print array1(5, 5) after filled in foo (passed sub-array)" > +gdb_test "print array1(1, 1)" " = 30" \ > + "print array1(1, 1) after filled in foo (passed sub-array)" > + > +gdb_continue_to_breakpoint "array2-almost-filled (2nd)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled (passed sub-array)" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine (passed sub-array)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger (passed sub-array)" > + > + > +# Try to access values from a VLA passed to subroutine. > +gdb_continue_to_breakpoint "not-filled (3rd)" > +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \ > + "print passed array1 in foo (passed vla)" > + > +gdb_continue_to_breakpoint "array1-filled (3rd)" > +gdb_test "print array1(5, 5)" " = 5" \ > + "print array1(5, 5) after filled in foo (passed vla)" > +gdb_test "print array1(1, 1)" " = 30" \ > + "print array1(1, 1) after filled in foo (passed vla)" > + > +gdb_continue_to_breakpoint "array2-almost-filled (3rd)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was filled (passed vla)" > +gdb_test "print array2(2,1,1)=20" " = 20" \ > + "set array(2,2,2) to 20 in subroutine (passed vla)" > +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ > + "print array2 in foo after it was mofified in debugger (passed vla)" > diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp > new file mode 100644 > index 0000000..6ea1eff > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla-value.exp > @@ -0,0 +1,148 @@ > +# Copyright 2015 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 "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 > +} Same remark as before. > + > +# 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" " = <not allocated>" "print non-allocated vla1" > +gdb_test "print &vla1" \ > + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $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" " = <not associated>" "print undefined pvla" > +gdb_test "print &pvla" \ > + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $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" " = <not associated>" \ > + "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..61e22b9 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/vla.f90 > @@ -0,0 +1,56 @@ > +! Copyright 2015 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/>. > + > +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 > diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp > new file mode 100644 > index 0000000..d191623 > --- /dev/null > +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp > @@ -0,0 +1,182 @@ > +# Copyright 2015 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/>. > + > +# Verify that, using the MI, we can evaluate a simple C Variable Length > +# Array (VLA). > + > +load_lib mi-support.exp > +set MIFLAGS "-i=mi" > + > +gdb_exit > +if [mi_gdb_start] { > + continue > +} > + > +standard_testfile vla.f90 > + > +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \ > + {debug f90}] != "" } { > + untested mi-vla-fortran.exp > + return -1 > +} > + > +mi_delete_breakpoints > +mi_gdb_reinitialize_dir $srcdir/$subdir > +mi_gdb_load ${binfile} > + > +set bp_lineno [gdb_get_line_number "vla1-not-allocated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \ > + ".*vla.f90" $bp_lineno $hex \ > + "insert breakpoint at line $bp_lineno (vla not allocated)" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "500-data-evaluate-expression vla1" \ > + "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" > + > +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ > + "create local variable vla1_not_allocated" > +mi_gdb_test "501-var-info-type vla1_not_allocated" \ > + "501\\^done,type=\"<not allocated>\"" \ > + "info type variable vla1_not_allocated" > +mi_gdb_test "502-var-show-format vla1_not_allocated" \ > + "502\\^done,format=\"natural\"" \ > + "show format variable vla1_not_allocated" > +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \ > + "503\\^done,value=\"\\\[0\\\]\"" \ > + "eval variable vla1_not_allocated" > +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ > + "real\\\(kind=4\\\)" "get children of vla1_not_allocated" > + > + > + > +set bp_lineno [gdb_get_line_number "vla1-allocated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "510-data-evaluate-expression vla1" \ > + "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla" > + > +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ > + "create local variable vla1_allocated" > +mi_gdb_test "511-var-info-type vla1_allocated" \ > + "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ > + "info type variable vla1_allocated" > +mi_gdb_test "512-var-show-format vla1_allocated" \ > + "512\\^done,format=\"natural\"" \ > + "show format variable vla1_allocated" > +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \ > + "513\\^done,value=\"\\\[5\\\]\"" \ > + "eval variable vla1_allocated" > +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ > + "real\\\(kind=4\\\)" "get children of vla1_allocated" > + > + > +set bp_lineno [gdb_get_line_number "vla1-filled"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "520-data-evaluate-expression vla1" \ > + "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla" > + > + > +set bp_lineno [gdb_get_line_number "vla1-modified"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "530-data-evaluate-expression vla1" \ > + "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla" > +mi_gdb_test "540-data-evaluate-expression vla1(1)" \ > + "540\\^done,value=\"1\"" "evaluate filled vla" > +mi_gdb_test "550-data-evaluate-expression vla1(2)" \ > + "550\\^done,value=\"42\"" "evaluate filled vla" > +mi_gdb_test "560-data-evaluate-expression vla1(4)" \ > + "560\\^done,value=\"24\"" "evaluate filled vla" > + > + > +set bp_lineno [gdb_get_line_number "vla1-deallocated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "570-data-evaluate-expression vla1" \ > + "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" > + > + > +set bp_lineno [gdb_get_line_number "pvla2-not-associated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "580-data-evaluate-expression pvla2" \ > + "580\\^done,value=\"<not associated>\"" "evaluate not associated vla" > + > +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ > + "create local variable pvla2_not_associated" > +mi_gdb_test "581-var-info-type pvla2_not_associated" \ > + "581\\^done,type=\"<not associated>\"" \ > + "info type variable pvla2_not_associated" > +mi_gdb_test "582-var-show-format pvla2_not_associated" \ > + "582\\^done,format=\"natural\"" \ > + "show format variable pvla2_not_associated" > +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \ > + "583\\^done,value=\"\\\[0\\\]\"" \ > + "eval variable pvla2_not_associated" > +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ > + "real\\\(kind=4\\\)" "get children of pvla2_not_associated" > + > + > +set bp_lineno [gdb_get_line_number "pvla2-associated"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "590-data-evaluate-expression pvla2" \ > + "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \ > + "evaluate associated vla" > + > +mi_create_varobj_checked pvla2_associated pvla2 \ > + "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" > +mi_gdb_test "591-var-info-type pvla2_associated" \ > + "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ > + "info type variable pvla2_associated" > +mi_gdb_test "592-var-show-format pvla2_associated" \ > + "592\\^done,format=\"natural\"" \ > + "show format variable pvla2_associated" > +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \ > + "593\\^done,value=\"\\\[2\\\]\"" \ > + "eval variable pvla2_associated" > + > + > +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"] > +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \ > + $bp_lineno $hex "insert breakpoint at line $bp_lineno" > +mi_run_cmd > +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ > + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" > +mi_gdb_test "600-data-evaluate-expression pvla2" \ > + "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null" > + > +mi_gdb_exit > +return 0 > diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90 > new file mode 100644 > index 0000000..0b89d34 > --- /dev/null > +++ b/gdb/testsuite/gdb.mi/vla.f90 > @@ -0,0 +1,42 @@ > +! Copyright 2015 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/>. > + > +program vla > + real, allocatable :: vla1 (:) > + real, target, allocatable :: vla2(:, :) > + real, pointer :: pvla2 (:, :) > + logical :: l > + > + allocate (vla1 (5)) ! vla1-not-allocated > + l = allocated(vla1) ! vla1-allocated > + > + vla1(:) = 1 > + vla1(2) = 42 ! vla1-filled > + vla1(4) = 24 > + > + deallocate (vla1) ! vla1-modified > + l = allocated(vla1) ! vla1-deallocated > + > + allocate (vla2 (5, 2)) > + vla2(:, :) = 2 > + > + pvla2 => vla2 ! pvla2-not-associated > + l = associated(pvla2) ! pvla2-associated > + > + pvla2(2, 1) = 42 > + > + pvla2 => null() > + l = associated(pvla2) ! pvla2-set-to-null > +end program vla > -- > 1.7.9.5
On 21.07.2015 20:19, Joel Brobecker wrote: > On Wed, Jul 01, 2015 at 02:42:12PM +0200, Keven Boell wrote: >> Add basic test coverage for most dynamic array use-cases >> in Fortran. >> The commit contains the following tests: >> * Ensure that values of Fortran dynamic arrays >> can be evaluated correctly in various ways and states. >> * Ensure that Fortran primitives can be evaluated >> correctly when used as a dynamic array. >> * Dynamic arrays passed to subroutines and handled >> in different ways inside the routine. >> * Ensure that the ptype of dynamic arrays in >> Fortran can be printed in GDB correctly. >> * Ensure that dynamic arrays in different states >> (allocated/associated) can be evaluated. >> * Dynamic arrays passed to functions and returned from >> functions. >> * History values of dynamic arrays can be accessed and >> printed again with the correct values. >> * Dynamic array evaluations using MI protocol. >> * Sizeof output of dynamic arrays in various states. >> >> 2015-03-13 Keven Boell <keven.boell@intel.com> >> Sanimir Agovic <sanimir.agovic@intel.com> >> >> testsuite/gdb.fortran: >> >> * vla-alloc-assoc.exp: New file. >> * vla-datatypes.exp: New file. >> * vla-datatypes.f90: New file. >> * vla-history.exp: New file. >> * vla-ptype-sub.exp: New file. >> * vla-ptype.exp: New file. >> * vla-sizeof.exp: New file. >> * vla-sub.f90: New file. >> * vla-value-sub-arbitrary.exp: New file. >> * vla-value-sub-finish.exp: New file. >> * vla-value-sub.exp: New file. >> * vla-value.exp: New file. >> * vla-ptr-info.exp: New file. >> * vla.f90: New file. >> >> testsuite/gdb.mi: >> >> * mi-vla-fortran.exp: New file. >> * vla.f90: New file. > > I only quickly scanned this patch, as it's really huge (huge > is good, in this case). > > One general comment is that we avoid re-using the same code > for each test. See: https://sourceware.org/gdb/wiki/GDBTestcaseCookbook#Make_sure_test_executables_are_unique > > Even if all testcases end up using the same code, I suggest > making one source file for each testcase, and naming the source > file the same as the .exp files (modulo the extension, of course). > That's a fairly standard practice that makes it easier to associate > testcase and code. > The chapter you refered to on the Testcase Cookbook page says the opposite: "[...] but if for some reason a new test reuses the sources of another existing test, the new test shall compile to its own executable [...]" This is exactly what I'm doing here. I would like to avoid code duplications as much as possible. > >> --- >> gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ >> gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ >> gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ >> gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ >> gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ >> gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ >> gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ >> gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ >> gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ >> .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ >> gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ >> gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ >> gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ >> gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ >> gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 ++++++++++++++++++++ >> gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ >> 16 files changed, 1205 insertions(+) >> create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 >> create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 >> create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp >> create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 >> create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp >> create mode 100644 gdb/testsuite/gdb.mi/vla.f90 >> >> diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp >> new file mode 100644 >> index 0000000..542b65c >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp >> @@ -0,0 +1,65 @@ >> +# Copyright 2015 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 "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 >> +} > > Let's try to standardize a bit on how we write testcases. We have > a "cookbook" for testcases at... > > https://sourceware.org/gdb/wiki/GDBTestcaseCookbook > > ... and it shows how to handle runto failures: > > untested "could not run to main" > return -1 > > Done. > >> + >> +# Check the association status of various types of VLA's >> +# and pointer to VLA's. >> +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] >> +gdb_continue_to_breakpoint "vla1-allocated" >> +gdb_test "print l" " = \\.TRUE\\." \ >> + "print vla1 allocation status (allocated)" >> + >> +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] >> +gdb_continue_to_breakpoint "vla2-allocated" >> +gdb_test "print l" " = \\.TRUE\\." \ >> + "print vla2 allocation status (allocated)" >> + >> +gdb_breakpoint [gdb_get_line_number "pvla-associated"] >> +gdb_continue_to_breakpoint "pvla-associated" >> +gdb_test "print l" " = \\.TRUE\\." \ >> + "print pvla associated status (associated)" >> + >> +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] >> +gdb_continue_to_breakpoint "pvla-re-associated" >> +gdb_test "print l" " = \\.TRUE\\." \ >> + "print pvla associated status (re-associated)" >> + >> +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] >> +gdb_continue_to_breakpoint "pvla-deassociated" >> +gdb_test "print l" " = \\.FALSE\\." \ >> + "print pvla allocation status (deassociated)" >> + >> +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] >> +gdb_continue_to_breakpoint "vla1-deallocated" >> +gdb_test "print l" " = \\.FALSE\\." \ >> + "print vla1 allocation status (deallocated)" >> +gdb_test "print vla1" " = <not allocated>" \ >> + "print deallocated vla1" >> + >> +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] >> +gdb_continue_to_breakpoint "vla2-deallocated" >> +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated" >> +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2" >> diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp >> new file mode 100644 >> index 0000000..a61cb70 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp >> @@ -0,0 +1,82 @@ >> +# Copyright 2015 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 >> +} >> + >> +# check that all fortran standard datatypes will be >> +# handled correctly when using as VLA's >> + >> +if ![runto MAIN__] then { >> + perror "couldn't run to breakpoint MAIN__" >> + continue >> +} > > Same as above. Done. > >> + >> +gdb_breakpoint [gdb_get_line_number "vlas-allocated"] >> +gdb_continue_to_breakpoint "vlas-allocated" >> +gdb_test "next" " = allocated\\\(realvla\\\)" \ >> + "next to allocation status of intvla" >> +gdb_test "print l" " = \\.TRUE\\." "intvla allocated" >> +gdb_test "next" " = allocated\\\(complexvla\\\)" \ >> + "next to allocation status of realvla" >> +gdb_test "print l" " = \\.TRUE\\." "realvla allocated" >> +gdb_test "next" " = allocated\\\(logicalvla\\\)" \ >> + "next to allocation status of complexvla" >> +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" >> +gdb_test "next" " = allocated\\\(charactervla\\\)" \ >> + "next to allocation status of logicalvla" >> +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" >> +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ >> + "next to allocation status of charactervla" >> +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" >> + >> +gdb_breakpoint [gdb_get_line_number "vlas-initialized"] >> +gdb_continue_to_breakpoint "vlas-initialized" >> +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \ >> + "ptype intvla" >> +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ >> + "ptype realvla" >> +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \ >> + "ptype complexvla" >> +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \ >> + "ptype logicalvla" >> +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \ >> + "ptype charactervla" >> + >> +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" >> +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ >> + "print realvla(5,5,5) (1st)" >> +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ >> + "print complexvla(5,5,5) (1st)" >> +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ >> + "print logicalvla(5,5,5) (1st)" >> +gdb_test "print charactervla(5,5,5)" " = 'K'" \ >> + "print charactervla(5,5,5) (1st)" >> + >> +gdb_breakpoint [gdb_get_line_number "vlas-modified"] >> +gdb_continue_to_breakpoint "vlas-modified" >> +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" >> +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ >> + "print realvla(5,5,5) (2nd)" >> +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ >> + "print complexvla(5,5,5) (2nd)" >> +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ >> + "print logicalvla(5,5,5) (2nd)" >> +gdb_test "print charactervla(5,5,5)" " = 'X'" \ >> + "print charactervla(5,5,5) (2nd)" >> diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 >> new file mode 100644 >> index 0000000..db25695 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 >> @@ -0,0 +1,51 @@ >> +! Copyright 2015 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_primitives >> + integer, allocatable :: intvla(:, :, :) >> + real, allocatable :: realvla(:, :, :) >> + complex, allocatable :: complexvla(:, :, :) >> + logical, allocatable :: logicalvla(:, :, :) >> + character, allocatable :: charactervla(:, :, :) >> + logical :: l >> + >> + allocate (intvla (11,22,33)) >> + allocate (realvla (11,22,33)) >> + allocate (complexvla (11,22,33)) >> + allocate (logicalvla (11,22,33)) >> + allocate (charactervla (11,22,33)) >> + >> + l = allocated(intvla) ! vlas-allocated >> + l = allocated(realvla) >> + l = allocated(complexvla) >> + l = allocated(logicalvla) >> + l = allocated(charactervla) >> + >> + intvla(:,:,:) = 1 >> + realvla(:,:,:) = 3.14 >> + complexvla(:,:,:) = cmplx(2.0,-3.0) >> + logicalvla(:,:,:) = .TRUE. >> + charactervla(:,:,:) = char(75) >> + >> + intvla(5,5,5) = 42 ! vlas-initialized >> + realvla(5,5,5) = 4.13 >> + complexvla(5,5,5) = cmplx(-3.0,2.0) >> + logicalvla(5,5,5) = .FALSE. >> + charactervla(5,5,5) = 'X' >> + >> + ! dummy statement for bp >> + l = .FALSE. ! vlas-modified >> +end program vla_primitives >> diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp >> new file mode 100644 >> index 0000000..d56519c >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-history.exp >> @@ -0,0 +1,62 @@ >> +# Copyright 2015 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 "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 >> +} > > Same as above. Done. > >> + >> +# Set some breakpoints and print complete vla. >> +gdb_breakpoint [gdb_get_line_number "vla1-init"] >> +gdb_continue_to_breakpoint "vla1-init" >> +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" >> + >> +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] >> +gdb_continue_to_breakpoint "vla2-allocated" >> +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ >> + "print vla1 allocated" >> +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ >> + "print vla2 allocated" >> + >> +gdb_breakpoint [gdb_get_line_number "vla1-filled"] >> +gdb_continue_to_breakpoint "vla1-filled" >> +gdb_test "print vla1" \ >> + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ >> + "print vla1 filled" >> + >> +# Try to access history values for full vla prints. >> +gdb_test "print \$1" " = <not allocated>" "print \$1" >> +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ >> + "print \$2" >> +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ >> + "print \$3" >> +gdb_test "print \$4" \ >> + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4" >> + >> +gdb_breakpoint [gdb_get_line_number "vla2-filled"] >> +gdb_continue_to_breakpoint "vla2-filled" >> +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)" >> +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)" >> + >> +# Try to access history values for vla values. >> +gdb_test "print \$9" " = 1311" "print \$9" >> +gdb_test "print \$10" " = 1001" "print \$10" >> diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp >> new file mode 100644 >> index 0000000..b2d8f00 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp >> @@ -0,0 +1,32 @@ >> +# Copyright 2015 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 "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 > > Same remark as above. Done. > >> +} >> + >> +# Check the status of a pointer to a dynamic array. >> +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 pvla pointer information" >> diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp >> new file mode 100644 >> index 0000000..98fd663 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp >> @@ -0,0 +1,87 @@ >> +# Copyright 2015 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 "vla-sub.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 >> +} > > Same as above. Done. > >> + >> +# Pass fixed array to function and handle them as vla in function. >> +gdb_breakpoint [gdb_get_line_number "not-filled"] >> +gdb_continue_to_breakpoint "not-filled (1st)" >> +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \ >> + "ptype array1 (passed fixed)" >> +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \ >> + "ptype array2 (passed fixed)" >> +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \ >> + "ptype array1(40, 10) (passed fixed)" >> +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \ >> + "ptype array2(13, 11, 5) (passed fixed)" >> + >> +# Pass sub arrays to function and handle them as vla in function. >> +gdb_continue_to_breakpoint "not-filled (2nd)" >> +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \ >> + "ptype array1 (passed sub-array)" >> +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \ >> + "ptype array2 (passed sub-array)" >> +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ >> + "ptype array1(3, 3) (passed sub-array)" >> +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ >> + "ptype array2(4, 4, 4) (passed sub-array)" >> + >> +# Check ptype outside of bounds. This should not crash GDB. > > Missing second space after a period. Done. > >> +gdb_test "ptype array1(100, 100)" "no such vector element" \ >> + "ptype array1(100, 100) subarray do not crash (passed sub-array)" >> +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ >> + "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)" >> + >> +# Pass vla to function. >> +gdb_continue_to_breakpoint "not-filled (3rd)" >> +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \ >> + "ptype array1 (passed vla)" >> +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ >> + "ptype array2 (passed vla)" >> +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ >> + "ptype array1(3, 3) (passed vla)" >> +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ >> + "ptype array2(4, 4, 4) (passed vla)" >> + >> +# Check ptype outside of bounds. This should not crash GDB. > > Same here. Done. > >> +gdb_test "ptype array1(100, 100)" "no such vector element" \ >> + "ptype array1(100, 100) VLA do not crash (passed vla)" >> +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ >> + "ptype array2(100, 100, 100) VLA do not crash (passed vla)" >> + >> +# Pass fixed array to function and handle it as VLA of arbitrary length in >> +# function. >> +gdb_breakpoint [gdb_get_line_number "end-of-bar"] >> +gdb_continue_to_breakpoint "end-of-bar" >> +gdb_test "ptype array1" \ >> + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \ >> + "ptype array1 (arbitrary length)" >> +gdb_test "ptype array2" \ >> + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \ >> + "ptype array2 (arbitrary length)" >> +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \ >> + "ptype array1(100) (arbitrary length)" >> +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \ >> + "ptype array2(4,100) (arbitrary length)" >> diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp >> new file mode 100644 >> index 0000000..cd47bbe >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp >> @@ -0,0 +1,96 @@ >> +# Copyright 2015 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 "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 > > Same remark as before. Done. > >> +} >> + >> +# Check the ptype of various VLA states and pointer to VLA's. >> +gdb_breakpoint [gdb_get_line_number "vla1-init"] >> +gdb_continue_to_breakpoint "vla1-init" >> +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" >> +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" >> +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" >> +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \ >> + "ptype vla1(3, 6, 9) not initialized" >> +gdb_test "ptype vla2(5, 45, 20)" \ >> + "no such vector element because not allocated" \ >> + "ptype vla1(5, 45, 20) not initialized" >> + >> +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] >> +gdb_continue_to_breakpoint "vla1-allocated" >> +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ >> + "ptype vla1 allocated" >> + >> +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] >> +gdb_continue_to_breakpoint "vla2-allocated" >> +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ >> + "ptype vla2 allocated" >> + >> +gdb_breakpoint [gdb_get_line_number "vla1-filled"] >> +gdb_continue_to_breakpoint "vla1-filled" >> +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ >> + "ptype vla1 filled" >> +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \ >> + "ptype vla1(3, 6, 9)" >> + >> +gdb_breakpoint [gdb_get_line_number "vla2-filled"] >> +gdb_continue_to_breakpoint "vla2-filled" >> +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ >> + "ptype vla2 filled" >> +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ >> + "ptype vla1(5, 45, 20) filled" >> + >> +gdb_breakpoint [gdb_get_line_number "pvla-associated"] >> +gdb_continue_to_breakpoint "pvla-associated" >> +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ >> + "ptype pvla associated" >> +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \ >> + "ptype pvla(3, 6, 9)" >> + >> +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] >> +gdb_continue_to_breakpoint "pvla-re-associated" >> +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ >> + "ptype pvla re-associated" >> +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ >> + "ptype vla1(5, 45, 20) re-associated" >> + >> +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] >> +gdb_continue_to_breakpoint "pvla-deassociated" >> +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" >> +gdb_test "ptype pvla(5, 45, 20)" \ >> + "no such vector element because not associated" \ >> + "ptype pvla(5, 45, 20) not associated" >> + >> +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] >> +gdb_continue_to_breakpoint "vla1-deallocated" >> +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" >> +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \ >> + "ptype vla1(3, 6, 9) not allocated" >> + >> +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] >> +gdb_continue_to_breakpoint "vla2-deallocated" >> +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" >> +gdb_test "ptype vla2(5, 45, 20)" \ >> + "no such vector element because not allocated" \ >> + "ptype vla2(5, 45, 20) not allocated" >> diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp >> new file mode 100644 >> index 0000000..8281425 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp >> @@ -0,0 +1,46 @@ >> +# Copyright 2015 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 "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 > > Same remark as before. Done. > >> +} >> + >> +# 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 sizeof(vla1)" " = 0" "print sizeof 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 "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" >> + >> +# Try to access values in undefined pointer to VLA (dangling) >> +gdb_breakpoint [gdb_get_line_number "vla1-filled"] >> +gdb_continue_to_breakpoint "vla1-filled" >> +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" >> + >> +# 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 sizeof(pvla)" " = 4000" "print sizeof associated pvla" >> diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90 >> new file mode 100644 >> index 0000000..dfda411 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-sub.f90 >> @@ -0,0 +1,82 @@ >> +! Copyright 2015 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. >> +! >> +! Original file written by Jakub Jelinek <jakub@redhat.com> and >> +! Jan Kratochvil <jan.kratochvil@redhat.com>. >> +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>. >> + >> +subroutine foo (array1, array2) >> + integer :: array1 (:, :) >> + real :: array2 (:, :, :) >> + >> + array1(:,:) = 5 ! not-filled >> + array1(1, 1) = 30 >> + >> + array2(:,:,:) = 6 ! array1-filled >> + array2(:,:,:) = 3 >> + array2(1,1,1) = 30 >> + array2(3,3,3) = 90 ! array2-almost-filled >> +end subroutine >> + >> +subroutine bar (array1, array2) >> + integer :: array1 (*) >> + integer :: array2 (4:9, 10:*) >> + >> + array1(5:10) = 1311 >> + array1(7) = 1 >> + array1(100) = 100 >> + array2(4,10) = array1(7) >> + array2(4,100) = array1(7) >> + return ! end-of-bar >> +end subroutine >> + >> +program vla_sub >> + interface >> + subroutine foo (array1, array2) >> + integer :: array1 (:, :) >> + real :: array2 (:, :, :) >> + end subroutine >> + end interface >> + interface >> + subroutine bar (array1, array2) >> + integer :: array1 (*) >> + integer :: array2 (4:9, 10:*) >> + end subroutine >> + end interface >> + >> + real, allocatable :: vla1 (:, :, :) >> + integer, allocatable :: vla2 (:, :) >> + >> + ! used for subroutine >> + integer :: sub_arr1(42, 42) >> + real :: sub_arr2(42, 42, 42) >> + integer :: sub_arr3(42) >> + >> + sub_arr1(:,:) = 1 ! vla2-deallocated >> + sub_arr2(:,:,:) = 2 >> + sub_arr3(:) = 3 >> + >> + call foo(sub_arr1, sub_arr2) >> + call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15)) >> + >> + allocate (vla1 (10,10,10)) >> + allocate (vla2 (20,20)) >> + vla1(:,:,:) = 1311 >> + vla2(:,:) = 42 >> + call foo(vla2, vla1) >> + >> + call bar(sub_arr3, sub_arr1) >> +end program vla_sub >> diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp >> new file mode 100644 >> index 0000000..88defda >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp >> @@ -0,0 +1,35 @@ >> +# Copyright 2015 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 "vla-sub.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 > > Same remark as before. Done. > >> +} >> + >> +# Check VLA with arbitary length and check that elements outside of >> +# bounds of the passed VLA can be accessed correctly. >> +gdb_breakpoint [gdb_get_line_number "end-of-bar"] >> +gdb_continue_to_breakpoint "end-of-bar" >> +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)" >> +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)" >> +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)" >> +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)" >> diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp >> new file mode 100644 >> index 0000000..6738875 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp >> @@ -0,0 +1,49 @@ >> +# Copyright 2015 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 "vla-sub.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 >> +} > > Same Remark as before. Done. > >> + >> +# "up" works with GCC but other Fortran compilers may copy the values into the >> +# outer function only on the exit of the inner function. >> +# We need both variants as depending on the arch we optionally may still be >> +# executing the caller line or not after `finish'. >> + >> +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] >> +gdb_continue_to_breakpoint "array2-almost-filled" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was filled" >> +gdb_test "print array2(2,1,1)=20" " = 20" \ >> + "set array(2,2,2) to 20 in subroutine" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was mofified in debugger" >> + >> +gdb_test "finish" \ >> + ".*(foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)|foo \\\(array1=..., array2=...\\\).*)" \ >> + "finish function" >> +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish" >> +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish" >> +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish" >> +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish" >> + >> diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp >> new file mode 100644 >> index 0000000..de88333 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp >> @@ -0,0 +1,90 @@ >> +# Copyright 2015 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 "vla-sub.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 >> +} > > Same remark as before. Done. > >> + >> +# Check the values of VLA's in subroutine can be evaluated correctly >> + >> +# Try to access values from a fixed array handled as VLA in subroutine. >> +gdb_breakpoint [gdb_get_line_number "not-filled"] >> +gdb_continue_to_breakpoint "not-filled (1st)" >> +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \ >> + "print passed array1 in foo (passed fixed array)" >> + >> +gdb_breakpoint [gdb_get_line_number "array1-filled"] >> +gdb_continue_to_breakpoint "array1-filled (1st)" >> +gdb_test "print array1(5, 7)" " = 5" \ >> + "print array1(5, 7) after filled in foo (passed fixed array)" >> +gdb_test "print array1(1, 1)" " = 30" \ >> + "print array1(1, 1) after filled in foo (passed fixed array)" >> + >> +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] >> +gdb_continue_to_breakpoint "array2-almost-filled (1st)" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was filled (passed fixed array)" >> +gdb_test "print array2(2,1,1)=20" " = 20" \ >> + "set array(2,2,2) to 20 in subroutine (passed fixed array)" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was mofified in debugger (passed fixed array)" >> + >> + >> +# Try to access values from a fixed sub-array handled as VLA in subroutine. >> +gdb_continue_to_breakpoint "not-filled (2nd)" >> +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \ >> + "print passed array1 in foo (passed sub-array)" >> + >> +gdb_continue_to_breakpoint "array1-filled (2nd)" >> +gdb_test "print array1(5, 5)" " = 5" \ >> + "print array1(5, 5) after filled in foo (passed sub-array)" >> +gdb_test "print array1(1, 1)" " = 30" \ >> + "print array1(1, 1) after filled in foo (passed sub-array)" >> + >> +gdb_continue_to_breakpoint "array2-almost-filled (2nd)" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was filled (passed sub-array)" >> +gdb_test "print array2(2,1,1)=20" " = 20" \ >> + "set array(2,2,2) to 20 in subroutine (passed sub-array)" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was mofified in debugger (passed sub-array)" >> + >> + >> +# Try to access values from a VLA passed to subroutine. >> +gdb_continue_to_breakpoint "not-filled (3rd)" >> +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \ >> + "print passed array1 in foo (passed vla)" >> + >> +gdb_continue_to_breakpoint "array1-filled (3rd)" >> +gdb_test "print array1(5, 5)" " = 5" \ >> + "print array1(5, 5) after filled in foo (passed vla)" >> +gdb_test "print array1(1, 1)" " = 30" \ >> + "print array1(1, 1) after filled in foo (passed vla)" >> + >> +gdb_continue_to_breakpoint "array2-almost-filled (3rd)" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was filled (passed vla)" >> +gdb_test "print array2(2,1,1)=20" " = 20" \ >> + "set array(2,2,2) to 20 in subroutine (passed vla)" >> +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ >> + "print array2 in foo after it was mofified in debugger (passed vla)" >> diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp >> new file mode 100644 >> index 0000000..6ea1eff >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla-value.exp >> @@ -0,0 +1,148 @@ >> +# Copyright 2015 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 "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 >> +} > > Same remark as before. Done. > >> + >> +# 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" " = <not allocated>" "print non-allocated vla1" >> +gdb_test "print &vla1" \ >> + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $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" " = <not associated>" "print undefined pvla" >> +gdb_test "print &pvla" \ >> + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $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" " = <not associated>" \ >> + "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..61e22b9 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.fortran/vla.f90 >> @@ -0,0 +1,56 @@ >> +! Copyright 2015 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/>. >> + >> +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 >> diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp >> new file mode 100644 >> index 0000000..d191623 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp >> @@ -0,0 +1,182 @@ >> +# Copyright 2015 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/>. >> + >> +# Verify that, using the MI, we can evaluate a simple C Variable Length >> +# Array (VLA). >> + >> +load_lib mi-support.exp >> +set MIFLAGS "-i=mi" >> + >> +gdb_exit >> +if [mi_gdb_start] { >> + continue >> +} >> + >> +standard_testfile vla.f90 >> + >> +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \ >> + {debug f90}] != "" } { >> + untested mi-vla-fortran.exp >> + return -1 >> +} >> + >> +mi_delete_breakpoints >> +mi_gdb_reinitialize_dir $srcdir/$subdir >> +mi_gdb_load ${binfile} >> + >> +set bp_lineno [gdb_get_line_number "vla1-not-allocated"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \ >> + ".*vla.f90" $bp_lineno $hex \ >> + "insert breakpoint at line $bp_lineno (vla not allocated)" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "500-data-evaluate-expression vla1" \ >> + "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" >> + >> +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ >> + "create local variable vla1_not_allocated" >> +mi_gdb_test "501-var-info-type vla1_not_allocated" \ >> + "501\\^done,type=\"<not allocated>\"" \ >> + "info type variable vla1_not_allocated" >> +mi_gdb_test "502-var-show-format vla1_not_allocated" \ >> + "502\\^done,format=\"natural\"" \ >> + "show format variable vla1_not_allocated" >> +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \ >> + "503\\^done,value=\"\\\[0\\\]\"" \ >> + "eval variable vla1_not_allocated" >> +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ >> + "real\\\(kind=4\\\)" "get children of vla1_not_allocated" >> + >> + >> + >> +set bp_lineno [gdb_get_line_number "vla1-allocated"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \ >> + $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "510-data-evaluate-expression vla1" \ >> + "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla" >> + >> +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ >> + "create local variable vla1_allocated" >> +mi_gdb_test "511-var-info-type vla1_allocated" \ >> + "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ >> + "info type variable vla1_allocated" >> +mi_gdb_test "512-var-show-format vla1_allocated" \ >> + "512\\^done,format=\"natural\"" \ >> + "show format variable vla1_allocated" >> +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \ >> + "513\\^done,value=\"\\\[5\\\]\"" \ >> + "eval variable vla1_allocated" >> +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ >> + "real\\\(kind=4\\\)" "get children of vla1_allocated" >> + >> + >> +set bp_lineno [gdb_get_line_number "vla1-filled"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \ >> + $bp_lineno $hex "insert breakpoint at line $bp_lineno" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "520-data-evaluate-expression vla1" \ >> + "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla" >> + >> + >> +set bp_lineno [gdb_get_line_number "vla1-modified"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \ >> + $bp_lineno $hex "insert breakpoint at line $bp_lineno" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "530-data-evaluate-expression vla1" \ >> + "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla" >> +mi_gdb_test "540-data-evaluate-expression vla1(1)" \ >> + "540\\^done,value=\"1\"" "evaluate filled vla" >> +mi_gdb_test "550-data-evaluate-expression vla1(2)" \ >> + "550\\^done,value=\"42\"" "evaluate filled vla" >> +mi_gdb_test "560-data-evaluate-expression vla1(4)" \ >> + "560\\^done,value=\"24\"" "evaluate filled vla" >> + >> + >> +set bp_lineno [gdb_get_line_number "vla1-deallocated"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \ >> + $bp_lineno $hex "insert breakpoint at line $bp_lineno" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "570-data-evaluate-expression vla1" \ >> + "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" >> + >> + >> +set bp_lineno [gdb_get_line_number "pvla2-not-associated"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \ >> + $bp_lineno $hex "insert breakpoint at line $bp_lineno" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "580-data-evaluate-expression pvla2" \ >> + "580\\^done,value=\"<not associated>\"" "evaluate not associated vla" >> + >> +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ >> + "create local variable pvla2_not_associated" >> +mi_gdb_test "581-var-info-type pvla2_not_associated" \ >> + "581\\^done,type=\"<not associated>\"" \ >> + "info type variable pvla2_not_associated" >> +mi_gdb_test "582-var-show-format pvla2_not_associated" \ >> + "582\\^done,format=\"natural\"" \ >> + "show format variable pvla2_not_associated" >> +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \ >> + "583\\^done,value=\"\\\[0\\\]\"" \ >> + "eval variable pvla2_not_associated" >> +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ >> + "real\\\(kind=4\\\)" "get children of pvla2_not_associated" >> + >> + >> +set bp_lineno [gdb_get_line_number "pvla2-associated"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \ >> + $bp_lineno $hex "insert breakpoint at line $bp_lineno" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "590-data-evaluate-expression pvla2" \ >> + "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \ >> + "evaluate associated vla" >> + >> +mi_create_varobj_checked pvla2_associated pvla2 \ >> + "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" >> +mi_gdb_test "591-var-info-type pvla2_associated" \ >> + "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ >> + "info type variable pvla2_associated" >> +mi_gdb_test "592-var-show-format pvla2_associated" \ >> + "592\\^done,format=\"natural\"" \ >> + "show format variable pvla2_associated" >> +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \ >> + "593\\^done,value=\"\\\[2\\\]\"" \ >> + "eval variable pvla2_associated" >> + >> + >> +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"] >> +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \ >> + $bp_lineno $hex "insert breakpoint at line $bp_lineno" >> +mi_run_cmd >> +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ >> + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" >> +mi_gdb_test "600-data-evaluate-expression pvla2" \ >> + "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null" >> + >> +mi_gdb_exit >> +return 0 >> diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90 >> new file mode 100644 >> index 0000000..0b89d34 >> --- /dev/null >> +++ b/gdb/testsuite/gdb.mi/vla.f90 >> @@ -0,0 +1,42 @@ >> +! Copyright 2015 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/>. >> + >> +program vla >> + real, allocatable :: vla1 (:) >> + real, target, allocatable :: vla2(:, :) >> + real, pointer :: pvla2 (:, :) >> + logical :: l >> + >> + allocate (vla1 (5)) ! vla1-not-allocated >> + l = allocated(vla1) ! vla1-allocated >> + >> + vla1(:) = 1 >> + vla1(2) = 42 ! vla1-filled >> + vla1(4) = 24 >> + >> + deallocate (vla1) ! vla1-modified >> + l = allocated(vla1) ! vla1-deallocated >> + >> + allocate (vla2 (5, 2)) >> + vla2(:, :) = 2 >> + >> + pvla2 => vla2 ! pvla2-not-associated >> + l = associated(pvla2) ! pvla2-associated >> + >> + pvla2(2, 1) = 42 >> + >> + pvla2 => null() >> + l = associated(pvla2) ! pvla2-set-to-null >> +end program vla >> -- >> 1.7.9.5 > Thanks, Keven
diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp new file mode 100644 index 0000000..542b65c --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp @@ -0,0 +1,65 @@ +# Copyright 2015 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 "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 +} + +# Check the association status of various types of VLA's +# and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla1 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print l" " = \\.TRUE\\." \ + "print vla2 allocation status (allocated)" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "print l" " = \\.TRUE\\." \ + "print pvla associated status (re-associated)" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "print l" " = \\.FALSE\\." \ + "print pvla allocation status (deassociated)" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "print l" " = \\.FALSE\\." \ + "print vla1 allocation status (deallocated)" +gdb_test "print vla1" " = <not allocated>" \ + "print deallocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated" +gdb_test "print vla2" " = <not allocated>" "print deallocated vla2" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp new file mode 100644 index 0000000..a61cb70 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp @@ -0,0 +1,82 @@ +# Copyright 2015 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 +} + +# check that all fortran standard datatypes will be +# handled correctly when using as VLA's + +if ![runto MAIN__] then { + perror "couldn't run to breakpoint MAIN__" + continue +} + +gdb_breakpoint [gdb_get_line_number "vlas-allocated"] +gdb_continue_to_breakpoint "vlas-allocated" +gdb_test "next" " = allocated\\\(realvla\\\)" \ + "next to allocation status of intvla" +gdb_test "print l" " = \\.TRUE\\." "intvla allocated" +gdb_test "next" " = allocated\\\(complexvla\\\)" \ + "next to allocation status of realvla" +gdb_test "print l" " = \\.TRUE\\." "realvla allocated" +gdb_test "next" " = allocated\\\(logicalvla\\\)" \ + "next to allocation status of complexvla" +gdb_test "print l" " = \\.TRUE\\." "complexvla allocated" +gdb_test "next" " = allocated\\\(charactervla\\\)" \ + "next to allocation status of logicalvla" +gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated" +gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \ + "next to allocation status of charactervla" +gdb_test "print l" " = \\.TRUE\\." "charactervla allocated" + +gdb_breakpoint [gdb_get_line_number "vlas-initialized"] +gdb_continue_to_breakpoint "vlas-initialized" +gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype intvla" +gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype realvla" +gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype complexvla" +gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \ + "ptype logicalvla" +gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \ + "ptype charactervla" + +gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)" +gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \ + "print realvla(5,5,5) (1st)" +gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \ + "print complexvla(5,5,5) (1st)" +gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \ + "print logicalvla(5,5,5) (1st)" +gdb_test "print charactervla(5,5,5)" " = 'K'" \ + "print charactervla(5,5,5) (1st)" + +gdb_breakpoint [gdb_get_line_number "vlas-modified"] +gdb_continue_to_breakpoint "vlas-modified" +gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)" +gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \ + "print realvla(5,5,5) (2nd)" +gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \ + "print complexvla(5,5,5) (2nd)" +gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \ + "print logicalvla(5,5,5) (2nd)" +gdb_test "print charactervla(5,5,5)" " = 'X'" \ + "print charactervla(5,5,5) (2nd)" diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 new file mode 100644 index 0000000..db25695 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90 @@ -0,0 +1,51 @@ +! Copyright 2015 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_primitives + integer, allocatable :: intvla(:, :, :) + real, allocatable :: realvla(:, :, :) + complex, allocatable :: complexvla(:, :, :) + logical, allocatable :: logicalvla(:, :, :) + character, allocatable :: charactervla(:, :, :) + logical :: l + + allocate (intvla (11,22,33)) + allocate (realvla (11,22,33)) + allocate (complexvla (11,22,33)) + allocate (logicalvla (11,22,33)) + allocate (charactervla (11,22,33)) + + l = allocated(intvla) ! vlas-allocated + l = allocated(realvla) + l = allocated(complexvla) + l = allocated(logicalvla) + l = allocated(charactervla) + + intvla(:,:,:) = 1 + realvla(:,:,:) = 3.14 + complexvla(:,:,:) = cmplx(2.0,-3.0) + logicalvla(:,:,:) = .TRUE. + charactervla(:,:,:) = char(75) + + intvla(5,5,5) = 42 ! vlas-initialized + realvla(5,5,5) = 4.13 + complexvla(5,5,5) = cmplx(-3.0,2.0) + logicalvla(5,5,5) = .FALSE. + charactervla(5,5,5) = 'X' + + ! dummy statement for bp + l = .FALSE. ! vlas-modified +end program vla_primitives diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp new file mode 100644 index 0000000..d56519c --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-history.exp @@ -0,0 +1,62 @@ +# Copyright 2015 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 "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 +} + +# Set some breakpoints and print complete vla. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla1 allocated" +gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print vla1" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \ + "print vla1 filled" + +# Try to access history values for full vla prints. +gdb_test "print \$1" " = <not allocated>" "print \$1" +gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$2" +gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \ + "print \$3" +gdb_test "print \$4" \ + " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)" +gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)" + +# Try to access history values for vla values. +gdb_test "print \$9" " = 1311" "print \$9" +gdb_test "print \$10" " = 1001" "print \$10" diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp new file mode 100644 index 0000000..b2d8f00 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp @@ -0,0 +1,32 @@ +# Copyright 2015 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 "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 +} + +# Check the status of a pointer to a dynamic array. +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 pvla pointer information" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp new file mode 100644 index 0000000..98fd663 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp @@ -0,0 +1,87 @@ +# Copyright 2015 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 "vla-sub.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 +} + +# Pass fixed array to function and handle them as vla in function. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \ + "ptype array1 (passed fixed)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \ + "ptype array2 (passed fixed)" +gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(40, 10) (passed fixed)" +gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \ + "ptype array2(13, 11, 5) (passed fixed)" + +# Pass sub arrays to function and handle them as vla in function. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \ + "ptype array1 (passed sub-array)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \ + "ptype array2 (passed sub-array)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed sub-array)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed sub-array)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) subarray do not crash (passed sub-array)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)" + +# Pass vla to function. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \ + "ptype array1 (passed vla)" +gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype array2 (passed vla)" +gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(3, 3) (passed vla)" +gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \ + "ptype array2(4, 4, 4) (passed vla)" + +# Check ptype outside of bounds. This should not crash GDB. +gdb_test "ptype array1(100, 100)" "no such vector element" \ + "ptype array1(100, 100) VLA do not crash (passed vla)" +gdb_test "ptype array2(100, 100, 100)" "no such vector element" \ + "ptype array2(100, 100, 100) VLA do not crash (passed vla)" + +# Pass fixed array to function and handle it as VLA of arbitrary length in +# function. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "ptype array1" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \ + "ptype array1 (arbitrary length)" +gdb_test "ptype array2" \ + "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \ + "ptype array2 (arbitrary length)" +gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \ + "ptype array1(100) (arbitrary length)" +gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \ + "ptype array2(4,100) (arbitrary length)" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp new file mode 100644 index 0000000..cd47bbe --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp @@ -0,0 +1,96 @@ +# Copyright 2015 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 "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 +} + +# Check the ptype of various VLA states and pointer to VLA's. +gdb_breakpoint [gdb_get_line_number "vla1-init"] +gdb_continue_to_breakpoint "vla1-init" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \ + "ptype vla1(3, 6, 9) not initialized" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element because not allocated" \ + "ptype vla1(5, 45, 20) not initialized" + +gdb_breakpoint [gdb_get_line_number "vla1-allocated"] +gdb_continue_to_breakpoint "vla1-allocated" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-allocated"] +gdb_continue_to_breakpoint "vla2-allocated" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 allocated" + +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype vla1 filled" +gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "vla2-filled"] +gdb_continue_to_breakpoint "vla2-filled" +gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype vla2 filled" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) filled" + +gdb_breakpoint [gdb_get_line_number "pvla-associated"] +gdb_continue_to_breakpoint "pvla-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \ + "ptype pvla associated" +gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \ + "ptype pvla(3, 6, 9)" + +gdb_breakpoint [gdb_get_line_number "pvla-re-associated"] +gdb_continue_to_breakpoint "pvla-re-associated" +gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \ + "ptype pvla re-associated" +gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \ + "ptype vla1(5, 45, 20) re-associated" + +gdb_breakpoint [gdb_get_line_number "pvla-deassociated"] +gdb_continue_to_breakpoint "pvla-deassociated" +gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated" +gdb_test "ptype pvla(5, 45, 20)" \ + "no such vector element because not associated" \ + "ptype pvla(5, 45, 20) not associated" + +gdb_breakpoint [gdb_get_line_number "vla1-deallocated"] +gdb_continue_to_breakpoint "vla1-deallocated" +gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated" +gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \ + "ptype vla1(3, 6, 9) not allocated" + +gdb_breakpoint [gdb_get_line_number "vla2-deallocated"] +gdb_continue_to_breakpoint "vla2-deallocated" +gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated" +gdb_test "ptype vla2(5, 45, 20)" \ + "no such vector element because not allocated" \ + "ptype vla2(5, 45, 20) not allocated" diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp new file mode 100644 index 0000000..8281425 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp @@ -0,0 +1,46 @@ +# Copyright 2015 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 "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 sizeof(vla1)" " = 0" "print sizeof 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 "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" + +# Try to access values in undefined pointer to VLA (dangling) +gdb_breakpoint [gdb_get_line_number "vla1-filled"] +gdb_continue_to_breakpoint "vla1-filled" +gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" + +# 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 sizeof(pvla)" " = 4000" "print sizeof associated pvla" diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90 new file mode 100644 index 0000000..dfda411 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-sub.f90 @@ -0,0 +1,82 @@ +! Copyright 2015 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. +! +! Original file written by Jakub Jelinek <jakub@redhat.com> and +! Jan Kratochvil <jan.kratochvil@redhat.com>. +! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>. + +subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + + array1(:,:) = 5 ! not-filled + array1(1, 1) = 30 + + array2(:,:,:) = 6 ! array1-filled + array2(:,:,:) = 3 + array2(1,1,1) = 30 + array2(3,3,3) = 90 ! array2-almost-filled +end subroutine + +subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + + array1(5:10) = 1311 + array1(7) = 1 + array1(100) = 100 + array2(4,10) = array1(7) + array2(4,100) = array1(7) + return ! end-of-bar +end subroutine + +program vla_sub + interface + subroutine foo (array1, array2) + integer :: array1 (:, :) + real :: array2 (:, :, :) + end subroutine + end interface + interface + subroutine bar (array1, array2) + integer :: array1 (*) + integer :: array2 (4:9, 10:*) + end subroutine + end interface + + real, allocatable :: vla1 (:, :, :) + integer, allocatable :: vla2 (:, :) + + ! used for subroutine + integer :: sub_arr1(42, 42) + real :: sub_arr2(42, 42, 42) + integer :: sub_arr3(42) + + sub_arr1(:,:) = 1 ! vla2-deallocated + sub_arr2(:,:,:) = 2 + sub_arr3(:) = 3 + + call foo(sub_arr1, sub_arr2) + call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15)) + + allocate (vla1 (10,10,10)) + allocate (vla2 (20,20)) + vla1(:,:,:) = 1311 + vla2(:,:) = 42 + call foo(vla2, vla1) + + call bar(sub_arr3, sub_arr1) +end program vla_sub diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp new file mode 100644 index 0000000..88defda --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp @@ -0,0 +1,35 @@ +# Copyright 2015 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 "vla-sub.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 VLA with arbitary length and check that elements outside of +# bounds of the passed VLA can be accessed correctly. +gdb_breakpoint [gdb_get_line_number "end-of-bar"] +gdb_continue_to_breakpoint "end-of-bar" +gdb_test "p array1(42)" " = 3" "print arbitary array1(42)" +gdb_test "p array1(100)" " = 100" "print arbitary array1(100)" +gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)" +gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)" diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp new file mode 100644 index 0000000..6738875 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp @@ -0,0 +1,49 @@ +# Copyright 2015 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 "vla-sub.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 +} + +# "up" works with GCC but other Fortran compilers may copy the values into the +# outer function only on the exit of the inner function. +# We need both variants as depending on the arch we optionally may still be +# executing the caller line or not after `finish'. + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger" + +gdb_test "finish" \ + ".*(foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)|foo \\\(array1=..., array2=...\\\).*)" \ + "finish function" +gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish" +gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish" +gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish" +gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish" + diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp new file mode 100644 index 0000000..de88333 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp @@ -0,0 +1,90 @@ +# Copyright 2015 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 "vla-sub.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 the values of VLA's in subroutine can be evaluated correctly + +# Try to access values from a fixed array handled as VLA in subroutine. +gdb_breakpoint [gdb_get_line_number "not-filled"] +gdb_continue_to_breakpoint "not-filled (1st)" +gdb_test "print array1" " = \\(\[()1, .\]*\\)" \ + "print passed array1 in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array1-filled"] +gdb_continue_to_breakpoint "array1-filled (1st)" +gdb_test "print array1(5, 7)" " = 5" \ + "print array1(5, 7) after filled in foo (passed fixed array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed fixed array)" + +gdb_breakpoint [gdb_get_line_number "array2-almost-filled"] +gdb_continue_to_breakpoint "array2-almost-filled (1st)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed fixed array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed fixed array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed fixed array)" + + +# Try to access values from a fixed sub-array handled as VLA in subroutine. +gdb_continue_to_breakpoint "not-filled (2nd)" +gdb_test "print array1" " = \\(\[()5, .\]*\\)" \ + "print passed array1 in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array1-filled (2nd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed sub-array)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed sub-array)" + +gdb_continue_to_breakpoint "array2-almost-filled (2nd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed sub-array)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed sub-array)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed sub-array)" + + +# Try to access values from a VLA passed to subroutine. +gdb_continue_to_breakpoint "not-filled (3rd)" +gdb_test "print array1" " = \\(\[()42, .\]*\\)" \ + "print passed array1 in foo (passed vla)" + +gdb_continue_to_breakpoint "array1-filled (3rd)" +gdb_test "print array1(5, 5)" " = 5" \ + "print array1(5, 5) after filled in foo (passed vla)" +gdb_test "print array1(1, 1)" " = 30" \ + "print array1(1, 1) after filled in foo (passed vla)" + +gdb_continue_to_breakpoint "array2-almost-filled (3rd)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was filled (passed vla)" +gdb_test "print array2(2,1,1)=20" " = 20" \ + "set array(2,2,2) to 20 in subroutine (passed vla)" +gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \ + "print array2 in foo after it was mofified in debugger (passed vla)" diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp new file mode 100644 index 0000000..6ea1eff --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla-value.exp @@ -0,0 +1,148 @@ +# Copyright 2015 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 "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" " = <not allocated>" "print non-allocated vla1" +gdb_test "print &vla1" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $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" " = <not associated>" "print undefined pvla" +gdb_test "print &pvla" \ + " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $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" " = <not associated>" \ + "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..61e22b9 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/vla.f90 @@ -0,0 +1,56 @@ +! Copyright 2015 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/>. + +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 diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp new file mode 100644 index 0000000..d191623 --- /dev/null +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp @@ -0,0 +1,182 @@ +# Copyright 2015 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/>. + +# Verify that, using the MI, we can evaluate a simple C Variable Length +# Array (VLA). + +load_lib mi-support.exp +set MIFLAGS "-i=mi" + +gdb_exit +if [mi_gdb_start] { + continue +} + +standard_testfile vla.f90 + +if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \ + {debug f90}] != "" } { + untested mi-vla-fortran.exp + return -1 +} + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +set bp_lineno [gdb_get_line_number "vla1-not-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \ + ".*vla.f90" $bp_lineno $hex \ + "insert breakpoint at line $bp_lineno (vla not allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "500-data-evaluate-expression vla1" \ + "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + +mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ + "create local variable vla1_not_allocated" +mi_gdb_test "501-var-info-type vla1_not_allocated" \ + "501\\^done,type=\"<not allocated>\"" \ + "info type variable vla1_not_allocated" +mi_gdb_test "502-var-show-format vla1_not_allocated" \ + "502\\^done,format=\"natural\"" \ + "show format variable vla1_not_allocated" +mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \ + "503\\^done,value=\"\\\[0\\\]\"" \ + "eval variable vla1_not_allocated" +mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_not_allocated" + + + +set bp_lineno [gdb_get_line_number "vla1-allocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "510-data-evaluate-expression vla1" \ + "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla" + +mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ + "create local variable vla1_allocated" +mi_gdb_test "511-var-info-type vla1_allocated" \ + "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ + "info type variable vla1_allocated" +mi_gdb_test "512-var-show-format vla1_allocated" \ + "512\\^done,format=\"natural\"" \ + "show format variable vla1_allocated" +mi_gdb_test "513-var-evaluate-expression vla1_allocated" \ + "513\\^done,value=\"\\\[5\\\]\"" \ + "eval variable vla1_allocated" +mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \ + "real\\\(kind=4\\\)" "get children of vla1_allocated" + + +set bp_lineno [gdb_get_line_number "vla1-filled"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "520-data-evaluate-expression vla1" \ + "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-modified"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "530-data-evaluate-expression vla1" \ + "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla" +mi_gdb_test "540-data-evaluate-expression vla1(1)" \ + "540\\^done,value=\"1\"" "evaluate filled vla" +mi_gdb_test "550-data-evaluate-expression vla1(2)" \ + "550\\^done,value=\"42\"" "evaluate filled vla" +mi_gdb_test "560-data-evaluate-expression vla1(4)" \ + "560\\^done,value=\"24\"" "evaluate filled vla" + + +set bp_lineno [gdb_get_line_number "vla1-deallocated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "570-data-evaluate-expression vla1" \ + "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla" + + +set bp_lineno [gdb_get_line_number "pvla2-not-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "580-data-evaluate-expression pvla2" \ + "580\\^done,value=\"<not associated>\"" "evaluate not associated vla" + +mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ + "create local variable pvla2_not_associated" +mi_gdb_test "581-var-info-type pvla2_not_associated" \ + "581\\^done,type=\"<not associated>\"" \ + "info type variable pvla2_not_associated" +mi_gdb_test "582-var-show-format pvla2_not_associated" \ + "582\\^done,format=\"natural\"" \ + "show format variable pvla2_not_associated" +mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \ + "583\\^done,value=\"\\\[0\\\]\"" \ + "eval variable pvla2_not_associated" +mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ + "real\\\(kind=4\\\)" "get children of pvla2_not_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-associated"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "590-data-evaluate-expression pvla2" \ + "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \ + "evaluate associated vla" + +mi_create_varobj_checked pvla2_associated pvla2 \ + "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated" +mi_gdb_test "591-var-info-type pvla2_associated" \ + "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \ + "info type variable pvla2_associated" +mi_gdb_test "592-var-show-format pvla2_associated" \ + "592\\^done,format=\"natural\"" \ + "show format variable pvla2_associated" +mi_gdb_test "593-var-evaluate-expression pvla2_associated" \ + "593\\^done,value=\"\\\[2\\\]\"" \ + "eval variable pvla2_associated" + + +set bp_lineno [gdb_get_line_number "pvla2-set-to-null"] +mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \ + $bp_lineno $hex "insert breakpoint at line $bp_lineno" +mi_run_cmd +mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ + { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno" +mi_gdb_test "600-data-evaluate-expression pvla2" \ + "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null" + +mi_gdb_exit +return 0 diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90 new file mode 100644 index 0000000..0b89d34 --- /dev/null +++ b/gdb/testsuite/gdb.mi/vla.f90 @@ -0,0 +1,42 @@ +! Copyright 2015 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/>. + +program vla + real, allocatable :: vla1 (:) + real, target, allocatable :: vla2(:, :) + real, pointer :: pvla2 (:, :) + logical :: l + + allocate (vla1 (5)) ! vla1-not-allocated + l = allocated(vla1) ! vla1-allocated + + vla1(:) = 1 + vla1(2) = 42 ! vla1-filled + vla1(4) = 24 + + deallocate (vla1) ! vla1-modified + l = allocated(vla1) ! vla1-deallocated + + allocate (vla2 (5, 2)) + vla2(:, :) = 2 + + pvla2 => vla2 ! pvla2-not-associated + l = associated(pvla2) ! pvla2-associated + + pvla2(2, 1) = 42 + + pvla2 => null() + l = associated(pvla2) ! pvla2-set-to-null +end program vla
Add basic test coverage for most dynamic array use-cases in Fortran. The commit contains the following tests: * Ensure that values of Fortran dynamic arrays can be evaluated correctly in various ways and states. * Ensure that Fortran primitives can be evaluated correctly when used as a dynamic array. * Dynamic arrays passed to subroutines and handled in different ways inside the routine. * Ensure that the ptype of dynamic arrays in Fortran can be printed in GDB correctly. * Ensure that dynamic arrays in different states (allocated/associated) can be evaluated. * Dynamic arrays passed to functions and returned from functions. * History values of dynamic arrays can be accessed and printed again with the correct values. * Dynamic array evaluations using MI protocol. * Sizeof output of dynamic arrays in various states. 2015-03-13 Keven Boell <keven.boell@intel.com> Sanimir Agovic <sanimir.agovic@intel.com> testsuite/gdb.fortran: * vla-alloc-assoc.exp: New file. * vla-datatypes.exp: New file. * vla-datatypes.f90: New file. * vla-history.exp: New file. * vla-ptype-sub.exp: New file. * vla-ptype.exp: New file. * vla-sizeof.exp: New file. * vla-sub.f90: New file. * vla-value-sub-arbitrary.exp: New file. * vla-value-sub-finish.exp: New file. * vla-value-sub.exp: New file. * vla-value.exp: New file. * vla-ptr-info.exp: New file. * vla.f90: New file. testsuite/gdb.mi: * mi-vla-fortran.exp: New file. * vla.f90: New file. --- gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++ gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++ gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 ++++++ gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++ gdb/testsuite/gdb.fortran/vla-ptr-info.exp | 32 ++++ gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 ++++++++++ gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++ gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 +++++ gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 +++++++++ .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++ gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 ++++++ gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++ gdb/testsuite/gdb.fortran/vla-value.exp | 148 ++++++++++++++++ gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++ gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 ++++++++++++++++++++ gdb/testsuite/gdb.mi/vla.f90 | 42 +++++ 16 files changed, 1205 insertions(+) create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptr-info.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp create mode 100644 gdb/testsuite/gdb.mi/vla.f90