aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/testsuite/gdb.fortran')
-rw-r--r--gdb/testsuite/gdb.fortran/array-slices.exp58
-rw-r--r--gdb/testsuite/gdb.fortran/array-slices.f9070
-rw-r--r--gdb/testsuite/gdb.fortran/derived-type-striding.exp37
-rw-r--r--gdb/testsuite/gdb.fortran/derived-type-striding.f9043
4 files changed, 208 insertions, 0 deletions
diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp
new file mode 100644
index 0000000..db07ace
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.exp
@@ -0,0 +1,58 @@
+# Copyright 2019 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/> .
+
+# Print a 2 dimensional assumed shape array. We pass different slices
+# of the array to a subroutine and print the array as recieved within
+# the subroutine. This should exercise GDB's ability to handle
+# different strides for the different dimensions.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint "show"
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+set array_contents \
+ [list \
+ " = \\(\\( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\( 11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\( 21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\( 31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\( 41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\( 51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\( 61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\( 71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\( 81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\( 91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\) \\)" \
+ " = \\(\\( 1, 2, 3, 4, 5\\) \\( 11, 12, 13, 14, 15\\) \\( 21, 22, 23, 24, 25\\) \\( 31, 32, 33, 34, 35\\) \\( 41, 42, 43, 44, 45\\) \\)" \
+ " = \\(\\( 1, 3, 5, 7, 9\\) \\( 21, 23, 25, 27, 29\\) \\( 41, 43, 45, 47, 49\\) \\( 61, 63, 65, 67, 69\\) \\( 81, 83, 85, 87, 89\\) \\)" \
+ " = \\(\\( 1, 4, 7, 10\\) \\( 21, 24, 27, 30\\) \\( 41, 44, 47, 50\\) \\( 61, 64, 67, 70\\) \\( 81, 84, 87, 90\\) \\)" \
+ " = \\(\\( 1, 5, 9\\) \\( 31, 35, 39\\) \\( 61, 65, 69\\) \\( 91, 95, 99\\) \\)" \
+ " = \\(\\( -26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\( -19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\( -12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\( -5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\( 2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\( 9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\( 16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\( 23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\( 30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\( 37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\) \\)" \
+ " = \\(\\( -26, -25, -24, -23, -22, -21\\) \\( -19, -18, -17, -16, -15, -14\\) \\( -12, -11, -10, -9, -8, -7\\) \\)" \
+ " = \\(\\( -26, -24, -22, -20, -18\\) \\( -5, -3, -1, 1, 3\\) \\( 16, 18, 20, 22, 24\\) \\( 37, 39, 41, 43, 45\\) \\)" ]
+
+set i 0
+foreach result $array_contents {
+ incr i
+ with_test_prefix "test $i" {
+ gdb_continue_to_breakpoint "show"
+ gdb_test "p array" $result
+ }
+}
+
+gdb_continue_to_breakpoint "continue to Final Breakpoint"
diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90
new file mode 100644
index 0000000..ec4e1eb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/array-slices.f90
@@ -0,0 +1,70 @@
+! Copyright 2019 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/>.
+
+subroutine show (message, array)
+ character (len=*) :: message
+ integer, dimension (:,:) :: array
+
+ print *, message
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ write(*, fmt="(i4)", advance="no") array (j, i)
+ end do
+ print *, ""
+ end do
+ print *, array
+ print *, ""
+
+end subroutine show
+
+program test
+
+ interface
+ subroutine show (message, array)
+ character (len=*) :: message
+ integer, dimension(:,:) :: array
+ end subroutine show
+ end interface
+
+ integer, dimension (1:10,1:10) :: array
+ integer, allocatable :: other (:, :)
+
+ allocate (other (-5:4, -2:7))
+
+ do i=LBOUND (array, 2), UBOUND (array, 2), 1
+ do j=LBOUND (array, 1), UBOUND (array, 1), 1
+ array (j,i) = ((i - 1) * UBOUND (array, 2)) + j
+ end do
+ end do
+
+ do i=LBOUND (other, 2), UBOUND (other, 2), 1
+ do j=LBOUND (other, 1), UBOUND (other, 1), 1
+ other (j,i) = ((i - 1) * UBOUND (other, 2)) + j
+ end do
+ end do
+
+ call show ("array", array)
+ call show ("array (1:5,1:5)", array (1:5,1:5))
+ call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2))
+ call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2))
+ call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3))
+
+ call show ("other", other)
+ call show ("other (-5:0, -2:0)", other (-5:0, -2:0))
+ call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3))
+
+ deallocate (other)
+ print *, "" ! Final Breakpoint.
+end program test
diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.exp b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
new file mode 100644
index 0000000..a2590a9
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/derived-type-striding.exp
@@ -0,0 +1,37 @@
+# Copyright 2019 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/> .
+
+# Print some single dimensional integer arrays that will have a byte
+# stride in the debug information.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if {![runto [gdb_get_line_number "post_init"]]} then {
+ perror "couldn't run to breakpoint post_init"
+ continue
+}
+
+# Test homogeneous derived type.
+gdb_test "p point_dimension" "= \\\(2, 2, 2, 2, 2, 2, 2, 2, 2\\\)"
+
+# Test mixed type derived type.
+gdb_test "p point_mixed_dimension" "= \\\(3, 3, 3, 3\\\)"
diff --git a/gdb/testsuite/gdb.fortran/derived-type-striding.f90 b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
new file mode 100644
index 0000000..8189ad3
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/derived-type-striding.f90
@@ -0,0 +1,43 @@
+! Copyright 2019 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 derived_type_member_stride
+ type cartesian
+ integer(kind=8) :: x
+ integer(kind=8) :: y
+ integer(kind=8) :: z
+ end type
+ type mixed_cartesian
+ integer(kind=8) :: x
+ integer(kind=4) :: y
+ integer(kind=8) :: z
+ end type
+ type(cartesian), dimension(10), target :: cloud
+ type(mixed_cartesian), dimension(10), target :: mixed_cloud
+ integer(kind=8), dimension(:), pointer :: point_dimension => null()
+ integer(kind=8), dimension(:), pointer :: point_mixed_dimension => null()
+ cloud(:)%x = 1
+ cloud(:)%y = 2
+ cloud(:)%z = 3
+ point_dimension => cloud(1:9)%y
+ mixed_cloud(:)%x = 1
+ mixed_cloud(:)%y = 2
+ mixed_cloud(:)%z = 3
+ point_mixed_dimension => mixed_cloud(1:4)%z
+ ! Prevent the compiler from optimising the work out.
+ print *, cloud(:)%x ! post_init
+ print *, point_dimension
+ print *, point_mixed_dimension
+end program
generated by cgit v1.1 at 2024-12-04 07:26:33 +0000