* [PATCH V5 1/6] Fortran: Testsuite, fix differences in type naming.
2016-10-14 11:54 [PATCH V5 0/6] Fortran: Resolve target types of pointers Bernhard Heckel
@ 2016-10-14 11:54 ` Bernhard Heckel
2016-10-14 11:54 ` [PATCH V5 3/6] Typeprint: Resolve any dynamic target type of a pointer Bernhard Heckel
` (5 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Bernhard Heckel @ 2016-10-14 11:54 UTC (permalink / raw)
To: qiyaoltc, brobecker; +Cc: gdb-patches, Bernhard Heckel
Continued on 0c13f7e559afe5f973a59311b0e401296c48d96c
(fortran: Testsuite, fix different type naming across compilers).
2016-06-08 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Testsuite/Changelog:
* gdb.fortran/vla-value.exp: Use type names defined in libfortran.
* gdb.mi/mi-var-child-f.exp: Likewise.
* gdb.mi/mi-vla-fortran.exp: Likewise.
---
gdb/testsuite/gdb.fortran/vla-value.exp | 13 +++++++++----
gdb/testsuite/gdb.mi/mi-var-child-f.exp | 8 ++++----
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 19 ++++++++++++-------
3 files changed, 25 insertions(+), 15 deletions(-)
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 0945181..5ac6317 100644
--- a/gdb/testsuite/gdb.fortran/vla-value.exp
+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
@@ -14,6 +14,7 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
standard_testfile "vla.f90"
+load_lib "fortran.exp"
if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
{debug f90 quiet}] } {
@@ -25,12 +26,16 @@ if ![runto_main] {
return -1
}
+# Depending on the compiler being used,
+# the type names can be printed differently.
+set real [fortran_real4]
+
# Try to access values in non allocated VLA
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\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\)\\\)\\\) $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)"
@@ -51,7 +56,7 @@ with_timeout_factor 15 {
"step over value assignment of vla1"
}
gdb_test "print &vla1" \
- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \
"print allocated &vla1"
gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)"
gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)"
@@ -71,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\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(<not associated>\\\)\\\)\\\) $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)"
@@ -80,7 +85,7 @@ gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated
gdb_breakpoint [gdb_get_line_number "pvla-associated"]
gdb_continue_to_breakpoint "pvla-associated"
gdb_test "print &pvla" \
- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
+ " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \
"print associated &pvla"
gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)"
gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)"
diff --git a/gdb/testsuite/gdb.mi/mi-var-child-f.exp b/gdb/testsuite/gdb.mi/mi-var-child-f.exp
index f3ed7c2..7a0bb76 100644
--- a/gdb/testsuite/gdb.mi/mi-var-child-f.exp
+++ b/gdb/testsuite/gdb.mi/mi-var-child-f.exp
@@ -17,6 +17,7 @@
load_lib mi-support.exp
set MIFLAGS "-i=mi"
+load_lib "fortran.exp"
if { [skip_fortran_tests] } { return -1 }
@@ -40,10 +41,9 @@ mi_runto MAIN__
mi_create_varobj "array" "array" "create local variable array"
-# Depending on the compiler version being used, the name of the 4-byte integer
-# and real types can be printed differently. For instance, gfortran-4.1 uses
-# "int4" whereas gfortran-4.3 uses "integer(kind=4)".
-set int4 "(int4|integer\\(kind=4\\))"
+# Depending on the compiler being used,
+# the type names can be printed differently.
+set int4 [fortran_int4]
set children [list [list "array.-1" "-1" 2 "$int4 \\(2\\)"] \
[list "array.0" "0" 2 "$int4 \\(2\\)"] \
diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
index 333b71a..c71fc0b 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -17,6 +17,7 @@
# Array (VLA).
load_lib mi-support.exp
+load_lib fortran.exp
set MIFLAGS "-i=mi"
gdb_exit
@@ -32,6 +33,10 @@ if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \
return -1
}
+# Depending on the compiler being used,
+# the type names can be printed differently.
+set real [fortran_real4]
+
mi_delete_breakpoints
mi_gdb_reinitialize_dir $srcdir/$subdir
mi_gdb_load ${binfile}
@@ -58,7 +63,7 @@ mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \
"503\\^done,value=\"\\\[0\\\]\"" \
"eval variable vla1_not_allocated"
mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
- "real\\\(kind=4\\\)" "get children of vla1_not_allocated"
+ "$real" "get children of vla1_not_allocated"
@@ -71,10 +76,10 @@ mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
mi_gdb_test "510-data-evaluate-expression vla1" \
"510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla"
-mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \
+mi_create_varobj_checked vla1_allocated vla1 "$real \\\(5\\\)" \
"create local variable vla1_allocated"
mi_gdb_test "511-var-info-type vla1_allocated" \
- "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \
+ "511\\^done,type=\"$real \\\(5\\\)\"" \
"info type variable vla1_allocated"
mi_gdb_test "512-var-show-format vla1_allocated" \
"512\\^done,format=\"natural\"" \
@@ -83,7 +88,7 @@ mi_gdb_test "513-var-evaluate-expression vla1_allocated" \
"513\\^done,value=\"\\\[5\\\]\"" \
"eval variable vla1_allocated"
mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
- "real\\\(kind=4\\\)" "get children of vla1_allocated"
+ "$real" "get children of vla1_allocated"
set bp_lineno [gdb_get_line_number "vla1-filled"]
@@ -148,7 +153,7 @@ gdb_expect {
"583\\^done,value=\"\\\[0\\\]\"" \
"eval variable pvla2_not_associated"
mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
- "real\\\(kind=4\\\)" "get children of pvla2_not_associated"
+ "$real" "get children of pvla2_not_associated"
}
-re "580\\^error,msg=\"value contents too large \\(\[0-9\]+ bytes\\).*${mi_gdb_prompt}$" {
# Undefined behaviour in gfortran.
@@ -173,9 +178,9 @@ mi_gdb_test "590-data-evaluate-expression pvla2" \
"evaluate associated vla"
mi_create_varobj_checked pvla2_associated pvla2 \
- "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated"
+ "$real \\\(5,2\\\)" "create local variable pvla2_associated"
mi_gdb_test "591-var-info-type pvla2_associated" \
- "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \
+ "591\\^done,type=\"$real \\\(5,2\\\)\"" \
"info type variable pvla2_associated"
mi_gdb_test "592-var-show-format pvla2_associated" \
"592\\^done,format=\"natural\"" \
--
2.7.1.339.g0233b80
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH V5 3/6] Typeprint: Resolve any dynamic target type of a pointer.
2016-10-14 11:54 [PATCH V5 0/6] Fortran: Resolve target types of pointers Bernhard Heckel
2016-10-14 11:54 ` [PATCH V5 1/6] Fortran: Testsuite, fix differences in type naming Bernhard Heckel
@ 2016-10-14 11:54 ` Bernhard Heckel
2016-10-14 11:54 ` [PATCH V5 6/6] Fortran: Testsuite, add cyclic pointers Bernhard Heckel
` (4 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Bernhard Heckel @ 2016-10-14 11:54 UTC (permalink / raw)
To: qiyaoltc, brobecker; +Cc: gdb-patches, Bernhard Heckel
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 | 7 +++++++
gdb/testsuite/gdb.cp/vla-cxx.exp | 5 +++++
gdb/typeprint.c | 19 +++++++++++++++++++
3 files changed, 31 insertions(+)
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc
index a1fd510..2b01aa8 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.cc
+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc
@@ -15,6 +15,8 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
+#include <cstddef>
+
struct container;
struct element
@@ -40,11 +42,16 @@ int main(int argc, char **argv)
typedef typeof (vla) &vlareftypedef;
vlareftypedef vlaref2 (vla);
container c;
+ typeof (vla) *ptr = NULL;
+
+ // Before pointer assignment
+ ptr = &vla;
for (int i = 0; i < z; ++i)
vla[i] = 5 + 2 * i;
// vlas_filled
vla[0] = 2 * vla[0];
+
return vla[2];
}
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
index f6224dc..babdfb7 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 e77513e..e214942 100644
--- a/gdb/typeprint.c
+++ b/gdb/typeprint.c
@@ -485,6 +485,25 @@ whatis_exp (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 (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE(type)))
+ 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),
+ NULL, addr);
+ }
+
LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags);
printf_filtered ("\n");
--
2.7.1.339.g0233b80
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH V5 6/6] Fortran: Testsuite, add cyclic pointers.
2016-10-14 11:54 [PATCH V5 0/6] Fortran: Resolve target types of pointers Bernhard Heckel
2016-10-14 11:54 ` [PATCH V5 1/6] Fortran: Testsuite, fix differences in type naming Bernhard Heckel
2016-10-14 11:54 ` [PATCH V5 3/6] Typeprint: Resolve any dynamic target type of a pointer Bernhard Heckel
@ 2016-10-14 11:54 ` Bernhard Heckel
2016-10-14 11:54 ` [PATCH V5 4/6] Fortran: Typeprint, fix dangling types Bernhard Heckel
` (3 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Bernhard Heckel @ 2016-10-14 11:54 UTC (permalink / raw)
To: qiyaoltc, brobecker; +Cc: gdb-patches, Bernhard Heckel
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 881cf07..b99ca56 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 000193c..6240c87 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.7.1.339.g0233b80
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH V5 4/6] Fortran: Typeprint, fix dangling types.
2016-10-14 11:54 [PATCH V5 0/6] Fortran: Resolve target types of pointers Bernhard Heckel
` (2 preceding siblings ...)
2016-10-14 11:54 ` [PATCH V5 6/6] Fortran: Testsuite, add cyclic pointers Bernhard Heckel
@ 2016-10-14 11:54 ` Bernhard Heckel
2016-10-14 11:54 ` [PATCH V5 5/6] Resolve dynamic target types of pointers Bernhard Heckel
` (2 subsequent siblings)
6 siblings, 0 replies; 10+ messages in thread
From: Bernhard Heckel @ 2016-10-14 11:54 UTC (permalink / raw)
To: qiyaoltc, brobecker; +Cc: gdb-patches, Bernhard Heckel
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.mi/mi-vla-fortran.exp: Likewise.
---
gdb/f-typeprint.c | 93 ++++++++++++++--------------
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 +--
7 files changed, 246 insertions(+), 58 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 920c21f..13ab284 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);
@@ -54,18 +54,6 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
enum type_code code;
int demangled_args;
- 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')
@@ -87,7 +75,7 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
so don't print an additional pair of ()'s. */
demangled_args = 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);
}
}
@@ -157,7 +145,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;
@@ -181,34 +169,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
@@ -219,13 +223,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, ")");
@@ -376,7 +381,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/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
new file mode 100644
index 0000000..9ebbaa9
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -0,0 +1,80 @@
+! Copyright 2016 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 0000000..45b4968
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/print_type.exp
@@ -0,0 +1,100 @@
+# Copyright 2016 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 175661f..aa5c64a 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 401782b..dddcf39 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 5ac6317..42b92e5 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 c71fc0b..d1edb05 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"
-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\"" \
@@ -141,10 +141,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.7.1.339.g0233b80
^ permalink raw reply [flat|nested] 10+ messages in thread* [PATCH V5 5/6] Resolve dynamic target types of pointers.
2016-10-14 11:54 [PATCH V5 0/6] Fortran: Resolve target types of pointers Bernhard Heckel
` (3 preceding siblings ...)
2016-10-14 11:54 ` [PATCH V5 4/6] Fortran: Typeprint, fix dangling types Bernhard Heckel
@ 2016-10-14 11:54 ` Bernhard Heckel
2016-10-14 13:05 ` Eli Zaretskii
2016-10-14 11:54 ` [PATCH V5 2/6] Fortran: Resolve dynamic properties of pointer types Bernhard Heckel
2016-10-14 13:21 ` [PATCH V5 0/6] Fortran: Resolve target types of pointers Yao Qi
6 siblings, 1 reply; 10+ messages in thread
From: Bernhard Heckel @ 2016-10-14 11:54 UTC (permalink / raw)
To: qiyaoltc, brobecker; +Cc: gdb-patches, Bernhard Heckel
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 4a61438..7350643 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -33,6 +33,8 @@ Synopsys ARC arc*-*-elf32
* 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 2cb418d..04d3345 100644
--- a/gdb/c-valprint.c
+++ b/gdb/c-valprint.c
@@ -645,6 +645,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 babdfb7..7f8bae3 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 0000000..881cf07
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -0,0 +1,137 @@
+# Copyright 2016 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 9ebbaa9..000193c 100644
--- a/gdb/testsuite/gdb.fortran/pointers.f90
+++ b/gdb/testsuite/gdb.fortran/pointers.f90
@@ -20,14 +20,20 @@ program pointers
integer, allocatable :: ivla2 (:, :)
end type two
+ type :: twoPtr
+ type (two), pointer :: p
+ end type twoPtr
+
logical, target :: logv
complex, target :: comv
character, target :: charv
character (len=3), target :: chara
integer, target :: intv
integer, target, dimension (10,2) :: inta
+ integer, target, allocatable, dimension (:) :: intvla
real, target :: realv
type(two), target :: twov
+ type(twoPtr) :: arrayOfPtr (3)
logical, pointer :: logp
complex, pointer :: comp
@@ -35,6 +41,7 @@ program pointers
character (len=3), pointer:: charap
integer, pointer :: intp
integer, pointer, dimension (:,:) :: intap
+ integer, pointer, dimension (:) :: intvlap
real, pointer :: realp
type(two), pointer :: twop
@@ -44,8 +51,12 @@ program pointers
nullify (charap)
nullify (intp)
nullify (intap)
+ nullify (intvlap)
nullify (realp)
nullify (twop)
+ nullify (arrayOfPtr(1)%p)
+ nullify (arrayOfPtr(2)%p)
+ nullify (arrayOfPtr(3)%p)
logp => logv ! Before pointer assignment
comp => comv
@@ -53,8 +64,10 @@ program pointers
charap => chara
intp => intv
intap => inta
+ intvlap => intvla
realp => realv
twop => twov
+ arrayOfPtr(2)%p => twov
logv = associated(logp) ! Before value assignment
comv = cmplx(1,2)
@@ -63,6 +76,10 @@ program pointers
intv = 10
inta(:,:) = 1
inta(3,1) = 3
+ allocate (intvla(10))
+ intvla(:) = 2
+ intvla(4) = 4
+ intvlap => intvla
realv = 3.14
allocate (twov%ivla1(3))
diff --git a/gdb/valops.c b/gdb/valops.c
index 40392e8..6f38560 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -1562,6 +1562,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. */
@@ -1577,8 +1590,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 ca30a7f..ae532ff 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1141,12 +1141,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.7.1.339.g0233b80
^ permalink raw reply [flat|nested] 10+ messages in thread* Re: [PATCH V5 5/6] Resolve dynamic target types of pointers.
2016-10-14 11:54 ` [PATCH V5 5/6] Resolve dynamic target types of pointers Bernhard Heckel
@ 2016-10-14 13:05 ` Eli Zaretskii
0 siblings, 0 replies; 10+ messages in thread
From: Eli Zaretskii @ 2016-10-14 13:05 UTC (permalink / raw)
To: Bernhard Heckel; +Cc: qiyaoltc, brobecker, gdb-patches
> From: Bernhard Heckel <bernhard.heckel@intel.com>
> Cc: gdb-patches@sourceware.org, Bernhard Heckel <bernhard.heckel@intel.com>
> Date: Fri, 14 Oct 2016 13:54:03 +0200
>
> 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.
Thanks, the NEWS part is OK.
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH V5 2/6] Fortran: Resolve dynamic properties of pointer types.
2016-10-14 11:54 [PATCH V5 0/6] Fortran: Resolve target types of pointers Bernhard Heckel
` (4 preceding siblings ...)
2016-10-14 11:54 ` [PATCH V5 5/6] Resolve dynamic target types of pointers Bernhard Heckel
@ 2016-10-14 11:54 ` Bernhard Heckel
2016-10-14 13:21 ` [PATCH V5 0/6] Fortran: Resolve target types of pointers Yao Qi
6 siblings, 0 replies; 10+ messages in thread
From: Bernhard Heckel @ 2016-10-14 11:54 UTC (permalink / raw)
To: qiyaoltc, brobecker; +Cc: gdb-patches, Bernhard Heckel
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 ad890ca..33a8b7c 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1806,7 +1806,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
@@ -2105,6 +2106,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 *
@@ -2153,6 +2176,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.7.1.339.g0233b80
^ permalink raw reply [flat|nested] 10+ messages in thread* Re: [PATCH V5 0/6] Fortran: Resolve target types of pointers.
2016-10-14 11:54 [PATCH V5 0/6] Fortran: Resolve target types of pointers Bernhard Heckel
` (5 preceding siblings ...)
2016-10-14 11:54 ` [PATCH V5 2/6] Fortran: Resolve dynamic properties of pointer types Bernhard Heckel
@ 2016-10-14 13:21 ` Yao Qi
2016-10-17 7:11 ` Bernhard Heckel
6 siblings, 1 reply; 10+ messages in thread
From: Yao Qi @ 2016-10-14 13:21 UTC (permalink / raw)
To: Bernhard Heckel; +Cc: Joel Brobecker, gdb-patches
On Fri, Oct 14, 2016 at 12:53 PM, Bernhard Heckel
<bernhard.heckel@intel.com> wrote:
> Addressed in V5:
> - Fixed several "line to long" issues
> - include <cstddef>
> - Don't compare bool-like values against 0/1
I don't think my comments here
https://sourceware.org/ml/gdb-patches/2016-10/msg00360.html
are addressed in this version.
--
Yao (齐尧)
^ permalink raw reply [flat|nested] 10+ messages in thread* Re: [PATCH V5 0/6] Fortran: Resolve target types of pointers.
2016-10-14 13:21 ` [PATCH V5 0/6] Fortran: Resolve target types of pointers Yao Qi
@ 2016-10-17 7:11 ` Bernhard Heckel
0 siblings, 0 replies; 10+ messages in thread
From: Bernhard Heckel @ 2016-10-17 7:11 UTC (permalink / raw)
To: Yao Qi; +Cc: Joel Brobecker, gdb-patches
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset="utf-8"; format="flowed", Size: 918 bytes --]
On 14/10/2016 15:21, Yao Qi wrote:
> On Fri, Oct 14, 2016 at 12:53 PM, Bernhard Heckel
> <bernhard.heckel@intel.com> wrote:
>> Addressed in V5:
>> - Fixed several "line to long" issues
>> - include <cstddef>
>> - Don't compare bool-like values against 0/1
> I don't think my comments here
> https://sourceware.org/ml/gdb-patches/2016-10/msg00360.html
> are addressed in this version.
>
The two different versions are related to different compilers, described
here.
https://sourceware.org/ml/gdb-patches/2016-10/msg00373.html
Do you want me to add comments in the test?
Intel Deutschland GmbH
Registered Address: Am Campeon 10-12, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de
Managing Directors: Christin Eisenschmid, Christian Lamprechter
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928
\x16º&Öéj×!zÊÞ¶êç×~4çÙb²Ö«r\x18\x1dn–r\x17¬
^ permalink raw reply [flat|nested] 10+ messages in thread