From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 59379 invoked by alias); 4 Jul 2016 09:52:58 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Received: (qmail 59204 invoked by uid 89); 4 Jul 2016 09:52:57 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.1 required=5.0 tests=AWL,BAYES_00,KAM_LAZY_DOMAIN_SECURITY,RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=type_code, sk:propert, refers, logical X-HELO: mga01.intel.com Received: from mga01.intel.com (HELO mga01.intel.com) (192.55.52.88) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 04 Jul 2016 09:52:47 +0000 Received: from orsmga002.jf.intel.com ([10.7.209.21]) by fmsmga101.fm.intel.com with ESMTP; 04 Jul 2016 02:52:47 -0700 X-ExtLoop1: 1 Received: from irvmail001.ir.intel.com ([163.33.26.43]) by orsmga002.jf.intel.com with ESMTP; 04 Jul 2016 02:52:46 -0700 Received: from ulvlx001.iul.intel.com (ulvlx001.iul.intel.com [172.28.207.17]) by irvmail001.ir.intel.com (8.14.3/8.13.6/MailSET/Hub) with ESMTP id u649qht3011739; Mon, 4 Jul 2016 10:52:43 +0100 Received: from ulvlx001.iul.intel.com (localhost [127.0.0.1]) by ulvlx001.iul.intel.com with ESMTP id u649qh9I021649; Mon, 4 Jul 2016 11:52:43 +0200 Received: (from heckel@localhost) by ulvlx001.iul.intel.com with œ id u649qhLL021645; Mon, 4 Jul 2016 11:52:43 +0200 From: Bernhard Heckel To: qiyaoltc@gmail.com, eliz@gnu.org Cc: gdb-patches@sourceware.org, Bernhard Heckel Subject: [PATCH V2 3/5] Fortran: Resolve dynamic target types of pointers. Date: Mon, 04 Jul 2016 09:52:00 -0000 Message-Id: <1467625943-21294-4-git-send-email-bernhard.heckel@intel.com> In-Reply-To: <1467625943-21294-1-git-send-email-bernhard.heckel@intel.com> References: <1467625943-21294-1-git-send-email-bernhard.heckel@intel.com> X-IsSubscribed: yes X-SW-Source: 2016-07/txt/msg00034.txt.bz2 Dynamic target types of pointers have to be resolved before they can be further processed. If not, GDB wil show wrong boundaries, size,... or even crash as it will access some random memory. 2016-06-30 Bernhard Heckel gdb/Changelog: * NEWS: Added new fortran feature. * gdbtypes.c (resolve_dynamic_pointer_types): Resolve dynamic target types. * valops.c (value_ind): Throw error when pointer is not associated. gdb/Testsuite/Changelog: * gdb.fortran/pointers.f90: Add dynamic variables. * gdb.fortran/pointers.exp: Test dynamic variables. * gdb.fortran/print_type.exp: Test pointer to dynamic types. --- gdb/NEWS | 2 + gdb/gdbtypes.c | 83 ++++++++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/pointers.exp | 48 ++++++++++++++++++ gdb/testsuite/gdb.fortran/pointers.f90 | 17 +++++++ gdb/testsuite/gdb.fortran/print_type.exp | 10 ++++ gdb/valops.c | 3 ++ 6 files changed, 163 insertions(+) diff --git a/gdb/NEWS b/gdb/NEWS index 3e8e7a1..bea86d3 100644 --- a/gdb/NEWS +++ b/gdb/NEWS @@ -3,6 +3,8 @@ *** Changes since GDB 7.11 +* Fortran: Support pointers to dynamic types. + * Fortran: Support structures with fields of dynamic types and arrays of dynamic types. diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 9e1759b..76ae406 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1828,6 +1828,18 @@ is_dynamic_type_internal (struct type *type, int top_level) switch (TYPE_CODE (type)) { + case TYPE_CODE_PTR: + { + /* Some Fortran compiler don't create the associated property which + would cause a "return 1". + For a correct value/type print we have to treat every pointer as + dynamic type to cover nullified pointers as well as dynamic target + types. */ + if (current_language->la_language == language_fortran) + return 1; + + return 0; + } case TYPE_CODE_RANGE: { /* A range type is obviously dynamic if it has at least one @@ -2105,6 +2117,73 @@ resolve_dynamic_struct (struct type *type, return resolved_type; } +/* Worker for pointer types. */ + +static struct type * +resolve_dynamic_pointer (struct type *type, + struct property_addr_info *addr_stack) +{ + struct property_addr_info pinfo; + int is_associated; + + /* If valaddr is set, the type was already resolved + and assigned to an value. */ + if (0 != addr_stack->valaddr) + return type; + + if (TYPE_OBJFILE_OWNED (type)) + { + struct dynamic_prop *prop; + CORE_ADDR value; + + type = copy_type (type); + + /* Resolve associated property. */ + prop = TYPE_ASSOCIATED_PROP (type); + if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) + { + TYPE_DYN_PROP_ADDR (prop) = value; + TYPE_DYN_PROP_KIND (prop) = PROP_CONST; + is_associated = value; + } + else + { + /* Compiler doesn't create associated property for this pointer + therefore we have to check whether it is still null. */ + if (0 != read_memory_typed_address (addr_stack->addr, type)) + is_associated = 1; + else + is_associated = 0; + } + } + else + { + /* Do nothing, as this pointer is created on the fly and therefore + associated. For example "print *((integer*) &intvla)". */ + is_associated = 1; + } + + /* Don't resolve not associated pointers. */ + if (0 == is_associated) + return type; + + pinfo.type = check_typedef (TYPE_TARGET_TYPE (type)); + pinfo.valaddr = NULL; + /* Data location attr. refers to the "address of the variable". + Therefore we don't derefence anything here but + keep the "address of the variable". */ + if (NULL != TYPE_DATA_LOCATION (pinfo.type)) + pinfo.addr = addr_stack->addr; + else + pinfo.addr = read_memory_typed_address (addr_stack->addr, type); + pinfo.next = addr_stack; + TYPE_TARGET_TYPE (type) = + resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type), + &pinfo, 0); + + return type; +} + /* Worker for resolved_dynamic_type. */ static struct type * @@ -2153,6 +2232,10 @@ resolve_dynamic_type_internal (struct type *type, break; } + case TYPE_CODE_PTR: + resolved_type = resolve_dynamic_pointer (type, addr_stack); + break; + case TYPE_CODE_ARRAY: resolved_type = resolve_dynamic_array (type, addr_stack); break; diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp index beecbe4..310544c 100644 --- a/gdb/testsuite/gdb.fortran/pointers.exp +++ b/gdb/testsuite/gdb.fortran/pointers.exp @@ -59,6 +59,11 @@ gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" +gdb_breakpoint [gdb_get_line_number "Before value assignment"] +gdb_continue_to_breakpoint "Before value assignment" +gdb_test "print *(twop)%ivla2" "= " + + gdb_breakpoint [gdb_get_line_number "After value assignment"] gdb_continue_to_breakpoint "After value assignment" gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?" @@ -71,5 +76,48 @@ gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?" gdb_test "print *charap" "= 'abc'" gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?" gdb_test "print *intp" "= 10" +set test_name "print intap, associated" +gdb_test_multiple "print intap" $test_name { + -re "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)\r\n$gdb_prompt $" { + pass $test_name + } + -re "= \\(PTR TO -> \\( $int \\(10,2\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" { + gdb_test "print *intap" "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)" + pass $test_name + } +} +set test_name "print intvlap, associated" +gdb_test_multiple "print intvlap" $test_name { + -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" { + pass $test_name + } + -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" { + gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)" + pass $test_name + } +} gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?" gdb_test "print *realp" "= 3\\.14000\\d+" +gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?" +gdb_test "print *(arrayOfPtr(2)%p)" "= \\( \\(11, 12, 13\\), \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)" +set test_name "print arrayOfPtr(3)%p" +gdb_test_multiple $test_name $test_name { + -re "= \r\n$gdb_prompt $" { + pass $test_name + } + -re "= \\(PTR TO -> \\( Type two \\)\\) 0x0\r\n$gdb_prompt $" { + pass $test_name + } +} +set test_name "print *(arrayOfPtr(3)%p), associated" +gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name { + -re "Location address is not set.\r\n$gdb_prompt $" { + pass $test_name + } + -re "Attempt to take contents of a not associated pointer.\r\n$gdb_prompt $" { + pass $test_name + } +} +gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array" +gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla" +gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\)\\(\\)\\)\\) $hex " "Print program counter" diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90 index 9ebbaa9..000193c 100644 --- a/gdb/testsuite/gdb.fortran/pointers.f90 +++ b/gdb/testsuite/gdb.fortran/pointers.f90 @@ -20,14 +20,20 @@ program pointers integer, allocatable :: ivla2 (:, :) end type two + type :: twoPtr + type (two), pointer :: p + end type twoPtr + logical, target :: logv complex, target :: comv character, target :: charv character (len=3), target :: chara integer, target :: intv integer, target, dimension (10,2) :: inta + integer, target, allocatable, dimension (:) :: intvla real, target :: realv type(two), target :: twov + type(twoPtr) :: arrayOfPtr (3) logical, pointer :: logp complex, pointer :: comp @@ -35,6 +41,7 @@ program pointers character (len=3), pointer:: charap integer, pointer :: intp integer, pointer, dimension (:,:) :: intap + integer, pointer, dimension (:) :: intvlap real, pointer :: realp type(two), pointer :: twop @@ -44,8 +51,12 @@ program pointers nullify (charap) nullify (intp) nullify (intap) + nullify (intvlap) nullify (realp) nullify (twop) + nullify (arrayOfPtr(1)%p) + nullify (arrayOfPtr(2)%p) + nullify (arrayOfPtr(3)%p) logp => logv ! Before pointer assignment comp => comv @@ -53,8 +64,10 @@ program pointers charap => chara intp => intv intap => inta + intvlap => intvla realp => realv twop => twov + arrayOfPtr(2)%p => twov logv = associated(logp) ! Before value assignment comv = cmplx(1,2) @@ -63,6 +76,10 @@ program pointers intv = 10 inta(:,:) = 1 inta(3,1) = 3 + allocate (intvla(10)) + intvla(:) = 2 + intvla(4) = 4 + intvlap => intvla realv = 3.14 allocate (twov%ivla1(3)) diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp index 37e19ec..1b23af3 100755 --- a/gdb/testsuite/gdb.fortran/print_type.exp +++ b/gdb/testsuite/gdb.fortran/print_type.exp @@ -62,6 +62,16 @@ gdb_test "ptype two" \ " $int :: 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 :: ivla1\\(:\\)" \ + " $int :: 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" diff --git a/gdb/valops.c b/gdb/valops.c index 71fb1b3..5ef0c65 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -1554,6 +1554,9 @@ value_ind (struct value *arg1) { struct type *enc_type; + if (type_not_associated (base_type)) + error (_("Attempt to take contents of a not associated pointer.")); + /* We may be pointing to something embedded in a larger object. Get the real type of the enclosing object. */ enc_type = check_typedef (value_enclosing_type (arg1)); -- 2.7.1.339.g0233b80