On 2022-09-20 03:26, Nils-Christian Kempke via Gdb-patches wrote:
> From: Bernhard Heckel <bernhard.heckel@intel.com>
>
> This commit allows pointers to be dynamic types (on the outmost
> level). Similar to references, a pointer is considered a dynamic type
> if its target type is a dynamic type and it is on the outmost level.
>
> When resolving a dynamic pointer in resolve_dynamic_pointer
> we a) try and resolve its target type (in a similar fashion as it is
> done for references) and b) resolve the dynamic DW_AT_associated
> property, which is emitted by ifx and ifort for pointers.
>
> This generally makes the GDB output more verbose. We are able to print
> more details about a pointer's target like the dimension of an array.
>
> In Fortran, if we have a pointer to a dynamic type
>
> type buffer
> real, dimension(:), pointer :: ptr
> end type buffer
> type(buffer), pointer :: buffer_ptr
> allocate (buffer_ptr)
> allocate (buffer_ptr%ptr (5))
>
> which then gets allocated, we now resolve the dynamic type before
> printing the pointer's type:
>
> Before:
>
> (gdb) ptype buffer_ptr
> type = PTR TO -> ( Type buffer
> real(kind=4) :: alpha(:)
> End Type buffer )
>
> After:
>
> (gdb) ptype buffer_ptr
> type = PTR TO -> ( Type buffer
> real(kind=4) :: alpha(5)
> End Type buffer )
>
> Similarly in C++ we can dynamically resolve e.g. pointers to arrays:
>
> int len = 3;
> int arr[len];
> int (*ptr)[len];
> int ptr = &arr;
>
> Once the pointer is assigned one gets:
>
> Before:
>
> (gdb) p ptr
> $1 = (int (*)[variable length]) 0x123456
> (gdb) ptype ptr
> type = int (*)[variable length]
>
> After:
>
> (gdb) p ptr
> $1 = (int (*)[3]) 0x123456
> (gdb) ptype ptr
> type = int (*)[3]
>
> For more examples see the modified/added test cases.
Hi,
That all looks nice to me, that seems like some concrete improvements
for the user. I noted some nits below. I am not really familiar with
Fortran or the dynamic types thing, so I'd really like if someone more
familiar with those could take a look.
> ---
> gdb/gdbtypes.c | 53 +++++-
> gdb/testsuite/gdb.cp/vla-cxx.cc | 4 +
> gdb/testsuite/gdb.cp/vla-cxx.exp | 33 ++++
> gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp | 16 +-
> .../gdb.fortran/pointer-to-pointer.exp | 2 +-
> gdb/testsuite/gdb.fortran/pointers.exp | 178 ++++++++++++++++++
> gdb/testsuite/gdb.fortran/pointers.f90 | 29 +++
> gdb/valprint.c | 6 -
> 8 files changed, 303 insertions(+), 18 deletions(-)
> create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp
>
> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> index c458b204157..a4d79a64e95 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -2083,9 +2083,15 @@ is_dynamic_type_internal (struct type *type, int top_level)
> {
> type = check_typedef (type);
>
> - /* We only want to recognize references at the outermost level. */
> - if (top_level && type->code () == TYPE_CODE_REF)
> - type = check_typedef (TYPE_TARGET_TYPE (type));
> + /* We only want to recognize references and pointers at the outermost
> + level. */
> + if (type->code () == TYPE_CODE_REF || type->code () == TYPE_CODE_PTR)
> + {
> + if (top_level != 0)
> + type = check_typedef (TYPE_TARGET_TYPE (type));
> + else
> + return 0;
> + }
Can you explain this change here, specifically the addition of the
"return 0"?
My understanding is that for REFs and PTRs, nothing below will match and
we will end up returning 0 anyway, so this is just a new shortcut for
when the type is a REF or PTR and top_level is false. But I'd like to
confirm.
>
> /* Types that have a dynamic TYPE_DATA_LOCATION are considered
> dynamic, even if the type itself is statically defined.
> @@ -2787,6 +2793,43 @@ 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 dynamic_prop *prop;
> + CORE_ADDR value;
> +
> + /* Resolve the target type of this type. */
> + struct property_addr_info pinfo;
> + pinfo.type = check_typedef (TYPE_TARGET_TYPE (type));
> + pinfo.valaddr = {};
> + if (addr_stack->valaddr.data () != NULL)
NULL -> nullptr
> + pinfo.addr = extract_typed_address (addr_stack->valaddr.data (),
> + type);
"type" would fit on the same line
> + else
> + pinfo.addr = read_memory_typed_address (addr_stack->addr, type);
> + pinfo.next = addr_stack;
> +
> + struct type* resolved_type = copy_type (type);
Space before *
> +
> + /* Resolve associated property. */
> + prop = TYPE_ASSOCIATED_PROP (resolved_type);
> + if (prop != nullptr
> + && dwarf2_evaluate_property (prop, nullptr, addr_stack, &value))
> + prop->set_const_val (value);
> +
> + if (pinfo.addr != 0x0 && !type_not_associated (resolved_type))
> + TYPE_TARGET_TYPE (resolved_type)
> + = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type),
> + &pinfo, 0);
> +
> +
Remove one newline here.
> diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
> index 3494b5e8b77..e2bb8989212 100644
> --- a/gdb/testsuite/gdb.cp/vla-cxx.exp
> +++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
> @@ -23,6 +23,36 @@ if ![runto_main] {
> return -1
> }
>
> +gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
> +gdb_continue_to_breakpoint "Before pointer assignment"
> +
> +set test_name "ptype ptr, Before pointer assignment"
> +gdb_test_multiple "ptype ptr" $test_name {
> + # gcc/icx
> + -re -wrap "= int \\(\\*\\)\\\[variable length\\\]" {
> + pass $test_name
> + }
> + # icc
> + -re -wrap "= int \\(\\*\\)\\\[3\\\]" {
> + pass $test_name
> + }
No need to use the test_name variable nowadays, you can use the magic
$gdb_test_name inside the gdb_test_multiple body to access the name that
was passed to it.
Simon
Hi Simon,
Thanks for the review!
> Hi,
>
> That all looks nice to me, that seems like some concrete improvements
> for the user. I noted some nits below. I am not really familiar with
> Fortran or the dynamic types thing, so I'd really like if someone more
> familiar with those could take a look.
>
> > ---
> > gdb/gdbtypes.c | 53 +++++-
> > gdb/testsuite/gdb.cp/vla-cxx.cc | 4 +
> > gdb/testsuite/gdb.cp/vla-cxx.exp | 33 ++++
> > gdb/testsuite/gdb.dwarf2/dynarr-ptr.exp | 16 +-
> > .../gdb.fortran/pointer-to-pointer.exp | 2 +-
> > gdb/testsuite/gdb.fortran/pointers.exp | 178 ++++++++++++++++++
> > gdb/testsuite/gdb.fortran/pointers.f90 | 29 +++
> > gdb/valprint.c | 6 -
> > 8 files changed, 303 insertions(+), 18 deletions(-)
> > create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp
> >
> > diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> > index c458b204157..a4d79a64e95 100644
> > --- a/gdb/gdbtypes.c
> > +++ b/gdb/gdbtypes.c
> > @@ -2083,9 +2083,15 @@ is_dynamic_type_internal (struct type *type, int
> top_level)
> > {
> > type = check_typedef (type);
> >
> > - /* We only want to recognize references at the outermost level. */
> > - if (top_level && type->code () == TYPE_CODE_REF)
> > - type = check_typedef (TYPE_TARGET_TYPE (type));
> > + /* We only want to recognize references and pointers at the outermost
> > + level. */
> > + if (type->code () == TYPE_CODE_REF || type->code () ==
> TYPE_CODE_PTR)
> > + {
> > + if (top_level != 0)
> > + type = check_typedef (TYPE_TARGET_TYPE (type));
> > + else
> > + return 0;
> > + }
>
> Can you explain this change here, specifically the addition of the
> "return 0"?
>
> My understanding is that for REFs and PTRs, nothing below will match and
> we will end up returning 0 anyway, so this is just a new shortcut for
> when the type is a REF or PTR and top_level is false. But I'd like to
> confirm.
Yes, you are right. All the others should not match here.
The reason this shortcut was added is that ifort/icc emit the DW_AT_associated
for Fortran pointers. I thought this was correct (until the discussion on PATCH 3),
but looking at the DWARF spec it seems to be unexpected.
Further down in this Patch I actually added resolution of the DW_AT_associated
for dynamic pointers - which should not even be there. It is not listed under
the attributes applicable for pointers.
Here, icc/ifort pointers would run into an infinite loop ever resolving their
pointer types if we have a cyclic pointer dependency (as added in one of the
tests).
I am not sure how to fix this while making clear that it is an exception for
icc/ifort but it should be made clear as this is not at all obvious. As we have a
similar discussion in PATCH 3 (I agree that the handling of ifort/icc's
pointer/reference DWARF should be behind some compiler check),
I would remove this shortcut from this patch and move its treatment over to
PATCH 3. Similarly I am now inclined to remove the resolution of
DW_AT_associated from resolve_dynamic_pointer as it is not an expected attribute
for pointers to have.
> >
> > /* Types that have a dynamic TYPE_DATA_LOCATION are considered
> > dynamic, even if the type itself is statically defined.
> > @@ -2787,6 +2793,43 @@ 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 dynamic_prop *prop;
> > + CORE_ADDR value;
> > +
> > + /* Resolve the target type of this type. */
> > + struct property_addr_info pinfo;
> > + pinfo.type = check_typedef (TYPE_TARGET_TYPE (type));
> > + pinfo.valaddr = {};
> > + if (addr_stack->valaddr.data () != NULL)
>
> NULL -> nullptr
Fixed in V2.
> > + pinfo.addr = extract_typed_address (addr_stack->valaddr.data (),
> > + type);
>
> "type" would fit on the same line
>
Fixed in V2.
> > + else
> > + pinfo.addr = read_memory_typed_address (addr_stack->addr, type);
> > + pinfo.next = addr_stack;
> > +
> > + struct type* resolved_type = copy_type (type);
>
> Space before *
>
Fixed in V2
> > +
> > + /* Resolve associated property. */
> > + prop = TYPE_ASSOCIATED_PROP (resolved_type);
> > + if (prop != nullptr
> > + && dwarf2_evaluate_property (prop, nullptr, addr_stack, &value))
> > + prop->set_const_val (value);
This is the part I was referencing above..
> > +
> > + if (pinfo.addr != 0x0 && !type_not_associated (resolved_type))
> > + TYPE_TARGET_TYPE (resolved_type)
> > + = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type),
> > + &pinfo, 0);
> > +
> > +
>
> Remove one newline here.
>
Fixed in V2.
> > diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-
> cxx.exp
> > index 3494b5e8b77..e2bb8989212 100644
> > --- a/gdb/testsuite/gdb.cp/vla-cxx.exp
> > +++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
> > @@ -23,6 +23,36 @@ if ![runto_main] {
> > return -1
> > }
> >
> > +gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
> > +gdb_continue_to_breakpoint "Before pointer assignment"
> > +
> > +set test_name "ptype ptr, Before pointer assignment"
> > +gdb_test_multiple "ptype ptr" $test_name {
> > + # gcc/icx
> > + -re -wrap "= int \\(\\*\\)\\\[variable length\\\]" {
> > + pass $test_name
> > + }
> > + # icc
> > + -re -wrap "= int \\(\\*\\)\\\[3\\\]" {
> > + pass $test_name
> > + }
>
> No need to use the test_name variable nowadays, you can use the magic
> $gdb_test_name inside the gdb_test_multiple body to access the name that
> was passed to it.
>
Fixed in V2.
I'll update this locally for now - and send a V2 soon with all above mentioned
changes incorporated.
Thanks again!
Nils
Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928
@@ -2083,9 +2083,15 @@ is_dynamic_type_internal (struct type *type, int top_level)
{
type = check_typedef (type);
- /* We only want to recognize references at the outermost level. */
- if (top_level && type->code () == TYPE_CODE_REF)
- type = check_typedef (TYPE_TARGET_TYPE (type));
+ /* We only want to recognize references and pointers at the outermost
+ level. */
+ if (type->code () == TYPE_CODE_REF || type->code () == TYPE_CODE_PTR)
+ {
+ if (top_level != 0)
+ type = check_typedef (TYPE_TARGET_TYPE (type));
+ else
+ return 0;
+ }
/* Types that have a dynamic TYPE_DATA_LOCATION are considered
dynamic, even if the type itself is statically defined.
@@ -2787,6 +2793,43 @@ 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 dynamic_prop *prop;
+ CORE_ADDR value;
+
+ /* Resolve the target type of this type. */
+ struct property_addr_info pinfo;
+ pinfo.type = check_typedef (TYPE_TARGET_TYPE (type));
+ pinfo.valaddr = {};
+ if (addr_stack->valaddr.data () != NULL)
+ pinfo.addr = extract_typed_address (addr_stack->valaddr.data (),
+ type);
+ else
+ pinfo.addr = read_memory_typed_address (addr_stack->addr, type);
+ pinfo.next = addr_stack;
+
+ struct type* resolved_type = copy_type (type);
+
+ /* Resolve associated property. */
+ prop = TYPE_ASSOCIATED_PROP (resolved_type);
+ if (prop != nullptr
+ && dwarf2_evaluate_property (prop, nullptr, addr_stack, &value))
+ prop->set_const_val (value);
+
+ if (pinfo.addr != 0x0 && !type_not_associated (resolved_type))
+ TYPE_TARGET_TYPE (resolved_type)
+ = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (type),
+ &pinfo, 0);
+
+
+ return resolved_type;
+}
+
/* Worker for resolved_dynamic_type. */
static struct type *
@@ -2842,6 +2885,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_STRING:
/* Strings are very much like an array of characters, and can be
treated as one here. */
@@ -40,6 +40,10 @@ int main(int argc, char **argv)
typedef typeof (vla) &vlareftypedef;
vlareftypedef vlaref2 (vla);
container c;
+ typeof (vla) *ptr = nullptr;
+
+ // Before pointer assignment
+ ptr = &vla;
for (int i = 0; i < z; ++i)
vla[i] = 5 + 2 * i;
@@ -23,6 +23,36 @@ if ![runto_main] {
return -1
}
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+
+set test_name "ptype ptr, Before pointer assignment"
+gdb_test_multiple "ptype ptr" $test_name {
+ # gcc/icx
+ -re -wrap "= int \\(\\*\\)\\\[variable length\\\]" {
+ pass $test_name
+ }
+ # icc
+ -re -wrap "= int \\(\\*\\)\\\[3\\\]" {
+ pass $test_name
+ }
+}
+
+set test_name "print ptr, Before pointer assignment"
+gdb_test_multiple "print ptr" $test_name {
+ # gcc/icx
+ -re -wrap "= \\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" {
+ pass $test_name
+ }
+ # icc
+ -re -wrap "= \\(int \\(\\*\\)\\\[3\\\]\\) 0x0" {
+ pass $test_name
+ }
+}
+
+gdb_test "print *ptr" "Cannot access memory at address 0x0" \
+ "print *ptr, Before pointer assignment"
+
gdb_breakpoint [gdb_get_line_number "vlas_filled"]
gdb_continue_to_breakpoint "vlas_filled"
@@ -33,3 +63,6 @@ gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}"
# bug being tested, it's better not to depend on the exact spelling.
gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}"
gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}"
+gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]"
+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex"
+gdb_test "print *ptr" " = \\{5, 7, 9\\}"
@@ -156,7 +156,7 @@ gdb_test "print foo.three_ptr.all'length" \
" = 3"
gdb_test "ptype foo.three_ptr.all" \
- " = array \\(<>\\) of integer"
+ " = array \\(1 \\.\\. 3\\) of integer"
# foo.three_ptr
@@ -179,7 +179,7 @@ gdb_test "print foo.three_ptr'length" \
" = 3"
gdb_test "ptype foo.three_ptr" \
- " = access array \\(<>\\) of integer"
+ " = access array \\(1 \\.\\. 3\\) of integer"
# foo.three_ptr_tdef.all
@@ -205,7 +205,7 @@ gdb_test "print foo.three_ptr_tdef.all'length" \
" = 3"
gdb_test "ptype foo.three_ptr_tdef.all" \
- " = array \\(<>\\) of integer"
+ " = array \\(1 \\.\\. 3\\) of integer"
# foo.three_ptr_tdef
@@ -228,7 +228,7 @@ gdb_test "print foo.three_ptr_tdef'length" \
" = 3"
gdb_test "ptype foo.three_ptr_tdef" \
- " = access array \\(<>\\) of integer"
+ " = access array \\(1 \\.\\. 3\\) of integer"
# foo.five_ptr.all
@@ -260,7 +260,7 @@ gdb_test "print foo.five_ptr.all'length" \
" = 5"
gdb_test "ptype foo.five_ptr.all" \
- " = array \\(<>\\) of integer"
+ " = array \\(2 \\.\\. 6\\) of integer"
# foo.five_ptr
@@ -289,7 +289,7 @@ gdb_test "print foo.five_ptr'length" \
" = 5"
gdb_test "ptype foo.five_ptr" \
- " = access array \\(<>\\) of integer"
+ " = access array \\(2 \\.\\. 6\\) of integer"
# foo.five_ptr_tdef.all
@@ -321,7 +321,7 @@ gdb_test "print foo.five_ptr_tdef.all'length" \
" = 5"
gdb_test "ptype foo.five_ptr_tdef.all" \
- " = array \\(<>\\) of integer"
+ " = array \\(2 \\.\\. 6\\) of integer"
# foo.five_ptr_tdef
@@ -350,4 +350,4 @@ gdb_test "print foo.five_ptr_tdef'length" \
" = 5"
gdb_test "ptype foo.five_ptr_tdef" \
- " = access array \\(<>\\) of integer"
+ " = access array \\(2 \\.\\. 6\\) of integer"
@@ -41,7 +41,7 @@ gdb_test "print buffer" \
gdb_test "ptype buffer" \
[multi_line \
"type = PTR TO -> \\( Type l_buffer" \
- " $real4 :: alpha\\(:\\)" \
+ " $real4 :: alpha\\(5\\)" \
"End Type l_buffer \\)" ]
gdb_test "ptype buffer%alpha" "type = $real4 \\(5\\)"
new file mode 100644
@@ -0,0 +1,178 @@
+# Copyright 2022 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 <http://www.gnu.org/licenses/>.
+
+standard_testfile "pointers.f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}]} {
+ return -1
+}
+
+if {![fortran_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]
+
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) 0x0" \
+ "print logp, not associated"
+gdb_test "print *logp" "Cannot access memory at address 0x0" \
+ "print *logp, not associated"
+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) 0x0" \
+ "print comp, not associated"
+gdb_test "print *comp" "Cannot access memory at address 0x0" \
+ "print *comp, not associated"
+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) 0x0" \
+ "print charp, not associated"
+gdb_test "print *charp" "Cannot access memory at address 0x0" \
+ "print *charp, not associated"
+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) 0x0" \
+ "print charap, not associated"
+gdb_test "print *charap" "Cannot access memory at address 0x0" \
+ "print *charap, not associated"
+gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" \
+ "print intp, not associated"
+gdb_test "print *intp" "Cannot access memory at address 0x0" \
+ "print *intp, not associated"
+
+set test "print intap, not associated"
+gdb_test_multiple "print intap" $test {
+ # gfortran/ifx
+ -re -wrap " = <not associated>" {
+ pass $test
+ }
+ # ifort
+ -re -wrap " = \\(PTR TO -> \\( $int \\(:,:\\) \\)\\) <not associated>" {
+ pass $test
+ }
+}
+
+gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" \
+ "print realp, not associated"
+gdb_test "print *realp" "Cannot access memory at address 0x0" \
+ "print *realp, not associated"
+gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
+set test "print cyclicp1, not associated"
+gdb_test_multiple "print cyclicp1" $test {
+ # gfortran/ifx
+ -re -wrap "= \\( i = -?\\d+, p = 0x0 \\)" {
+ pass $test
+ }
+ # ifort
+ -re -wrap "= \\( i = -?\\d+, p = <not associated> \\)" {
+ pass $test
+ }
+}
+
+set test "print cyclicp1%p, not associated"
+gdb_test_multiple "print cyclicp1%p" $test {
+ # gfortran/ifx
+ -re -wrap "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0" {
+ pass $test
+ }
+ # ifort
+ -re -wrap "= \\(PTR TO -> \\( Type typewithpointer \\)\\) <not associated>" {
+ pass $test
+ }
+}
+
+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
+gdb_continue_to_breakpoint "Before value assignment"
+gdb_test "print *(twop)%ivla2" "= <not allocated>"
+
+gdb_breakpoint [gdb_get_line_number "After value assignment"]
+gdb_continue_to_breakpoint "After value assignment"
+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?"
+gdb_test "print *logp" "= \\.TRUE\\."
+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?"
+gdb_test "print *comp" "= \\(1,2\\)"
+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?"
+gdb_test "print *charp" "= 'a'"
+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 {
+ # gfortran/ifx
+ -re -wrap "= \\(\\(1, 1, 3(, 1){7}\\) \\(1(, 1){9}\\)\\)" {
+ pass $test_name
+ }
+ # ifort
+ -re -wrap "= \\(PTR TO -> \\( $int \\(10,2\\) \\)\\) $hex\( <.*>\)?" {
+ 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 {
+ # gfortran/ifx
+ -re -wrap "= \\(2, 2, 2, 4(, 2){6}\\)" {
+ pass $test_name
+ }
+ # ifort
+ -re -wrap "= \\(PTR TO -> \\( $int \\(10\\) \\)\\) $hex\( <.*>\)?" {
+ 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)" \
+ "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\(211, 221\\) \\(212, 222\\)\\) \\)"
+
+set test_name "print arrayOfPtr(3)%p"
+gdb_test_multiple $test_name $test_name {
+ # gfortran/ifx
+ -re -wrap "= \\(PTR TO -> \\( Type two \\)\\) 0x0" {
+ pass $test_name
+ }
+ # ifort
+ -re -wrap "= \\(PTR TO -> \\( Type two \\)\\) <not associated>" {
+ pass $test_name
+ }
+}
+
+set test "print *(arrayOfPtr(3)%p)"
+set test_name "print *(arrayOfPtr(3)%p), associated"
+gdb_test_multiple $test $test_name {
+ # gfortran/ifx
+ -re -wrap "Cannot access memory at address 0x0" {
+ pass $test_name
+ }
+ # ifort
+ -re -wrap "Location address is not set." {
+ pass $test_name
+ }
+}
+
+gdb_test "print cyclicp1" "= \\( i = 1, p = $hex\( <.*>\)? \\)"
+gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer \\)\\) $hex\( <.*>\)?"
+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 <pointers\\+\\d+>" \
+ "Print program counter"
@@ -20,14 +20,26 @@ program pointers
integer, allocatable :: ivla2 (:, :)
end type two
+ type :: typeWithPointer
+ integer i
+ type(typeWithPointer), pointer:: p
+ end type typeWithPointer
+
+ 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)
+ type(typeWithPointer), target:: cyclicp1,cyclicp2
logical, pointer :: logp
complex, pointer :: comp
@@ -35,6 +47,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 +57,14 @@ 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)
+ nullify (cyclicp1%p)
+ nullify (cyclicp2%p)
logp => logv ! Before pointer assignment
comp => comv
@@ -53,8 +72,14 @@ program pointers
charap => chara
intp => intv
intap => inta
+ intvlap => intvla
realp => realv
twop => twov
+ arrayOfPtr(2)%p => twov
+ cyclicp1%i = 1
+ cyclicp1%p => cyclicp2
+ cyclicp2%i = 2
+ cyclicp2%p => cyclicp1
logv = associated(logp) ! Before value assignment
comv = cmplx(1,2)
@@ -63,6 +88,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))
@@ -1137,12 +1137,6 @@ value_check_printable (struct value *val, struct ui_file *stream,
return 0;
}
- if (type_not_associated (value_type (val)))
- {
- val_print_not_associated (stream);
- return 0;
- }
-
if (type_not_allocated (value_type (val)))
{
val_print_not_allocated (stream);