* [PATCH 02/11] Fortran: Fix negative bounds for dynamic allocated arrays.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2019-03-02 18:52 ` Andrew Burgess
2018-11-27 19:40 ` [PATCH 07/11] Resolve dynamic target types of pointers Sebastian Basierski
` (11 subsequent siblings)
12 siblings, 1 reply; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
Fortran arrays might have negative bounds.
Take this into consideration when evaluating
dynamic bound properties.
Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* gdbtypes.c (resolve_dynamic_range):
Call dwarf2_evaluate_property_signed to resolve dynamic bounds.
gdb/Testsuite/Changelog:
* gdb.fortran/vla.f90: Extend by an array with negative bounds.
* gdb/testsuite/gdb.fortran/vla-sizeof.exp: Test array with negative bounds.
* gdb/testsuite/gdb.fortran/vla-ptype.exp: Test array with negative bounds.
---
gdb/gdbtypes.c | 4 ++--
gdb/testsuite/gdb.fortran/vla-ptype.exp | 4 ++++
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 ++++
gdb/testsuite/gdb.fortran/vla.f90 | 10 ++++++++++
4 files changed, 20 insertions(+), 2 deletions(-)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 9e87b8f4c5..8adf899f9a 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1995,7 +1995,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
{
low_bound.kind = PROP_CONST;
low_bound.data.const_val = value;
@@ -2007,7 +2007,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
}
prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
+ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
{
high_bound.kind = PROP_CONST;
high_bound.data.const_val = value;
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
index 5f367348b0..5351a0aa2e 100644
--- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
+++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
@@ -98,3 +98,7 @@ gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
gdb_test "ptype vla2(5, 45, 20)" \
"no such vector element \\\(vector not allocated\\\)" \
"ptype vla2(5, 45, 20) not allocated"
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
+gdb_continue_to_breakpoint "vla1-neg-bounds"
+gdb_test "ptype vla1" "type = $real \\(-2:1,-5:4,-3:-1\\)" "ptype vla1 negative bounds"
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 3113983ba4..83bc849619 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -44,3 +44,7 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
gdb_breakpoint [gdb_get_line_number "pvla-associated"]
gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
+
+gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
+gdb_continue_to_breakpoint "vla1-neg-bounds"
+gdb_test "print sizeof(vla1)" " = 480" "print sizeof vla1 negative bounds"
diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
index 508290a36e..d87f59b92b 100644
--- a/gdb/testsuite/gdb.fortran/vla.f90
+++ b/gdb/testsuite/gdb.fortran/vla.f90
@@ -54,4 +54,14 @@ program vla
allocate (vla3 (2,2)) ! vla2-deallocated
vla3(:,:) = 13
+
+ allocate (vla1 (-2:1, -5:4, -3:-1))
+ l = allocated(vla1)
+
+ vla1(:, :, :) = 1
+ vla1(-2, -3, -1) = -231
+
+ deallocate (vla1) ! vla1-neg-bounds
+ l = allocated(vla1)
+
end program vla
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* Re: [PATCH 02/11] Fortran: Fix negative bounds for dynamic allocated arrays.
2018-11-27 19:40 ` [PATCH 02/11] Fortran: Fix negative bounds for dynamic allocated arrays Sebastian Basierski
@ 2019-03-02 18:52 ` Andrew Burgess
0 siblings, 0 replies; 19+ messages in thread
From: Andrew Burgess @ 2019-03-02 18:52 UTC (permalink / raw)
To: Sebastian Basierski; +Cc: gdb-patches, Tomasz Kulasek
* Sebastian Basierski <sbasierski@pl.sii.eu> [2018-11-27 19:31:30 +0100]:
> From: Bernhard Heckel <bernhard.heckel@intel.com>
>
> Fortran arrays might have negative bounds.
> Take this into consideration when evaluating
> dynamic bound properties.
>
> Bernhard Heckel <bernhard.heckel@intel.com>
>
> gdb/Changelog:
> * gdbtypes.c (resolve_dynamic_range):
> Call dwarf2_evaluate_property_signed to resolve dynamic bounds.
>
> gdb/Testsuite/Changelog:
> * gdb.fortran/vla.f90: Extend by an array with negative bounds.
> * gdb/testsuite/gdb.fortran/vla-sizeof.exp: Test array with negative bounds.
> * gdb/testsuite/gdb.fortran/vla-ptype.exp: Test array with negative bounds.
The last two lines of this ChangeLog entry are not correct, the
'gdb/testsuite' prefix is not needed.
It feels like this patch is trying to test the previous one in the
series, but like I said these tests all seem to pass on
upstream/master, so I think some additional investigation is needed.
Thanks,
Andrew
> ---
> gdb/gdbtypes.c | 4 ++--
> gdb/testsuite/gdb.fortran/vla-ptype.exp | 4 ++++
> gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 ++++
> gdb/testsuite/gdb.fortran/vla.f90 | 10 ++++++++++
> 4 files changed, 20 insertions(+), 2 deletions(-)
>
> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
> index 9e87b8f4c5..8adf899f9a 100644
> --- a/gdb/gdbtypes.c
> +++ b/gdb/gdbtypes.c
> @@ -1995,7 +1995,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
> gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
>
> prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
> - if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> + if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
> {
> low_bound.kind = PROP_CONST;
> low_bound.data.const_val = value;
> @@ -2007,7 +2007,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
> }
>
> prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
> - if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
> + if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
> {
> high_bound.kind = PROP_CONST;
> high_bound.data.const_val = value;
> diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
> index 5f367348b0..5351a0aa2e 100644
> --- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
> +++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
> @@ -98,3 +98,7 @@ gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
> gdb_test "ptype vla2(5, 45, 20)" \
> "no such vector element \\\(vector not allocated\\\)" \
> "ptype vla2(5, 45, 20) not allocated"
> +
> +gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
> +gdb_continue_to_breakpoint "vla1-neg-bounds"
> +gdb_test "ptype vla1" "type = $real \\(-2:1,-5:4,-3:-1\\)" "ptype vla1 negative bounds"
> diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> index 3113983ba4..83bc849619 100644
> --- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> +++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
> @@ -44,3 +44,7 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
> gdb_breakpoint [gdb_get_line_number "pvla-associated"]
> gdb_continue_to_breakpoint "pvla-associated"
> gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
> +
> +gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
> +gdb_continue_to_breakpoint "vla1-neg-bounds"
> +gdb_test "print sizeof(vla1)" " = 480" "print sizeof vla1 negative bounds"
> diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
> index 508290a36e..d87f59b92b 100644
> --- a/gdb/testsuite/gdb.fortran/vla.f90
> +++ b/gdb/testsuite/gdb.fortran/vla.f90
> @@ -54,4 +54,14 @@ program vla
>
> allocate (vla3 (2,2)) ! vla2-deallocated
> vla3(:,:) = 13
> +
> + allocate (vla1 (-2:1, -5:4, -3:-1))
> + l = allocated(vla1)
> +
> + vla1(:, :, :) = 1
> + vla1(-2, -3, -1) = -231
> +
> + deallocate (vla1) ! vla1-neg-bounds
> + l = allocated(vla1)
> +
> end program vla
> --
> 2.17.1
>
^ permalink raw reply [flat|nested] 19+ messages in thread
* [PATCH 07/11] Resolve dynamic target types of pointers.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
2018-11-27 19:40 ` [PATCH 02/11] Fortran: Fix negative bounds for dynamic allocated arrays Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2018-11-28 6:07 ` Eli Zaretskii
2018-11-27 19:40 ` [PATCH 06/11] Fortran: Typeprint, fix dangling types Sebastian Basierski
` (10 subsequent siblings)
12 siblings, 1 reply; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
When dereferencing pointers to dynamic target types,
resolve the target type.
2016-06-30 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* NEWS: Added entry.
* c-valprint.c (c_print_val): Resolve dynamic target types.
* valops.c (value_ind): Resolve dynamic target types.
* valprint.c (check_printable): Don't shortcut not associated
pointers.
gdb/Testsuite/Changelog:
* pointers.f90: Added pointer to dynamic types.
* gdb.fortran/pointers.exp: New.
---
gdb/NEWS | 2 +
gdb/c-valprint.c | 22 ++++
gdb/testsuite/gdb.cp/vla-cxx.exp | 6 ++
gdb/testsuite/gdb.fortran/pointers.exp | 137 +++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.f90 | 17 +++
gdb/valops.c | 16 ++-
gdb/valprint.c | 6 --
7 files changed, 198 insertions(+), 8 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp
diff --git a/gdb/NEWS b/gdb/NEWS
index ff9b192a38..8fe8faecb6 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -650,6 +650,8 @@ show disassembler-options
* GDBserver now supports recording btrace without maintaining an active
GDB connection.
+* Fortran: Support pointers to dynamic types.
+
* GDB now supports a negative repeat count in the 'x' command to examine
memory backward from the given address. For example:
diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c
index c4c0918e26..254ebd1ee6 100644
--- a/gdb/c-valprint.c
+++ b/gdb/c-valprint.c
@@ -653,6 +653,28 @@ c_value_print (struct value *val, struct ui_file *stream,
else
{
/* normal case */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR
+ && is_dynamic_type (type))
+ {
+ CORE_ADDR addr;
+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type)))
+ addr = value_address (val);
+ else
+ addr = value_as_address (val);
+
+ /* We resolve the target-type only when the
+ pointer is associated. */
+ if ((addr != 0)
+ && !type_not_associated (type))
+ TYPE_TARGET_TYPE (type) =
+ resolve_dynamic_type (TYPE_TARGET_TYPE (type),
+ NULL, addr);
+ }
+ else
+ {
+ /* Do nothing. References are already resolved from the beginning,
+ only pointers are resolved when we actual need the target. */
+ }
fprintf_filtered (stream, "(");
type_print (value_type (val), "", stream, -1);
fprintf_filtered (stream, ") ");
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
index 2cf2d9868f..32e4329f93 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.exp
+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
@@ -26,6 +26,10 @@ if ![runto_main] {
gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
gdb_continue_to_breakpoint "Before pointer assignment"
gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment"
+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" \
+ "print ptr, Before pointer assignment"
+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"
@@ -38,3 +42,5 @@ gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}"
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\\}"
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
new file mode 100644
index 0000000000..0f6c9d3cdf
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -0,0 +1,137 @@
+# Copyright 2018 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 ![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 {
+ -re " = \\(PTR TO -> \\( $int \\(:,:\\)\\)\\) <not associated>\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re " = <not associated>\r\n$gdb_prompt $" {
+ 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"
+
+
+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 {
+ -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)" \
+ "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)"
+set test_name "print arrayOfPtr(3)%p"
+gdb_test_multiple $test_name $test_name {
+ -re "= \\(PTR TO -> \\( Type two \\)\\) <not associated>\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 "Cannot access memory at address 0x0\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 <pointers\\+\\d+>" \
+ "Print program counter"
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
index dd4fe811be..c36398d76a 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/valops.c b/gdb/valops.c
index a34e74b2be..90dc2fec0c 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1558,6 +1558,19 @@ value_ind (struct value *arg1)
if (TYPE_CODE (base_type) == TYPE_CODE_PTR)
{
struct type *enc_type;
+ CORE_ADDR addr;
+
+ if (type_not_associated (base_type))
+ error (_("Attempt to take contents of a not associated pointer."));
+
+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type)))
+ addr = value_address (arg1);
+ else
+ addr = value_as_address (arg1);
+
+ if (addr != 0)
+ TYPE_TARGET_TYPE (base_type) =
+ resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), NULL, addr);
/* We may be pointing to something embedded in a larger object.
Get the real type of the enclosing object. */
@@ -1573,8 +1586,7 @@ value_ind (struct value *arg1)
else
/* Retrieve the enclosing object pointed to. */
arg2 = value_at_lazy (enc_type,
- (value_as_address (arg1)
- - value_pointed_to_offset (arg1)));
+ (addr - value_pointed_to_offset (arg1)));
enc_type = value_type (arg2);
return readjust_indirect_value_type (arg2, enc_type, base_type, arg1);
diff --git a/gdb/valprint.c b/gdb/valprint.c
index b2236f8931..35f22b6d43 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1108,12 +1108,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);
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* Re: [PATCH 07/11] Resolve dynamic target types of pointers.
2018-11-27 19:40 ` [PATCH 07/11] Resolve dynamic target types of pointers Sebastian Basierski
@ 2018-11-28 6:07 ` Eli Zaretskii
0 siblings, 0 replies; 19+ messages in thread
From: Eli Zaretskii @ 2018-11-28 6:07 UTC (permalink / raw)
To: Sebastian Basierski; +Cc: gdb-patches
> From: Sebastian Basierski <sbasierski@pl.sii.eu>
> Date: Tue, 27 Nov 2018 19:31:35 +0100
>
> From: Bernhard Heckel <bernhard.heckel@intel.com>
>
> When dereferencing pointers to dynamic target types,
> resolve the target type.
>
> 2016-06-30 Bernhard Heckel <bernhard.heckel@intel.com>
>
> gdb/Changelog:
> * NEWS: Added entry.
> * c-valprint.c (c_print_val): Resolve dynamic target types.
> * valops.c (value_ind): Resolve dynamic target types.
> * valprint.c (check_printable): Don't shortcut not associated
> pointers.
>
> gdb/Testsuite/Changelog:
> * pointers.f90: Added pointer to dynamic types.
> * gdb.fortran/pointers.exp: New.
OK for the NEWS part.
Thanks.
^ permalink raw reply [flat|nested] 19+ messages in thread
* [PATCH 06/11] Fortran: Typeprint, fix dangling types.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
2018-11-27 19:40 ` [PATCH 02/11] Fortran: Fix negative bounds for dynamic allocated arrays Sebastian Basierski
2018-11-27 19:40 ` [PATCH 07/11] Resolve dynamic target types of pointers Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2018-11-27 19:40 ` [PATCH 05/11] Typeprint: Resolve any dynamic target type of a pointer Sebastian Basierski
` (9 subsequent siblings)
12 siblings, 0 replies; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
Show the type of not-allocated and/or not-associated types
as this is known. For array types and pointer to array types
we are going to print the number of ranks.
2016-06-30 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/ChangeLog:
* f-typeprint.c (f_print_type): Don't bypass dangling types.
(f_type_print_varspec_suffix): Add print_rank parameter.
(f_type_print_varspec_suffix): Print ranks of array types
in case they dangling.
(f_type_print_base): Add print_rank parameter.
gdb/Testsuite/ChangeLog:
* gdb.fortran/pointers.f90: New.
* gdb.fortran/print_type.exp: New.
* gdb.fortran/vla-ptype.exp: Adapt expected results.
* gdb.fortran/vla-type.exp: Likewise.
* gdb.fortran/vla-value.exp: Likewise.
* gdb.fortran/oop-extend-type.exp: Likewise.
* gdb.mi/mi-vla-fortran.exp: Likewise.
---
gdb/f-typeprint.c | 93 ++++++++--------
gdb/testsuite/gdb.fortran/oop-extend-type.exp | 2 +-
gdb/testsuite/gdb.fortran/pointers.f90 | 80 ++++++++++++++
gdb/testsuite/gdb.fortran/print_type.exp | 100 ++++++++++++++++++
gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 +--
gdb/testsuite/gdb.fortran/vla-type.exp | 7 +-
gdb/testsuite/gdb.fortran/vla-value.exp | 4 +-
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 8 +-
8 files changed, 247 insertions(+), 59 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/pointers.f90
create mode 100755 gdb/testsuite/gdb.fortran/print_type.exp
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 133eaf9b98..f8ade5b835 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -37,7 +37,7 @@ static void f_type_print_args (struct type *, struct ui_file *);
#endif
static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
- int, int, int);
+ int, int, int, int);
void f_type_print_varspec_prefix (struct type *, struct ui_file *,
int, int);
@@ -53,18 +53,6 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
{
enum type_code code;
- if (type_not_associated (type))
- {
- val_print_not_associated (stream);
- return;
- }
-
- if (type_not_allocated (type))
- {
- val_print_not_allocated (stream);
- return;
- }
-
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
@@ -89,7 +77,7 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
demangled_args = (*varstring != '\0'
&& varstring[strlen (varstring) - 1] == ')');
- f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
+ f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0, 0);
}
}
@@ -159,7 +147,7 @@ f_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
static void
f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
int show, int passed_a_ptr, int demangled_args,
- int arrayprint_recurse_level)
+ int arrayprint_recurse_level, int print_rank_only)
{
int upper_bound, lower_bound;
@@ -183,34 +171,50 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
fprintf_filtered (stream, "(");
if (type_not_associated (type))
- val_print_not_associated (stream);
+ print_rank_only = 1;
else if (type_not_allocated (type))
- val_print_not_allocated (stream);
+ print_rank_only = 1;
+ else if ((TYPE_ASSOCIATED_PROP (type)
+ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type)))
+ || (TYPE_ALLOCATED_PROP (type)
+ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type)))
+ || (TYPE_DATA_LOCATION (type)
+ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_DATA_LOCATION (type))))
+ /* This case exist when we ptype a typename which has the
+ dynamic properties but cannot be resolved as there is
+ no object. */
+ print_rank_only = 1;
+
+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+ 0, 0, arrayprint_recurse_level,
+ print_rank_only);
+
+ if (print_rank_only == 1)
+ fprintf_filtered (stream, ":");
else
- {
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
- 0, 0, arrayprint_recurse_level);
-
- lower_bound = f77_get_lowerbound (type);
- if (lower_bound != 1) /* Not the default. */
- fprintf_filtered (stream, "%d:", lower_bound);
-
- /* Make sure that, if we have an assumed size array, we
- print out a warning and print the upperbound as '*'. */
-
- if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
- fprintf_filtered (stream, "*");
- else
- {
- upper_bound = f77_get_upperbound (type);
- fprintf_filtered (stream, "%d", upper_bound);
- }
-
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
- 0, 0, arrayprint_recurse_level);
- }
+ {
+ lower_bound = f77_get_lowerbound (type);
+ if (lower_bound != 1) /* Not the default. */
+ fprintf_filtered (stream, "%d:", lower_bound);
+
+ /* Make sure that, if we have an assumed size array, we
+ print out a warning and print the upperbound as '*'. */
+
+ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+ fprintf_filtered (stream, "*");
+ else
+ {
+ upper_bound = f77_get_upperbound (type);
+ fprintf_filtered (stream, "%d", upper_bound);
+ }
+ }
+
+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+ 0, 0, arrayprint_recurse_level,
+ print_rank_only);
+
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, ")");
else
@@ -221,13 +225,14 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
case TYPE_CODE_PTR:
case TYPE_CODE_REF:
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
- arrayprint_recurse_level);
+ arrayprint_recurse_level, 0);
fprintf_filtered (stream, ")");
break;
case TYPE_CODE_FUNC:
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
- passed_a_ptr, 0, arrayprint_recurse_level);
+ passed_a_ptr, 0, arrayprint_recurse_level,
+ 0);
if (passed_a_ptr)
fprintf_filtered (stream, ")");
@@ -412,7 +417,7 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
fputs_filtered (" :: ", stream);
fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
- stream, show - 1, 0, 0, 0);
+ stream, show - 1, 0, 0, 0, 0);
fputs_filtered ("\n", stream);
}
fprintfi_filtered (level, stream, "End Type ");
diff --git a/gdb/testsuite/gdb.fortran/oop-extend-type.exp b/gdb/testsuite/gdb.fortran/oop-extend-type.exp
index 8c3bb50a3a..85eef493be 100644
--- a/gdb/testsuite/gdb.fortran/oop-extend-type.exp
+++ b/gdb/testsuite/gdb.fortran/oop-extend-type.exp
@@ -31,7 +31,7 @@ set real [fortran_real4]
gdb_breakpoint [gdb_get_line_number "! Before vla allocation"]
gdb_continue_to_breakpoint "! Before vla allocation" ".*! Before vla allocation"
-gdb_test "whatis wp_vla" "type = <not allocated>"
+gdb_test "whatis wp_vla" "type = Type waypoint \\(:\\)"
gdb_breakpoint [gdb_get_line_number "! After value assignment"]
gdb_continue_to_breakpoint "! After value assignment" ".*! After value assignment"
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
new file mode 100644
index 0000000000..dd4fe811be
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -0,0 +1,80 @@
+! Copyright 2018 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/>.
+
+program pointers
+
+ type :: two
+ integer, allocatable :: ivla1 (:)
+ integer, allocatable :: ivla2 (:, :)
+ end type two
+
+ logical, target :: logv
+ complex, target :: comv
+ character, target :: charv
+ character (len=3), target :: chara
+ integer, target :: intv
+ integer, target, dimension (10,2) :: inta
+ real, target :: realv
+ type(two), target :: twov
+
+ logical, pointer :: logp
+ complex, pointer :: comp
+ character, pointer:: charp
+ character (len=3), pointer:: charap
+ integer, pointer :: intp
+ integer, pointer, dimension (:,:) :: intap
+ real, pointer :: realp
+ type(two), pointer :: twop
+
+ nullify (logp)
+ nullify (comp)
+ nullify (charp)
+ nullify (charap)
+ nullify (intp)
+ nullify (intap)
+ nullify (realp)
+ nullify (twop)
+
+ logp => logv ! Before pointer assignment
+ comp => comv
+ charp => charv
+ charap => chara
+ intp => intv
+ intap => inta
+ realp => realv
+ twop => twov
+
+ logv = associated(logp) ! Before value assignment
+ comv = cmplx(1,2)
+ charv = "a"
+ chara = "abc"
+ intv = 10
+ inta(:,:) = 1
+ inta(3,1) = 3
+ realv = 3.14
+
+ allocate (twov%ivla1(3))
+ allocate (twov%ivla2(2,2))
+ twov%ivla1(1) = 11
+ twov%ivla1(2) = 12
+ twov%ivla1(3) = 13
+ twov%ivla2(1,1) = 211
+ twov%ivla2(2,1) = 221
+ twov%ivla2(1,2) = 212
+ twov%ivla2(2,2) = 222
+
+ intv = intv + 1 ! After value assignment
+
+end program pointers
diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp
new file mode 100755
index 0000000000..538f28c5d2
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/print_type.exp
@@ -0,0 +1,100 @@
+# Copyright 2018 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 ![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 "ptype logp" "type = PTR TO -> \\( $logical \\)" "ptype logp, not associated"
+gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" "ptype comp, not associated"
+gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" "ptype charp, not associated"
+gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" "ptype charap, not associated"
+gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" "ptype intp, not associated"
+set test "ptype intap, not associated"
+gdb_test_multiple "ptype intap" $test {
+ -re "type = PTR TO -> \\( $int \\(:,:\\)\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = $int \\(:,:\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" "ptype realp, not associated"
+gdb_test "ptype twop" \
+ [multi_line "type = PTR TO -> \\( Type two" \
+ " $int :: ivla1\\(:\\)" \
+ " $int :: ivla2\\(:,:\\)" \
+ "End Type two \\)"] \
+ "ptype twop, not associated"
+gdb_test "ptype two" \
+ [multi_line "type = Type two" \
+ " $int :: ivla1\\(:\\)" \
+ " $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"
+gdb_test "ptype comv" "type = $complex"
+gdb_test "ptype charv" "type = character\\*1"
+gdb_test "ptype chara" "type = character\\*3"
+gdb_test "ptype intv" "type = $int"
+gdb_test "ptype inta" "type = $int \\(10,2\\)"
+gdb_test "ptype realv" "type = $real"
+
+
+gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)"
+gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)"
+gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)"
+gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)"
+gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)"
+set test "ptype intap"
+gdb_test_multiple $test $test {
+ -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = PTR TO -> \\( $int \\(10,2\\)\\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)"
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
index 5351a0aa2e..fa248c5a0c 100644
--- a/gdb/testsuite/gdb.fortran/vla-ptype.exp
+++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
@@ -32,9 +32,9 @@ set real [fortran_real4]
# Check the ptype of various VLA states and pointer to VLA's.
gdb_breakpoint [gdb_get_line_number "vla1-init"]
gdb_continue_to_breakpoint "vla1-init"
-gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized"
-gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
-gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
+gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not initialized"
+gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not initialized"
+gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla not initialized"
gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
"ptype vla1(3, 6, 9) not initialized"
gdb_test "ptype vla2(5, 45, 20)" \
@@ -81,20 +81,20 @@ gdb_test "ptype vla2(5, 45, 20)" "type = $real" \
gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
gdb_continue_to_breakpoint "pvla-deassociated"
-gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
+gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla deassociated"
gdb_test "ptype pvla(5, 45, 20)" \
"no such vector element \\\(vector not associated\\\)" \
"ptype pvla(5, 45, 20) not associated"
gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
gdb_continue_to_breakpoint "vla1-deallocated"
-gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
+gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not allocated"
gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
"ptype vla1(3, 6, 9) not allocated"
gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
gdb_continue_to_breakpoint "vla2-deallocated"
-gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
+gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not allocated"
gdb_test "ptype vla2(5, 45, 20)" \
"no such vector element \\\(vector not allocated\\\)" \
"ptype vla2(5, 45, 20) not allocated"
diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp
index aff0d5a258..6f2d6a4009 100755
--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -132,7 +132,10 @@ gdb_test "ptype fivearr(2)%tone" \
"End Type one" ]
# Check allocation status of dynamic array and it's dynamic members
-gdb_test "ptype fivedynarr" "type = <not allocated>"
+gdb_test "ptype fivedynarr" \
+ [multi_line "type = Type five" \
+ " Type one :: tone" \
+ "End Type five \\(:\\)" ]
gdb_test "next" ""
gdb_test "ptype fivedynarr(2)" \
[multi_line "type = Type five" \
@@ -141,7 +144,7 @@ gdb_test "ptype fivedynarr(2)" \
"ptype fivedynarr(2), tone is not allocated"
gdb_test "ptype fivedynarr(2)%tone" \
[multi_line "type = Type one" \
- " $int :: ivla\\(<not allocated>\\)" \
+ " $int :: ivla\\(:,:,:\\)" \
"End Type one" ] \
"ptype fivedynarr(2)%tone, not allocated"
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 4b1842e38c..5a831a3964 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -35,7 +35,7 @@ gdb_breakpoint [gdb_get_line_number "vla1-init"]
gdb_continue_to_breakpoint "vla1-init"
gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \
"print non-allocated &vla1"
gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \
"print member in non-allocated vla1 (1)"
@@ -76,7 +76,7 @@ gdb_test "print vla1(9, 9, 9)" " = 999" \
# Try to access values in undefined pointer to VLA (dangling)
gdb_test "print pvla" " = <not associated>" "print undefined pvla"
gdb_test "print &pvla" \
- " = \\\(PTR TO -> \\\( $real \\\(<not associated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \
"print non-associated &pvla"
gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \
"print undefined pvla(1,3,8)"
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
index b6e777235c..14b611f7b5 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -51,10 +51,10 @@ mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
mi_gdb_test "500-data-evaluate-expression vla1" \
"500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla, before allocation"
-mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
+mi_create_varobj_checked vla1_not_allocated vla1 "$real \\(:\\)" \
"create local variable vla1_not_allocated"
mi_gdb_test "501-var-info-type vla1_not_allocated" \
- "501\\^done,type=\"<not allocated>\"" \
+ "501\\^done,type=\"$real \\(:\\)\"" \
"info type variable vla1_not_allocated"
mi_gdb_test "502-var-show-format vla1_not_allocated" \
"502\\^done,format=\"natural\"" \
@@ -146,10 +146,10 @@ gdb_expect {
-re "580\\^done,value=\"<not associated>\".*${mi_gdb_prompt}$" {
pass $test
- mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
+ mi_create_varobj_checked pvla2_not_associated pvla2 "$real \\(:,:\\)" \
"create local variable pvla2_not_associated"
mi_gdb_test "581-var-info-type pvla2_not_associated" \
- "581\\^done,type=\"<not associated>\"" \
+ "581\\^done,type=\"$real \\(:,:\\)\"" \
"info type variable pvla2_not_associated"
mi_gdb_test "582-var-show-format pvla2_not_associated" \
"582\\^done,format=\"natural\"" \
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* [PATCH 05/11] Typeprint: Resolve any dynamic target type of a pointer.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (2 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 06/11] Fortran: Typeprint, fix dangling types Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2018-11-27 19:40 ` [PATCH 04/11] Fortran: Resolve dynamic properties of pointer types Sebastian Basierski
` (8 subsequent siblings)
12 siblings, 0 replies; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
Before continuing with language specific type printing
we have to resolve the target type of a pointer
as we might wanna print more details of the target
like the dimension of an array. We have to resolve it here
as we don't have any address information later on.
2016-07-08 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* typeprint.c (whatis_exp): Resolve dynamic target type
of pointers.
gdb/Testsuite/Changelog:
* gdb.cp/vla-cxx.cc: Added pointer to dynamic type.
* gdb.cp/vla-cxx.exp: Test pointer to dynamic type.
---
gdb/testsuite/gdb.cp/vla-cxx.cc | 4 ++++
gdb/testsuite/gdb.cp/vla-cxx.exp | 5 +++++
gdb/typeprint.c | 17 +++++++++++++++++
3 files changed, 26 insertions(+)
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc
index 1b5b27bf3d..fce8876e7d 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.cc
+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc
@@ -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;
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
index ac87499d49..2cf2d9868f 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.exp
+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
@@ -23,6 +23,10 @@ if ![runto_main] {
return -1
}
+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
+gdb_continue_to_breakpoint "Before pointer assignment"
+gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment"
+
gdb_breakpoint [gdb_get_line_number "vlas_filled"]
gdb_continue_to_breakpoint "vlas_filled"
@@ -33,3 +37,4 @@ 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\\\]"
diff --git a/gdb/typeprint.c b/gdb/typeprint.c
index 393d825fe5..de8fbd7652 100644
--- a/gdb/typeprint.c
+++ b/gdb/typeprint.c
@@ -589,6 +589,23 @@ whatis_exp (const char *exp, int show)
printf_filtered (" */\n");
}
+ /* Resolve any dynamic target type, as we might print
+ additional information about the target.
+ For example, in Fortran and C we are printing the dimension of the
+ dynamic array the pointer is pointing to. */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR && is_dynamic_type (type))
+ {
+ CORE_ADDR addr;
+ if (TYPE_DATA_LOCATION (TYPE_TARGET_TYPE(type)) != nullptr)
+ addr = value_address (val);
+ else
+ addr = value_as_address (val);
+
+ if (addr != 0 && !type_not_associated (type))
+ TYPE_TARGET_TYPE (type) =
+ resolve_dynamic_type (TYPE_TARGET_TYPE (type), nullptr, addr);
+ }
+
LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags);
printf_filtered ("\n");
}
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* [PATCH 04/11] Fortran: Resolve dynamic properties of pointer types.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (3 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 05/11] Typeprint: Resolve any dynamic target type of a pointer Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2018-11-27 19:40 ` [PATCH 03/11] vla: add stride support to fortran arrays Sebastian Basierski
` (7 subsequent siblings)
12 siblings, 0 replies; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
In Fortran a pointer may have a dynamic associated property.
2016-07-08 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* gdbtypes.c (is_dynamic_type_internal): Resolve pointer types.
(resolve_dynamic_pointer): New.
---
gdb/gdbtypes.c | 29 ++++++++++++++++++++++++++++-
1 file changed, 28 insertions(+), 1 deletion(-)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 6730ae28e5..228b680a26 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1913,7 +1913,8 @@ 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) == TYPE_CODE_REF)
+ if (top_level &&
+ (TYPE_CODE (type) == TYPE_CODE_REF || TYPE_CODE (type) == TYPE_CODE_PTR))
type = check_typedef (TYPE_TARGET_TYPE (type));
/* Types that have a dynamic TYPE_DATA_LOCATION are considered
@@ -2248,6 +2249,28 @@ 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;
+
+ 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;
+ }
+
+ return type;
+}
+
/* Worker for resolved_dynamic_type. */
static struct type *
@@ -2296,6 +2319,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;
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* [PATCH 03/11] vla: add stride support to fortran arrays.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (4 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 04/11] Fortran: Resolve dynamic properties of pointer types Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2018-11-27 19:40 ` [PATCH 01/11] Dwarf: Fix dynamic properties with neg. value Sebastian Basierski
` (6 subsequent siblings)
12 siblings, 0 replies; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Keven Boell <keven.boell@intel.com>
2014-05-28 Bernhard Heckel <bernhard.heckel@intel.com>
Sanimir Agovic <sanimir.agovic@intel.com>
Keven Boell <keven.boell@intel.com>
gdb/Changelog:
* dwarf2read.c (read_subrange_type): Read dynamic
stride attributes.
* gdbtypes.c (create_array_type_with_stride): Add
stride support
(create_range_type): Add stride parameter.
(create_static_range_type): Pass default stride
parameter.
(resolve_dynamic_range): Evaluate stride baton.
* gdbtypes.h (TYPE_BYTE_STRIDE): New macro.
(TYPE_BYTE_STRIDE_BLOCK): New macro.
(TYPE_BYTE_STRIDE_LOCLIST): New macro.
(TYPE_BYTE_STRIDE_KIND): New macro.
* valarith.c (value_subscripted_rvalue): Use stride.
gdb/testsuite/Changelog:
* vla-stride.exp: New file.
* vla-stride.f90: New file.
---
gdb/dwarf2read.c | 14 ++++++--
gdb/f-valprint.c | 8 ++++-
gdb/gdbtypes.c | 29 ++++++++++++----
gdb/gdbtypes.h | 15 ++++++++
gdb/testsuite/gdb.fortran/vla-stride.exp | 44 ++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++++++++++++++++
gdb/valarith.c | 10 ++++--
7 files changed, 138 insertions(+), 11 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.exp
create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.f90
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 78f96ea0d1..902aad3fbc 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -17841,7 +17841,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
struct type *base_type, *orig_base_type;
struct type *range_type;
struct attribute *attr;
- struct dynamic_prop low, high;
+ struct dynamic_prop low, high, stride;
int low_default_is_valid;
int high_bound_is_count = 0;
const char *name;
@@ -17861,7 +17861,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
low.kind = PROP_CONST;
high.kind = PROP_CONST;
+ stride.kind = PROP_CONST;
high.data.const_val = 0;
+ stride.data.const_val = 0;
/* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
omitting DW_AT_lower_bound. */
@@ -17894,6 +17896,14 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
break;
}
+ attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
+ if (attr)
+ if (!attr_to_dynamic_prop (attr, die, cu, &stride))
+ complaint (_("Missing DW_AT_byte_stride "
+ "- DIE at 0x%s [in module %s]"),
+ sect_offset_str (die->sect_off),
+ objfile_name (cu->per_cu->dwarf2_per_objfile->objfile));
+
attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
if (attr)
attr_to_dynamic_prop (attr, die, cu, &low);
@@ -17986,7 +17996,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
&& !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
high.data.const_val |= negative_mask;
- range_type = create_range_type (NULL, orig_base_type, &low, &high);
+ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
if (high_bound_is_count)
TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 903f2af638..b4067a8460 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -119,8 +119,14 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
if (nss != ndimensions)
{
- size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+ size_t dim_size;
size_t offs = 0;
+ LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
+
+ if (byte_stride)
+ dim_size = byte_stride;
+ else
+ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
for (i = lowerbound;
(i < upperbound + 1 && (*elts) < options->print_max);
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 8adf899f9a..6730ae28e5 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -911,7 +911,8 @@ operator== (const range_bounds &l, const range_bounds &r)
struct type *
create_range_type (struct type *result_type, struct type *index_type,
const struct dynamic_prop *low_bound,
- const struct dynamic_prop *high_bound)
+ const struct dynamic_prop *high_bound,
+ const struct dynamic_prop *stride)
{
if (result_type == NULL)
result_type = alloc_type_copy (index_type);
@@ -926,6 +927,7 @@ create_range_type (struct type *result_type, struct type *index_type,
TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
TYPE_RANGE_DATA (result_type)->low = *low_bound;
TYPE_RANGE_DATA (result_type)->high = *high_bound;
+ TYPE_RANGE_DATA (result_type)->stride = *stride;
if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
TYPE_UNSIGNED (result_type) = 1;
@@ -954,7 +956,7 @@ struct type *
create_static_range_type (struct type *result_type, struct type *index_type,
LONGEST low_bound, LONGEST high_bound)
{
- struct dynamic_prop low, high;
+ struct dynamic_prop low, high, stride;
low.kind = PROP_CONST;
low.data.const_val = low_bound;
@@ -962,7 +964,11 @@ create_static_range_type (struct type *result_type, struct type *index_type,
high.kind = PROP_CONST;
high.data.const_val = high_bound;
- result_type = create_range_type (result_type, index_type, &low, &high);
+ stride.kind = PROP_CONST;
+ stride.data.const_val = 0;
+
+ result_type = create_range_type (result_type, index_type,
+ &low, &high, &stride);
return result_type;
}
@@ -1180,16 +1186,20 @@ create_array_type_with_stride (struct type *result_type,
&& (!type_not_associated (result_type)
&& !type_not_allocated (result_type)))
{
- LONGEST low_bound, high_bound;
+ LONGEST low_bound, high_bound, byte_stride;
if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
element_type = check_typedef (element_type);
+ byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
+
/* Be careful when setting the array length. Ada arrays can be
empty arrays with the high_bound being smaller than the low_bound.
In such cases, the array length should be zero. */
if (high_bound < low_bound)
TYPE_LENGTH (result_type) = 0;
+ else if (byte_stride > 0)
+ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
else if (bit_stride > 0)
TYPE_LENGTH (result_type) =
(bit_stride * (high_bound - low_bound + 1) + 7) / 8;
@@ -1990,7 +2000,7 @@ resolve_dynamic_range (struct type *dyn_range_type,
CORE_ADDR value;
struct type *static_range_type, *static_target_type;
const struct dynamic_prop *prop;
- struct dynamic_prop low_bound, high_bound;
+ struct dynamic_prop low_bound, high_bound, stride;
gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
@@ -2022,12 +2032,19 @@ resolve_dynamic_range (struct type *dyn_range_type,
high_bound.data.const_val = 0;
}
+ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
+ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
+ {
+ stride.kind = PROP_CONST;
+ stride.data.const_val = value;
+ }
+
static_target_type
= resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
addr_stack, 0);
static_range_type = create_range_type (copy_type (dyn_range_type),
static_target_type,
- &low_bound, &high_bound);
+ &low_bound, &high_bound, &stride);
TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
return static_range_type;
}
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index a115857c0a..738b88d762 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -613,6 +613,10 @@ struct range_bounds
struct dynamic_prop high;
+ /* * Stride of range. */
+
+ struct dynamic_prop stride;
+
/* True if HIGH range bound contains the number of elements in the
subrange. This affects how the final hight bound is computed. */
@@ -1330,6 +1334,14 @@ extern bool set_type_align (struct type *, ULONGEST);
TYPE_RANGE_DATA(range_type)->high.kind
#define TYPE_LOW_BOUND_KIND(range_type) \
TYPE_RANGE_DATA(range_type)->low.kind
+#define TYPE_BYTE_STRIDE(range_type) \
+ TYPE_RANGE_DATA(range_type)->stride.data.const_val
+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
+ TYPE_RANGE_DATA(range_type)->stride.data.locexpr
+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
+ TYPE_RANGE_DATA(range_type)->stride.data.loclist
+#define TYPE_BYTE_STRIDE_KIND(range_type) \
+ TYPE_RANGE_DATA(range_type)->stride.kind
/* Property accessors for the type data location. */
#define TYPE_DATA_LOCATION(thistype) \
@@ -1364,6 +1376,8 @@ extern bool set_type_align (struct type *, ULONGEST);
TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
+ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
(TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
@@ -1899,6 +1913,7 @@ extern struct type *create_array_type_with_stride
struct dynamic_prop *, unsigned int);
extern struct type *create_range_type (struct type *, struct type *,
+ const struct dynamic_prop *,
const struct dynamic_prop *,
const struct dynamic_prop *);
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
new file mode 100644
index 0000000000..ed732da4ed
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
@@ -0,0 +1,44 @@
+# Copyright 2018 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 ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
+gdb_continue_to_breakpoint "re-reverse-elements"
+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
+ "print re-reverse-elements"
+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
+
+gdb_breakpoint [gdb_get_line_number "odd-elements"]
+gdb_continue_to_breakpoint "odd-elements"
+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
+gdb_test "print pvla(1)" " = 1" "print first odd-element"
+gdb_test "print pvla(5)" " = 9" "print last odd-element"
+
+gdb_breakpoint [gdb_get_line_number "single-element"]
+gdb_continue_to_breakpoint "single-element"
+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
+gdb_test "print pvla(1)" " = 5" "print one single-element"
diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
new file mode 100644
index 0000000000..51d56e27cb
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
@@ -0,0 +1,29 @@
+! Copyright 2018 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/>.
+
+program vla_stride
+ integer, target, allocatable :: vla (:)
+ integer, pointer :: pvla (:)
+
+ allocate(vla(10))
+ vla = (/ (I, I = 1,10) /)
+
+ pvla => vla(10:1:-1)
+ pvla => pvla(10:1:-1)
+ pvla => vla(1:10:2) ! re-reverse-elements
+ pvla => vla(5:4:-2) ! odd-elements
+
+ pvla => null() ! single-element
+end program vla_stride
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 807cdd5dbd..26cd17cc46 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -187,11 +187,17 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
struct type *array_type = check_typedef (value_type (array));
struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
ULONGEST elt_size = type_length_units (elt_type);
- ULONGEST elt_offs = elt_size * (index - lowerbound);
+ LONGEST elt_offs = index - lowerbound;
+ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
+
+ if (elt_stride != 0)
+ elt_offs *= elt_stride;
+ else
+ elt_offs *= elt_size;
if (index < lowerbound
|| (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
- && elt_offs >= type_length_units (array_type))
+ && abs (elt_offs) >= type_length_units (array_type))
|| (VALUE_LVAL (array) != lval_memory
&& TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)))
{
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* [PATCH 01/11] Dwarf: Fix dynamic properties with neg. value.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (5 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 03/11] vla: add stride support to fortran arrays Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2019-03-02 18:23 ` Andrew Burgess
2018-11-27 19:40 ` [PATCH 08/11] Fortran: Testsuite, add cyclic pointers Sebastian Basierski
` (5 subsequent siblings)
12 siblings, 1 reply; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
Evaluating of neg. value of 32bit inferiours running on 64bit plattform
causes issues because of the missing sign bits.
Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog
* dwarf2loc.h: Declare
* dwarf2loc.c (dwarf2_evaluate_property_signed): New.
(dwarf2_evaluate_property): Delegate tasks to
dwarf2_evaluate_property_signed.
---
gdb/dwarf2loc.c | 44 +++++++++++++++++++++++++++++++++++---------
gdb/dwarf2loc.h | 7 +++++++
2 files changed, 42 insertions(+), 9 deletions(-)
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index ee6a8e277c..c94bdc60f2 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -2659,11 +2659,13 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
/* See dwarf2loc.h. */
int
-dwarf2_evaluate_property (const struct dynamic_prop *prop,
- struct frame_info *frame,
- struct property_addr_info *addr_stack,
- CORE_ADDR *value)
+dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
+ struct frame_info *frame,
+ struct property_addr_info *addr_stack,
+ CORE_ADDR *value, int is_signed)
{
+ int rc = 0;
+
if (prop == NULL)
return 0;
@@ -2687,7 +2689,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
*value = value_as_address (val);
}
- return 1;
+ rc = 1;
}
}
break;
@@ -2709,7 +2711,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
if (!value_optimized_out (val))
{
*value = value_as_address (val);
- return 1;
+ rc = 1;
}
}
}
@@ -2717,7 +2719,8 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
case PROP_CONST:
*value = prop->data.const_val;
- return 1;
+ rc = 1;
+ break;
case PROP_ADDR_OFFSET:
{
@@ -2739,11 +2742,34 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
val = value_at (baton->offset_info.type,
pinfo->addr + baton->offset_info.offset);
*value = value_as_address (val);
- return 1;
+ rc = 1;
}
+ break;
}
- return 0;
+ if (rc == 1 && is_signed == 1)
+ {
+ /* If we have a valid return candidate and it's value is signed,
+ we have to sign-extend the value because CORE_ADDR on 64bit machine has
+ 8 bytes but address size of an 32bit application is 4 bytes. */
+ struct gdbarch * gdbarch = target_gdbarch ();
+ const int addr_bit = gdbarch_addr_bit (gdbarch);
+ const CORE_ADDR neg_mask = ((~0) << (addr_bit - 1));
+
+ /* Check if signed bit is set and sign-extend values. */
+ if (*value & (neg_mask))
+ *value |= (neg_mask );
+ }
+ return rc;
+}
+
+int
+dwarf2_evaluate_property (const struct dynamic_prop *prop,
+ struct frame_info *frame,
+ struct property_addr_info *addr_stack,
+ CORE_ADDR *value)
+{
+ return dwarf2_evaluate_property_signed (prop, frame, addr_stack, value, 0);
}
/* See dwarf2loc.h. */
diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
index d7a56db05d..408e1904cd 100644
--- a/gdb/dwarf2loc.h
+++ b/gdb/dwarf2loc.h
@@ -143,6 +143,13 @@ int dwarf2_evaluate_property (const struct dynamic_prop *prop,
struct property_addr_info *addr_stack,
CORE_ADDR *value);
+int dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
+ struct frame_info *frame,
+ struct property_addr_info *addr_stack,
+ CORE_ADDR *value,
+ int is_signed);
+
+
/* A helper for the compiler interface that compiles a single dynamic
property to C code.
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* Re: [PATCH 01/11] Dwarf: Fix dynamic properties with neg. value.
2018-11-27 19:40 ` [PATCH 01/11] Dwarf: Fix dynamic properties with neg. value Sebastian Basierski
@ 2019-03-02 18:23 ` Andrew Burgess
0 siblings, 0 replies; 19+ messages in thread
From: Andrew Burgess @ 2019-03-02 18:23 UTC (permalink / raw)
To: Sebastian Basierski; +Cc: gdb-patches, Tomasz Kulasek
* Sebastian Basierski <sbasierski@pl.sii.eu> [2018-11-27 19:31:29 +0100]:
> From: Bernhard Heckel <bernhard.heckel@intel.com>
>
> Evaluating of neg. value of 32bit inferiours running on 64bit plattform
> causes issues because of the missing sign bits.
>
> Bernhard Heckel <bernhard.heckel@intel.com>
>
> gdb/Changelog
> * dwarf2loc.h: Declare
> * dwarf2loc.c (dwarf2_evaluate_property_signed): New.
> (dwarf2_evaluate_property): Delegate tasks to
> dwarf2_evaluate_property_signed.
> ---
> gdb/dwarf2loc.c | 44 +++++++++++++++++++++++++++++++++++---------
> gdb/dwarf2loc.h | 7 +++++++
> 2 files changed, 42 insertions(+), 9 deletions(-)
>
> diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
> index ee6a8e277c..c94bdc60f2 100644
> --- a/gdb/dwarf2loc.c
> +++ b/gdb/dwarf2loc.c
> @@ -2659,11 +2659,13 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
> /* See dwarf2loc.h. */
>
> int
> -dwarf2_evaluate_property (const struct dynamic_prop *prop,
> - struct frame_info *frame,
> - struct property_addr_info *addr_stack,
> - CORE_ADDR *value)
> +dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
> + struct frame_info *frame,
> + struct property_addr_info *addr_stack,
> + CORE_ADDR *value, int is_signed)
I don't like this renaming, the function now has a '_signed' suffix,
but also now takes a flag 'is_signed', there seems to be some
confusion here.
Additional 'is_signed' should be a bool.
> {
> + int rc = 0;
> +
> if (prop == NULL)
> return 0;
>
> @@ -2687,7 +2689,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
>
> *value = value_as_address (val);
> }
> - return 1;
> + rc = 1;
> }
> }
> break;
> @@ -2709,7 +2711,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
> if (!value_optimized_out (val))
> {
> *value = value_as_address (val);
> - return 1;
> + rc = 1;
> }
> }
> }
> @@ -2717,7 +2719,8 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
>
> case PROP_CONST:
> *value = prop->data.const_val;
> - return 1;
> + rc = 1;
> + break;
>
> case PROP_ADDR_OFFSET:
> {
> @@ -2739,11 +2742,34 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
> val = value_at (baton->offset_info.type,
> pinfo->addr + baton->offset_info.offset);
> *value = value_as_address (val);
> - return 1;
> + rc = 1;
> }
> + break;
> }
>
> - return 0;
> + if (rc == 1 && is_signed == 1)
> + {
> + /* If we have a valid return candidate and it's value is signed,
> + we have to sign-extend the value because CORE_ADDR on 64bit machine has
> + 8 bytes but address size of an 32bit application is 4 bytes. */
> + struct gdbarch * gdbarch = target_gdbarch ();
Getting the gdbarch from the frame would probably be better.
> + const int addr_bit = gdbarch_addr_bit (gdbarch);
> + const CORE_ADDR neg_mask = ((~0) << (addr_bit - 1));
> +
> + /* Check if signed bit is set and sign-extend values. */
> + if (*value & (neg_mask))
> + *value |= (neg_mask );
I notice that there's no tests included in this patch, I tried the
entire series with this new code commented out (except for patch #9
which wouldn't merge for me) and I couldn't see any failures (I only
ran the gdb.fortran/*.exp tests though, so its not clear if this code
is tested at all.
What I do see is the new code triggering (that is sign extending a
value) but this doesn't seem to be required. I haven't dug into why
this doesn't make a difference yet though.
FYI I tried running these tests using 'gfortran -m32' on an x86-64
machine, which I think is the setup that you're expecting to see
failures on.
Ideally I like to see this new code covered with a test.
> + }
> + return rc;
> +}
> +
> +int
> +dwarf2_evaluate_property (const struct dynamic_prop *prop,
> + struct frame_info *frame,
> + struct property_addr_info *addr_stack,
> + CORE_ADDR *value)
> +{
> + return dwarf2_evaluate_property_signed (prop, frame, addr_stack, value, 0);
> }
The 'dwarf2_evaluate_property' function isn't used that often, I think
it might be worth sticking with the existing
'dwarf2_evaluate_property' name, and just adding the 'is_signed' flag
there, then update all of the users, that way users are forced to
think about what the correct value for the flag should be.
>
> /* See dwarf2loc.h. */
> diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
> index d7a56db05d..408e1904cd 100644
> --- a/gdb/dwarf2loc.h
> +++ b/gdb/dwarf2loc.h
> @@ -143,6 +143,13 @@ int dwarf2_evaluate_property (const struct dynamic_prop *prop,
> struct property_addr_info *addr_stack,
> CORE_ADDR *value);
>
> +int dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
> + struct frame_info *frame,
> + struct property_addr_info *addr_stack,
> + CORE_ADDR *value,
> + int is_signed);
I don't think this will be needed, but new functions should have a
header comment.
Thanks,
Andrew
> +
> +
> /* A helper for the compiler interface that compiles a single dynamic
> property to C code.
>
> --
> 2.17.1
>
^ permalink raw reply [flat|nested] 19+ messages in thread
* [PATCH 08/11] Fortran: Testsuite, add cyclic pointers.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (6 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 01/11] Dwarf: Fix dynamic properties with neg. value Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2018-11-27 19:40 ` [PATCH 11/11] fortran: Testsuite, add sizeof tests to indexed and sliced arrays Sebastian Basierski
` (4 subsequent siblings)
12 siblings, 0 replies; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
2016-05-25 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/testsuite/Changelog:
* pointers.f90: Add cylic pointers.
* pointers.exp: Add print of cyclic pointers.
---
gdb/testsuite/gdb.fortran/pointers.exp | 20 ++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.f90 | 12 ++++++++++++
2 files changed, 32 insertions(+)
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
index 0f6c9d3cdf..287803120a 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -69,6 +69,24 @@ gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" \
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 {
+ -re "= \\( i = -?\\d+, p = 0x0 \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "= \\( i = -?\\d+, p = <not associated> \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "print cyclicp1%p, not associated"
+gdb_test_multiple "print cyclicp1%p" $test {
+ -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) <not associated>\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
gdb_breakpoint [gdb_get_line_number "Before value assignment"]
@@ -131,6 +149,8 @@ gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name {
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+>" \
diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
index c36398d76a..1ba5463745 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -20,6 +20,11 @@ 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
@@ -34,6 +39,7 @@ program pointers
real, target :: realv
type(two), target :: twov
type(twoPtr) :: arrayOfPtr (3)
+ type(typeWithPointer), target:: cyclicp1,cyclicp2
logical, pointer :: logp
complex, pointer :: comp
@@ -57,6 +63,8 @@ program pointers
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
@@ -68,6 +76,10 @@ program pointers
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)
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* [PATCH 11/11] fortran: Testsuite, add sizeof tests to indexed and sliced arrays.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (7 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 08/11] Fortran: Testsuite, add cyclic pointers Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2019-05-15 21:30 ` [PUSHED] gdb/fortran: Add sizeof tests for " Andrew Burgess
2018-11-27 19:40 ` [PATCH 10/11] fortran: Fix sizeof in case pointer is not associated and allocated Sebastian Basierski
` (3 subsequent siblings)
12 siblings, 1 reply; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
gdb/testsuite/Changelog:
* gdb fortran/vla-sizeof.exp: Add tests of sizeof applied
to indexed and sliced arrays.
---
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 12 ++++++++++++
1 file changed, 12 insertions(+)
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 83bc849619..fca355f939 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -29,21 +29,33 @@ if ![runto_main] {
gdb_breakpoint [gdb_get_line_number "vla1-init"]
gdb_continue_to_breakpoint "vla1-init"
gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
+gdb_test "print sizeof(vla1(3,2,1))" "no such vector element \\(vector not allocated\\)" \
+ "print sizeof non-allocated indexed vla1"
+gdb_test "print sizeof(vla1(3:4,2,1))" "slice out of range" \
+ "print sizeof non-allocated sliced vla1"
# Try to access value in allocated VLA
gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
gdb_continue_to_breakpoint "vla2-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
+gdb_test "print sizeof(vla1(3,2,1))" "4" "print sizeof non-allocated vla1"
+gdb_test "print sizeof(vla1(3:4,2,1))" "800" "print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
gdb_breakpoint [gdb_get_line_number "vla1-filled"]
gdb_continue_to_breakpoint "vla1-filled"
gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
+gdb_test "print sizeof(pvla(3,2,1))" "no such vector element \\(vector not associated\\)" \
+ "print sizeof non-associated indexed pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "slice out of range" \
+ "print sizeof non-associated sliced pvla"
# Try to access values in pointer to VLA and compare them
gdb_breakpoint [gdb_get_line_number "pvla-associated"]
gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
+gdb_test "print sizeof(pvla(3,2,1))" "4" "print sizeof non-associated pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
gdb_continue_to_breakpoint "vla1-neg-bounds"
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* [PUSHED] gdb/fortran: Add sizeof tests for indexed and sliced arrays
2018-11-27 19:40 ` [PATCH 11/11] fortran: Testsuite, add sizeof tests to indexed and sliced arrays Sebastian Basierski
@ 2019-05-15 21:30 ` Andrew Burgess
0 siblings, 0 replies; 19+ messages in thread
From: Andrew Burgess @ 2019-05-15 21:30 UTC (permalink / raw)
To: gdb-patches; +Cc: Andrew Burgess
I've pushed the below.
Thanks,
Andrew
--
Add tests for calling sizeof on indexed and sliced arrays, and on
pointers to arrays. These are all things that currently work, but
were previously untested.
gdb/testsuite/ChangeLog:
* gdb.fortran/vla-sizeof.exp: Add tests of sizeof applied to
indexed and sliced arrays, and pointers to arrays.
---
gdb/testsuite/ChangeLog | 5 +++++
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 23 +++++++++++++++++++----
2 files changed, 24 insertions(+), 4 deletions(-)
diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
index 7f74a699d76..b6fdaebbf51 100644
--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
@@ -29,18 +29,33 @@ if ![runto_main] {
gdb_breakpoint [gdb_get_line_number "vla1-init"]
gdb_continue_to_breakpoint "vla1-init"
gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
+gdb_test "print sizeof(vla1(3,2,1))" \
+ "no such vector element \\(vector not allocated\\)" \
+ "print sizeof non-allocated indexed vla1"
+gdb_test "print sizeof(vla1(3:4,2,1))" "slice out of range" \
+ "print sizeof non-allocated sliced vla1"
# Try to access value in allocated VLA
-gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
-gdb_continue_to_breakpoint "vla2-allocated"
+gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
+gdb_continue_to_breakpoint "vla1-allocated"
gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
+gdb_test "print sizeof(vla1(3,2,1))" "4" \
+ "print sizeof element from allocated vla1"
+gdb_test "print sizeof(vla1(3:4,2,1))" "800" \
+ "print sizeof sliced vla1"
# Try to access values in undefined pointer to VLA (dangling)
-gdb_breakpoint [gdb_get_line_number "vla1-filled"]
-gdb_continue_to_breakpoint "vla1-filled"
gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
+gdb_test "print sizeof(pvla(3,2,1))" \
+ "no such vector element \\(vector not associated\\)" \
+ "print sizeof non-associated indexed pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "slice out of range" \
+ "print sizeof non-associated sliced pvla"
# Try to access values in pointer to VLA and compare them
gdb_breakpoint [gdb_get_line_number "pvla-associated"]
gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
+gdb_test "print sizeof(pvla(3,2,1))" "4" \
+ "print sizeof element from associated pvla"
+gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla"
--
2.14.5
^ permalink raw reply [flat|nested] 19+ messages in thread
* [PATCH 10/11] fortran: Fix sizeof in case pointer is not associated and allocated.
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (8 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 11/11] fortran: Testsuite, add sizeof tests to indexed and sliced arrays Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2018-11-27 19:40 ` [PATCH 09/11] fort_dyn_array: Fortran dynamic string support Sebastian Basierski
` (2 subsequent siblings)
12 siblings, 0 replies; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
2016-03-04 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* eval.c (evaluate_subexp_for_sizeof): Dereference pointer when
associated and allocated.
gdb/testsuite/Changelog:
* gdb fortran/vla-sizeof.exp: Adapt expected output.
* gdb.fortran/pointers.exp: Likewise.
---
gdb/eval.c | 9 +++++++++
gdb/testsuite/gdb.fortran/pointers.exp | 8 ++++++++
2 files changed, 17 insertions(+)
diff --git a/gdb/eval.c b/gdb/eval.c
index 047aba59ae..3413e208e5 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -3248,6 +3248,15 @@ evaluate_subexp_for_sizeof (struct expression *exp, int *pos,
if (exp->language_defn->la_language == language_cplus
&& (TYPE_IS_REFERENCE (type)))
type = check_typedef (TYPE_TARGET_TYPE (type));
+ else if (exp->language_defn->la_language == language_fortran)
+ {
+ if (type_not_associated (type) || type_not_allocated (type))
+ return value_from_longest (size_type, 0);
+
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+ type = check_typedef (TYPE_TARGET_TYPE (type));
+ }
+
return value_from_longest (size_type, (LONGEST) TYPE_LENGTH (type));
}
diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
index 287803120a..4dcc5c61e3 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -94,6 +94,10 @@ gdb_continue_to_breakpoint "Before value assignment"
gdb_test "print *(twop)%ivla2" "= <not allocated>"
+gdb_test "print sizeof(intp)" "= 4"
+gdb_test "print sizeof(realp)" "= 4"
+gdb_test "print sizeof(charap)" "= 3"
+
gdb_breakpoint [gdb_get_line_number "After value assignment"]
gdb_continue_to_breakpoint "After value assignment"
gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?"
@@ -155,3 +159,7 @@ 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"
+
+gdb_test "print sizeof(intp)" "= 4"
+gdb_test "print sizeof(realp)" "= 4"
+gdb_test "print sizeof(charap)" "= 3"
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* [PATCH 09/11] fort_dyn_array: Fortran dynamic string support
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (9 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 10/11] fortran: Fix sizeof in case pointer is not associated and allocated Sebastian Basierski
@ 2018-11-27 19:40 ` Sebastian Basierski
2019-03-01 11:42 ` PING Re: [PATCH 00/11] Adds functionality and fixes some code Tomasz Kulasek
2019-03-01 11:59 ` Tomasz Kulasek
12 siblings, 0 replies; 19+ messages in thread
From: Sebastian Basierski @ 2018-11-27 19:40 UTC (permalink / raw)
To: gdb-patches
From: Bernhard Heckel <bernhard.heckel@intel.com>
This patch changes the semantic of the Dwarf string length
attribute to reflect the standard as well as enables
correct string length calculation of dynamic strings. Add
tests for varous dynamic string evaluations.
Old:
(gdb) p my_dyn_string
Cannot access memory at address 0x605fc0
New:
(gdb) p *my_dyn_string
$1 = 'foo'
gdb/Changlog:
* dwarf2read.c (read_tag_string_type): changed
semantic of DW_AT_string_length to be able to
handle Dwarf blocks as well. Support for
DW_AT_byte_length added to get correct length
if specified in combination with
DW_AT_string_length.
(attr_to_dynamic_prop): added
functionality to add Dwarf operators to baton
data attribute. Added post values to baton
as required by the string evaluation case.
(read_subrange_type): Adapt caller.
(set_die_type): Adapt caller.
* gdbtypes.c (resolve_dynamic_type_internal): Handle
string types like array types.
(resolve_dynamic_array): Add conditions for dynamic
strings and create a new string type.
(is_dynamic_type_internal): Handle string types like
array types.
gdb/testsuite/Changelog:
* vla-strings.f90: New file.
* vla-strings.exp: New file.
---
gdb/dwarf2read.c | 153 ++++++++++++++++++----
gdb/gdbtypes.c | 15 ++-
gdb/testsuite/gdb.fortran/vla-strings.exp | 100 ++++++++++++++
gdb/testsuite/gdb.fortran/vla-strings.f90 | 39 ++++++
4 files changed, 274 insertions(+), 33 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.exp
create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.f90
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 902aad3fbc..3e1965e5b4 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -1805,7 +1805,9 @@ static void read_signatured_type (struct signatured_type *);
static int attr_to_dynamic_prop (const struct attribute *attr,
struct die_info *die, struct dwarf2_cu *cu,
- struct dynamic_prop *prop);
+ struct dynamic_prop *prop,
+ const gdb_byte *additional_data,
+ int additional_data_size);
/* memory allocation interface */
@@ -13826,7 +13828,7 @@ read_func_scope (struct die_info *die, struct dwarf2_cu *cu)
{
newobj->static_link
= XOBNEW (&objfile->objfile_obstack, struct dynamic_prop);
- attr_to_dynamic_prop (attr, die, cu, newobj->static_link);
+ attr_to_dynamic_prop (attr, die, cu, newobj->static_link, nullptr, 0);
}
cu->list_in_scope = cu->builder->get_local_symbols ();
@@ -16584,7 +16586,8 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu)
byte_stride_prop
= (struct dynamic_prop *) alloca (sizeof (struct dynamic_prop));
- stride_ok = attr_to_dynamic_prop (attr, die, cu, byte_stride_prop);
+ stride_ok = attr_to_dynamic_prop (attr, die, cu, byte_stride_prop,
+ nullptr, 0);
if (!stride_ok)
{
complaint (_("unable to read array DW_AT_byte_stride "
@@ -17343,31 +17346,90 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
{
struct objfile *objfile = cu->per_cu->dwarf2_per_objfile->objfile;
struct gdbarch *gdbarch = get_objfile_arch (objfile);
- struct type *type, *range_type, *index_type, *char_type;
+ struct type *type, *char_type;
struct attribute *attr;
- unsigned int length;
+ unsigned int length = UINT_MAX;
+
+ struct type *index_type = objfile_type (objfile)->builtin_int;
+ struct type *range_type = create_static_range_type (nullptr, index_type, 1, length);
+ /* If DW_AT_string_length is defined, the length is stored in memory. */
attr = dwarf2_attr (die, DW_AT_string_length, cu);
if (attr)
{
- length = DW_UNSND (attr);
+ if (attr_form_is_block (attr))
+ {
+ struct attribute *byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
+ struct attribute *bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
+ struct dynamic_prop high;
+
+ /* DW_AT_byte_size should never occur in combination with
+ DW_AT_bit_size. */
+ if (byte_size != nullptr && bit_size != nullptr)
+ complaint (_("DW_AT_byte_size AND "
+ "DW_AT_bit_size found together at the same time."));
+
+ /* If DW_AT_string_length AND DW_AT_byte_size exist together,
+ DW_AT_byte_size describes the number of bytes that should be read
+ from the length memory location. */
+ if (byte_size != nullptr)
+ {
+ /* Build new dwarf2_locexpr_baton structure with additions to the
+ data attribute, to reflect DWARF specialities to get address
+ sizes. */
+ const gdb_byte append_ops[] =
+ {
+ /* DW_OP_deref_size: size of an address on the target machine
+ (bytes), where the size will be specified by the next
+ operand. */
+ DW_OP_deref_size,
+ /* Operand for DW_OP_deref_size. */
+ gdb_byte (DW_UNSND (byte_size))
+ };
+
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
+ ARRAY_SIZE(append_ops)))
+ complaint (_("Could not parse DW_AT_byte_size"));
+ }
+ else if (bit_size != NULL)
+ complaint (_("DW_AT_string_length AND "
+ "DW_AT_bit_size found but not supported yet."));
+ /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
+ is the address size of the target machine. */
+ else
+ {
+ const gdb_byte append_ops[] = { DW_OP_deref };
+
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
+ ARRAY_SIZE (append_ops)))
+ complaint (_("Could not parse DW_AT_string_length"));
+ }
+
+ TYPE_RANGE_DATA (range_type)->high = high;
+ }
+ else
+ {
+ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
+ }
}
else
{
- /* Check for the DW_AT_byte_size attribute. */
+ /* Check for the DW_AT_byte_size attribute, which represents the length
+ in this case. */
attr = dwarf2_attr (die, DW_AT_byte_size, cu);
if (attr)
- {
- length = DW_UNSND (attr);
- }
+ {
+ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
+ }
else
- {
- length = 1;
- }
+ {
+ TYPE_HIGH_BOUND (range_type) = 1;
+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
+ }
}
- index_type = objfile_type (objfile)->builtin_int;
- range_type = create_static_range_type (NULL, index_type, 1, length);
char_type = language_string_char_type (cu->language_defn, gdbarch);
type = create_string_type (NULL, char_type, range_type);
@@ -17735,7 +17797,8 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
static int
attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
- struct dwarf2_cu *cu, struct dynamic_prop *prop)
+ struct dwarf2_cu *cu, struct dynamic_prop *prop,
+ const gdb_byte *additional_data, int additional_data_size)
{
struct dwarf2_property_baton *baton;
struct obstack *obstack
@@ -17749,11 +17812,26 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
baton = XOBNEW (obstack, struct dwarf2_property_baton);
baton->referenced_type = NULL;
baton->locexpr.per_cu = cu->per_cu;
- baton->locexpr.size = DW_BLOCK (attr)->size;
- baton->locexpr.data = DW_BLOCK (attr)->data;
+
+ if (additional_data != nullptr && additional_data_size > 0)
+ {
+ gdb_byte *data = (gdb_byte *) obstack_alloc (obstack,
+ DW_BLOCK (attr)->size + additional_data_size);
+ memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
+ memcpy (data + DW_BLOCK (attr)->size, additional_data,
+ additional_data_size);
+
+ baton->locexpr.data = data;
+ baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
+ }
+ else
+ {
+ baton->locexpr.data = DW_BLOCK (attr)->data;
+ baton->locexpr.size = DW_BLOCK (attr)->size;
+ }
+
prop->data.baton = baton;
prop->kind = PROP_LOCEXPR;
- gdb_assert (prop->data.baton != NULL);
}
else if (attr_form_is_ref (attr))
{
@@ -17786,11 +17864,28 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
baton = XOBNEW (obstack, struct dwarf2_property_baton);
baton->referenced_type = die_type (target_die, target_cu);
baton->locexpr.per_cu = cu->per_cu;
- baton->locexpr.size = DW_BLOCK (target_attr)->size;
- baton->locexpr.data = DW_BLOCK (target_attr)->data;
+
+ if (additional_data != NULL && additional_data_size > 0)
+ {
+ gdb_byte *data = (gdb_byte *) obstack_alloc (obstack,
+ DW_BLOCK (target_attr)->size + additional_data_size);
+ memcpy (data, DW_BLOCK (target_attr)->data,
+ DW_BLOCK (target_attr)->size);
+ memcpy (data + DW_BLOCK (target_attr)->size,
+ additional_data, additional_data_size);
+
+ baton->locexpr.data = data;
+ baton->locexpr.size = (DW_BLOCK (target_attr)->size
+ + additional_data_size);
+ }
+ else
+ {
+ baton->locexpr.data = DW_BLOCK (target_attr)->data;
+ baton->locexpr.size = DW_BLOCK (target_attr)->size;
+ }
+
prop->data.baton = baton;
prop->kind = PROP_LOCEXPR;
- gdb_assert (prop->data.baton != NULL);
}
else
{
@@ -17898,7 +17993,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
if (attr)
- if (!attr_to_dynamic_prop (attr, die, cu, &stride))
+ if (!attr_to_dynamic_prop (attr, die, cu, &stride, nullptr, 0))
complaint (_("Missing DW_AT_byte_stride "
"- DIE at 0x%s [in module %s]"),
sect_offset_str (die->sect_off),
@@ -17906,7 +18001,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
if (attr)
- attr_to_dynamic_prop (attr, die, cu, &low);
+ attr_to_dynamic_prop (attr, die, cu, &low, nullptr, 0);
else if (!low_default_is_valid)
complaint (_("Missing DW_AT_lower_bound "
"- DIE at %s [in module %s]"),
@@ -17915,10 +18010,10 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu)
struct attribute *attr_ub, *attr_count;
attr = attr_ub = dwarf2_attr (die, DW_AT_upper_bound, cu);
- if (!attr_to_dynamic_prop (attr, die, cu, &high))
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, nullptr, 0))
{
attr = attr_count = dwarf2_attr (die, DW_AT_count, cu);
- if (attr_to_dynamic_prop (attr, die, cu, &high))
+ if (attr_to_dynamic_prop (attr, die, cu, &high, nullptr, 0))
{
/* If bounds are constant do the final calculation here. */
if (low.kind == PROP_CONST && high.kind == PROP_CONST)
@@ -25510,7 +25605,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
attr = dwarf2_attr (die, DW_AT_allocated, cu);
if (attr_form_is_block (attr))
{
- if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, nullptr, 0))
add_dyn_prop (DYN_PROP_ALLOCATED, prop, type);
}
else if (attr != NULL)
@@ -25524,7 +25619,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
attr = dwarf2_attr (die, DW_AT_associated, cu);
if (attr_form_is_block (attr))
{
- if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, nullptr, 0))
add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type);
}
else if (attr != NULL)
@@ -25536,7 +25631,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
/* Read DW_AT_data_location and set in type. */
attr = dwarf2_attr (die, DW_AT_data_location, cu);
- if (attr_to_dynamic_prop (attr, die, cu, &prop))
+ if (attr_to_dynamic_prop (attr, die, cu, &prop, nullptr, 0))
add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type);
if (dwarf2_per_objfile->die_type_hash == NULL)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 228b680a26..bb692caebf 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1948,6 +1948,7 @@ is_dynamic_type_internal (struct type *type, int top_level)
}
case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
{
gdb_assert (TYPE_NFIELDS (type) == 1);
@@ -2065,7 +2066,8 @@ resolve_dynamic_array (struct type *type,
struct dynamic_prop *prop;
unsigned int bit_stride = 0;
- gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
+ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
+ || TYPE_CODE (type) == TYPE_CODE_STRING);
type = copy_type (type);
@@ -2090,7 +2092,8 @@ resolve_dynamic_array (struct type *type,
ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
- if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
+ if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
+ || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
elt_type = resolve_dynamic_array (ary_dim, addr_stack);
else
elt_type = TYPE_TARGET_TYPE (type);
@@ -2118,8 +2121,11 @@ resolve_dynamic_array (struct type *type,
else
bit_stride = TYPE_FIELD_BITSIZE (type, 0);
- return create_array_type_with_stride (type, elt_type, range_type, NULL,
- bit_stride);
+ if (TYPE_CODE (type) == TYPE_CODE_STRING)
+ return create_string_type (type, elt_type, range_type);
+ else
+ return create_array_type_with_stride (type, elt_type, range_type,
+ nullptr, bit_stride);
}
/* Resolve dynamic bounds of members of the union TYPE to static
@@ -2324,6 +2330,7 @@ resolve_dynamic_type_internal (struct type *type,
break;
case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
resolved_type = resolve_dynamic_array (type, addr_stack);
break;
diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp
new file mode 100644
index 0000000000..be9107514c
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-strings.exp
@@ -0,0 +1,100 @@
+# Copyright 2018 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 ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+if ![runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
+gdb_continue_to_breakpoint "var_char-allocated-1"
+set test "whatis var_char first time"
+gdb_test_multiple "whatis var_char" $test {
+ -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*10\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "ptype var_char first time"
+gdb_test_multiple "ptype var_char" $test {
+ -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*10\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+
+
+gdb_test "next" "\\d+.*var_char = 'foo'.*" \
+ "next to allocation status of var_char"
+gdb_test "print l" " = \\.TRUE\\." "print allocation status first time"
+
+
+gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
+gdb_continue_to_breakpoint "var_char-filled-1"
+set test "print var_char, var_char-filled-1"
+gdb_test_multiple "print var_char" $test {
+ -re "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\r\n$gdb_prompt $" {
+ gdb_test "print *var_char" "= 'foo'" "print *var_char, var_char-filled-1"
+ pass $test
+ }
+ -re "= 'foo'\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "ptype var_char, var_char-filled-1"
+gdb_test_multiple "ptype var_char" $test {
+ -re "type = PTR TO -> \\( character\\*3 \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*3\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+gdb_test "print var_char(1)" " = 102" "print var_char(1)"
+gdb_test "print var_char(3)" " = 111" "print var_char(3)"
+
+
+gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
+gdb_continue_to_breakpoint "var_char-filled-2"
+set test "print var_char, var_char-filled-2"
+gdb_test_multiple "print var_char" $test {
+ -re "= \\(PTR TO -> \\( character\\*6 \\)\\) $hex\r\n$gdb_prompt $" {
+ gdb_test "print *var_char" "= 'foobar'" "print *var_char, var_char-filled-2"
+ pass $test
+ }
+ -re "= 'foobar'\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
+set test "ptype var_char, var_char-filled-2"
+gdb_test_multiple "ptype var_char" $test {
+ -re "type = PTR TO -> \\( character\\*6 \\)\r\n$gdb_prompt $" {
+ pass $test
+ }
+ -re "type = character\\*6\r\n$gdb_prompt $" {
+ pass $test
+ }
+}
diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90
new file mode 100644
index 0000000000..5d393f9f40
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-strings.f90
@@ -0,0 +1,39 @@
+! Copyright 2018 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/>.
+
+program vla_strings
+ character(len=:), target, allocatable :: var_char
+ character(len=:), pointer :: var_char_p
+ logical :: l
+
+ allocate(character(len=10) :: var_char)
+ l = allocated(var_char) ! var_char-allocated-1
+ var_char = 'foo'
+ deallocate(var_char) ! var_char-filled-1
+ l = allocated(var_char) ! var_char-deallocated
+ allocate(character(len=42) :: var_char)
+ l = allocated(var_char)
+ var_char = 'foobar'
+ var_char = '' ! var_char-filled-2
+ var_char = 'bar' ! var_char-empty
+ deallocate(var_char)
+ allocate(character(len=21) :: var_char)
+ l = allocated(var_char) ! var_char-allocated-3
+ var_char = 'johndoe'
+ var_char_p => var_char
+ l = associated(var_char_p) ! var_char_p-associated
+ var_char_p => null()
+ l = associated(var_char_p) ! var_char_p-not-associated
+end program vla_strings
--
2.17.1
^ permalink raw reply [flat|nested] 19+ messages in thread* PING Re: [PATCH 00/11] Adds functionality and fixes some code
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (10 preceding siblings ...)
2018-11-27 19:40 ` [PATCH 09/11] fort_dyn_array: Fortran dynamic string support Sebastian Basierski
@ 2019-03-01 11:42 ` Tomasz Kulasek
2019-03-01 11:59 ` Tomasz Kulasek
12 siblings, 0 replies; 19+ messages in thread
From: Tomasz Kulasek @ 2019-03-01 11:42 UTC (permalink / raw)
To: gdb-patches; +Cc: Tomasz Kulasek
Hi,
I know these patches are old, but can someone look into them?
Thanks
Tomek
^ permalink raw reply [flat|nested] 19+ messages in thread* PING Re: [PATCH 00/11] Adds functionality and fixes some code
2018-11-27 19:40 [PATCH 00/11] Adds functionality and fixes some code Sebastian Basierski
` (11 preceding siblings ...)
2019-03-01 11:42 ` PING Re: [PATCH 00/11] Adds functionality and fixes some code Tomasz Kulasek
@ 2019-03-01 11:59 ` Tomasz Kulasek
2019-03-01 15:24 ` Andrew Burgess
12 siblings, 1 reply; 19+ messages in thread
From: Tomasz Kulasek @ 2019-03-01 11:59 UTC (permalink / raw)
To: gdb-patches; +Cc: Tomasz Kulasek
Hi,
I know these patches are old, but can someone look into them?
Thanks
Tomek
^ permalink raw reply [flat|nested] 19+ messages in thread* Re: PING Re: [PATCH 00/11] Adds functionality and fixes some code
2019-03-01 11:59 ` Tomasz Kulasek
@ 2019-03-01 15:24 ` Andrew Burgess
0 siblings, 0 replies; 19+ messages in thread
From: Andrew Burgess @ 2019-03-01 15:24 UTC (permalink / raw)
To: Tomasz Kulasek; +Cc: gdb-patches
* Tomasz Kulasek <tkulasek@sii.pl> [2019-03-01 13:01:53 +0100]:
> I know these patches are old, but can someone look into them?
I must have sensed something....
I started looking through this series today. I don't have time right
now to finish the review, but I plan to over the weekend, you should
expect some feedback by Monday.
Thanks,
Andrew
^ permalink raw reply [flat|nested] 19+ messages in thread