diff options
author | Andrew Burgess <andrew.burgess@embecosm.com> | 2019-03-01 11:12:33 +0000 |
---|---|---|
committer | Andrew Burgess <andrew.burgess@embecosm.com> | 2019-06-16 00:29:35 +0100 |
commit | 584a927c5ad0d18e9995a0049066b6c503bb7482 (patch) | |
tree | e7235e42ae1098ff109a169478c77dc1ef97accd /gdb | |
parent | 30056ea04ae3ecd828e2a06e12e6f174ae6659c9 (diff) | |
download | gdb-584a927c5ad0d18e9995a0049066b6c503bb7482.zip gdb-584a927c5ad0d18e9995a0049066b6c503bb7482.tar.gz gdb-584a927c5ad0d18e9995a0049066b6c503bb7482.tar.bz2 |
gdb/fortran: Show the type for non allocated / associated types
Show the type of not-allocated and/or not-associated types. For array
types and pointer to array types we are going to print the number of
ranks.
Consider this Fortran program:
program test
integer, allocatable :: vla (:)
logical l
allocate (vla(5:12))
l = allocated (vla)
end program test
And this GDB session with current HEAD:
(gdb) start
...
2 integer, allocatable :: vla (:)
(gdb) n
4 allocate (vla(5:12))
(gdb) ptype vla
type = <not allocated>
(gdb) p vla
$1 = <not allocated>
(gdb)
And the same session with this patch applied:
(gdb) start
...
2 integer, allocatable :: vla (:)
(gdb) n
4 allocate (vla(5:12))
(gdb) ptype vla
type = integer(kind=4), allocatable (:)
(gdb) p vla
$1 = <not allocated>
(gdb)
The type of 'vla' is now printed correctly, while the value itself
still shows as '<not allocated>'. How GDB prints the type of
associated pointers has changed in a similar way.
gdb/ChangeLog:
* f-typeprint.c (f_print_type): Don't return early for not
associated or not allocated types.
(f_type_print_varspec_suffix): Add print_rank parameter and print
ranks of array types in case they dangling.
(f_type_print_base): Add print_rank parameter.
gdb/testsuite/ChangeLog:
* 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.
Diffstat (limited to 'gdb')
-rw-r--r-- | gdb/ChangeLog | 9 | ||||
-rw-r--r-- | gdb/f-typeprint.c | 90 | ||||
-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 |
9 files changed, 283 insertions, 57 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 4dae9aa..77c5115 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,12 @@ +2019-06-16 Bernhard Heckel <bernhard.heckel@intel.com> + Andrew Burgess <andrew.burgess@embecosm.com> + + * f-typeprint.c (f_print_type): Don't return early for not + associated or not allocated types. + (f_type_print_varspec_suffix): Add print_rank parameter and print + ranks of array types in case they dangling. + (f_type_print_base): Add print_rank parameter. + 2019-06-15 Andrew Burgess <andrew.burgess@embecosm.com> * NEWS: Mention new MI commands. diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index a7c1a00..17ac02f 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -37,7 +37,7 @@ static void f_type_print_args (struct type *, struct ui_file *); #endif static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int, - int, int, int); + int, int, int, bool); void f_type_print_varspec_prefix (struct type *, struct ui_file *, int, int); @@ -53,18 +53,6 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, { enum type_code code; - if (type_not_associated (type)) - { - val_print_not_associated (stream); - return; - } - - if (type_not_allocated (type)) - { - val_print_not_allocated (stream); - return; - } - f_type_print_base (type, stream, show, level); code = TYPE_CODE (type); if ((varstring != NULL && *varstring != '\0') @@ -96,7 +84,7 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream, demangled_args = (*varstring != '\0' && varstring[strlen (varstring) - 1] == ')'); - f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0); + f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0, false); } } @@ -161,12 +149,17 @@ f_type_print_varspec_prefix (struct type *type, struct ui_file *stream, /* Print any array sizes, function arguments or close parentheses needed after the variable name (to describe its type). - Args work like c_type_print_varspec_prefix. */ + Args work like c_type_print_varspec_prefix. + + PRINT_RANK_ONLY is true when TYPE is an array which should be printed + without the upper and lower bounds being specified, this will occur + when the array is not allocated or not associated and so there are no + known upper or lower bounds. */ static void f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, int show, int passed_a_ptr, int demangled_args, - int arrayprint_recurse_level) + int arrayprint_recurse_level, bool print_rank_only) { /* No static variables are permitted as an error call may occur during execution of this function. */ @@ -188,36 +181,52 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, fprintf_filtered (stream, "("); if (type_not_associated (type)) - val_print_not_associated (stream); + print_rank_only = true; else if (type_not_allocated (type)) - val_print_not_allocated (stream); - else - { - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, - 0, 0, arrayprint_recurse_level); + print_rank_only = true; + else if ((TYPE_ASSOCIATED_PROP (type) + && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type))) + || (TYPE_ALLOCATED_PROP (type) + && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type))) + || (TYPE_DATA_LOCATION (type) + && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_DATA_LOCATION (type)))) + { + /* This case exist when we ptype a typename which has the dynamic + properties but cannot be resolved as there is no object. */ + print_rank_only = true; + } - LONGEST lower_bound = f77_get_lowerbound (type); + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level, + print_rank_only); - if (lower_bound != 1) /* Not the default. */ + if (print_rank_only) + fprintf_filtered (stream, ":"); + else + { + LONGEST lower_bound = f77_get_lowerbound (type); + if (lower_bound != 1) /* Not the default. */ fprintf_filtered (stream, "%s:", plongest (lower_bound)); - /* Make sure that, if we have an assumed size array, we - print out a warning and print the upperbound as '*'. */ + /* Make sure that, if we have an assumed size array, we + print out a warning and print the upperbound as '*'. */ - if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) - fprintf_filtered (stream, "*"); - else - { - LONGEST upper_bound = f77_get_upperbound (type); + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "*"); + else + { + LONGEST upper_bound = f77_get_upperbound (type); fputs_filtered (plongest (upper_bound), stream); - } + } + } + + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, + 0, 0, arrayprint_recurse_level, + print_rank_only); - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, - 0, 0, arrayprint_recurse_level); - } if (arrayprint_recurse_level == 1) fprintf_filtered (stream, ")"); else @@ -228,7 +237,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, case TYPE_CODE_PTR: case TYPE_CODE_REF: f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0, - arrayprint_recurse_level); + arrayprint_recurse_level, false); fprintf_filtered (stream, " )"); break; @@ -237,7 +246,8 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, int i, nfields = TYPE_NFIELDS (type); f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, - passed_a_ptr, 0, arrayprint_recurse_level); + passed_a_ptr, 0, + arrayprint_recurse_level, false); if (passed_a_ptr) fprintf_filtered (stream, ") "); fprintf_filtered (stream, "("); @@ -416,7 +426,7 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, fputs_filtered (" :: ", stream); fputs_filtered (TYPE_FIELD_NAME (type, index), stream); f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index), - stream, show - 1, 0, 0, 0); + stream, show - 1, 0, 0, 0, false); fputs_filtered ("\n", stream); } fprintfi_filtered (level, stream, "End Type "); 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\"" \ |