From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x429.google.com (mail-wr1-x429.google.com [IPv6:2a00:1450:4864:20::429]) by sourceware.org (Postfix) with ESMTPS id 86FD9383F84F for ; Fri, 10 Jul 2020 15:22:35 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 86FD9383F84F 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-wr1-x429.google.com with SMTP id a6so6364438wrm.4 for ; Fri, 10 Jul 2020 08:22:35 -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:in-reply-to:references :mime-version:content-transfer-encoding; bh=mu7g3+lLReA5gk57ug0PZzH4/uV87EOywOQahPfMtSk=; b=deHIX7NIxfOIQAWf9pPEkWWqPeRmjA5uzt1FZSRZel4rej7myKRY/Txa4lqrYfdJtl /8mP7hX0dJx2ZkyB4j10ghi7TB2N34cLmM22odV2uL4AyYUynqO2ljka6FsMwa8zbIoo jGXgH6GUHFvWZZuKmmR0jM/bmzeiFlGuHldr6w0OZr7Ly++52dgRd9Qmyk6UJJzYwQNu Ub+QXGBuE2N3expFolrusMTiyC6a2xkJuBI0n2V0Ss7mB5hamcNBL+0wOCufi86e3beH J3fVGzIuq56rbU82xR/wqB493I/R+nubJphnOfL8TfrBiNne/zCskNqtFyNuXRxCSdt7 Ca/w== 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:in-reply-to :references:mime-version:content-transfer-encoding; bh=mu7g3+lLReA5gk57ug0PZzH4/uV87EOywOQahPfMtSk=; b=hZEAO+W3xzESFqHkA5KKfaSwtcNECFXUfRxLwiXI8KQU6RCxK8f9+7BfBdXtN2jLvC +m6bzZTDI+JlMOjyFYw0dxXRty+DDr47kZ7qONyiiyl2zHsQm4ZCCovQOFjrxjRKkqUX K8LxYXiPoeZpWuuDnodFvpUg/hPKC03iT/yYwFurRXIyf5h4WB4T8FOD+BuJ8AQog1CH xfaw8vOAL6aHo+chKuuCMkq48hHkmPFFwjGkBZOIpXOyt46uzM1T0XwkAYgYO7vMS9B1 /iNzi33InoQ3hl+DDcHIQ3g3x4z52WcTs5JKpUJZIId00sHZRuglFdqWyayzCN2Qi3zE tZkg== X-Gm-Message-State: AOAM532Ncpg3qjeuurM102lD1jepIM+wB8+Rm1ckxtvRrRXAcc2utm0R IrtCtWwoo8Ti4b3w2wHGaQROW1qPM5o= X-Google-Smtp-Source: ABdhPJzIlR9FtOqRyM2SYEOA74b/2k9mayTgi4l40UeVHGHPRgqT4qWL7WNv6aNipPhiHofxoE//nw== X-Received: by 2002:a5d:60d1:: with SMTP id x17mr68065866wrt.293.1594394554107; Fri, 10 Jul 2020 08:22:34 -0700 (PDT) Received: from localhost (host109-154-20-168.range109-154.btcentralplus.com. [109.154.20.168]) by smtp.gmail.com with ESMTPSA id q5sm10648569wrp.60.2020.07.10.08.22.33 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 10 Jul 2020 08:22:33 -0700 (PDT) From: Andrew Burgess To: gdb-patches@sourceware.org Subject: [PATCH 1/2] gdb/fortran: resolve dynamic types when readjusting after an indirection Date: Fri, 10 Jul 2020 16:22:28 +0100 Message-Id: X-Mailer: git-send-email 2.25.4 In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-10.2 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: Fri, 10 Jul 2020 15:22:37 -0000 After dereferencing a pointer (in value_ind) or following a reference (in coerce_ref) we call readjust_indirect_value_type to "fixup" the type of the resulting value object. This fixup handles cases relating to the type of the resulting object being different (a sub-class) of the original pointers target type. If we encounter a pointer to a dynamic type then after dereferencing a pointer (in value_ind) the type of the object created will have had its dynamic type resolved. However, in readjust_indirect_value_type, we use the target type of the original pointer to "fixup" the type of the resulting value. In this case, the target type will be a dynamic type, so the resulting value object, once again has a dynamic type. This then triggers an assertion later within GDB. The solution I propose here is that we call resolve_dynamic_type on the pointer's target type (within readjust_indirect_value_type) so that the resulting value is not converted back to a dynamic type. The test case is based on the original test in the bug report. gdb/ChangeLog: PR fortran/26139 * valops.c (value_ind): Pass address to readjust_indirect_value_type. * value.c (readjust_indirect_value_type): Make parameter non-const, and add extra address parameter. Resolve original type before using it. * value.h (readjust_indirect_value_type): Update function signature and comment. gdb/testsuite/ChangeLog: PR fortran/26139 * gdb.fortran/class-allocatable-array.exp: New file. * gdb.fortran/class-allocatable-array.f90: New file. --- gdb/ChangeLog | 11 ++++ gdb/testsuite/ChangeLog | 6 +++ .../gdb.fortran/class-allocatable-array.exp | 43 +++++++++++++++ .../gdb.fortran/class-allocatable-array.f90 | 54 +++++++++++++++++++ gdb/valops.c | 24 +++++---- gdb/value.c | 23 +++++--- gdb/value.h | 7 ++- 7 files changed, 149 insertions(+), 19 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/class-allocatable-array.exp create mode 100644 gdb/testsuite/gdb.fortran/class-allocatable-array.f90 diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp new file mode 100644 index 00000000000..9475ba3b393 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp @@ -0,0 +1,43 @@ +# Copyright 2020 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 that GDB can print an allocatable array that is a data field +# within a class like type. + +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] { + untested "could not run to main" + return -1 +} + +gdb_breakpoint [gdb_get_line_number "Break Here"] +gdb_continue_to_breakpoint "Break Here" + +# If this first test fails then the Fortran compiler being used uses +# different names, or maybe a completely different approach, for +# representing class like structures. The following tests are +# cetainly going to fail. +gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)" +gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+" +gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)" diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 new file mode 100644 index 00000000000..26d5fab0355 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 @@ -0,0 +1,54 @@ +! Copyright 2020 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 . + +module test_module + type test_type + integer a + real, allocatable :: b (:, :) + contains + procedure :: test_proc + end type test_type + +contains + + subroutine test_proc (this) + class(test_type), intent (inout) :: this + allocate (this%b (3, 2)) + call fill_array_2d (this%b) + print *, "" ! Break Here + contains + ! Helper subroutine to fill 2-dimensional array with unique + ! values. + subroutine fill_array_2d (array) + real, dimension (:,:) :: array + real :: counter + + counter = 1.0 + do i=LBOUND (array, 2), UBOUND (array, 2), 1 + do j=LBOUND (array, 1), UBOUND (array, 1), 1 + array (j,i) = counter + counter = counter + 1 + end do + end do + end subroutine fill_array_2d + end subroutine test_proc +end module + +program test + use test_module + implicit none + type(test_type) :: t + call t%test_proc () +end program test diff --git a/gdb/valops.c b/gdb/valops.c index afdb429dc37..61625977f00 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -1559,20 +1559,24 @@ value_ind (struct value *arg1) enc_type = check_typedef (value_enclosing_type (arg1)); enc_type = TYPE_TARGET_TYPE (enc_type); + CORE_ADDR base_addr; if (check_typedef (enc_type)->code () == TYPE_CODE_FUNC || check_typedef (enc_type)->code () == TYPE_CODE_METHOD) - /* For functions, go through find_function_addr, which knows - how to handle function descriptors. */ - arg2 = value_at_lazy (enc_type, - find_function_addr (arg1, NULL)); + { + /* For functions, go through find_function_addr, which knows + how to handle function descriptors. */ + base_addr = find_function_addr (arg1, NULL); + } else - /* Retrieve the enclosing object pointed to. */ - arg2 = value_at_lazy (enc_type, - (value_as_address (arg1) - - value_pointed_to_offset (arg1))); - + { + /* Retrieve the enclosing object pointed to. */ + base_addr = (value_as_address (arg1) + - value_pointed_to_offset (arg1)); + } + arg2 = value_at_lazy (enc_type, base_addr); enc_type = value_type (arg2); - return readjust_indirect_value_type (arg2, enc_type, base_type, arg1); + return readjust_indirect_value_type (arg2, enc_type, base_type, + arg1, base_addr); } error (_("Attempt to take contents of a non-pointer value.")); diff --git a/gdb/value.c b/gdb/value.c index 97a099ddbd3..826cd35b43f 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -3618,10 +3618,20 @@ coerce_ref_if_computed (const struct value *arg) struct value * readjust_indirect_value_type (struct value *value, struct type *enc_type, const struct type *original_type, - const struct value *original_value) + struct value *original_value, + CORE_ADDR original_value_address) { + gdb_assert (original_type->code () == TYPE_CODE_PTR + || TYPE_IS_REFERENCE (original_type)); + + struct type *original_target_type = TYPE_TARGET_TYPE (original_type); + gdb::array_view view; + struct type *resolved_original_target_type + = resolve_dynamic_type (original_target_type, view, + original_value_address); + /* Re-adjust type. */ - deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type)); + deprecated_set_value_type (value, resolved_original_target_type); /* Add embedding info. */ set_value_enclosing_type (value, enc_type); @@ -3648,12 +3658,11 @@ coerce_ref (struct value *arg) enc_type = check_typedef (value_enclosing_type (arg)); enc_type = TYPE_TARGET_TYPE (enc_type); - retval = value_at_lazy (enc_type, - unpack_pointer (value_type (arg), - value_contents (arg))); + CORE_ADDR addr = unpack_pointer (value_type (arg), value_contents (arg)); + retval = value_at_lazy (enc_type, addr); enc_type = value_type (retval); - return readjust_indirect_value_type (retval, enc_type, - value_type_arg_tmp, arg); + return readjust_indirect_value_type (retval, enc_type, value_type_arg_tmp, + arg, addr); } struct value * diff --git a/gdb/value.h b/gdb/value.h index 70c3d5667ae..12e4a13e3e4 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -488,7 +488,9 @@ extern struct value *coerce_ref_if_computed (const struct value *arg); /* Setup a new value type and enclosing value type for dereferenced value VALUE. ENC_TYPE is the new enclosing type that should be set. ORIGINAL_TYPE and - ORIGINAL_VAL are the type and value of the original reference or pointer. + ORIGINAL_VAL are the type and value of the original reference or + pointer. ORIGINAL_VALUE_ADDRESS is the address within VALUE, that is + the address that was dereferenced. Note, that VALUE is modified by this function. @@ -497,7 +499,8 @@ extern struct value *coerce_ref_if_computed (const struct value *arg); extern struct value * readjust_indirect_value_type (struct value *value, struct type *enc_type, const struct type *original_type, - const struct value *original_val); + struct value *original_val, + CORE_ADDR original_value_address); /* Convert a REF to the object referenced. */ -- 2.25.4