From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x329.google.com (mail-wm1-x329.google.com [IPv6:2a00:1450:4864:20::329]) by sourceware.org (Postfix) with ESMTPS id 5FBAA3857C6F for ; Wed, 31 Mar 2021 20:13:34 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 5FBAA3857C6F Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=embecosm.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=andrew.burgess@embecosm.com Received: by mail-wm1-x329.google.com with SMTP id j4-20020a05600c4104b029010c62bc1e20so1747810wmi.3 for ; Wed, 31 Mar 2021 13:13:34 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=date:from:to:subject:message-id:references:mime-version :content-disposition:in-reply-to; bh=sXv2463G8aGVlcytIL5e4tWq4WSKCvt6UWcHNr1Xpos=; b=Q/PNrKjppzuTvvJJDipnqTG+PBb+dt/xlKNOzhvCTmsAk61e6uBWR06CZ5tTTDTmf4 gUIyYhU68UbkcV7Uuip3E7rlwnvECtP93xmKf+8LrgSbESQdQlBxbcmnW+GsfEHOc9Ym CeGZella9hloMR1FyHUALborHUILqyuyx6xL0vxi51lzAYNk/nAM849ttQlk0h+Fm3TE MQZBQJqCzLwH096JWM8CCU5o7kW9H+C/HRSCFsH+/sIFWOlYJXvjdrp+043wluuOEHoe TMRlbli+FugOs9yjcJtSYtT4ATDb383aXZqaJL+N6iohD8doMKD/670FWdb8oqkEO++Q dC4A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:date:from:to:subject:message-id:references :mime-version:content-disposition:in-reply-to; bh=sXv2463G8aGVlcytIL5e4tWq4WSKCvt6UWcHNr1Xpos=; b=db1856wPgzaKGVUMcKXBNMXvP2Gkz21GZMAj5r7hTrCgYsE0sHWJ6M9Sd3gUuqiALV 63FnromLVe6I6mhs2FB+iHItbpdsb305SBe1tzZMb3/OE6hwJSA+fAuH8FPICLGLEhQB gu2qzZk5VdqSGj90LDfep2t5KaNfVqaQepgwG6/wRLIw9+fwRUaLOQEJER/5AAR9PCyR ESNBiJAvnNsKT/p2XYhjGkhJZDJyvMoPNpR8Zws7zUl4CvFK3aCFBPIulL0fnfQfzITv S52pesMewBXzJ4Wye3jBg2k8XFjumDOodjINWh1Mv/Kh5FCox4LRQZdf/j6yCYO8Mrlb vdtg== X-Gm-Message-State: AOAM533aP+i1TROUyti6WHfjy3q8IsaP+WdiyGztcixxVByDmaUiIWF2 6ToZ3kMh6qTn8elLb36dQ7NDamQGzA3kvg== X-Google-Smtp-Source: ABdhPJyS6Vx8LJgoKvwuaRzAEf515/ctsJ3wIEV7czTOFFKqxmCVf4483oRzSUjMQAd4ZL5JTzz5Pw== X-Received: by 2002:a05:600c:1913:: with SMTP id j19mr4623128wmq.155.1617221613021; Wed, 31 Mar 2021 13:13:33 -0700 (PDT) Received: from localhost (host109-151-46-70.range109-151.btcentralplus.com. [109.151.46.70]) by smtp.gmail.com with ESMTPSA id o8sm5253028wmr.28.2021.03.31.13.13.32 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 31 Mar 2021 13:13:32 -0700 (PDT) Date: Wed, 31 Mar 2021 21:13:32 +0100 From: Andrew Burgess To: gdb-patches@sourceware.org Subject: Re: [PATCH] gdb/fortran: handle dynamic types within arrays and structures Message-ID: <20210331201332.GE5391@embecosm.com> References: <20210317225843.3686644-1-andrew.burgess@embecosm.com> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <20210317225843.3686644-1-andrew.burgess@embecosm.com> X-Operating-System: Linux/5.8.18-100.fc31.x86_64 (x86_64) X-Uptime: 21:13:20 up 1 day, 5:40, X-Editor: GNU Emacs [ http://www.gnu.org/software/emacs ] X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 31 Mar 2021 20:13:37 -0000 Ping! Any feedback? Thanks, Andrew * Andrew Burgess [2021-03-17 22:58:43 +0000]: > This commit replaces this patch: > > https://sourceware.org/pipermail/gdb-patches/2021-January/174933.html > > which was itself a replacement for this patch: > > https://sourceware.org/pipermail/gdb-patches/2020-July/170335.html > > The motivation behind the original patch can be seen in the new test, > which currently gives a GDB session like this: > > (gdb) ptype var8 > type = Type type6 > PTR TO -> ( Type type2 :: ptr_1 ) > PTR TO -> ( Type type2 :: ptr_2 ) > End Type type6 > (gdb) ptype var8%ptr_2 > type = PTR TO -> ( Type type2 > integer(kind=4) :: spacer > Type type1, allocatable :: t2_array(:) <------ Issue #1 > End Type type2 ) > (gdb) ptype var8%ptr_2%t2_array > Cannot access memory at address 0x38 <------ Issue #2 > (gdb) > > Issue #1: Here we see the abstract dynamic type, rather than the > resolved concrete type. Though in some cases the user might be > interested in the abstract dynamic type, I think that in most cases > showing the resolved concrete type will be of more use. Plus, the > user can always figure out the dynamic type (by source code inspection > if nothing else) given the concrete type, but it is much harder to > figure out the concrete type given only the dynamic type. > > Issue #2: In this example, GDB evaluates the expression in > EVAL_AVOID_SIDE_EFFECTS mode (due to ptype). The value returned for > var8%ptr_2 will be a non-lazy, zero value of the correct dynamic > type. However, when GDB asks about the type of t2_array this requires > GDB to access the value of var8%ptr_2 in order to read the dynamic > properties. As this value was forced to zero (thanks to the use of > EVAL_AVOID_SIDE_EFFECTS) then GDB ends up accessing memory at a base > of zero plus some offset. > > Both this patch, and my previous two attempts, have all tried to > resolve this problem by stopping EVAL_AVOID_SIDE_EFFECTS replacing the > result value with a zero value in some cases. > > This new patch is influenced by how Ada handles its tagged typed. > There are plenty of examples in ada-lang.c, but one specific case is > ada_structop_operation::evaluate. When GDB spots that we are dealing > with a tagged (dynamic) type, and we're in EVAL_AVOID_SIDE_EFFECTS > mode, then GDB re-evaluates the child operation in EVAL_NORMAL mode. > > This commit handles two cases like this specifically for Fortran, a > new fortran_structop_operation, and the already existing > fortran_undetermined, which is where we handle array accesses. > > In these two locations we spot when we are dealing with a dynamic type > and re-evaluate the child operation in EVAL_NORMAL mode so that we > are able to access the dynamic properties of the type. > > The rest of this commit message is my attempt to record why my > previous patches failed. > > To understand my second patch, and why it failed lets consider two > expressions, this Fortran expression: > > (gdb) ptype var8%ptr_2%t2_array -- > Operation: STRUCTOP_STRUCT --(1) > Operation: STRUCTOP_STRUCT --(2) > Operation: OP_VAR_VALUE --(3) > Symbol: var8 > Block: 0x3980ac0 > String: ptr_2 > String: t2_array > > And this C expression: > > (gdb) ptype ptr && ptr->a == 3 -- > Operation: BINOP_LOGICAL_AND --(4) > Operation: OP_VAR_VALUE --(5) > Symbol: ptr > Block: 0x45a2a00 > Operation: BINOP_EQUAL --(6) > Operation: STRUCTOP_PTR --(7) > Operation: OP_VAR_VALUE --(8) > Symbol: ptr > Block: 0x45a2a00 > String: a > Operation: OP_LONG --(9) > Type: int > Constant: 0x0000000000000003 > > In expression we should assume that t2_array is of dynamic type. > Nothing has dynamic type in expression . > > This is how GDB currently handles expression , in all cases, > EVAL_AVOID_SIDE_EFFECTS or EVAL_NORMAL, an OP_VAR_VALUE operation > always returns the real value of the symbol, this is not forced to a > zero value even in EVAL_AVOID_SIDE_EFFECTS mode. This means that (3), > (5), and (8) will always return a real lazy value for the symbol. > > However a STRUCTOP_STRUCT will always replace its result with a > non-lazy, zero value with the same type as its result. So (2) will > lookup the field ptr_2 and create a zero value with that type. In > this case the type is a pointer to a dynamic type. > > Then, when we evaluate (1) to figure out the resolved type of > t2_array, we need to read the types dynamic properties. These > properties are stored in memory relative to the objects base address, > and the base address is in var8%ptr_2, which we already figured out > has the value zero. GDB then evaluates the DWARF expressions that > take the base address, add an offset and dereference. GDB then ends > up trying to access addresses like 0x16, 0x8, etc. > > To fix this, I proposed changing STRUCTOP_STRUCT so that instead of > returning a zero value we instead returned the actual value > representing the structure's field in the target. My thinking was > that GDB would not try to access the value's contents unless it needed > it to resolve a dynamic type. This belief was incorrect. > > Consider expression . We already know that (5) and (8) will return > real values for the symbols being referenced. The BINOP_LOGICAL_AND, > operation (4) will evaluate both of its children in > EVAL_AVOID_SIDE_EFFECTS in order to get the types, this is required > for C++ operator lookup. This means that even if the value of (5) > would result in the BINOP_LOGICAL_AND returning false (say, ptr is > NULL), we still evaluate (6) in EVAL_AVOID_SIDE_EFFECTS mode. > > Operation (6) will evaluate both children in EVAL_AVOID_SIDE_EFFECTS > mode, operation (9) is easy, it just returns a value with the constant > packed into it, but (7) is where the problem lies. Currently in GDB > this STRUCTOP_STRUCT will always return a non-lazy zero value of the > correct type. > > When the results of (7) and (9) are back in the BINOP_LOGICAL_AND > operation (6), the two values are passed to value_equal which performs > the comparison and returns a result. Note, the two things compared > here are the immediate value (9), and a non-lazy zero value from (7). > > However, with my proposed patch operation (7) no longer returns a zero > value, instead it returns a lazy value representing the actual value > in target memory. When we call value_equal in (6) this code causes > GDB to try and fetch the actual value from target memory. If `ptr` is > NULL then this will cause GDB to access some invalid address at an > offset from zero, this will most likely fail, and cause GDB to throw > an error instead of returning the expected type. > > And so, we can now describe the problem that we're facing. The way > GDB's expression evaluator is currently written we assume, when in > EVAL_AVOID_SIDE_EFFECTS mode, that any value returned from a child > operation can safely have its content read without throwing an > error. If child operations start returning real values (instead of > the fake zero values), then this is simply not true. > > If we wanted to work around this then we would need to rewrite almost > all operations (I would guess) so that EVAL_AVOID_SIDE_EFFECTS mode > does not cause evaluation of an operation to try and read the value of > a child operation. As an example, consider this current GDB code from > eval.c: > > struct value * > eval_op_equal (struct type *expect_type, struct expression *exp, > enum noside noside, enum exp_opcode op, > struct value *arg1, struct value *arg2) > { > if (binop_user_defined_p (op, arg1, arg2)) > { > return value_x_binop (arg1, arg2, op, OP_NULL, noside); > } > else > { > binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2); > int tem = value_equal (arg1, arg2); > struct type *type = language_bool_type (exp->language_defn, > exp->gdbarch); > return value_from_longest (type, (LONGEST) tem); > } > } > > We could change this function to be this: > > struct value * > eval_op_equal (struct type *expect_type, struct expression *exp, > enum noside noside, enum exp_opcode op, > struct value *arg1, struct value *arg2) > { > if (binop_user_defined_p (op, arg1, arg2)) > { > return value_x_binop (arg1, arg2, op, OP_NULL, noside); > } > else > { > struct type *type = language_bool_type (exp->language_defn, > exp->gdbarch); > if (noside == EVAL_AVOID_SIDE_EFFECTS) > return value_zero (type, VALUE_LVAL (arg1)); > else > { > binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2); > int tem = value_equal (arg1, arg2); > return value_from_longest (type, (LONGEST) tem); > } > } > } > > Now we don't call value_equal unless we really need to. However, we > would need to make the same, or similar change to almost all > operations, which would be a big task, and might not be a direction we > wanted to take GDB in. > > So, for now, I'm proposing we go with the more targeted, Fortran > specific solution, that does the minimal required in order to > correctly resolve the dynamic types. > > gdb/ChangeLog: > > * f-exp.h (class fortran_structop_operation): New class. > * f-exp.y (exp): Create fortran_structop_operation instead of the > generic structop_operation. > * f-lang.c (fortran_undetermined::evaluate): Re-evaluate > expression as EVAL_NORMAL if the result type was dynamic so we can > extract the actual array bounds. > (fortran_structop_operation::evaluate): New function. > > gdb/testsuite/ChangeLog: > > * gdb.fortran/dynamic-ptype-whatis.exp: New file. > * gdb.fortran/dynamic-ptype-whatis.f90: New file. > --- > gdb/ChangeLog | 16 ++ > gdb/f-exp.h | 16 ++ > gdb/f-exp.y | 9 +- > gdb/f-lang.c | 40 +++++ > gdb/testsuite/ChangeLog | 5 + > .../gdb.fortran/dynamic-ptype-whatis.exp | 158 ++++++++++++++++++ > .../gdb.fortran/dynamic-ptype-whatis.f90 | 93 +++++++++++ > 7 files changed, 333 insertions(+), 4 deletions(-) > create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp > create mode 100644 gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90 > > diff --git a/gdb/f-exp.h b/gdb/f-exp.h > index b3d0e0e9d54..955d1873f51 100644 > --- a/gdb/f-exp.h > +++ b/gdb/f-exp.h > @@ -273,6 +273,22 @@ class fortran_bound_2arg > { return std::get<0> (m_storage); } > }; > > +/* Implement STRUCTOP_STRUCT for Fortran. */ > +class fortran_structop_operation > + : public structop_base_operation > +{ > +public: > + > + using structop_base_operation::structop_base_operation; > + > + value *evaluate (struct type *expect_type, > + struct expression *exp, > + enum noside noside) override; > + > + enum exp_opcode opcode () const override > + { return STRUCTOP_STRUCT; } > +}; > + > } /* namespace expr */ > > #endif /* FORTRAN_EXP_H */ > diff --git a/gdb/f-exp.y b/gdb/f-exp.y > index ce11b09b18e..6608831a9a5 100644 > --- a/gdb/f-exp.y > +++ b/gdb/f-exp.y > @@ -492,7 +492,7 @@ exp : '(' type ')' exp %prec UNARY > > exp : exp '%' name > { > - pstate->push_new > + pstate->push_new > (pstate->pop (), copy_name ($3)); > } > ; > @@ -500,8 +500,8 @@ exp : exp '%' name > exp : exp '%' name COMPLETE > { > structop_base_operation *op > - = new structop_operation (pstate->pop (), > - copy_name ($3)); > + = new fortran_structop_operation (pstate->pop (), > + copy_name ($3)); > pstate->mark_struct_expression (op); > pstate->push (operation_up (op)); > } > @@ -510,7 +510,8 @@ exp : exp '%' name COMPLETE > exp : exp '%' COMPLETE > { > structop_base_operation *op > - = new structop_operation (pstate->pop (), ""); > + = new fortran_structop_operation (pstate->pop (), > + ""); > pstate->mark_struct_expression (op); > pstate->push (operation_up (op)); > } > diff --git a/gdb/f-lang.c b/gdb/f-lang.c > index 0c49420e1f1..7e921b99517 100644 > --- a/gdb/f-lang.c > +++ b/gdb/f-lang.c > @@ -1405,6 +1405,9 @@ fortran_undetermined::evaluate (struct type *expect_type, > enum noside noside) > { > value *callee = std::get<0> (m_storage)->evaluate (nullptr, exp, noside); > + if (noside == EVAL_AVOID_SIDE_EFFECTS > + && is_dynamic_type (value_type (callee))) > + callee = std::get<0> (m_storage)->evaluate (nullptr, exp, EVAL_NORMAL); > struct type *type = check_typedef (value_type (callee)); > enum type_code code = type->code (); > > @@ -1490,6 +1493,43 @@ fortran_bound_2arg::evaluate (struct type *expect_type, > return fortran_bounds_for_dimension (lbound_p, exp->gdbarch, arg1, arg2); > } > > +/* Implement STRUCTOP_STRUCT for Fortran. See operation::evaluate in > + expression.h for argument descriptions. */ > + > +value * > +fortran_structop_operation::evaluate (struct type *expect_type, > + struct expression *exp, > + enum noside noside) > +{ > + value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside); > + const char *str = std::get<1> (m_storage).c_str (); > + if (noside == EVAL_AVOID_SIDE_EFFECTS) > + { > + struct type *type = lookup_struct_elt_type (value_type (arg1), str, 1); > + > + if (type != nullptr && is_dynamic_type (type)) > + arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, EVAL_NORMAL); > + } > + > + value *elt = value_struct_elt (&arg1, NULL, str, NULL, "structure"); > + > + if (noside == EVAL_AVOID_SIDE_EFFECTS) > + { > + struct type *elt_type = value_type (elt); > + if (is_dynamic_type (elt_type)) > + { > + const gdb_byte *valaddr = value_contents_for_printing (elt); > + CORE_ADDR address = value_address (elt); > + gdb::array_view view > + = gdb::make_array_view (valaddr, TYPE_LENGTH (elt_type)); > + elt_type = resolve_dynamic_type (elt_type, view, address); > + } > + elt = value_zero (elt_type, VALUE_LVAL (elt)); > + } > + > + return elt; > +} > + > } /* namespace expr */ > > /* See language.h. */ > diff --git a/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp > new file mode 100644 > index 00000000000..d2ffd6d73f7 > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.exp > @@ -0,0 +1,158 @@ > +# Copyright 2021 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 . > + > +# Test using whatis and ptype on different configurations of dynamic > +# types. > + > +if {[skip_fortran_tests]} { return -1 } > + > +standard_testfile ".f90" > +load_lib fortran.exp > + > +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ > + {debug f90}]} { > + return -1 > +} > + > +if {![fortran_runto_main]} { > + perror "Could not run to main." > + continue > +} > + > +gdb_breakpoint [gdb_get_line_number "Break Here"] > +gdb_continue_to_breakpoint "Break Here" > + > +gdb_test "whatis var1" "type = real\\(kind=4\\) \\(3\\)" > +gdb_test "whatis var2" "type = real\\(kind=4\\), allocatable \\(4\\)" > +gdb_test "whatis var3" "type = Type type1" > +gdb_test "whatis var4" "type = Type type2" > +gdb_test "whatis var5" "type = Type type3" > +gdb_test "whatis var6" "type = Type type4" > +gdb_test "whatis var7" "type = Type type5" > +gdb_test "ptype var1" "type = real\\(kind=4\\) \\(3\\)" > +gdb_test "ptype var2" "type = real\\(kind=4\\), allocatable \\(4\\)" > +gdb_test "ptype var3" \ > + [ multi_line "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1" ] > +gdb_test "ptype var4" \ > + [multi_line "type = Type type2" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type1, allocatable :: t2_array\\(3\\)" \ > + "End Type type2"] > +gdb_test "ptype var5" \ > + [ multi_line "type = Type type3" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type1 :: t3_array\\(3\\)"\ > + "End Type type3" ] > +gdb_test "ptype var6" \ > + [ multi_line "type = Type type4" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type2, allocatable :: t4_array\\(3\\)" \ > + "End Type type4" ] > +gdb_test "ptype var7" \ > + [ multi_line "type = Type type5" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type2 :: t5_array\\(4\\)" \ > + "End Type type5" ] > +gdb_test "whatis var3%t1_i" "type = integer\\(kind=4\\)" > +gdb_test "whatis var4%t2_array" "type = Type type1, allocatable \\(3\\)" > +gdb_test "whatis var5%t3_array" "type = Type type1 \\(3\\)" > +gdb_test "whatis var6%t4_array" "type = Type type2, allocatable \\(3\\)" > +gdb_test "whatis var7%t5_array" "type = Type type2 \\(4\\)" > +gdb_test "ptype var3%t1_i" [ multi_line "type = integer\\(kind=4\\)" ] > +gdb_test "ptype var4%t2_array" [ multi_line "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1, allocatable \\(3\\)" ] > +gdb_test "ptype var5%t3_array" [ multi_line "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1 \\(3\\)" ] > +gdb_test "ptype var6%t4_array" \ > + [ multi_line "type = Type type2" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type1, allocatable :: t2_array\\(:\\)" \ > + "End Type type2, allocatable \\(3\\)" ] > +gdb_test "ptype var7%t5_array" \ > + [ multi_line "type = Type type2" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type1, allocatable :: t2_array\\(:\\)" \ > + "End Type type2 \\(4\\)" ] > +gdb_test "whatis var4%t2_array(1)" "type = Type type1" > +gdb_test "whatis var5%t3_array(1)" "type = Type type1" > +gdb_test "whatis var6%t4_array(1)" "type = Type type2" > +gdb_test "whatis var7%t5_array(1)" "type = Type type2" > +gdb_test "ptype var4%t2_array(1)" \ > + [ multi_line "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1" ] > +gdb_test "ptype var5%t3_array(1)" \ > + [ multi_line "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1" ] > +gdb_test "ptype var6%t4_array(1)" \ > + [ multi_line "type = Type type2" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type1, allocatable :: t2_array\\(2\\)" \ > + "End Type type2" ] > +gdb_test "ptype var7%t5_array(1)" \ > + [ multi_line "type = Type type2" \ > + " integer\\(kind=4\\) :: spacer" \ > + " Type type1, allocatable :: t2_array\\(2\\)" \ > + "End Type type2" ] > +gdb_test "whatis var4%t2_array(1)%t1_i" "type = integer\\(kind=4\\)" > +gdb_test "whatis var5%t3_array(1)%t1_i" "type = integer\\(kind=4\\)" > +gdb_test "whatis var6%t4_array(1)%t2_array" \ > + "type = Type type1, allocatable \\(2\\)" > +gdb_test "whatis var7%t5_array(1)%t2_array" \ > + "type = Type type1, allocatable \\(2\\)" > +gdb_test "ptype var4%t2_array(1)%t1_i" "type = integer\\(kind=4\\)" > +gdb_test "ptype var5%t3_array(1)%t1_i" "type = integer\\(kind=4\\)" > +gdb_test "ptype var6%t4_array(1)%t2_array" \ > + [ multi_line "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1, allocatable \\(2\\)" ] > +gdb_test "ptype var7%t5_array(1)%t2_array" \ > + [ multi_line "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1, allocatable \\(2\\)" ] > +gdb_test "whatis var6%t4_array(1)%t2_array(1)" \ > + "type = Type type1" > +gdb_test "whatis var7%t5_array(1)%t2_array(1)" \ > + "type = Type type1" > +gdb_test "ptype var6%t4_array(1)%t2_array(1)" \ > + [ multi_line \ > + "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1" ] > +gdb_test "ptype var7%t5_array(1)%t2_array(1)" \ > + [ multi_line \ > + "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1" ] > +gdb_test "ptype var8%ptr_1%t2_array" \ > + [ multi_line \ > + "type = Type type1" \ > + " integer\\(kind=4\\) :: spacer" \ > + " integer\\(kind=4\\) :: t1_i" \ > + "End Type type1, allocatable \\(3\\)" ] > diff --git a/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90 b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90 > new file mode 100644 > index 00000000000..e56bf7952dc > --- /dev/null > +++ b/gdb/testsuite/gdb.fortran/dynamic-ptype-whatis.f90 > @@ -0,0 +1,93 @@ > +! Copyright 2021 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 main > + > + ! A non-dynamic type. > + type type1 > + integer(kind=4) :: spacer > + integer(kind=4) t1_i > + end type type1 > + > + ! A first dynamic type. The array is of a static type. > + type type2 > + integer(kind=4) :: spacer > + type(type1), allocatable :: t2_array(:) > + end type type2 > + > + ! Another dynamic type, the array is again a static type. > + type type3 > + integer(kind=4) :: spacer > + type(type1), pointer :: t3_array(:) > + end type type3 > + > + ! A dynamic type, this time the array contains a dynamic type. > + type type4 > + integer(kind=4) :: spacer > + type(type2), allocatable :: t4_array(:) > + end type type4 > + > + ! A static type, the array though contains dynamic types. > + type type5 > + integer(kind=4) :: spacer > + type(type2) :: t5_array (4) > + end type type5 > + > + ! A static type containing pointers to a type that contains a > + ! dynamic array. > + type type6 > + type(type2), pointer :: ptr_1 > + type(type2), pointer :: ptr_2 > + end type type6 > + > + real, dimension(:), pointer :: var1 > + real, dimension(:), allocatable :: var2 > + type(type1) :: var3 > + type(type2), target :: var4 > + type(type3) :: var5 > + type(type4) :: var6 > + type(type5) :: var7 > + type(type6) :: var8 > + > + allocate (var1 (3)) > + > + allocate (var2 (4)) > + > + allocate (var4%t2_array(3)) > + > + allocate (var5%t3_array(3)) > + > + allocate (var6%t4_array(3)) > + allocate (var6%t4_array(1)%t2_array(2)) > + allocate (var6%t4_array(2)%t2_array(5)) > + allocate (var6%t4_array(3)%t2_array(4)) > + > + allocate (var7%t5_array(1)%t2_array(2)) > + allocate (var7%t5_array(2)%t2_array(5)) > + allocate (var7%t5_array(3)%t2_array(4)) > + allocate (var7%t5_array(4)%t2_array(1)) > + > + var8%ptr_1 => var4 > + var8%ptr_2 => var4 > + > + print *, var1 ! Break Here > + print *, var2 > + print *, var3 > + print *, var4%t2_array(1) > + print *, var5%t3_array(2) > + print *, var6%t4_array(1)%t2_array(1) > + print *, var7%t5_array(1)%t2_array(1) > + > +end program main > -- > 2.25.4 >