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.
This commit is contained in:
Andrew Burgess
parent
30056ea04a
commit
584a927c5a
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
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;
|
||||
}
|
||||
|
||||
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 (print_rank_only)
|
||||
fprintf_filtered (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);
|
||||
|
||||
LONGEST lower_bound = f77_get_lowerbound (type);
|
||||
|
||||
if (lower_bound != 1) /* Not the default. */
|
||||
{
|
||||
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 ");
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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 \\)"
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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\"" \
|
||||
|
|
|
|||
Loading…
Reference in New Issue