rpms/gdb
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Rebase to FSF GDB 7.11.90.20160907 (pre-7.12 branch snapshot).

Browse Source 
- Rebase Intel VLA patchset.
This commit is contained in:
Jan Kratochvil 2016-09-07 22:47:48 +02:00
parent 35cbc92246
commit d258670d64
16 changed files with 1718 additions and 2924 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -1,3 +1,3 @@
/gdb-libstdc++-v3-python-6.1.1-20160817.tar.xz /gdb-libstdc++-v3-python-6.1.1-20160817.tar.xz
/v1.5.tar.gz /v1.5.tar.gz
/gdb-7.11.90.20160904.tar.xz /gdb-7.11.90.20160907.tar.xz

10
gdb-6.6-buildid-locate.patch
View File

@ -281,6 +281,16 @@ Index: gdb-7.11.50.20160630/gdb/testsuite/lib/mi-support.exp
if { $separate_inferior_pty } { if { $separate_inferior_pty } {
mi_create_inferior_pty mi_create_inferior_pty
--- gdb-7.11.90.20160907/gdb/testsuite/gdb.base/new-ui-pending-input.exp-orig 2016-09-07 04:01:15.000000000 +0200
+++ gdb-7.11.90.20160907/gdb/testsuite/gdb.base/new-ui-pending-input.exp 2016-09-07 22:35:35.818534069 +0200
@@ -62,6 +62,7 @@ proc test_command_line_new_ui_pending_in
set options ""
append options " -iex \"set height 0\""
append options " -iex \"set width 0\""
+ append options " -iex \"set build-id-verbose 0\""
append options " -iex \"new-ui console $extra_tty_name\""
append options " -ex \"b $bpline\""
append options " -ex \"run\""
Index: gdb-7.11.50.20160630/gdb/objfiles.h Index: gdb-7.11.50.20160630/gdb/objfiles.h
=================================================================== ===================================================================
--- gdb-7.11.50.20160630.orig/gdb/objfiles.h 2016-07-03 14:33:28.130205528 +0200 --- gdb-7.11.50.20160630.orig/gdb/objfiles.h 2016-07-03 14:33:28.130205528 +0200

20
gdb-rhbz795424-bitpos-25of25.patch
View File

@ -47,10 +47,10 @@ Content-Type: text/x-patch
Content-Transfer-Encoding: 7bit Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename=f77-bounds.patch Content-Disposition: attachment; filename=f77-bounds.patch
Index: gdb-7.11.50.20160630/gdb/f-lang.h Index: gdb-7.11.90.20160907/gdb/f-lang.h
=================================================================== ===================================================================
--- gdb-7.11.50.20160630.orig/gdb/f-lang.h 2016-07-16 10:56:11.682762722 +0200 --- gdb-7.11.90.20160907.orig/gdb/f-lang.h 2016-09-07 21:48:33.308624019 +0200
+++ gdb-7.11.50.20160630/gdb/f-lang.h 2016-07-16 10:56:15.554793704 +0200 +++ gdb-7.11.90.20160907/gdb/f-lang.h 2016-09-07 21:48:40.967692469 +0200
@@ -49,9 +49,9 @@ @@ -49,9 +49,9 @@
struct symbol *contents[1]; struct symbol *contents[1];
}; };
@ -63,10 +63,10 @@ Index: gdb-7.11.50.20160630/gdb/f-lang.h
extern void f77_get_dynamic_array_length (struct type *); extern void f77_get_dynamic_array_length (struct type *);
Index: gdb-7.11.50.20160630/gdb/f-typeprint.c Index: gdb-7.11.90.20160907/gdb/f-typeprint.c
=================================================================== ===================================================================
--- gdb-7.11.50.20160630.orig/gdb/f-typeprint.c 2016-07-16 10:56:11.682762722 +0200 --- gdb-7.11.90.20160907.orig/gdb/f-typeprint.c 2016-09-07 21:48:33.309624028 +0200
+++ gdb-7.11.50.20160630/gdb/f-typeprint.c 2016-07-16 10:56:43.795019660 +0200 +++ gdb-7.11.90.20160907/gdb/f-typeprint.c 2016-09-07 21:48:40.967692469 +0200
@@ -147,7 +147,7 @@ @@ -147,7 +147,7 @@
int show, int passed_a_ptr, int demangled_args, int show, int passed_a_ptr, int demangled_args,
int arrayprint_recurse_level, int print_rank_only) int arrayprint_recurse_level, int print_rank_only)
@ -84,7 +84,7 @@ Index: gdb-7.11.50.20160630/gdb/f-typeprint.c
+ fprintf_filtered (stream, "%s:", plongest (lower_bound)); + fprintf_filtered (stream, "%s:", plongest (lower_bound));
/* Make sure that, if we have an assumed size array, we /* Make sure that, if we have an assumed size array, we
print out a warning and print the upperbound as '*'. */ print out a warning and print the upperbound as '*'. */
@@ -204,7 +204,7 @@ @@ -204,7 +204,7 @@
else else
{ {
@ -112,10 +112,10 @@ Index: gdb-7.11.50.20160630/gdb/f-typeprint.c
} }
break; break;
Index: gdb-7.11.50.20160630/gdb/f-valprint.c Index: gdb-7.11.90.20160907/gdb/f-valprint.c
=================================================================== ===================================================================
--- gdb-7.11.50.20160630.orig/gdb/f-valprint.c 2016-07-16 10:56:11.682762722 +0200 --- gdb-7.11.90.20160907.orig/gdb/f-valprint.c 2016-09-07 21:48:33.309624028 +0200
+++ gdb-7.11.50.20160630/gdb/f-valprint.c 2016-07-16 10:56:15.554793704 +0200 +++ gdb-7.11.90.20160907/gdb/f-valprint.c 2016-09-07 21:48:40.967692469 +0200
@@ -43,7 +43,7 @@ @@ -43,7 +43,7 @@
/* Array which holds offsets to be applied to get a row's elements /* Array which holds offsets to be applied to get a row's elements
for a given array. Array also holds the size of each subarray. */ for a given array. Array also holds the size of each subarray. */

180
gdb-vla-intel-1of7.patch
View File

@ -1,180 +0,0 @@
From 26e156d62211ca8458faa326f21940e9fa18c8fe Mon Sep 17 00:00:00 2001
From: Bernhard Heckel <bernhard.heckel@intel.com>
Date: Tue, 12 Jul 2016 08:19:34 +0200
Subject: [PATCH 1/7] Fortran: Testsuite, fix differences in type naming.
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.
Change-Id: I7ee94587a992add27fec77c7726f9a69c8fdf373
---
gdb/testsuite/gdb.fortran/vla-value.exp | 12 ++++++++----
gdb/testsuite/gdb.mi/mi-var-child-f.exp | 7 +++----
gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 18 +++++++++++-------
3 files changed, 22 insertions(+), 15 deletions(-)
diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
index 0945181..275f738 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,15 @@ 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 +55,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 +75,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 +84,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..bc44c6b 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,8 @@ 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..1779ec0 100644
--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
@@ -18,6 +18,7 @@
load_lib mi-support.exp
set MIFLAGS "-i=mi"
+load_lib "fortran.exp"
gdb_exit
if [mi_gdb_start] {
@@ -32,6 +33,9 @@ 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 +62,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 +75,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 +87,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 +152,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 +177,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.4

75
gdb-vla-intel-2of7.patch
View File

@ -1,75 +0,0 @@
From a879b2501e61ee3d3efadbdb6b33212b57d3a2e1 Mon Sep 17 00:00:00 2001
From: Bernhard Heckel <bernhard.heckel@intel.com>
Date: Tue, 12 Jul 2016 08:19:34 +0200
Subject: [PATCH 2/7] Fortran: Resolve dynamic properties of pointer types.
In Fortran a pointer may have a dynamic associated property.
2016-07-08 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* gdbtypes.c (resolve_dynamic_types_internal): Resolve pointer types.
(resolve_dynamic_pointer): New.
Change-Id: Ie4b9d6397cfa089ee2e0db02beb18415a751c1c0
---
gdb/gdbtypes.c | 29 ++++++++++++++++++++++++++++-
1 file changed, 28 insertions(+), 1 deletion(-)
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index ec5c17a..b53e649 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.4

113
gdb-vla-intel-3of7.patch
View File

@ -1,113 +0,0 @@
From d2fd5fea2c06052c53d99bfa25fdaed9cf5dd217 Mon Sep 17 00:00:00 2001
From: Bernhard Heckel <bernhard.heckel@intel.com>
Date: Tue, 12 Jul 2016 08:19:34 +0200
Subject: [PATCH 3/7] Typeprint: Resolve any dynamic target type of a pointer.
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.
Change-Id: Idff0d6dd0eab3125b45d470a12b5e66b392e42c3
---
gdb/testsuite/gdb.cp/vla-cxx.cc | 9 +++++++++
gdb/testsuite/gdb.cp/vla-cxx.exp | 5 +++++
gdb/typeprint.c | 19 +++++++++++++++++++
3 files changed, 33 insertions(+)
diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc
index a1fd510..5f8f8ab 100644
--- a/gdb/testsuite/gdb.cp/vla-cxx.cc
+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc
@@ -15,6 +15,10 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
+extern "C" {
+#include <stddef.h>
+}
+
struct container;
struct element
@@ -40,11 +44,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..e3d84c7 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) == 1)
+ {
+ 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) == 0)
+ 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.4

508
gdb-vla-intel-4of7.patch
View File

@ -1,508 +0,0 @@
From f63782d25ebd593c4c4669d4c394a2706f15e660 Mon Sep 17 00:00:00 2001
From: Bernhard Heckel <bernhard.heckel@intel.com>
Date: Tue, 12 Jul 2016 08:19:34 +0200
Subject: [PATCH 4/7] Fortran: Typeprint, fix dangling types.
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.
Change-Id: Ib55f28b4092cf88e34918449a2ebb6e5daafe512
---
gdb/f-typeprint.c | 95 +++++++++++++++--------------
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 | 9 +--
7 files changed, 248 insertions(+), 59 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/pointers.f90
create mode 100755 gdb/testsuite/gdb.fortran/print_type.exp
Index: gdb-7.11.50.20160630/gdb/f-typeprint.c
===================================================================
--- gdb-7.11.50.20160630.orig/gdb/f-typeprint.c 2016-07-16 10:54:48.749099150 +0200
+++ gdb-7.11.50.20160630/gdb/f-typeprint.c 2016-07-16 10:55:59.763667355 +0200
@@ -37,7 +37,7 @@
#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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 ");
Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/pointers.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/pointers.f90 2016-07-16 10:55:42.079525860 +0200
@@ -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
Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/print_type.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/print_type.exp 2016-07-16 10:55:42.079525860 +0200
@@ -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 \\)"
Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-ptype.exp
===================================================================
--- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.fortran/vla-ptype.exp 2016-07-16 10:54:48.749099150 +0200
+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-ptype.exp 2016-07-16 10:55:42.079525860 +0200
@@ -32,9 +32,9 @@
# 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_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"
Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-type.exp
===================================================================
--- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.fortran/vla-type.exp 2016-07-16 10:54:48.749099150 +0200
+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-type.exp 2016-07-16 10:55:42.080525868 +0200
@@ -132,7 +132,10 @@
"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 @@
"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"
Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-value.exp
===================================================================
--- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.fortran/vla-value.exp 2016-07-16 10:54:48.749099150 +0200
+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-value.exp 2016-07-16 10:55:42.080525868 +0200
@@ -34,7 +34,7 @@
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)"
@@ -75,7 +75,7 @@
# 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)"
Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
===================================================================
--- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2016-07-16 10:54:48.749099150 +0200
+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2016-07-16 10:55:42.080525868 +0200
@@ -17,6 +17,7 @@
# Array (VLA).
load_lib mi-support.exp
+load_lib fortran.exp
set MIFLAGS "-i=mi"
load_lib "fortran.exp"
@@ -50,10 +51,10 @@
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\"" \
@@ -140,10 +141,10 @@
-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\"" \

345
gdb-vla-intel-5of7.patch
View File

@ -1,345 +0,0 @@
From b6e668ccd356ea3e75d30f20314334b1203c22de Mon Sep 17 00:00:00 2001
From: Bernhard Heckel <bernhard.heckel@intel.com>
Date: Tue, 12 Jul 2016 08:19:34 +0200
Subject: [PATCH 5/7] Resolve dynamic target types of pointers.
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.
Change-Id: I998d4da4a5ba4899b8cb2115576f44efa741e698
---
gdb/NEWS | 2 +
gdb/c-valprint.c | 22 ++++++
gdb/testsuite/gdb.cp/vla-cxx.exp | 4 ++
gdb/testsuite/gdb.fortran/pointers.exp | 123 +++++++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/pointers.f90 | 17 +++++
gdb/valops.c | 16 ++++-
gdb/valprint.c | 6 --
7 files changed, 182 insertions(+), 8 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp
Index: gdb-7.11.90.20160807/gdb/NEWS
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/NEWS 2016-08-07 21:18:44.032409065 +0200
+++ gdb-7.11.90.20160807/gdb/NEWS 2016-08-07 21:19:17.178715116 +0200
@@ -1,6 +1,8 @@
What has changed in GDB?
(Organized release by release)
+* Fortran: Support pointers to dynamic types.
+
*** Changes in GDB 7.12
* GDB and GDBserver now build with a C++ compiler by default.
Index: gdb-7.11.90.20160807/gdb/c-valprint.c
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/c-valprint.c 2016-08-07 21:18:44.032409065 +0200
+++ gdb-7.11.90.20160807/gdb/c-valprint.c 2016-08-07 21:18:51.087474207 +0200
@@ -645,6 +645,28 @@
else
{
/* normal case */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR
+ && 1 == 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)
+ && (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, ") ");
Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.cp/vla-cxx.exp
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.cp/vla-cxx.exp 2016-08-07 21:18:44.033409074 +0200
+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.cp/vla-cxx.exp 2016-08-07 21:18:51.088474216 +0200
@@ -26,6 +26,8 @@
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 +40,5 @@
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\\}"
Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.exp 2016-08-07 21:18:51.088474216 +0200
@@ -0,0 +1,123 @@
+# 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"
Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.f90
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.fortran/pointers.f90 2016-08-07 21:18:44.033409074 +0200
+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.f90 2016-08-07 21:18:51.088474216 +0200
@@ -20,14 +20,20 @@
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 @@
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 @@
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 @@
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 @@
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))
Index: gdb-7.11.90.20160807/gdb/valops.c
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/valops.c 2016-08-07 21:18:44.035409093 +0200
+++ gdb-7.11.90.20160807/gdb/valops.c 2016-08-07 21:18:51.089474225 +0200
@@ -1562,6 +1562,19 @@
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 @@
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);
Index: gdb-7.11.90.20160807/gdb/valprint.c
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/valprint.c 2016-08-07 04:00:01.000000000 +0200
+++ gdb-7.11.90.20160807/gdb/valprint.c 2016-08-07 21:18:51.090474235 +0200
@@ -1141,12 +1141,6 @@
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);

102
gdb-vla-intel-6of7.patch
View File

@ -1,102 +0,0 @@
From 8665344c14b9ae8b2e0c37ba06d6881a546d1a37 Mon Sep 17 00:00:00 2001
From: Bernhard Heckel <bernhard.heckel@intel.com>
Date: Tue, 12 Jul 2016 08:19:34 +0200
Subject: [PATCH 6/7] Fortran: Testsuite, add cyclic pointers.
2016-05-25 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/testsuite/Changelog:
* pointers.f90: Add cylic pointers.
* pointers.exp: Add print of cyclic pointers.
Change-Id: Ic3b6187c5980fd6c37e2e94787f8321e5b7f2d75
---
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 c19d7e0..67cf999 100644
--- a/gdb/testsuite/gdb.fortran/pointers.exp
+++ b/gdb/testsuite/gdb.fortran/pointers.exp
@@ -57,6 +57,24 @@ gdb_test_multiple "print intap" $test {
gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" "print realp, not associated"
gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated"
gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
+set test "print cyclicp1, not associated"
+gdb_test_multiple "print cyclicp1" $test {
+ -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"]
@@ -118,6 +136,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+>" "Print program counter"
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.4

521
gdb-vla-intel-7of7.patch
View File

@ -1,521 +0,0 @@
From 1e5bd9aec9ee02c2f771e4dc997570c82d74b3b8 Mon Sep 17 00:00:00 2001
From: Bernhard Heckel <bernhard.heckel@intel.com>
Date: Tue, 12 Jul 2016 08:19:34 +0200
Subject: [PATCH 7/7] fort_dyn_array: Fortran dynamic string support
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.
(add_post_values_to_baton): New function.
* gdbtypes.c (resolve_dynamic_type): Add
conditions to support string types.
(resolve_dynamic_array): Add conditions for dynamic
strings and create a new string type.
(is_dynamic_type): Follow pointer if a string type
was detected, as Fortran strings are represented
as pointers to strings internally.
gdb/testsuite/Changelog:
* vla-strings.f90: New file.
* vla-strings.exp: New file.
Change-Id: I7d7f47c7a4900a7fdb51102032455b53d60e60d7
---
gdb/dwarf2read.c | 158 +++++++++++++++++++++++++-----
gdb/gdbtypes.c | 15 ++-
gdb/testsuite/gdb.fortran/vla-strings.exp | 103 +++++++++++++++++++
gdb/testsuite/gdb.fortran/vla-strings.f90 | 39 ++++++++
4 files changed, 285 insertions(+), 30 deletions(-)
create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.exp
create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.f90
Index: gdb-7.11.90.20160807/gdb/dwarf2read.c
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/dwarf2read.c 2016-08-25 16:08:17.397714936 +0200
+++ gdb-7.11.90.20160807/gdb/dwarf2read.c 2016-08-25 16:09:56.703580597 +0200
@@ -1764,7 +1764,8 @@
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 */
@@ -11446,7 +11447,7 @@
{
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, NULL, 0);
}
cu->list_in_scope = &local_symbols;
@@ -14512,29 +14513,94 @@
struct gdbarch *gdbarch = get_objfile_arch (objfile);
struct type *type, *range_type, *index_type, *char_type;
struct attribute *attr;
- unsigned int length;
+ unsigned int length = UINT_MAX;
+ index_type = objfile_type (objfile)->builtin_int;
+ range_type = create_static_range_type (NULL, 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, *bit_size;
+ struct dynamic_prop high;
+
+ byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
+ bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
+
+ /* DW_AT_byte_size should never occur in combination with
+ DW_AT_bit_size. */
+ if (byte_size != NULL && bit_size != NULL)
+ complaint (&symfile_complaints,
+ _("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 != NULL)
+ {
+ /* 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. */
+ DW_UNSND(byte_size) };
+
+ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
+ ARRAY_SIZE(append_ops)))
+ complaint (&symfile_complaints,
+ _("Could not parse DW_AT_byte_size"));
+ }
+ else if (bit_size != NULL)
+ complaint (&symfile_complaints,
+ _("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 (&symfile_complaints,
+ _("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);
@@ -14864,7 +14930,8 @@
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 = &cu->objfile->objfile_obstack;
@@ -14874,14 +14941,33 @@
if (attr_form_is_block (attr))
{
- baton = XOBNEW (obstack, struct dwarf2_property_baton);
+ 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 != NULL && additional_data_size > 0)
+ {
+ gdb_byte *data;
+
+ data = (gdb_byte *) obstack_alloc(
+ &cu->objfile->objfile_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);
+ gdb_assert(prop->data.baton != NULL);
}
else if (attr_form_is_ref (attr))
{
@@ -14914,8 +15000,28 @@
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;
+
+ data = (gdb_byte *) obstack_alloc (&cu->objfile->objfile_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);
@@ -15027,24 +15133,24 @@
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, NULL, 0))
complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
"- DIE at 0x%x [in module %s]"),
die->offset.sect_off, objfile_name (cu->objfile));
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, NULL, 0);
else if (!low_default_is_valid)
complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
"- DIE at 0x%x [in module %s]"),
die->offset.sect_off, objfile_name (cu->objfile));
attr = 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, NULL, 0))
{
attr = 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, NULL, 0))
{
/* If bounds are constant do the final calculation here. */
if (low.kind == PROP_CONST && high.kind == PROP_CONST)
@@ -22416,7 +22522,7 @@
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, NULL, 0))
add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile);
}
else if (attr != NULL)
@@ -22431,7 +22537,7 @@
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, NULL, 0))
add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile);
}
else if (attr != NULL)
@@ -22444,7 +22550,7 @@
/* 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, NULL, 0))
add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile);
if (dwarf2_per_objfile->die_type_hash == NULL)
Index: gdb-7.11.90.20160807/gdb/gdbtypes.c
===================================================================
--- gdb-7.11.90.20160807.orig/gdb/gdbtypes.c 2016-08-25 16:08:17.397714936 +0200
+++ gdb-7.11.90.20160807/gdb/gdbtypes.c 2016-08-25 16:09:11.623187626 +0200
@@ -1851,6 +1851,7 @@
}
case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
{
gdb_assert (TYPE_NFIELDS (type) == 1);
@@ -1964,7 +1965,8 @@
struct type *ary_dim;
struct dynamic_prop *prop;
- 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);
@@ -1989,13 +1991,17 @@
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);
- return create_array_type_with_stride (type, elt_type, range_type,
- TYPE_FIELD_BITSIZE (type, 0));
+ 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,
+ TYPE_FIELD_BITSIZE (type, 0));
}
/* Resolve dynamic bounds of members of the union TYPE to static
@@ -2200,6 +2206,7 @@
break;
case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRING:
resolved_type = resolve_dynamic_array (type, addr_stack);
break;
Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.exp 2016-08-25 16:09:11.624187635 +0200
@@ -0,0 +1,103 @@
+# 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 ".f90"
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+ return -1
+}
+
+# check that all fortran standard datatypes will be
+# handled correctly when using as VLA's
+
+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 'f'" "print var_char(1)"
+gdb_test "print var_char(3)" " = 111 'o'" "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
+ }
+}
Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.f90 2016-08-25 16:09:11.624187635 +0200
@@ -0,0 +1,39 @@
+! 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 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

64
gdb-vla-intel-branch-fix-stride-1of2.patch
View File

@ -1,64 +0,0 @@
http://sourceware.org/ml/gdb-patches/2016-08/msg00278.html
Subject: Re: [V4 00/21] Fortran dynamic array support
--X1bOJ3K7DJ5YkBrT
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
On Thu, 25 Aug 2016 19:22:17 +0200, Jan Kratochvil wrote:
> I see the source handles negative stide specially. Particularly the comment
> here does not explain the code it comments:
With the attached patch disabling these cases still the supplied
gdb.fortran/static-arrays.exp and gdb.fortran/vla-stride.exp PASS (on Fedora 24
x86_64).
Jan
--X1bOJ3K7DJ5YkBrT
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline; filename=1
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 88801ac..695825a 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2197,12 +2197,14 @@ resolve_dynamic_type_internal (struct type *type,
{
struct type *range_type = TYPE_INDEX_TYPE (resolved_type);
+#if 0 // Fedora: gdb-vla-intel-branch-fix-stride.patch
/* Adjust the data location with the value of byte stride if set, which
can describe the separation between successive elements along the
dimension. */
if (TYPE_BYTE_STRIDE (range_type) < 0)
value += (TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type))
* TYPE_BYTE_STRIDE (range_type);
+#endif
TYPE_DATA_LOCATION_ADDR (resolved_type) = value;
TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST;
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 9093969..eca7992 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -199,12 +199,14 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
if (elt_stride > 0)
elt_offs *= elt_stride;
+#if 0 // Fedora: gdb-vla-intel-branch-fix-stride.patch
else if (elt_stride < 0)
{
int offs = (elt_offs + 1) * elt_stride;
elt_offs = TYPE_LENGTH (array_type) + offs;
}
+#endif
else
elt_offs *= elt_size;
--X1bOJ3K7DJ5YkBrT--

929
gdb-vla-intel-branch-fix-stride-2of2.patch
View File

@ -1,929 +0,0 @@
http://sourceware.org/ml/gdb-patches/2016-08/msg00274.html
Subject: Re: [V4 00/21] Fortran dynamic array support
--VbJkn9YxBvnuCH5J
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
On Tue, 23 Aug 2016 15:34:09 +0200, Bernhard Heckel wrote:
> created a branch with all stride patches.
users/bheckel/fortran-strides
2c392d41a3f2e38deeb9db5b7a93ca45682bbe3b
> I don't see regression on RH7.1, gcc 4.8.3-9
I see a regression for 32-bit targets (x86_64-m32 or native i686)
on Fedora 24 (gcc-gfortran-6.1.1-3.fc24.x86_64). I do not see the regression
on CentOS-7.2 (x86_64-m32).
print pvla^M
value requires 4294967288 bytes, which is more than max-value-size^M
(gdb) FAIL: gdb.fortran/vla-stride.exp: print single-element
I have attached a fix.
It is because:
<115> DW_AT_lower_bound : 4 byte block: 97 23 10 6 (DW_OP_push_object_address; DW_OP_plus_uconst: 16; DW_OP_deref)
<11a> DW_AT_upper_bound : 4 byte block: 97 23 14 6 (DW_OP_push_object_address; DW_OP_plus_uconst: 20; DW_OP_deref)
<11f> DW_AT_byte_stride : 6 byte block: 97 23 c 6 34 1e (DW_OP_push_object_address; DW_OP_plus_uconst: 12; DW_OP_deref; DW_OP_lit4; DW_OP_mul)
DW_AT_lower_bound == 1
DW_AT_upper_bound == 1
DW_AT_byte_stride == (-2) * 4 == -8
I am not sure if gfortran is really wrong or not but a stride does not make
sense for me for a single row array.
Attaching also gdb.fortran/vla-stride.f90 from your branch built with
gcc-gfortran-6.1.1-3.fc24.x86_64 on Fedora 24 x86_64 in -m32 mode.
Besides that I see on all archs
-FAIL: gdb.pascal/arrays.exp: Print dynamic array of string
+FAIL: gdb.pascal/arrays.exp: Print dynamic array of string (GDB internal error)
but that testcase is only in Fedora and the Pascal (fpc) support has been not
well maintained so far so I am OK with that.
Thanks,
Jan
--VbJkn9YxBvnuCH5J
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline; filename=1
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 88801ac..1fbf69a 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1103,10 +1103,12 @@ create_array_type_with_stride (struct type *result_type,
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);
+ TYPE_LENGTH (result_type) = (byte_stride * (high_bound - low_bound)
+ + TYPE_LENGTH (element_type));
else if (bit_stride > 0)
TYPE_LENGTH (result_type) =
- (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
+ ((bit_stride * (high_bound - low_bound) + 7) / 8
+ + TYPE_LENGTH (element_type));
else
TYPE_LENGTH (result_type) =
TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
--VbJkn9YxBvnuCH5J
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="vla-stride.s"
.file "vla-stride.f90"
.text
.Ltext0:
.section .rodata
.align 4
.LC0:
.string "Integer overflow when calculating the amount of memory to allocate"
.LC1:
.string "vla"
.align 4
.LC2:
.string "Attempting to allocate already allocated variable '%s'"
.align 4
.LC3:
.string "At line 20 of file gdb.fortran/vla-stride.f90"
.align 4
.LC4:
.string "Allocation would exceed memory limit"
.text
.type MAIN__, @function
MAIN__:
.LFB0:
.file 1 "gdb.fortran/vla-stride.f90"
# gdb.fortran/vla-stride.f90:16
.loc 1 16 0
.cfi_startproc
# BLOCK 2 seq:0
# PRED: ENTRY (FALLTHRU)
pushl %ebp
.cfi_def_cfa_offset 8
.cfi_offset 5, -8
movl %esp, %ebp
.cfi_def_cfa_register 5
pushl %edi
pushl %esi
pushl %ebx
subl $60, %esp
.cfi_offset 7, -12
.cfi_offset 6, -16
.cfi_offset 3, -20
# gdb.fortran/vla-stride.f90:17
.loc 1 17 0
movl $0, -72(%ebp)
.LBB2:
# gdb.fortran/vla-stride.f90:20
.loc 1 20 0
movl $0, %eax
testl %eax, %eax
# SUCC: 3 (FALLTHRU) 4
je .L2
# BLOCK 3 seq:1
# PRED: 2 (FALLTHRU)
# gdb.fortran/vla-stride.f90:20
.loc 1 20 0 is_stmt 0 discriminator 1
subl $12, %esp
pushl $.LC0
# SUCC:
call _gfortran_runtime_error
# BLOCK 4 seq:2
# PRED: 2
.L2:
# gdb.fortran/vla-stride.f90:20
.loc 1 20 0 discriminator 2
movl -72(%ebp), %eax
testl %eax, %eax
# SUCC: 5 (FALLTHRU) 6
je .L3
# BLOCK 5 seq:3
# PRED: 4 (FALLTHRU)
# gdb.fortran/vla-stride.f90:20
.loc 1 20 0 discriminator 3
subl $4, %esp
pushl $.LC1
pushl $.LC2
pushl $.LC3
# SUCC:
call _gfortran_runtime_error_at
# BLOCK 6 seq:4
# PRED: 4
.L3:
# gdb.fortran/vla-stride.f90:20
.loc 1 20 0 discriminator 4
subl $12, %esp
pushl $40
call malloc
addl $16, %esp
movl %eax, -72(%ebp)
movl -72(%ebp), %eax
testl %eax, %eax
# SUCC: 7 (FALLTHRU) 8
jne .L4
# BLOCK 7 seq:5
# PRED: 6 (FALLTHRU)
# gdb.fortran/vla-stride.f90:20
.loc 1 20 0 discriminator 5
subl $12, %esp
pushl $.LC4
# SUCC:
call _gfortran_os_error
# BLOCK 8 seq:6
# PRED: 6
.L4:
# gdb.fortran/vla-stride.f90:20
.loc 1 20 0 discriminator 6
movl $265, -64(%ebp)
movl $1, -56(%ebp)
movl $10, -52(%ebp)
movl $1, -60(%ebp)
movl $-1, -68(%ebp)
.LBB3:
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 is_stmt 1 discriminator 6
movl -72(%ebp), %edx
movl -68(%ebp), %esi
movl -56(%ebp), %ebx
.LBB4:
.LBB5:
movl -72(%ebp), %eax
testl %eax, %eax
sete %al
movzbl %al, %eax
testl %eax, %eax
# SUCC: 10 9 (FALLTHRU)
jne .L5
# BLOCK 9 seq:7
# PRED: 8 (FALLTHRU)
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 is_stmt 0 discriminator 2
movl -56(%ebp), %ecx
leal 9(%ecx), %edi
movl -52(%ebp), %ecx
cmpl %ecx, %edi
# SUCC: 10 (FALLTHRU) 18
je .L6
# BLOCK 10 seq:8
# PRED: 8 9 (FALLTHRU)
.L5:
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 3
testl %eax, %eax
# SUCC: 11 (FALLTHRU) 12
je .L7
# BLOCK 11 seq:9
# PRED: 10 (FALLTHRU)
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 4
movl $0, %eax
# SUCC: 13 [100.0%]
jmp .L8
# BLOCK 12 seq:10
# PRED: 10
.L7:
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 5
movl -52(%ebp), %edx
movl -56(%ebp), %eax
subl %eax, %edx
movl %edx, %eax
addl $1, %eax
movl $0, %edx
testl %eax, %eax
# SUCC: 13 (FALLTHRU)
cmovs %edx, %eax
# BLOCK 13 seq:11
# PRED: 12 (FALLTHRU) 11 [100.0%]
.L8:
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 7
cmpl $10, %eax
setne %al
movzbl %al, %eax
movl $1, -56(%ebp)
movl $10, -52(%ebp)
movl $1, -60(%ebp)
movl -56(%ebp), %edx
negl %edx
movl %edx, -68(%ebp)
movl -68(%ebp), %esi
movl -56(%ebp), %ebx
movl -72(%ebp), %edx
testl %edx, %edx
# SUCC: 14 (FALLTHRU) 15
jne .L9
# BLOCK 14 seq:12
# PRED: 13 (FALLTHRU)
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 8
subl $12, %esp
pushl $40
call malloc
addl $16, %esp
movl %eax, -72(%ebp)
movl $265, -64(%ebp)
# SUCC: 17 [100.0%]
jmp .L10
# BLOCK 15 seq:13
# PRED: 13
.L9:
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 9
testl %eax, %eax
# SUCC: 16 (FALLTHRU) 17
je .L10
# BLOCK 16 seq:14
# PRED: 15 (FALLTHRU)
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 11
movl -72(%ebp), %eax
subl $8, %esp
pushl $40
pushl %eax
call realloc
addl $16, %esp
# SUCC: 17 (FALLTHRU)
movl %eax, -72(%ebp)
# BLOCK 17 seq:15
# PRED: 16 (FALLTHRU) 15 14 [100.0%]
.L10:
# SUCC: 18 (FALLTHRU)
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 13
movl -72(%ebp), %edx
# BLOCK 18 seq:16
# PRED: 9 17 (FALLTHRU)
.L6:
.LBE5:
# SUCC: 19 (FALLTHRU)
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 14
movl $0, %eax
# BLOCK 19 seq:17
# PRED: 18 (FALLTHRU) 20 [100.0%]
.L12:
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 17
cmpl $9, %eax
# SUCC: 21 20 (FALLTHRU)
jg .L11
# BLOCK 20 seq:18
# PRED: 19 (FALLTHRU)
# gdb.fortran/vla-stride.f90:21
.loc 1 21 0 discriminator 16
leal (%eax,%ebx), %ecx
leal (%ecx,%esi), %edi
movl A.1.3368(,%eax,4), %ecx
movl %ecx, (%edx,%edi,4)
addl $1, %eax
# SUCC: 19 [100.0%]
jmp .L12
# BLOCK 21 seq:19
# PRED: 19
.L11:
.LBE4:
.LBE3:
# gdb.fortran/vla-stride.f90:23
.loc 1 23 0 is_stmt 1
movl $265, -40(%ebp)
movl $1, -32(%ebp)
movl $10, -28(%ebp)
movl $-1, -36(%ebp)
movl -72(%ebp), %eax
movl -56(%ebp), %edx
movl $10, %ecx
subl %edx, %ecx
movl %ecx, %edx
sall $2, %edx
addl %edx, %eax
movl %eax, -48(%ebp)
movl $1, -44(%ebp)
.LBB6:
# gdb.fortran/vla-stride.f90:24
.loc 1 24 0
movl $265, -40(%ebp)
movl -36(%ebp), %eax
movl $1, -32(%ebp)
movl $10, -28(%ebp)
movl %eax, %edx
negl %edx
movl %edx, -36(%ebp)
movl -48(%ebp), %edx
movl -32(%ebp), %ecx
movl $10, %ebx
subl %ecx, %ebx
movl %ebx, %ecx
imull %eax, %ecx
sall $2, %ecx
addl %ecx, %edx
movl %edx, -48(%ebp)
movl %eax, -44(%ebp)
.LBE6:
# gdb.fortran/vla-stride.f90:25
.loc 1 25 0
movl $265, -40(%ebp)
movl $1, -32(%ebp)
movl $5, -28(%ebp)
movl $2, -36(%ebp)
movl -72(%ebp), %eax
movl -56(%ebp), %edx
movl $1, %ecx
subl %edx, %ecx
movl %ecx, %edx
sall $2, %edx
addl %edx, %eax
movl %eax, -48(%ebp)
movl $-2, -44(%ebp)
# gdb.fortran/vla-stride.f90:26
.loc 1 26 0
movl $265, -40(%ebp)
movl $1, -32(%ebp)
movl $1, -28(%ebp)
movl $-2, -36(%ebp)
movl -72(%ebp), %eax
movl -56(%ebp), %edx
movl $5, %ecx
subl %edx, %ecx
movl %ecx, %edx
sall $2, %edx
addl %edx, %eax
movl %eax, -48(%ebp)
movl $2, -44(%ebp)
# gdb.fortran/vla-stride.f90:28
.loc 1 28 0
movl $0, -48(%ebp)
.LBE2:
# gdb.fortran/vla-stride.f90:29
.loc 1 29 0
nop
leal -12(%ebp), %esp
popl %ebx
.cfi_restore 3
popl %esi
.cfi_restore 6
popl %edi
.cfi_restore 7
popl %ebp
.cfi_restore 5
.cfi_def_cfa 4, 4
# SUCC: EXIT [100.0%]
ret
.cfi_endproc
.LFE0:
.size MAIN__, .-MAIN__
.globl main
.type main, @function
main:
.LFB1:
# gdb.fortran/vla-stride.f90:29
.loc 1 29 0
.cfi_startproc
# BLOCK 2 seq:0
# PRED: ENTRY (FALLTHRU)
leal 4(%esp), %ecx
.cfi_def_cfa 1, 0
andl $-16, %esp
pushl -4(%ecx)
pushl %ebp
.cfi_escape 0x10,0x5,0x2,0x75,0
movl %esp, %ebp
pushl %ecx
.cfi_escape 0xf,0x3,0x75,0x7c,0x6
subl $4, %esp
movl %ecx, %eax
# gdb.fortran/vla-stride.f90:29
.loc 1 29 0
subl $8, %esp
pushl 4(%eax)
pushl (%eax)
call _gfortran_set_args
addl $16, %esp
subl $8, %esp
pushl $options.3.3382
pushl $9
call _gfortran_set_options
addl $16, %esp
call MAIN__
movl $0, %eax
movl -4(%ebp), %ecx
.cfi_def_cfa 1, 0
leave
.cfi_restore 5
leal -4(%ecx), %esp
.cfi_def_cfa 4, 4
# SUCC: EXIT [100.0%]
ret
.cfi_endproc
.LFE1:
.size main, .-main
.section .rodata
.align 32
.type A.1.3368, @object
.size A.1.3368, 40
A.1.3368:
.long 1
.long 2
.long 3
.long 4
.long 5
.long 6
.long 7
.long 8
.long 9
.long 10
.align 32
.type options.3.3382, @object
.size options.3.3382, 36
options.3.3382:
.long 68
.long 1023
.long 0
.long 0
.long 1
.long 1
.long 0
.long 0
.long 31
.text
.Letext0:
.section .debug_info,"",@progbits
.Ldebug_info0:
.long 0x128 # Length of Compilation Unit Info
.value 0x4 # DWARF version number
.long .Ldebug_abbrev0 # Offset Into Abbrev. Section
.byte 0x4 # Pointer Size (in bytes)
.uleb128 0x1 # (DIE (0xb) DW_TAG_compile_unit)
.long .LASF5 # DW_AT_producer: "GNU Fortran2008 6.1.1 20160621 (Red Hat 6.1.1-3) -m32 -mtune=generic -march=i686 -g -fintrinsic-modules-path /usr/lib/gcc/x86_64-redhat-linux/6.1.1/32/finclude"
.byte 0xe # DW_AT_language
.byte 0x2 # DW_AT_identifier_case
.long .LASF6 # DW_AT_name: "gdb.fortran/vla-stride.f90"
.long .LASF7 # DW_AT_comp_dir: "/home/jkratoch/redhat/gdb-clean/gdb/testsuite"
.long .Ltext0 # DW_AT_low_pc
.long .Letext0-.Ltext0 # DW_AT_high_pc
.long .Ldebug_line0 # DW_AT_stmt_list
.uleb128 0x2 # (DIE (0x26) DW_TAG_base_type)
.byte 0x4 # DW_AT_byte_size
.byte 0x5 # DW_AT_encoding
.long .LASF2 # DW_AT_name: "integer(kind=4)"
.uleb128 0x3 # (DIE (0x2d) DW_TAG_const_type)
.long 0x26 # DW_AT_type
.uleb128 0x4 # (DIE (0x32) DW_TAG_subprogram)
# DW_AT_external
.long .LASF8 # DW_AT_name: "main"
.byte 0x1 # DW_AT_decl_file (gdb.fortran/vla-stride.f90)
.byte 0x1d # DW_AT_decl_line
.long 0x26 # DW_AT_type
.long .LFB1 # DW_AT_low_pc
.long .LFE1-.LFB1 # DW_AT_high_pc
.uleb128 0x1 # DW_AT_frame_base
.byte 0x9c # DW_OP_call_frame_cfa
# DW_AT_GNU_all_tail_call_sites
.long 0x69 # DW_AT_sibling
.uleb128 0x5 # (DIE (0x4b) DW_TAG_formal_parameter)
.long .LASF0 # DW_AT_name: "argc"
.byte 0x1 # DW_AT_decl_file (gdb.fortran/vla-stride.f90)
.byte 0x1d # DW_AT_decl_line
.long 0x2d # DW_AT_type
.uleb128 0x2 # DW_AT_location
.byte 0x91 # DW_OP_fbreg
.sleb128 0
.uleb128 0x5 # (DIE (0x59) DW_TAG_formal_parameter)
.long .LASF1 # DW_AT_name: "argv"
.byte 0x1 # DW_AT_decl_file (gdb.fortran/vla-stride.f90)
.byte 0x1d # DW_AT_decl_line
.long 0x69 # DW_AT_type
.uleb128 0x3 # DW_AT_location
.byte 0x91 # DW_OP_fbreg
.sleb128 4
.byte 0x6 # DW_OP_deref
.byte 0 # end of children of DIE 0x32
.uleb128 0x6 # (DIE (0x69) DW_TAG_pointer_type)
.byte 0x4 # DW_AT_byte_size
.long 0x6f # DW_AT_type
.uleb128 0x2 # (DIE (0x6f) DW_TAG_base_type)
.byte 0x1 # DW_AT_byte_size
.byte 0x8 # DW_AT_encoding
.long .LASF3 # DW_AT_name: "character(kind=1)"
.uleb128 0x7 # (DIE (0x76) DW_TAG_subprogram)
.long .LASF9 # DW_AT_name: "vla_stride"
.byte 0x1 # DW_AT_decl_file (gdb.fortran/vla-stride.f90)
.byte 0x10 # DW_AT_decl_line
# DW_AT_main_subprogram
.byte 0x2 # DW_AT_calling_convention
.long .LFB0 # DW_AT_low_pc
.long .LFE0-.LFB0 # DW_AT_high_pc
.uleb128 0x1 # DW_AT_frame_base
.byte 0x9c # DW_OP_call_frame_cfa
# DW_AT_GNU_all_tail_call_sites
.long 0xe7 # DW_AT_sibling
.uleb128 0x8 # (DIE (0x8c) DW_TAG_variable)
.ascii "i\0" # DW_AT_name
.byte 0x1 # DW_AT_decl_file (gdb.fortran/vla-stride.f90)
.byte 0x15 # DW_AT_decl_line
.long 0x26 # DW_AT_type
.uleb128 0x9 # (DIE (0x95) DW_TAG_variable)
.long .LASF4 # DW_AT_name: "pvla"
.byte 0x1 # DW_AT_decl_file (gdb.fortran/vla-stride.f90)
.byte 0x12 # DW_AT_decl_line
.long 0xe7 # DW_AT_type
.uleb128 0x2 # DW_AT_location
.byte 0x91 # DW_OP_fbreg
.sleb128 -56
.uleb128 0xa # (DIE (0xa3) DW_TAG_variable)
.ascii "vla\0" # DW_AT_name
.byte 0x1 # DW_AT_decl_file (gdb.fortran/vla-stride.f90)
.byte 0x11 # DW_AT_decl_line
.long 0x10b # DW_AT_type
.uleb128 0x3 # DW_AT_location
.byte 0x91 # DW_OP_fbreg
.sleb128 -80
.uleb128 0xb # (DIE (0xb2) DW_TAG_lexical_block)
.long .LBB2 # DW_AT_low_pc
.long .LBE2-.LBB2 # DW_AT_high_pc
.uleb128 0xc # (DIE (0xbb) DW_TAG_lexical_block)
.long .LBB3 # DW_AT_low_pc
.long .LBE3-.LBB3 # DW_AT_high_pc
.long 0xdc # DW_AT_sibling
.uleb128 0xb # (DIE (0xc8) DW_TAG_lexical_block)
.long .LBB4 # DW_AT_low_pc
.long .LBE4-.LBB4 # DW_AT_high_pc
.uleb128 0xd # (DIE (0xd1) DW_TAG_lexical_block)
.long .LBB5 # DW_AT_low_pc
.long .LBE5-.LBB5 # DW_AT_high_pc
.byte 0 # end of children of DIE 0xc8
.byte 0 # end of children of DIE 0xbb
.uleb128 0xd # (DIE (0xdc) DW_TAG_lexical_block)
.long .LBB6 # DW_AT_low_pc
.long .LBE6-.LBB6 # DW_AT_high_pc
.byte 0 # end of children of DIE 0xb2
.byte 0 # end of children of DIE 0x76
.uleb128 0xe # (DIE (0xe7) DW_TAG_array_type)
.uleb128 0x2 # DW_AT_data_location
.byte 0x97 # DW_OP_push_object_address
.byte 0x6 # DW_OP_deref
.uleb128 0x4 # DW_AT_associated
.byte 0x97 # DW_OP_push_object_address
.byte 0x6 # DW_OP_deref
.byte 0x30 # DW_OP_lit0
.byte 0x2e # DW_OP_ne
.long 0x26 # DW_AT_type
.long 0x10b # DW_AT_sibling
.uleb128 0xf # (DIE (0xf8) DW_TAG_subrange_type)
.uleb128 0x4 # DW_AT_lower_bound
.byte 0x97 # DW_OP_push_object_address
.byte 0x23 # DW_OP_plus_uconst
.uleb128 0x10
.byte 0x6 # DW_OP_deref
.uleb128 0x4 # DW_AT_upper_bound
.byte 0x97 # DW_OP_push_object_address
.byte 0x23 # DW_OP_plus_uconst
.uleb128 0x14
.byte 0x6 # DW_OP_deref
.uleb128 0x6 # DW_AT_byte_stride
.byte 0x97 # DW_OP_push_object_address
.byte 0x23 # DW_OP_plus_uconst
.uleb128 0xc
.byte 0x6 # DW_OP_deref
.byte 0x34 # DW_OP_lit4
.byte 0x1e # DW_OP_mul
.byte 0 # end of children of DIE 0xe7
.uleb128 0x10 # (DIE (0x10b) DW_TAG_array_type)
.uleb128 0x2 # DW_AT_data_location
.byte 0x97 # DW_OP_push_object_address
.byte 0x6 # DW_OP_deref
.uleb128 0x4 # DW_AT_allocated
.byte 0x97 # DW_OP_push_object_address
.byte 0x6 # DW_OP_deref
.byte 0x30 # DW_OP_lit0
.byte 0x2e # DW_OP_ne
.long 0x26 # DW_AT_type
.uleb128 0xf # (DIE (0x118) DW_TAG_subrange_type)
.uleb128 0x4 # DW_AT_lower_bound
.byte 0x97 # DW_OP_push_object_address
.byte 0x23 # DW_OP_plus_uconst
.uleb128 0x10
.byte 0x6 # DW_OP_deref
.uleb128 0x4 # DW_AT_upper_bound
.byte 0x97 # DW_OP_push_object_address
.byte 0x23 # DW_OP_plus_uconst
.uleb128 0x14
.byte 0x6 # DW_OP_deref
.uleb128 0x6 # DW_AT_byte_stride
.byte 0x97 # DW_OP_push_object_address
.byte 0x23 # DW_OP_plus_uconst
.uleb128 0xc
.byte 0x6 # DW_OP_deref
.byte 0x34 # DW_OP_lit4
.byte 0x1e # DW_OP_mul
.byte 0 # end of children of DIE 0x10b
.byte 0 # end of children of DIE 0xb
.section .debug_abbrev,"",@progbits
.Ldebug_abbrev0:
.uleb128 0x1 # (abbrev code)
.uleb128 0x11 # (TAG: DW_TAG_compile_unit)
.byte 0x1 # DW_children_yes
.uleb128 0x25 # (DW_AT_producer)
.uleb128 0xe # (DW_FORM_strp)
.uleb128 0x13 # (DW_AT_language)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x42 # (DW_AT_identifier_case)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3 # (DW_AT_name)
.uleb128 0xe # (DW_FORM_strp)
.uleb128 0x1b # (DW_AT_comp_dir)
.uleb128 0xe # (DW_FORM_strp)
.uleb128 0x11 # (DW_AT_low_pc)
.uleb128 0x1 # (DW_FORM_addr)
.uleb128 0x12 # (DW_AT_high_pc)
.uleb128 0x6 # (DW_FORM_data4)
.uleb128 0x10 # (DW_AT_stmt_list)
.uleb128 0x17 # (DW_FORM_sec_offset)
.byte 0
.byte 0
.uleb128 0x2 # (abbrev code)
.uleb128 0x24 # (TAG: DW_TAG_base_type)
.byte 0 # DW_children_no
.uleb128 0xb # (DW_AT_byte_size)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3e # (DW_AT_encoding)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3 # (DW_AT_name)
.uleb128 0xe # (DW_FORM_strp)
.byte 0
.byte 0
.uleb128 0x3 # (abbrev code)
.uleb128 0x26 # (TAG: DW_TAG_const_type)
.byte 0 # DW_children_no
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.uleb128 0x4 # (abbrev code)
.uleb128 0x2e # (TAG: DW_TAG_subprogram)
.byte 0x1 # DW_children_yes
.uleb128 0x3f # (DW_AT_external)
.uleb128 0x19 # (DW_FORM_flag_present)
.uleb128 0x3 # (DW_AT_name)
.uleb128 0xe # (DW_FORM_strp)
.uleb128 0x3a # (DW_AT_decl_file)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3b # (DW_AT_decl_line)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.uleb128 0x11 # (DW_AT_low_pc)
.uleb128 0x1 # (DW_FORM_addr)
.uleb128 0x12 # (DW_AT_high_pc)
.uleb128 0x6 # (DW_FORM_data4)
.uleb128 0x40 # (DW_AT_frame_base)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x2116 # (DW_AT_GNU_all_tail_call_sites)
.uleb128 0x19 # (DW_FORM_flag_present)
.uleb128 0x1 # (DW_AT_sibling)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.uleb128 0x5 # (abbrev code)
.uleb128 0x5 # (TAG: DW_TAG_formal_parameter)
.byte 0 # DW_children_no
.uleb128 0x3 # (DW_AT_name)
.uleb128 0xe # (DW_FORM_strp)
.uleb128 0x3a # (DW_AT_decl_file)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3b # (DW_AT_decl_line)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.uleb128 0x2 # (DW_AT_location)
.uleb128 0x18 # (DW_FORM_exprloc)
.byte 0
.byte 0
.uleb128 0x6 # (abbrev code)
.uleb128 0xf # (TAG: DW_TAG_pointer_type)
.byte 0 # DW_children_no
.uleb128 0xb # (DW_AT_byte_size)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.uleb128 0x7 # (abbrev code)
.uleb128 0x2e # (TAG: DW_TAG_subprogram)
.byte 0x1 # DW_children_yes
.uleb128 0x3 # (DW_AT_name)
.uleb128 0xe # (DW_FORM_strp)
.uleb128 0x3a # (DW_AT_decl_file)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3b # (DW_AT_decl_line)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x6a # (DW_AT_main_subprogram)
.uleb128 0x19 # (DW_FORM_flag_present)
.uleb128 0x36 # (DW_AT_calling_convention)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x11 # (DW_AT_low_pc)
.uleb128 0x1 # (DW_FORM_addr)
.uleb128 0x12 # (DW_AT_high_pc)
.uleb128 0x6 # (DW_FORM_data4)
.uleb128 0x40 # (DW_AT_frame_base)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x2116 # (DW_AT_GNU_all_tail_call_sites)
.uleb128 0x19 # (DW_FORM_flag_present)
.uleb128 0x1 # (DW_AT_sibling)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.uleb128 0x8 # (abbrev code)
.uleb128 0x34 # (TAG: DW_TAG_variable)
.byte 0 # DW_children_no
.uleb128 0x3 # (DW_AT_name)
.uleb128 0x8 # (DW_FORM_string)
.uleb128 0x3a # (DW_AT_decl_file)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3b # (DW_AT_decl_line)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.uleb128 0x9 # (abbrev code)
.uleb128 0x34 # (TAG: DW_TAG_variable)
.byte 0 # DW_children_no
.uleb128 0x3 # (DW_AT_name)
.uleb128 0xe # (DW_FORM_strp)
.uleb128 0x3a # (DW_AT_decl_file)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3b # (DW_AT_decl_line)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.uleb128 0x2 # (DW_AT_location)
.uleb128 0x18 # (DW_FORM_exprloc)
.byte 0
.byte 0
.uleb128 0xa # (abbrev code)
.uleb128 0x34 # (TAG: DW_TAG_variable)
.byte 0 # DW_children_no
.uleb128 0x3 # (DW_AT_name)
.uleb128 0x8 # (DW_FORM_string)
.uleb128 0x3a # (DW_AT_decl_file)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x3b # (DW_AT_decl_line)
.uleb128 0xb # (DW_FORM_data1)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.uleb128 0x2 # (DW_AT_location)
.uleb128 0x18 # (DW_FORM_exprloc)
.byte 0
.byte 0
.uleb128 0xb # (abbrev code)
.uleb128 0xb # (TAG: DW_TAG_lexical_block)
.byte 0x1 # DW_children_yes
.uleb128 0x11 # (DW_AT_low_pc)
.uleb128 0x1 # (DW_FORM_addr)
.uleb128 0x12 # (DW_AT_high_pc)
.uleb128 0x6 # (DW_FORM_data4)
.byte 0
.byte 0
.uleb128 0xc # (abbrev code)
.uleb128 0xb # (TAG: DW_TAG_lexical_block)
.byte 0x1 # DW_children_yes
.uleb128 0x11 # (DW_AT_low_pc)
.uleb128 0x1 # (DW_FORM_addr)
.uleb128 0x12 # (DW_AT_high_pc)
.uleb128 0x6 # (DW_FORM_data4)
.uleb128 0x1 # (DW_AT_sibling)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.uleb128 0xd # (abbrev code)
.uleb128 0xb # (TAG: DW_TAG_lexical_block)
.byte 0 # DW_children_no
.uleb128 0x11 # (DW_AT_low_pc)
.uleb128 0x1 # (DW_FORM_addr)
.uleb128 0x12 # (DW_AT_high_pc)
.uleb128 0x6 # (DW_FORM_data4)
.byte 0
.byte 0
.uleb128 0xe # (abbrev code)
.uleb128 0x1 # (TAG: DW_TAG_array_type)
.byte 0x1 # DW_children_yes
.uleb128 0x50 # (DW_AT_data_location)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x4f # (DW_AT_associated)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.uleb128 0x1 # (DW_AT_sibling)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.uleb128 0xf # (abbrev code)
.uleb128 0x21 # (TAG: DW_TAG_subrange_type)
.byte 0 # DW_children_no
.uleb128 0x22 # (DW_AT_lower_bound)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x2f # (DW_AT_upper_bound)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x51 # (DW_AT_byte_stride)
.uleb128 0x18 # (DW_FORM_exprloc)
.byte 0
.byte 0
.uleb128 0x10 # (abbrev code)
.uleb128 0x1 # (TAG: DW_TAG_array_type)
.byte 0x1 # DW_children_yes
.uleb128 0x50 # (DW_AT_data_location)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x4e # (DW_AT_allocated)
.uleb128 0x18 # (DW_FORM_exprloc)
.uleb128 0x49 # (DW_AT_type)
.uleb128 0x13 # (DW_FORM_ref4)
.byte 0
.byte 0
.byte 0
.section .debug_aranges,"",@progbits
.long 0x1c # Length of Address Ranges Info
.value 0x2 # DWARF Version
.long .Ldebug_info0 # Offset of Compilation Unit Info
.byte 0x4 # Size of Address
.byte 0 # Size of Segment Descriptor
.value 0 # Pad to 8 byte boundary
.value 0
.long .Ltext0 # Address
.long .Letext0-.Ltext0 # Length
.long 0
.long 0
.section .debug_line,"",@progbits
.Ldebug_line0:
.section .debug_str,"MS",@progbits,1
.LASF7:
.string "/home/jkratoch/redhat/gdb-clean/gdb/testsuite"
.LASF3:
.string "character(kind=1)"
.LASF0:
.string "argc"
.LASF9:
.string "vla_stride"
.LASF2:
.string "integer(kind=4)"
.LASF5:
.string "GNU Fortran2008 6.1.1 20160621 (Red Hat 6.1.1-3) -m32 -mtune=generic -march=i686 -g -fintrinsic-modules-path /usr/lib/gcc/x86_64-redhat-linux/6.1.1/32/finclude"
.LASF8:
.string "main"
.LASF4:
.string "pvla"
.LASF6:
.string "gdb.fortran/vla-stride.f90"
.LASF1:
.string "argv"
.ident "GCC: (GNU) 6.1.1 20160621 (Red Hat 6.1.1-3)"
.section .note.GNU-stack,"",@progbits
--VbJkn9YxBvnuCH5J--

251
gdb-vla-intel-branch.patch → gdb-vla-intel-fortran-strides.patch
View File

@ -1,25 +1,138 @@
git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides
2c392d41a3f2e38deeb9db5b7a93ca45682bbe3b dbfd7140bf4c0500d1f5d192be781f83f78f7922
gdb/dwarf2loc.c | 46 ++-
gdb/dwarf2loc.h | 6 +
gdb/dwarf2read.c | 13 +- gdb/dwarf2read.c | 13 +-
gdb/eval.c | 391 +++++++++++++++++++++----- gdb/eval.c | 391 +++++++++++++++++++++-----
gdb/expprint.c | 20 +- gdb/expprint.c | 20 +-
gdb/expression.h | 18 +- gdb/expression.h | 18 +-
gdb/f-exp.y | 42 ++- gdb/f-exp.y | 42 ++-
gdb/f-valprint.c | 8 +- gdb/f-valprint.c | 8 +-
gdb/gdbtypes.c | 45 ++- gdb/gdbtypes.c | 34 ++-
gdb/gdbtypes.h | 18 ++ gdb/gdbtypes.h | 18 +-
gdb/parse.c | 24 +- gdb/parse.c | 24 +-
gdb/rust-exp.y | 12 +- gdb/rust-exp.y | 12 +-
gdb/rust-lang.c | 17 +- gdb/rust-lang.c | 17 +-
gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++ gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++ gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++
gdb/testsuite/gdb.fortran/vla-ptype.exp | 4 +
gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 +
gdb/testsuite/gdb.fortran/vla-stride.exp | 44 +++ gdb/testsuite/gdb.fortran/vla-stride.exp | 44 +++
gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++ gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++
gdb/valarith.c | 14 +- gdb/testsuite/gdb.fortran/vla.f90 | 10 +
gdb/valarith.c | 10 +-
gdb/valops.c | 197 +++++++++++-- gdb/valops.c | 197 +++++++++++--
gdb/value.h | 2 + gdb/value.h | 2 +
18 files changed, 1197 insertions(+), 173 deletions(-) 23 files changed, 1242 insertions(+), 183 deletions(-)
diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
index 548e468..560e16f 100644
--- a/gdb/dwarf2loc.c
+++ b/gdb/dwarf2loc.c
@@ -2601,11 +2601,14 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
/* See dwarf2loc.h. */
int
-dwarf2_evaluate_property (const struct dynamic_prop *prop,
+dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
struct frame_info *frame,
struct property_addr_info *addr_stack,
- CORE_ADDR *value)
+ CORE_ADDR *value,
+ int is_signed)
{
+ int rc = 0;
+
if (prop == NULL)
return 0;
@@ -2629,7 +2632,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
*value = value_as_address (val);
}
- return 1;
+ rc = 1;
}
}
break;
@@ -2651,7 +2654,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
if (!value_optimized_out (val))
{
*value = value_as_address (val);
- return 1;
+ rc = 1;
}
}
}
@@ -2659,8 +2662,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:
{
struct dwarf2_property_baton *baton
@@ -2681,11 +2684,38 @@ 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 fa83459..da6b9cd 100644
--- a/gdb/dwarf2loc.h
+++ b/gdb/dwarf2loc.h
@@ -138,6 +138,12 @@ 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.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 6658a38..a1ac659 100644 index 6658a38..a1ac659 100644
@ -675,7 +788,7 @@ index 08215e2..e6eca6a 100644
for (i = lowerbound; for (i = lowerbound;
(i < upperbound + 1 && (*elts) < options->print_max); (i < upperbound + 1 && (*elts) < options->print_max);
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index ec5c17a..88801ac 100644 index ec5c17a..eb83791 100644
--- a/gdb/gdbtypes.c --- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c
@@ -836,7 +836,8 @@ allocate_stub_method (struct type *type) @@ -836,7 +836,8 @@ allocate_stub_method (struct type *type)
@ -740,28 +853,41 @@ index ec5c17a..88801ac 100644
else if (bit_stride > 0) else if (bit_stride > 0)
TYPE_LENGTH (result_type) = TYPE_LENGTH (result_type) =
(bit_stride * (high_bound - low_bound + 1) + 7) / 8; (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
@@ -1888,7 +1898,8 @@ resolve_dynamic_range (struct type *dyn_range_type, @@ -1888,12 +1898,12 @@ resolve_dynamic_range (struct type *dyn_range_type,
CORE_ADDR value; CORE_ADDR value;
struct type *static_range_type, *static_target_type; struct type *static_range_type, *static_target_type;
const struct dynamic_prop *prop; const struct dynamic_prop *prop;
- struct dynamic_prop low_bound, high_bound; - struct dynamic_prop low_bound, high_bound;
+ const struct dwarf2_locexpr_baton *baton;
+ struct dynamic_prop low_bound, high_bound, stride; + struct dynamic_prop low_bound, high_bound, stride;
gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
@@ -1919,13 +1930,21 @@ resolve_dynamic_range (struct type *dyn_range_type, prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
high_bound.kind = PROP_UNDEFINED; - 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;
@@ -1905,7 +1915,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;
@@ -1920,12 +1930,20 @@ resolve_dynamic_range (struct type *dyn_range_type,
high_bound.data.const_val = 0; high_bound.data.const_val = 0;
} }
+
+ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride; + prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
+ if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) + if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
+ { + {
+ stride.kind = PROP_CONST; + stride.kind = PROP_CONST;
+ stride.data.const_val = value; + stride.data.const_val = value;
+ } + }
+
static_target_type static_target_type
= resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type), = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
addr_stack, 0); addr_stack, 0);
@ -773,29 +899,8 @@ index ec5c17a..88801ac 100644
TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
return static_range_type; return static_range_type;
} }
@@ -2176,8 +2195,18 @@ resolve_dynamic_type_internal (struct type *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;
+ struct type *range_type = TYPE_INDEX_TYPE (resolved_type);
+
+ /* Adjust the data location with the value of byte stride if set, which
+ can describe the separation between successive elements along the
+ dimension. */
+ if (TYPE_BYTE_STRIDE (range_type) < 0)
+ value += (TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type))
+ * TYPE_BYTE_STRIDE (range_type);
+
+ TYPE_DATA_LOCATION_ADDR (resolved_type) = value;
+ TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST;
+
}
return resolved_type;
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 2dda074..97227c9 100644 index 2dda074..bcc9200 100644
--- a/gdb/gdbtypes.h --- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h
@@ -577,6 +577,10 @@ struct range_bounds @@ -577,6 +577,10 @@ struct range_bounds
@ -809,15 +914,15 @@ index 2dda074..97227c9 100644
/* True if HIGH range bound contains the number of elements in the /* True if HIGH range bound contains the number of elements in the
subrange. This affects how the final hight bound is computed. */ subrange. This affects how the final hight bound is computed. */
@@ -740,6 +744,7 @@ struct main_type @@ -739,7 +743,6 @@ struct main_type
/* * Union member used for range types. */
struct range_bounds *bounds; struct range_bounds *bounds;
-
+
} flds_bnds; } flds_bnds;
/* * Slot to point to additional language-specific fields of this /* * Slot to point to additional language-specific fields of this
@@ -1255,6 +1260,15 @@ extern void allocate_gnat_aux_type (struct type *); @@ -1255,6 +1258,15 @@ extern void allocate_gnat_aux_type (struct type *);
TYPE_RANGE_DATA(range_type)->high.kind TYPE_RANGE_DATA(range_type)->high.kind
#define TYPE_LOW_BOUND_KIND(range_type) \ #define TYPE_LOW_BOUND_KIND(range_type) \
TYPE_RANGE_DATA(range_type)->low.kind TYPE_RANGE_DATA(range_type)->low.kind
@ -833,7 +938,7 @@ index 2dda074..97227c9 100644
/* Property accessors for the type data location. */ /* Property accessors for the type data location. */
#define TYPE_DATA_LOCATION(thistype) \ #define TYPE_DATA_LOCATION(thistype) \
@@ -1289,6 +1303,9 @@ extern void allocate_gnat_aux_type (struct type *); @@ -1289,6 +1301,9 @@ extern void allocate_gnat_aux_type (struct type *);
TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
@ -843,7 +948,7 @@ index 2dda074..97227c9 100644
#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
(TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype)))) (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
@@ -1783,6 +1800,7 @@ extern struct type *create_array_type_with_stride @@ -1783,6 +1798,7 @@ extern struct type *create_array_type_with_stride
extern struct type *create_range_type (struct type *, struct type *, extern struct type *create_range_type (struct type *, struct type *,
const struct dynamic_prop *, const struct dynamic_prop *,
@ -1478,6 +1583,30 @@ index 0000000..f22fcbe
+program testprog +program testprog
+ call sub + call sub
+end +end
diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
index 175661f..544d40a 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 8010c0a..f8258a1 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-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
new file mode 100644 new file mode 100644
index 0000000..dcf15e5 index 0000000..dcf15e5
@ -1530,7 +1659,7 @@ index 0000000..dcf15e5
+gdb_test "print pvla(1)" " = 5" "print one 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 diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
new file mode 100644 new file mode 100644
index 0000000..eb0274c index 0000000..8d24252
--- /dev/null --- /dev/null
+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90 +++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
@@ -0,0 +1,29 @@ @@ -0,0 +1,29 @@
@ -1563,33 +1692,49 @@ index 0000000..eb0274c
+ +
+ pvla => null() ! single-element + pvla => null() ! single-element
+end program vla_stride +end program vla_stride
diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
index c76d24c..ef307b7 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
diff --git a/gdb/valarith.c b/gdb/valarith.c diff --git a/gdb/valarith.c b/gdb/valarith.c
index de6fcfd..9093969 100644 index de6fcfd..9753506 100644
--- a/gdb/valarith.c --- a/gdb/valarith.c
+++ b/gdb/valarith.c +++ b/gdb/valarith.c
@@ -193,9 +193,21 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) @@ -193,11 +193,17 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
struct type *array_type = check_typedef (value_type (array)); struct type *array_type = check_typedef (value_type (array));
struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
ULONGEST elt_size = type_length_units (elt_type); ULONGEST elt_size = type_length_units (elt_type);
- ULONGEST elt_offs = elt_size * (index - lowerbound); - ULONGEST elt_offs = elt_size * (index - lowerbound);
+ ULONGEST elt_offs = index - lowerbound; + LONGEST elt_offs = index - lowerbound;
+ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type)); + LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
struct value *v; struct value *v;
+ if (elt_stride > 0) + if (elt_stride != 0)
+ elt_offs *= elt_stride; + elt_offs *= elt_stride;
+ else if (elt_stride < 0)
+ {
+ int offs = (elt_offs + 1) * elt_stride;
+
+ elt_offs = TYPE_LENGTH (array_type) + offs;
+ }
+ else + else
+ elt_offs *= elt_size; + elt_offs *= elt_size;
+ +
if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
&& elt_offs >= type_length_units (array_type))) - && elt_offs >= type_length_units (array_type)))
+ && abs (elt_offs) >= type_length_units (array_type)))
{ {
if (type_not_associated (array_type))
error (_("no such vector element (vector not associated)"));
diff --git a/gdb/valops.c b/gdb/valops.c diff --git a/gdb/valops.c b/gdb/valops.c
index 40392e8..24ffacb 100644 index 40392e8..24ffacb 100644
--- a/gdb/valops.c --- a/gdb/valops.c

1488
gdb-vla-intel-fortran-vla-strings.patch Normal file
View File

File diff suppressed because it is too large Load Diff

28
gdb.spec
View File

@ -22,13 +22,13 @@ Name: %{?scl_prefix}gdb
%global snapsrc 20160801 %global snapsrc 20160801
# See timestamp of source gnulib installed into gdb/gnulib/ . # See timestamp of source gnulib installed into gdb/gnulib/ .
%global snapgnulib 20150822 %global snapgnulib 20150822
%global tardate 20160904 %global tardate 20160907
%global tarname gdb-7.11.90.%{tardate} %global tarname gdb-7.11.90.%{tardate}
Version: 7.12 Version: 7.12
# The release always contains a leading reserved number, start it at 1. # The release always contains a leading reserved number, start it at 1.
# `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing.
Release: 0.12.%{tardate}%{?dist} Release: 0.13.%{tardate}%{?dist}
License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and BSD and Public Domain and GFDL License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and BSD and Public Domain and GFDL
Group: Development/Debuggers Group: Development/Debuggers
@ -521,16 +521,8 @@ Patch848: gdb-dts-rhel6-python-compat.patch
Patch852: gdb-gnat-dwarf-crash-3of3.patch Patch852: gdb-gnat-dwarf-crash-3of3.patch
# VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests. # VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests.
Patch1058: gdb-vla-intel-branch.patch Patch1058: gdb-vla-intel-fortran-strides.patch
Patch1059: gdb-vla-intel-branch-fix-stride-1of2.patch Patch1132: gdb-vla-intel-fortran-vla-strings.patch
Patch1060: gdb-vla-intel-branch-fix-stride-2of2.patch
Patch1132: gdb-vla-intel-1of7.patch
Patch1133: gdb-vla-intel-2of7.patch
Patch1134: gdb-vla-intel-3of7.patch
Patch1135: gdb-vla-intel-4of7.patch
Patch1136: gdb-vla-intel-5of7.patch
Patch1137: gdb-vla-intel-6of7.patch
Patch1138: gdb-vla-intel-7of7.patch
Patch889: gdb-vla-intel-stringbt-fix.patch Patch889: gdb-vla-intel-stringbt-fix.patch
Patch887: gdb-archer-vla-tests.patch Patch887: gdb-archer-vla-tests.patch
Patch888: gdb-vla-intel-tests.patch Patch888: gdb-vla-intel-tests.patch
@ -789,15 +781,7 @@ find -name "*.info*"|xargs rm -f
#patch232 -p1 #patch232 -p1
%patch349 -p1 %patch349 -p1
%patch1058 -p1 %patch1058 -p1
%patch1059 -p1
%patch1060 -p1
%patch1132 -p1 %patch1132 -p1
%patch1133 -p1
%patch1134 -p1
%patch1135 -p1
%patch1136 -p1
%patch1137 -p1
%patch1138 -p1
%patch889 -p1 %patch889 -p1
%patch1 -p1 %patch1 -p1
@ -1468,6 +1452,10 @@ then
fi fi
%changelog %changelog
* Wed Sep 7 2016 Jan Kratochvil <jan.kratochvil@redhat.com> - 7.12-0.13.20160907.fc25
- Rebase to FSF GDB 7.11.90.20160907 (pre-7.12 branch snapshot).
- Rebase Intel VLA patchset.
* Wed Sep 7 2016 Jan Kratochvil <jan.kratochvil@redhat.com> - 7.12-0.12.20160904.fc25 * Wed Sep 7 2016 Jan Kratochvil <jan.kratochvil@redhat.com> - 7.12-0.12.20160904.fc25
- [rhel6+7] Fix compatibility of bison <3.1 and gcc >=6. - [rhel6+7] Fix compatibility of bison <3.1 and gcc >=6.

2
sources
View File

@ -1,3 +1,3 @@
131d0dfd20cd6014c168fbcab9be2c43 gdb-libstdc++-v3-python-6.1.1-20160817.tar.xz 131d0dfd20cd6014c168fbcab9be2c43 gdb-libstdc++-v3-python-6.1.1-20160817.tar.xz
29efc08219d9d6a0536d58f9807c8722 v1.5.tar.gz 29efc08219d9d6a0536d58f9807c8722 v1.5.tar.gz
67e2a5a5c4faead18837fa54ae90576a gdb-7.11.90.20160904.tar.xz 731f09d7e3b5d40af3318a2970db0cc5 gdb-7.11.90.20160907.tar.xz