From patchwork Wed May 15 11:16:06 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Burgess X-Patchwork-Id: 32693 Received: (qmail 79344 invoked by alias); 15 May 2019 11:16:16 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 79331 invoked by uid 89); 15 May 2019 11:16:15 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=1, 1 X-HELO: mail-wr1-f42.google.com Received: from mail-wr1-f42.google.com (HELO mail-wr1-f42.google.com) (209.85.221.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 15 May 2019 11:16:12 +0000 Received: by mail-wr1-f42.google.com with SMTP id c5so2182118wrs.11 for ; Wed, 15 May 2019 04:16:11 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=from:to:cc:subject:date:message-id; bh=6KsXpw8NbQHqtXZwFNA7MJSewuVpxlkn28wZrSj+844=; b=CQBobbhw194qu18BqGu/Ih6t0F2uLHbQ4kXa1+9Kr5AZcOkm37iy5xDwYIg1f9geEs 4xqDXJnimHzMFZdg2kt3p5AEv9VQLJ3ZPy6yQIq/FMLGrvM5GF0c7SE3WMOp9tGwotOc xr82uou9OFPVBQ9TCs5E108rZ3h+QsOwRTtXuHJbQnedxACcm5at1Ij5wT5cD4ecLf2w RB4WuWgbvncbFCqjkhWzJwnvsTXVAgAuwE9m96nFhC2J/eU3VP6R+zv793fw5VuUyUaS sVXFAszwooeiBkrydMlufr9poHr53PRyYgG6olzu0kwrR3g9/tsjdPlsjPUqrCdXSoES iTGA== Return-Path: Received: from localhost (host86-180-62-212.range86-180.btcentralplus.com. [86.180.62.212]) by smtp.gmail.com with ESMTPSA id w13sm6233515wmk.0.2019.05.15.04.16.08 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 15 May 2019 04:16:08 -0700 (PDT) From: Andrew Burgess To: gdb-patches@sourceware.org Cc: Andrew Burgess Subject: [PATCH] gdb/fortran: Show the type for non allocated / associated types Date: Wed, 15 May 2019 12:16:06 +0100 Message-Id: <20190515111606.6754-1-andrew.burgess@embecosm.com> X-IsSubscribed: yes This is an update of this patch: https://sourceware.org/ml/gdb-patches/2018-11/msg00474.html The only minor changes from the original patch are: + updating to use 'bool' instead of 'int' for a flag parameter, + updating expected testsuite results to take account of some other changes I've made in GDB's Fortran support, + probably some other minor comments / layout changes throughout. --- 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 = (gdb) p vla $1 = (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 = (gdb) The type of 'vla' is now printed correctly, while the value itself still shows as ''. 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. --- gdb/ChangeLog | 9 +++ gdb/f-typeprint.c | 83 +++++++++++----------- gdb/testsuite/ChangeLog | 10 +++ gdb/testsuite/gdb.fortran/pointers.f90 | 80 ++++++++++++++++++++++ gdb/testsuite/gdb.fortran/print_type.exp | 114 +++++++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 ++-- gdb/testsuite/gdb.fortran/vla-type.exp | 7 +- gdb/testsuite/gdb.fortran/vla-value.exp | 10 +-- gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 8 +-- 9 files changed, 277 insertions(+), 56 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/pointers.f90 create mode 100755 gdb/testsuite/gdb.fortran/print_type.exp diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index a7c1a00a714..659ed05a75e 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); } } @@ -166,7 +154,7 @@ f_type_print_varspec_prefix (struct type *type, struct ui_file *stream, 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 +176,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 +232,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 +241,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 +421,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/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90 new file mode 100644 index 00000000000..af0c9892995 --- /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 . + +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 00000000000..2d6fb34e4e3 --- /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 . + +# 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 0f4abb63757..a4c3c9c7030 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 = " "ptype vla1 not initialized" -gdb_test "ptype vla2" "type = " "ptype vla2 not initialized" -gdb_test "ptype pvla" "type = " "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 = " "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 = " "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 = " "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 951f118194a..b88a3d042d1 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 = " +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\\(\\)" \ + " $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 be397fd95fb..3cf5d675005 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" " = " "print non-allocated vla1" gdb_test "print &vla1" \ - " = \\\(PTR TO -> \\\( $real, allocatable \\\(\\\) \\\)\\\) $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" " = " "print undefined pvla" gdb_test "print &pvla" \ - " = \\\(PTR TO -> \\\( $real \\\(\\\) \\\)\\\) $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 0759ccbaebe..ec04bbe5a69 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=\"\"" "evaluate not allocated vla, before allocation" -mi_create_varobj_checked vla1_not_allocated vla1 "" \ +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=\"\"" \ + "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=\"\".*${mi_gdb_prompt}$" { pass $test - mi_create_varobj_checked pvla2_not_associated pvla2 "" \ + 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=\"\"" \ + "581\\^done,type=\"$real \\(:,:\\)\"" \ "info type variable pvla2_not_associated" mi_gdb_test "582-var-show-format pvla2_not_associated" \ "582\\^done,format=\"natural\"" \