diff options
Diffstat (limited to 'gdb/testsuite')
| -rw-r--r-- | gdb/testsuite/ChangeLog | 10 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/pointers.f90 | 80 | ||||
| -rwxr-xr-x | gdb/testsuite/gdb.fortran/print_type.exp | 114 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 | ||||
| -rwxr-xr-x | gdb/testsuite/gdb.fortran/vla-type.exp | 7 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/vla-value.exp | 10 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 8 |
7 files changed, 224 insertions, 17 deletions
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 94c73486..2efadd1 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2019-06-16 Bernhard Heckel <bernhard.heckel@intel.com> + Andrew Burgess <andrew.burgess@embecosm.com> + + * gdb.fortran/pointers.f90: New file. + * gdb.fortran/print_type.exp: New file. + * gdb.fortran/vla-ptype.exp: Adapt expected results. + * gdb.fortran/vla-type.exp: Likewise. + * gdb.fortran/vla-value.exp: Likewise. + * gdb.mi/mi-vla-fortran.exp: Likewise. + 2019-06-15 Andrew Burgess <andrew.burgess@embecosm.com> * gdb.mi/mi-catch-cpp-exceptions.cc: New file. diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90 new file mode 100644 index 0000000..cb7010d --- /dev/null +++ b/gdb/testsuite/gdb.fortran/pointers.f90 @@ -0,0 +1,80 @@ +! 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 pointers + + type :: two + integer, allocatable :: ivla1 (:) + integer, allocatable :: ivla2 (:, :) + end type two + + logical, target :: logv + complex, target :: comv + character, target :: charv + character (len=3), target :: chara + integer, target :: intv + integer, target, dimension (10,2) :: inta + real, target :: realv + type(two), target :: twov + + logical, pointer :: logp + complex, pointer :: comp + character, pointer :: charp + character (len=3), pointer :: charap + integer, pointer :: intp + integer, pointer, dimension (:,:) :: intap + real, pointer :: realp + type(two), pointer :: twop + + nullify (logp) + nullify (comp) + nullify (charp) + nullify (charap) + nullify (intp) + nullify (intap) + nullify (realp) + nullify (twop) + + logp => logv ! Before pointer assignment + comp => comv + charp => charv + charap => chara + intp => intv + intap => inta + realp => realv + twop => twov + + logv = associated(logp) ! Before value assignment + comv = cmplx(1,2) + charv = "a" + chara = "abc" + intv = 10 + inta(:,:) = 1 + inta(3,1) = 3 + realv = 3.14 + + allocate (twov%ivla1(3)) + allocate (twov%ivla2(2,2)) + twov%ivla1(1) = 11 + twov%ivla1(2) = 12 + twov%ivla1(3) = 13 + twov%ivla2(1,1) = 211 + twov%ivla2(2,1) = 221 + twov%ivla2(1,2) = 212 + twov%ivla2(2,2) = 222 + + intv = intv + 1 ! After value assignment + +end program pointers diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp new file mode 100755 index 0000000..2d6fb34 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/print_type.exp @@ -0,0 +1,114 @@ +# 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/>. + +# Check how GDB handles printing pointers, both when associated, and +# when not associated. + +standard_testfile "pointers.f90" +load_lib fortran.exp + +if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { + return -1 +} + +if ![runto_main] { + untested "could not run to main" + return -1 +} + +# Depending on the compiler being used, the type names can be printed +# differently. +set logical [fortran_logical4] +set real [fortran_real4] +set int [fortran_int4] +set complex [fortran_complex4] + +# Print the inferior variable VAR_NAME, and check that the result +# matches the string TYPE. +proc check_pointer_type { var_name type } { + gdb_test "ptype ${var_name}" \ + "type = PTR TO -> \\( ${type} \\)" +} + +gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] +gdb_continue_to_breakpoint "Before pointer assignment" + +with_test_prefix "pointers not associated" { + check_pointer_type "logp" "$logical" + check_pointer_type "comp" "$complex" + check_pointer_type "charp" "character\\*1" + check_pointer_type "charap" "character\\*3" + check_pointer_type "intp" "$int" + + # Current gfortran seems to not mark 'intap' as a pointer. Intels + # Fortran compiler does though. + set test "ptype intap" + gdb_test_multiple "ptype intap" $test { + -re "type = PTR TO -> \\( $int \\(:,:\\) \\)\r\n$gdb_prompt $" { + pass $test + } + -re "type = $int \\(:,:\\)\r\n$gdb_prompt $" { + pass $test + } + } + + check_pointer_type "realp" "$real" + check_pointer_type "twop" \ + [multi_line "Type two" \ + " $int, allocatable :: ivla1\\(:\\)" \ + " $int, allocatable :: ivla2\\(:,:\\)" \ + "End Type two"] +} + +gdb_test "ptype two" \ + [multi_line "type = Type two" \ + " $int, allocatable :: ivla1\\(:\\)" \ + " $int, allocatable :: ivla2\\(:,:\\)" \ + "End Type two"] + +gdb_breakpoint [gdb_get_line_number "Before value assignment"] +gdb_continue_to_breakpoint "Before value assignment" +gdb_test "ptype twop" \ + [multi_line "type = PTR TO -> \\( Type two" \ + " $int, allocatable :: ivla1\\(:\\)" \ + " $int, allocatable :: ivla2\\(:,:\\)" \ + "End Type two \\)"] + +gdb_breakpoint [gdb_get_line_number "After value assignment"] +gdb_continue_to_breakpoint "After value assignment" +gdb_test "ptype logv" "type = $logical" +gdb_test "ptype comv" "type = $complex" +gdb_test "ptype charv" "type = character\\*1" +gdb_test "ptype chara" "type = character\\*3" +gdb_test "ptype intv" "type = $int" +gdb_test "ptype inta" "type = $int \\(10,2\\)" +gdb_test "ptype realv" "type = $real" + +gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)" +gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" +gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" +gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" +gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" +set test "ptype intap" +gdb_test_multiple $test $test { + -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" { + pass $test + } + -re "type = PTR TO -> \\( $int \\(10,2\\)\\)\r\n$gdb_prompt $" { + pass $test + } +} +gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp index 0f4abb6..a4c3c9c 100644 --- a/gdb/testsuite/gdb.fortran/vla-ptype.exp +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp @@ -32,9 +32,9 @@ set real [fortran_real4] # 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" "type = $real, allocatable \\(:,:,:\\)" "ptype vla1 not initialized" +gdb_test "ptype vla2" "type = $real, allocatable \\(:,:,:\\)" "ptype vla2 not initialized" +gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla not initialized" gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \ "ptype vla1(3, 6, 9) not initialized" gdb_test "ptype vla2(5, 45, 20)" \ @@ -81,20 +81,20 @@ gdb_test "ptype vla2(5, 45, 20)" "type = $real" \ 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" "type = $real \\(:,:,:\\)" "ptype pvla deassociated" gdb_test "ptype pvla(5, 45, 20)" \ "no such vector element \\\(vector 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" "type = $real, allocatable \\(:,:,:\\)" "ptype vla1 not allocated" gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector 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" "type = $real, allocatable \\(:,:,:\\)" "ptype vla2 not allocated" gdb_test "ptype vla2(5, 45, 20)" \ "no such vector element \\\(vector not allocated\\\)" \ "ptype vla2(5, 45, 20) not allocated" diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp index 951f118..b88a3d0 100755 --- a/gdb/testsuite/gdb.fortran/vla-type.exp +++ b/gdb/testsuite/gdb.fortran/vla-type.exp @@ -132,7 +132,10 @@ gdb_test "ptype fivearr(2)%tone" \ "End Type one" ] # Check allocation status of dynamic array and it's dynamic members -gdb_test "ptype fivedynarr" "type = <not allocated>" +gdb_test "ptype fivedynarr" \ + [multi_line "type = Type five" \ + " Type one :: tone" \ + "End Type five, allocatable \\(:\\)" ] gdb_test "next" "" gdb_test "ptype fivedynarr(2)" \ [multi_line "type = Type five" \ @@ -141,7 +144,7 @@ gdb_test "ptype fivedynarr(2)" \ "ptype fivedynarr(2), tone is not allocated" gdb_test "ptype fivedynarr(2)%tone" \ [multi_line "type = Type one" \ - " $int, allocatable :: ivla\\(<not allocated>\\)" \ + " $int, allocatable :: ivla\\(:,:,:\\)" \ "End Type one" ] \ "ptype fivedynarr(2)%tone, not allocated" diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp index be397fd..3cf5d67 100644 --- a/gdb/testsuite/gdb.fortran/vla-value.exp +++ b/gdb/testsuite/gdb.fortran/vla-value.exp @@ -35,7 +35,7 @@ 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, allocatable \\\(<not allocated>\\\) \\\)\\\) $hex" \ + " = \\\(PTR TO -> \\\( $real, allocatable \\\(:,:,:\\\) \\\)\\\) $hex" \ "print non-allocated &vla1" gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \ "print member in non-allocated vla1 (1)" @@ -76,7 +76,7 @@ gdb_test "print vla1(9, 9, 9)" " = 999" \ # 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 \\\(<not associated>\\\) \\\)\\\) $hex" \ + " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\) \\\)\\\) $hex" \ "print non-associated &pvla" gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \ "print undefined pvla(1,3,8)" @@ -134,7 +134,7 @@ if ![runto MAIN__] then { continue } gdb_breakpoint [gdb_get_line_number "vla2-allocated"] -gdb_continue_to_breakpoint "vla2-allocated" +gdb_continue_to_breakpoint "vla2-allocated, second time" # Many instructions to be executed when step over this line, and it is # slower in remote debugging. Increase the timeout to avoid timeout # fail. @@ -151,13 +151,13 @@ 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_continue_to_breakpoint "pvla-associated, second time" 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_continue_to_breakpoint "pvla-deassociated, second time" gdb_test "print \$mypvar(1,3,8)" " = 1001" \ "print \$mypvar(1,3,8) after deallocated" diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp index 0759ccb..ec04bbe 100644 --- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp +++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp @@ -51,10 +51,10 @@ mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \ mi_gdb_test "500-data-evaluate-expression vla1" \ "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla, before allocation" -mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \ +mi_create_varobj_checked vla1_not_allocated vla1 "$real, allocatable \\(:\\)" \ "create local variable vla1_not_allocated" mi_gdb_test "501-var-info-type vla1_not_allocated" \ - "501\\^done,type=\"<not allocated>\"" \ + "501\\^done,type=\"$real, allocatable \\(:\\)\"" \ "info type variable vla1_not_allocated" mi_gdb_test "502-var-show-format vla1_not_allocated" \ "502\\^done,format=\"natural\"" \ @@ -146,10 +146,10 @@ gdb_expect { -re "580\\^done,value=\"<not associated>\".*${mi_gdb_prompt}$" { pass $test - mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \ + mi_create_varobj_checked pvla2_not_associated pvla2 "$real \\(:,:\\)" \ "create local variable pvla2_not_associated" mi_gdb_test "581-var-info-type pvla2_not_associated" \ - "581\\^done,type=\"<not associated>\"" \ + "581\\^done,type=\"$real \\(:,:\\)\"" \ "info type variable pvla2_not_associated" mi_gdb_test "582-var-show-format pvla2_not_associated" \ "582\\^done,format=\"natural\"" \ |