From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x32b.google.com (mail-wm1-x32b.google.com [IPv6:2a00:1450:4864:20::32b]) by sourceware.org (Postfix) with ESMTPS id DD8FA385782A for ; Wed, 17 Mar 2021 22:58:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org DD8FA385782A 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-x32b.google.com with SMTP id r10-20020a05600c35cab029010c946c95easo2219867wmq.4 for ; Wed, 17 Mar 2021 15:58:47 -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:mime-version :content-transfer-encoding; bh=XChtR0+Mzv9QFDOrDcHEBAWfRkJd4TRGI2/378tKVF4=; b=XqpMzlLEfw9oNHIA+G0fk7UqbXcGSSgZMkmgPJLES7XtISBYaSFAr5qtjQeQaln0EX ZkAqXHAsHzuOUiE/x71RHBecbWDX7cT3rhBMSNK/BcH5F7Xa5Q4pSmpsWaSBnn5ZRhP8 FdOVV5MfzphNitd9smKVXOks2JlvemvlW1ueJeLafR3Fc4Ny+AJXoH3fFgliuIDgR7Fi J4aa7YxyO4vEhBdLoqOptqiFhJmL8Ccq1buV2nOAjHab1zkferg4+VRlDT2Exd6UgORX sznxEt9snRwpYEJ1rfqOdmnEytEnw1DbO/RrDDvUV5/K7fqD/y/UsESeBW3r163szaPu ucNQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=XChtR0+Mzv9QFDOrDcHEBAWfRkJd4TRGI2/378tKVF4=; b=VQuIUf7nT9p9OyNmAeWapBZmum7MNUe6dvNphDQj3Rom5F4ABPZ4dwpGyKwr83meJC YawDK0x3KD996xc+834feB9U+J0EEceBjQEOg/amYAlrsHAYRHI38G3PKlEjvDJQg9Oq GsfaVJ7xihrLJAQMoVBI9L4OohwrPElPrtk00+iG7UpemGKBSowNbXHjlH8jd7G5hupq 7ckX81RwD6tp3Ih0lElQzCSInf/IIcKJkY+J767u2hGSRQHV9xd1B/kF63LUXy4H0I/f SRbwArQOBH7abxHAGx3+QmaJ2kHQ6KCnwfmsLKIpeHcMmTvc7/QLEts+xd0Mw7zyDgFg NYow== X-Gm-Message-State: AOAM530wIYT3QuQKddW2Im4t2PR6UvfysmS/sthaczqfKS9Uda+7IJCR Ja5I7AGpO2cnKJOW8eSckDxrUee/J6zpbw== X-Google-Smtp-Source: ABdhPJzHQ0ZMgLa35mzG/yGdJPg5pgn4iAHuxt9Yi0Evlhk3C9FVn77N6sVwyXkXqZzI7D6JjnC4dg== X-Received: by 2002:a1c:5f89:: with SMTP id t131mr819479wmb.173.1616021926352; Wed, 17 Mar 2021 15:58:46 -0700 (PDT) Received: from localhost (host86-134-238-232.range86-134.btcentralplus.com. [86.134.238.232]) by smtp.gmail.com with ESMTPSA id c131sm260391wma.37.2021.03.17.15.58.45 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 17 Mar 2021 15:58:46 -0700 (PDT) From: Andrew Burgess To: gdb-patches@sourceware.org Subject: [PATCH] gdb/fortran: handle dynamic types within arrays and structures Date: Wed, 17 Mar 2021 22:58:43 +0000 Message-Id: <20210317225843.3686644-1-andrew.burgess@embecosm.com> X-Mailer: git-send-email 2.25.4 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-12.0 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, 17 Mar 2021 22:58:51 -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