From d258670d645c91c1124ef42a8f55bd6c810a417a Mon Sep 17 00:00:00 2001 From: Jan Kratochvil Date: Sep 07 2016 20:47:48 +0000 Subject: Rebase to FSF GDB 7.11.90.20160907 (pre-7.12 branch snapshot). - Rebase Intel VLA patchset. --- diff --git a/.gitignore b/.gitignore index 214ab61..7f9ef28 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,3 @@ /gdb-libstdc++-v3-python-6.1.1-20160817.tar.xz /v1.5.tar.gz -/gdb-7.11.90.20160904.tar.xz +/gdb-7.11.90.20160907.tar.xz diff --git a/gdb-6.6-buildid-locate.patch b/gdb-6.6-buildid-locate.patch index ff77775..28773ec 100644 --- a/gdb-6.6-buildid-locate.patch +++ b/gdb-6.6-buildid-locate.patch @@ -281,6 +281,16 @@ Index: gdb-7.11.50.20160630/gdb/testsuite/lib/mi-support.exp if { $separate_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 =================================================================== --- gdb-7.11.50.20160630.orig/gdb/objfiles.h 2016-07-03 14:33:28.130205528 +0200 diff --git a/gdb-rhbz795424-bitpos-25of25.patch b/gdb-rhbz795424-bitpos-25of25.patch index ef5e048..cf5c17e 100644 --- a/gdb-rhbz795424-bitpos-25of25.patch +++ b/gdb-rhbz795424-bitpos-25of25.patch @@ -47,10 +47,10 @@ Content-Type: text/x-patch Content-Transfer-Encoding: 7bit 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.50.20160630/gdb/f-lang.h 2016-07-16 10:56:15.554793704 +0200 +--- gdb-7.11.90.20160907.orig/gdb/f-lang.h 2016-09-07 21:48:33.308624019 +0200 ++++ gdb-7.11.90.20160907/gdb/f-lang.h 2016-09-07 21:48:40.967692469 +0200 @@ -49,9 +49,9 @@ 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 *); -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.50.20160630/gdb/f-typeprint.c 2016-07-16 10:56:43.795019660 +0200 +--- gdb-7.11.90.20160907.orig/gdb/f-typeprint.c 2016-09-07 21:48:33.309624028 +0200 ++++ gdb-7.11.90.20160907/gdb/f-typeprint.c 2016-09-07 21:48:40.967692469 +0200 @@ -147,7 +147,7 @@ int show, int passed_a_ptr, int demangled_args, 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)); /* 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 @@ else { @@ -112,10 +112,10 @@ Index: gdb-7.11.50.20160630/gdb/f-typeprint.c } 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.50.20160630/gdb/f-valprint.c 2016-07-16 10:56:15.554793704 +0200 +--- gdb-7.11.90.20160907.orig/gdb/f-valprint.c 2016-09-07 21:48:33.309624028 +0200 ++++ gdb-7.11.90.20160907/gdb/f-valprint.c 2016-09-07 21:48:40.967692469 +0200 @@ -43,7 +43,7 @@ /* 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. */ diff --git a/gdb-vla-intel-1of7.patch b/gdb-vla-intel-1of7.patch deleted file mode 100644 index b572922..0000000 --- a/gdb-vla-intel-1of7.patch +++ /dev/null @@ -1,180 +0,0 @@ -From 26e156d62211ca8458faa326f21940e9fa18c8fe Mon Sep 17 00:00:00 2001 -From: Bernhard Heckel -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 - -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 . - - 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" " = " "print non-allocated vla1" - gdb_test "print &vla1" \ -- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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)" -@@ -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" " = " "print undefined pvla" - gdb_test "print &pvla" \ -- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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)" -@@ -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 - diff --git a/gdb-vla-intel-2of7.patch b/gdb-vla-intel-2of7.patch deleted file mode 100644 index 61a177a..0000000 --- a/gdb-vla-intel-2of7.patch +++ /dev/null @@ -1,75 +0,0 @@ -From a879b2501e61ee3d3efadbdb6b33212b57d3a2e1 Mon Sep 17 00:00:00 2001 -From: Bernhard Heckel -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 - -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 - diff --git a/gdb-vla-intel-3of7.patch b/gdb-vla-intel-3of7.patch deleted file mode 100644 index 8095404..0000000 --- a/gdb-vla-intel-3of7.patch +++ /dev/null @@ -1,113 +0,0 @@ -From d2fd5fea2c06052c53d99bfa25fdaed9cf5dd217 Mon Sep 17 00:00:00 2001 -From: Bernhard Heckel -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 - -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 . */ - -+extern "C" { -+#include -+} -+ - 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 - diff --git a/gdb-vla-intel-4of7.patch b/gdb-vla-intel-4of7.patch deleted file mode 100644 index 62dca35..0000000 --- a/gdb-vla-intel-4of7.patch +++ /dev/null @@ -1,508 +0,0 @@ -From f63782d25ebd593c4c4669d4c394a2706f15e660 Mon Sep 17 00:00:00 2001 -From: Bernhard Heckel -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 - -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 . -+ -+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 . -+ -+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 = " "ptype vla1 not initialized" --gdb_test "ptype vla2" "type = " "ptype vla2 not initialized" --gdb_test "ptype pvla" "type = " "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 = " "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 = " "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 = " "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 = " -+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\\(\\)" \ -+ " $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" " = " "print non-allocated vla1" - gdb_test "print &vla1" \ -- " = \\\(PTR TO -> \\\( $real \\\(\\\)\\\)\\\) $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" " = " "print undefined pvla" - gdb_test "print &pvla" \ -- " = \\\(PTR TO -> \\\( $real \\\(\\\)\\\)\\\) $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=\"\"" "evaluate not allocated vla" - --mi_create_varobj_checked vla1_not_allocated vla1 "" \ -+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=\"\"" \ -+ "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=\"\".*${mi_gdb_prompt}$" { - pass $test - -- mi_create_varobj_checked pvla2_not_associated pvla2 "" \ -+ 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=\"\"" \ -+ "581\\^done,type=\"$real \\(:,:\\)\"" \ - "info type variable pvla2_not_associated" - mi_gdb_test "582-var-show-format pvla2_not_associated" \ - "582\\^done,format=\"natural\"" \ diff --git a/gdb-vla-intel-5of7.patch b/gdb-vla-intel-5of7.patch deleted file mode 100644 index 68cfc57..0000000 --- a/gdb-vla-intel-5of7.patch +++ /dev/null @@ -1,345 +0,0 @@ -From b6e668ccd356ea3e75d30f20314334b1203c22de Mon Sep 17 00:00:00 2001 -From: Bernhard Heckel -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 - -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 . -+ -+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 \\(:,:\\)\\)\\) \r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re " = \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" "= " -+ -+ -+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 \\)\\) \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 " "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); diff --git a/gdb-vla-intel-6of7.patch b/gdb-vla-intel-6of7.patch deleted file mode 100644 index 45968e9..0000000 --- a/gdb-vla-intel-6of7.patch +++ /dev/null @@ -1,102 +0,0 @@ -From 8665344c14b9ae8b2e0c37ba06d6881a546d1a37 Mon Sep 17 00:00:00 2001 -From: Bernhard Heckel -Date: Tue, 12 Jul 2016 08:19:34 +0200 -Subject: [PATCH 6/7] Fortran: Testsuite, add cyclic pointers. - -2016-05-25 Bernhard Heckel - -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 = \\)\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 \\)\\) \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 " "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 - diff --git a/gdb-vla-intel-7of7.patch b/gdb-vla-intel-7of7.patch deleted file mode 100644 index 310ca60..0000000 --- a/gdb-vla-intel-7of7.patch +++ /dev/null @@ -1,521 +0,0 @@ -From 1e5bd9aec9ee02c2f771e4dc997570c82d74b3b8 Mon Sep 17 00:00:00 2001 -From: Bernhard Heckel -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 . -+ -+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 . -+ -+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 diff --git a/gdb-vla-intel-branch-fix-stride-1of2.patch b/gdb-vla-intel-branch-fix-stride-1of2.patch deleted file mode 100644 index f4c6670..0000000 --- a/gdb-vla-intel-branch-fix-stride-1of2.patch +++ /dev/null @@ -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-- - diff --git a/gdb-vla-intel-branch-fix-stride-2of2.patch b/gdb-vla-intel-branch-fix-stride-2of2.patch deleted file mode 100644 index 9840d0e..0000000 --- a/gdb-vla-intel-branch-fix-stride-2of2.patch +++ /dev/null @@ -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-- - diff --git a/gdb-vla-intel-branch.patch b/gdb-vla-intel-branch.patch deleted file mode 100644 index ee16e99..0000000 --- a/gdb-vla-intel-branch.patch +++ /dev/null @@ -1,1832 +0,0 @@ -git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides -2c392d41a3f2e38deeb9db5b7a93ca45682bbe3b - - gdb/dwarf2read.c | 13 +- - gdb/eval.c | 391 +++++++++++++++++++++----- - gdb/expprint.c | 20 +- - gdb/expression.h | 18 +- - gdb/f-exp.y | 42 ++- - gdb/f-valprint.c | 8 +- - gdb/gdbtypes.c | 45 ++- - gdb/gdbtypes.h | 18 ++ - gdb/parse.c | 24 +- - gdb/rust-exp.y | 12 +- - gdb/rust-lang.c | 17 +- - gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++ - gdb/testsuite/gdb.fortran/vla-stride.exp | 44 +++ - gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++ - gdb/valarith.c | 14 +- - gdb/valops.c | 197 +++++++++++-- - gdb/value.h | 2 + - 18 files changed, 1197 insertions(+), 173 deletions(-) - -diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c -index 6658a38..a1ac659 100644 ---- a/gdb/dwarf2read.c -+++ b/gdb/dwarf2read.c -@@ -14952,7 +14952,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - struct type *base_type, *orig_base_type; - struct type *range_type; - struct attribute *attr; -- struct dynamic_prop low, high; -+ struct dynamic_prop low, high, stride; - int low_default_is_valid; - int high_bound_is_count = 0; - const char *name; -@@ -14972,7 +14972,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - - low.kind = PROP_CONST; - high.kind = PROP_CONST; -+ stride.kind = PROP_CONST; - high.data.const_val = 0; -+ stride.data.const_val = 0; - - /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow - omitting DW_AT_lower_bound. */ -@@ -15006,6 +15008,13 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - break; - } - -+ attr = dwarf2_attr (die, DW_AT_byte_stride, cu); -+ if (attr) -+ if (!attr_to_dynamic_prop (attr, die, cu, &stride)) -+ complaint (&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); -@@ -15082,7 +15091,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask)) - high.data.const_val |= negative_mask; - -- range_type = create_range_type (NULL, orig_base_type, &low, &high); -+ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride); - - if (high_bound_is_count) - TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1; -diff --git a/gdb/eval.c b/gdb/eval.c -index 00a107c..91d8a03 100644 ---- a/gdb/eval.c -+++ b/gdb/eval.c -@@ -399,29 +399,325 @@ init_array_element (struct value *array, struct value *element, - return index; - } - -+/* Evaluates any operation on Fortran arrays or strings with at least -+ one user provided parameter. Expects the input ARRAY to be either -+ an array, or a string. Evaluates EXP by incrementing POS, and -+ writes the content from the elt stack into a local struct. NARGS -+ specifies number of literal or range arguments the user provided. -+ NARGS must be the same number as ARRAY has dimensions. */ -+ - static struct value * --value_f90_subarray (struct value *array, -- struct expression *exp, int *pos, enum noside noside) -+value_f90_subarray (struct value *array, struct expression *exp, -+ int *pos, int nargs, enum noside noside) - { -- int pc = (*pos) + 1; -+ int i, dim_count = 0; - LONGEST low_bound, high_bound; -- struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array))); -- enum range_type range_type -- = (enum range_type) longest_to_int (exp->elts[pc].longconst); -- -- *pos += 3; -- -- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) -- low_bound = TYPE_LOW_BOUND (range); -- else -- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); -+ struct value *new_array = array; -+ struct type *array_type = check_typedef (value_type (new_array)); -+ struct type *elt_type; -+ -+ typedef struct subscript_range -+ { -+ enum range_type f90_range_type; -+ LONGEST low, high, stride; -+ } subscript_range; -+ -+ typedef enum subscript_kind -+ { -+ SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */ -+ SUBSCRIPT_INDEX /* e.g. "(literal)" */ -+ } kind; -+ -+ /* Local struct to hold user data for Fortran subarray dimensions. */ -+ struct subscript_store -+ { -+ /* For every dimension, we are either working on a range or an index -+ expression, so we store this info separately for later. */ -+ enum subscript_kind kind; -+ -+ /* We also store either the lower and upper bound info, or the index -+ number. Before evaluation of the input values, we do not know if we are -+ actually working on a range of ranges, or an index in a range. So as a -+ first step we store all input in a union. The array calculation itself -+ deals with this later on. */ -+ union element_range -+ { -+ subscript_range range; -+ LONGEST number; -+ } U; -+ } *subscript_array; -+ -+ /* Check if the number of arguments provided by the user matches -+ the number of dimension of the array. A string has only one -+ dimension. */ -+ if (nargs != calc_f77_array_dims (value_type (new_array))) -+ error (_("Wrong number of subscripts")); -+ -+ subscript_array = (struct subscript_store*) alloca (sizeof (*subscript_array) * nargs); -+ -+ /* Parse the user input into the SUBSCRIPT_ARRAY to store it. We need -+ to evaluate it first, as the input is from left-to-right. The -+ array is stored from right-to-left. So we have to use the user -+ input in reverse order. Later on, we need the input information to -+ re-calculate the output array. For multi-dimensional arrays, we -+ can be dealing with any possible combination of ranges and indices -+ for every dimension. */ -+ for (i = 0; i < nargs; i++) -+ { -+ struct subscript_store *index = &subscript_array[i]; - -- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) -- high_bound = TYPE_HIGH_BOUND (range); -- else -- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); -+ /* The user input is a range, with or without lower and upper bound. -+ E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */ -+ if (exp->elts[*pos].opcode == OP_RANGE) -+ { -+ int pc = (*pos) + 1; -+ subscript_range *range; -+ -+ index->kind = SUBSCRIPT_RANGE; -+ range = &index->U.range; -+ -+ *pos += 3; -+ range->f90_range_type = (enum range_type) exp->elts[pc].longconst; -+ -+ /* If a lower bound was provided by the user, the bit has been -+ set and we can assign the value from the elt stack. Same for -+ upper bound. */ -+ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) -+ == SUBARRAY_LOW_BOUND) -+ range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp, -+ pos, noside)); -+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) -+ == SUBARRAY_HIGH_BOUND) -+ range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, -+ pos, noside)); -+ -+ /* Assign the user's stride value if provided. */ -+ if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) -+ range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, -+ pos, noside)); -+ -+ /* Assign the default stride value '1'. */ -+ else -+ range->stride = 1; -+ -+ /* Check the provided stride value is illegal, aka '0'. */ -+ if (range->stride == 0) -+ error (_("Stride must not be 0")); -+ } -+ /* User input is an index. E.g.: "p arry(5)". */ -+ else -+ { -+ struct value *val; -+ -+ index->kind = SUBSCRIPT_INDEX; -+ -+ /* Evaluate each subscript; it must be a legal integer in F77. This -+ ensures the validity of the provided index. */ -+ val = evaluate_subexp_with_coercion (exp, pos, noside); -+ index->U.number = value_as_long (val); -+ } -+ -+ } -+ -+ /* Traverse the array from right to left and set the high and low bounds -+ for later use. */ -+ for (i = nargs - 1; i >= 0; i--) -+ { -+ struct subscript_store *index = &subscript_array[i]; -+ struct type *index_type = TYPE_INDEX_TYPE (array_type); -+ -+ switch (index->kind) -+ { -+ case SUBSCRIPT_RANGE: -+ { -+ -+ /* When we hit the first range specified by the user, we must -+ treat any subsequent user entry as a range. We simply -+ increment DIM_COUNT which tells us how many times we are -+ calling VALUE_SLICE_1. */ -+ subscript_range *range = &index->U.range; -+ -+ /* If no lower bound was provided by the user, we take the -+ default boundary. Same for the high bound. */ -+ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0) -+ range->low = TYPE_LOW_BOUND (index_type); -+ -+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0) -+ range->high = TYPE_HIGH_BOUND (index_type); -+ -+ /* Both user provided low and high bound have to be inside the -+ array bounds. Throw an error if not. */ -+ if (range->low < TYPE_LOW_BOUND (index_type) -+ || range->low > TYPE_HIGH_BOUND (index_type) -+ || range->high < TYPE_LOW_BOUND (index_type) -+ || range->high > TYPE_HIGH_BOUND (index_type)) -+ error (_("provided bound(s) outside array bound(s)")); -+ -+ /* For a negative stride the lower boundary must be larger than the -+ upper boundary. -+ For a positive stride the lower boundary must be smaller than the -+ upper boundary. */ -+ if ((range->stride < 0 && range->low < range->high) -+ || (range->stride > 0 && range->low > range->high)) -+ error (_("Wrong value provided for stride and boundaries")); -+ -+ } -+ break; -+ -+ case SUBSCRIPT_INDEX: -+ break; -+ -+ } -+ -+ array_type = TYPE_TARGET_TYPE (array_type); -+ } -+ -+ /* Reset ARRAY_TYPE before slicing.*/ -+ array_type = check_typedef (value_type (new_array)); -+ -+ /* Traverse the array from right to left and evaluate each corresponding -+ user input. VALUE_SUBSCRIPT is called for every index, until a range -+ expression is evaluated. After a range expression has been evaluated, -+ every subsequent expression is also treated as a range. */ -+ for (i = nargs - 1; i >= 0; i--) -+ { -+ struct subscript_store *index = &subscript_array[i]; -+ struct type *index_type = TYPE_INDEX_TYPE (array_type); -+ -+ switch (index->kind) -+ { -+ case SUBSCRIPT_RANGE: -+ { -+ -+ /* When we hit the first range specified by the user, we must -+ treat any subsequent user entry as a range. We simply -+ increment DIM_COUNT which tells us how many times we are -+ calling VALUE_SLICE_1. */ -+ subscript_range *range = &index->U.range; -+ -+ /* DIM_COUNT counts every user argument that is treated as a range. -+ This is necessary for expressions like 'print array(7, 8:9). -+ Here the first argument is a literal, but must be treated as a -+ range argument to allow the correct output representation. */ -+ dim_count++; -+ -+ new_array -+ = value_slice_1 (new_array, range->low, -+ range->high - range->low + 1, -+ range->stride, dim_count); -+ } -+ break; -+ -+ case SUBSCRIPT_INDEX: -+ { -+ /* DIM_COUNT only stays '0' when no range argument was processed -+ before, starting from the last dimension. This way we can -+ reduce the number of dimensions from the result array. -+ However, if a range has been processed before an index, we -+ treat the index like a range with equal low- and high bounds -+ to get the value offset right. */ -+ if (dim_count == 0) -+ new_array -+ = value_subscripted_rvalue (new_array, index->U.number, -+ f77_get_lowerbound (value_type -+ (new_array))); -+ else -+ { -+ dim_count++; -+ -+ /* We might end up here, because we have to treat the provided -+ index like a range. But now VALUE_SUBSCRIPTED_RVALUE -+ cannot do the range checks for us. So we have to make sure -+ ourselves that the user provided index is inside the -+ array bounds. Throw an error if not. */ -+ if (index->U.number < TYPE_LOW_BOUND (index_type) -+ && index->U.number > TYPE_HIGH_BOUND (index_type)) -+ error (_("provided bound(s) outside array bound(s)")); -+ -+ if (index->U.number > TYPE_LOW_BOUND (index_type) -+ && index->U.number > TYPE_HIGH_BOUND (index_type)) -+ error (_("provided bound(s) outside array bound(s)")); -+ -+ new_array = value_slice_1 (new_array, -+ index->U.number, -+ 1, /* COUNT is '1' element */ -+ 1, /* STRIDE set to '1' */ -+ dim_count); -+ } -+ -+ } -+ break; -+ } -+ array_type = TYPE_TARGET_TYPE (array_type); -+ } -+ -+ /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect -+ an array of arrays, depending on how many ranges have been provided by -+ the user. So we need to rebuild the array dimensions for printing it -+ correctly. -+ Starting from right to left in the user input, after we hit the first -+ range argument every subsequent argument is also treated as a range. -+ E.g.: -+ "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3 -+ ranges. -+ "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2 -+ ranges. -+ "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1 -+ range. */ -+ if (dim_count > 1) -+ { -+ struct value *v = NULL; -+ -+ elt_type = TYPE_TARGET_TYPE (value_type (new_array)); -+ -+ /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in -+ the output array. So we traverse the SUBSCRIPT_ARRAY again, looking -+ for a range entry. When we find one, we use the range info to create -+ an additional range_type to set the correct bounds and dimensions for -+ the output array. In addition, we may have a stride value that is not -+ '1', forcing us to adjust the number of elements in a range, according -+ to the stride value. */ -+ for (i = 0; i < nargs; i++) -+ { -+ struct subscript_store *index = &subscript_array[i]; -+ -+ if (index->kind == SUBSCRIPT_RANGE) -+ { -+ struct type *range_type, *interim_array_type; -+ -+ int new_length; - -- return value_slice (array, low_bound, high_bound - low_bound + 1); -+ /* The length of a sub-dimension with all elements between the -+ bounds plus the start element itself. It may be modified by -+ a user provided stride value. */ -+ new_length = index->U.range.high - index->U.range.low; -+ -+ new_length /= index->U.range.stride; -+ -+ range_type -+ = create_static_range_type (NULL, -+ elt_type, -+ index->U.range.low, -+ index->U.range.low + new_length); -+ -+ interim_array_type = create_array_type (NULL, -+ elt_type, -+ range_type); -+ -+ TYPE_CODE (interim_array_type) -+ = TYPE_CODE (value_type (new_array)); -+ -+ v = allocate_value (interim_array_type); -+ -+ elt_type = value_type (v); -+ } -+ -+ } -+ value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type)); -+ return v; -+ } -+ -+ return new_array; - } - - -@@ -1810,19 +2106,8 @@ evaluate_subexp_standard (struct type *expect_type, - switch (code) - { - case TYPE_CODE_ARRAY: -- if (exp->elts[*pos].opcode == OP_RANGE) -- return value_f90_subarray (arg1, exp, pos, noside); -- else -- goto multi_f77_subscript; -- - case TYPE_CODE_STRING: -- if (exp->elts[*pos].opcode == OP_RANGE) -- return value_f90_subarray (arg1, exp, pos, noside); -- else -- { -- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); -- return value_subscript (arg1, value_as_long (arg2)); -- } -+ return value_f90_subarray (arg1, exp, pos, nargs, noside); - - case TYPE_CODE_PTR: - case TYPE_CODE_FUNC: -@@ -2223,49 +2508,6 @@ evaluate_subexp_standard (struct type *expect_type, - } - return (arg1); - -- multi_f77_subscript: -- { -- LONGEST subscript_array[MAX_FORTRAN_DIMS]; -- int ndimensions = 1, i; -- struct value *array = arg1; -- -- if (nargs > MAX_FORTRAN_DIMS) -- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); -- -- ndimensions = calc_f77_array_dims (type); -- -- if (nargs != ndimensions) -- error (_("Wrong number of subscripts")); -- -- gdb_assert (nargs > 0); -- -- /* Now that we know we have a legal array subscript expression -- let us actually find out where this element exists in the array. */ -- -- /* Take array indices left to right. */ -- for (i = 0; i < nargs; i++) -- { -- /* Evaluate each subscript; it must be a legal integer in F77. */ -- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); -- -- /* Fill in the subscript array. */ -- -- subscript_array[i] = value_as_long (arg2); -- } -- -- /* Internal type of array is arranged right to left. */ -- for (i = nargs; i > 0; i--) -- { -- struct type *array_type = check_typedef (value_type (array)); -- LONGEST index = subscript_array[i - 1]; -- -- array = value_subscripted_rvalue (array, index, -- f77_get_lowerbound (array_type)); -- } -- -- return array; -- } -- - case BINOP_LOGICAL_AND: - arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); - if (noside == EVAL_SKIP) -@@ -3123,6 +3365,9 @@ calc_f77_array_dims (struct type *array_type) - int ndimen = 1; - struct type *tmp_type; - -+ if (TYPE_CODE (array_type) == TYPE_CODE_STRING) -+ return 1; -+ - if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY)) - error (_("Can't get dimensions for a non-array type")); - -diff --git a/gdb/expprint.c b/gdb/expprint.c -index c37ecb0..214d58e 100644 ---- a/gdb/expprint.c -+++ b/gdb/expprint.c -@@ -568,12 +568,10 @@ print_subexp_standard (struct expression *exp, int *pos, - *pos += 2; - - fputs_filtered ("RANGE(", stream); -- if (range_type == HIGH_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT) -+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); - fputs_filtered ("..", stream); -- if (range_type == LOW_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT) -+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); - fputs_filtered (")", stream); - return; -@@ -1055,16 +1053,16 @@ dump_subexp_body_standard (struct expression *exp, - - switch (range_type) - { -- case BOTH_BOUND_DEFAULT: -+ case SUBARRAY_NONE_BOUND: - fputs_filtered ("Range '..'", stream); - break; -- case LOW_BOUND_DEFAULT: -+ case SUBARRAY_HIGH_BOUND: - fputs_filtered ("Range '..EXP'", stream); - break; -- case HIGH_BOUND_DEFAULT: -+ case SUBARRAY_LOW_BOUND: - fputs_filtered ("Range 'EXP..'", stream); - break; -- case NONE_BOUND_DEFAULT: -+ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND): - fputs_filtered ("Range 'EXP..EXP'", stream); - break; - default: -@@ -1072,11 +1070,9 @@ dump_subexp_body_standard (struct expression *exp, - break; - } - -- if (range_type == HIGH_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT) -+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) - elt = dump_subexp (exp, stream, elt); -- if (range_type == LOW_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT) -+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) - elt = dump_subexp (exp, stream, elt); - } - break; -diff --git a/gdb/expression.h b/gdb/expression.h -index 4952d84..34ca54b 100644 ---- a/gdb/expression.h -+++ b/gdb/expression.h -@@ -152,17 +152,17 @@ extern void dump_raw_expression (struct expression *, - struct ui_file *, char *); - extern void dump_prefix_expression (struct expression *, struct ui_file *); - --/* In an OP_RANGE expression, either bound could be empty, indicating -- that its value is by default that of the corresponding bound of the -- array or string. So we have four sorts of subrange. This -- enumeration type is to identify this. */ -- -+/* In an OP_RANGE expression, either bound can be provided by the user, or not. -+ In addition to this, the user can also specify a stride value to indicated -+ only certain elements of the array. This enumeration type is to identify -+ this. */ -+ - enum range_type - { -- BOTH_BOUND_DEFAULT, /* "(:)" */ -- LOW_BOUND_DEFAULT, /* "(:high)" */ -- HIGH_BOUND_DEFAULT, /* "(low:)" */ -- NONE_BOUND_DEFAULT /* "(low:high)" */ -+ SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */ -+ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ -+ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */ -+ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */ - }; - - #endif /* !defined (EXPRESSION_H) */ -diff --git a/gdb/f-exp.y b/gdb/f-exp.y -index e3148a3..71f1823 100644 ---- a/gdb/f-exp.y -+++ b/gdb/f-exp.y -@@ -253,31 +253,63 @@ arglist : subrange - - arglist : arglist ',' exp %prec ABOVE_COMMA - { arglist_len++; } -+ | arglist ',' subrange %prec ABOVE_COMMA -+ { arglist_len++; } - ; - - /* There are four sorts of subrange types in F90. */ - - subrange: exp ':' exp %prec ABOVE_COMMA -- { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT); -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, -+ SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - - subrange: exp ':' %prec ABOVE_COMMA - { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT); -+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - - subrange: ':' exp %prec ABOVE_COMMA - { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT); -+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - - subrange: ':' %prec ABOVE_COMMA - { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT); -+ write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+/* Each subrange type can have a stride argument. */ -+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND -+ | SUBARRAY_HIGH_BOUND -+ | SUBARRAY_STRIDE); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+subrange: exp ':' ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND -+ | SUBARRAY_STRIDE); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+subrange: ':' exp ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND -+ | SUBARRAY_STRIDE); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+subrange: ':' ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - -diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c -index 08215e2..e6eca6a 100644 ---- a/gdb/f-valprint.c -+++ b/gdb/f-valprint.c -@@ -121,8 +121,14 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type, - - if (nss != ndimensions) - { -- size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); -+ size_t dim_size; - size_t offs = 0; -+ LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); -+ -+ if (byte_stride) -+ dim_size = byte_stride; -+ else -+ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); - - for (i = lowerbound; - (i < upperbound + 1 && (*elts) < options->print_max); -diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c -index ec5c17a..88801ac 100644 ---- a/gdb/gdbtypes.c -+++ b/gdb/gdbtypes.c -@@ -836,7 +836,8 @@ allocate_stub_method (struct type *type) - struct type * - create_range_type (struct type *result_type, struct type *index_type, - const struct dynamic_prop *low_bound, -- const struct dynamic_prop *high_bound) -+ const struct dynamic_prop *high_bound, -+ const struct dynamic_prop *stride) - { - if (result_type == NULL) - result_type = alloc_type_copy (index_type); -@@ -851,6 +852,7 @@ create_range_type (struct type *result_type, struct type *index_type, - TYPE_ZALLOC (result_type, sizeof (struct range_bounds)); - TYPE_RANGE_DATA (result_type)->low = *low_bound; - TYPE_RANGE_DATA (result_type)->high = *high_bound; -+ TYPE_RANGE_DATA (result_type)->stride = *stride; - - if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0) - TYPE_UNSIGNED (result_type) = 1; -@@ -879,7 +881,7 @@ struct type * - create_static_range_type (struct type *result_type, struct type *index_type, - LONGEST low_bound, LONGEST high_bound) - { -- struct dynamic_prop low, high; -+ struct dynamic_prop low, high, stride; - - low.kind = PROP_CONST; - low.data.const_val = low_bound; -@@ -887,7 +889,11 @@ create_static_range_type (struct type *result_type, struct type *index_type, - high.kind = PROP_CONST; - high.data.const_val = high_bound; - -- result_type = create_range_type (result_type, index_type, &low, &high); -+ stride.kind = PROP_CONST; -+ stride.data.const_val = 0; -+ -+ result_type = create_range_type (result_type, index_type, -+ &low, &high, &stride); - - return result_type; - } -@@ -1084,16 +1090,20 @@ create_array_type_with_stride (struct type *result_type, - && (!type_not_associated (result_type) - && !type_not_allocated (result_type))) - { -- LONGEST low_bound, high_bound; -+ LONGEST low_bound, high_bound, byte_stride; - - if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) - low_bound = high_bound = 0; - element_type = check_typedef (element_type); -+ byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); -+ - /* Be careful when setting the array length. Ada arrays can be - empty arrays with the high_bound being smaller than the low_bound. - In such cases, the array length should be zero. */ - if (high_bound < low_bound) - TYPE_LENGTH (result_type) = 0; -+ else if (byte_stride > 0) -+ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1); - else if (bit_stride > 0) - TYPE_LENGTH (result_type) = - (bit_stride * (high_bound - low_bound + 1) + 7) / 8; -@@ -1888,7 +1898,8 @@ resolve_dynamic_range (struct type *dyn_range_type, - CORE_ADDR value; - struct type *static_range_type, *static_target_type; - const struct dynamic_prop *prop; -- struct dynamic_prop low_bound, high_bound; -+ const struct dwarf2_locexpr_baton *baton; -+ struct dynamic_prop low_bound, high_bound, stride; - - gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); - -@@ -1919,13 +1930,21 @@ resolve_dynamic_range (struct type *dyn_range_type, - high_bound.kind = PROP_UNDEFINED; - high_bound.data.const_val = 0; - } -+ -+ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride; -+ if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) -+ { -+ stride.kind = PROP_CONST; -+ stride.data.const_val = value; -+ } - - static_target_type - = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type), - addr_stack, 0); - static_range_type = create_range_type (copy_type (dyn_range_type), - static_target_type, -- &low_bound, &high_bound); -+ &low_bound, &high_bound, &stride); -+ - TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; - return static_range_type; - } -@@ -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 -index 2dda074..97227c9 100644 ---- a/gdb/gdbtypes.h -+++ b/gdb/gdbtypes.h -@@ -577,6 +577,10 @@ struct range_bounds - - struct dynamic_prop high; - -+ /* * Stride of range. */ -+ -+ struct dynamic_prop stride; -+ - /* True if HIGH range bound contains the number of elements in the - subrange. This affects how the final hight bound is computed. */ - -@@ -740,6 +744,7 @@ struct main_type - - struct range_bounds *bounds; - -+ - } flds_bnds; - - /* * Slot to point to additional language-specific fields of this -@@ -1255,6 +1260,15 @@ extern void allocate_gnat_aux_type (struct type *); - TYPE_RANGE_DATA(range_type)->high.kind - #define TYPE_LOW_BOUND_KIND(range_type) \ - TYPE_RANGE_DATA(range_type)->low.kind -+#define TYPE_BYTE_STRIDE(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.data.const_val -+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.data.locexpr -+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.data.loclist -+#define TYPE_BYTE_STRIDE_KIND(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.kind -+ - - /* Property accessors for the type data location. */ - #define TYPE_DATA_LOCATION(thistype) \ -@@ -1289,6 +1303,9 @@ extern void allocate_gnat_aux_type (struct type *); - TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) - #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ - TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) -+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \ -+ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0) -+ - - #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ - (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype)))) -@@ -1783,6 +1800,7 @@ extern struct type *create_array_type_with_stride - - extern struct type *create_range_type (struct type *, struct type *, - const struct dynamic_prop *, -+ const struct dynamic_prop *, - const struct dynamic_prop *); - - extern struct type *create_array_type (struct type *, struct type *, -diff --git a/gdb/parse.c b/gdb/parse.c -index 2b00708..992af87 100644 ---- a/gdb/parse.c -+++ b/gdb/parse.c -@@ -1006,22 +1006,20 @@ operator_length_standard (const struct expression *expr, int endpos, - - case OP_RANGE: - oplen = 3; -+ args = 0; - range_type = (enum range_type) - longest_to_int (expr->elts[endpos - 2].longconst); - -- switch (range_type) -- { -- case LOW_BOUND_DEFAULT: -- case HIGH_BOUND_DEFAULT: -- args = 1; -- break; -- case BOTH_BOUND_DEFAULT: -- args = 0; -- break; -- case NONE_BOUND_DEFAULT: -- args = 2; -- break; -- } -+ /* Increment the argument counter for each argument -+ provided by the user. */ -+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) -+ args++; -+ -+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) -+ args++; -+ -+ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) -+ args++; - - break; - -diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y -index aeb6058..b1b9633 100644 ---- a/gdb/rust-exp.y -+++ b/gdb/rust-exp.y -@@ -2429,23 +2429,17 @@ convert_ast_to_expression (struct parser_state *state, - - case OP_RANGE: - { -- enum range_type kind = BOTH_BOUND_DEFAULT; -+ enum range_type kind = SUBARRAY_NONE_BOUND; - - if (operation->left.op != NULL) - { - convert_ast_to_expression (state, operation->left.op, top); -- kind = HIGH_BOUND_DEFAULT; -+ kind = SUBARRAY_LOW_BOUND; - } - if (operation->right.op != NULL) - { - convert_ast_to_expression (state, operation->right.op, top); -- if (kind == BOTH_BOUND_DEFAULT) -- kind = LOW_BOUND_DEFAULT; -- else -- { -- gdb_assert (kind == HIGH_BOUND_DEFAULT); -- kind = NONE_BOUND_DEFAULT; -- } -+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND); - } - write_exp_elt_opcode (state, OP_RANGE); - write_exp_elt_longcst (state, kind); -diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c -index 17b20c6..295002f 100644 ---- a/gdb/rust-lang.c -+++ b/gdb/rust-lang.c -@@ -1241,9 +1241,9 @@ rust_range (struct expression *exp, int *pos, enum noside noside) - kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst); - *pos += 3; - -- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT) -+ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) - low = evaluate_subexp (NULL_TYPE, exp, pos, noside); -- if (kind == LOW_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT) -+ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) - high = evaluate_subexp (NULL_TYPE, exp, pos, noside); - - if (noside == EVAL_SKIP) -@@ -1332,7 +1332,7 @@ rust_compute_range (struct type *type, struct value *range, - - *low = 0; - *high = 0; -- *kind = BOTH_BOUND_DEFAULT; -+ *kind = SUBARRAY_NONE_BOUND; - - if (TYPE_NFIELDS (type) == 0) - return; -@@ -1340,15 +1340,14 @@ rust_compute_range (struct type *type, struct value *range, - i = 0; - if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0) - { -- *kind = HIGH_BOUND_DEFAULT; -+ *kind = SUBARRAY_LOW_BOUND; - *low = value_as_long (value_field (range, 0)); - ++i; - } - if (TYPE_NFIELDS (type) > i - && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0) - { -- *kind = (*kind == BOTH_BOUND_DEFAULT -- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT); -+ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND); - *high = value_as_long (value_field (range, i)); - } - } -@@ -1363,7 +1362,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, - struct type *rhstype; - LONGEST low, high_bound; - /* Initialized to appease the compiler. */ -- enum range_type kind = BOTH_BOUND_DEFAULT; -+ enum range_type kind = SUBARRAY_NONE_BOUND; - LONGEST high = 0; - int want_slice = 0; - -@@ -1425,7 +1424,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, - error (_("Cannot subscript non-array type")); - - if (want_slice -- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT)) -+ && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND)) - low = low_bound; - if (low < 0) - error (_("Index less than zero")); -@@ -1443,7 +1442,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, - CORE_ADDR addr; - struct value *addrval, *tem; - -- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT) -+ if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND) - high = high_bound; - if (high < 0) - error (_("High index less than zero")); -diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp -new file mode 100644 -index 0000000..cc9ecc0 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp -@@ -0,0 +1,421 @@ -+# Copyright 2015 Free Software Foundation, Inc. -+# -+# Contributed by Intel Corp. -+# -+# 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 . -+ -+standard_testfile static-arrays.f90 -+ -+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } { -+ return -1 -+} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_breakpoint [gdb_get_line_number "BP1"] -+gdb_continue_to_breakpoint "BP1" ".*BP1.*" -+ -+# Tests subarrays of one dimensional arrays with subrange variations -+gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ -+ "print ar1." -+gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \ -+ "print ar1\(4:7\)" -+gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \ -+ "print ar1\(8:\)" -+gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \ -+ "print ar1\(:3\)" -+gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ -+ "print ar1\(:\)" -+ -+# Check assignment -+gdb_test_no_output "set \$my_ary = ar1\(3:8\)" -+gdb_test "print \$my_ary" \ -+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ -+ "Assignment of subarray to variable" -+gdb_test_no_output "set ar1\(5\) = 42" -+ gdb_test "print ar1\(3:8\)" \ -+ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \ -+ "print ar1\(3:8\) after assignment" -+gdb_test "print \$my_ary" \ -+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ -+ "Assignment of subarray to variable after original array changed" -+ -+# Test for subarrays of one dimensional arrays with literals -+ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \ -+ "print ar1\(3\)" -+ -+# Tests for subranges of 2 dimensional arrays with subrange variations -+gdb_test "print ar2\(2:3, 3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \ -+ "print ar2\(2:3, 3:4\)." -+gdb_test "print ar2\(8:9,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:9,8:\)" -+gdb_test "print ar2\(8:9,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ -+ "print ar2\(8:9,:2\)" -+ -+gdb_test "print ar2\(8:,8:9\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:,8:9\)" -+gdb_test "print ar2\(8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:,8:\)" -+gdb_test "print ar2\(8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ -+ "print ar2\(8:,:2\)" -+ -+gdb_test "print ar2\(:2,2:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \ -+ "print ar2\(:2,2:3\)" -+gdb_test "print ar2\(:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \ -+ "print ar2\(:2,8:\)" -+gdb_test "print ar2\(:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \ -+ "print ar2\(:2,:2\)" -+ -+# Test subranges of 2 dimensional arrays with literals and subrange variations -+gdb_test "print ar2\(7, 3:6\)" \ -+ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \ -+ "print ar2\(7, 3:6\)" -+gdb_test "print ar2\(7,8:\)" \ -+ "\\$\[0-9\]+ = \\(78, 79\\)" \ -+ "print ar2\(7,8:\)" -+gdb_test "print ar2\(7,:2\)" \ -+ "\\$\[0-9\]+ = \\(71, 72\\)" \ -+ "print ar2\(7,:2\)" -+ -+gdb_test "print ar2\(7:8,4\)" \ -+ "\\$\[0-9\]+ = \\(74, 84\\)" \ -+ "print ar2(7:8,4\)" -+gdb_test "print ar2\(8:,4\)" \ -+ "\\$\[0-9\]+ = \\(84, 94\\)" \ -+ "print ar2\(8:,4\)" -+gdb_test "print ar2\(:2,4\)" \ -+ "\\$\[0-9\]+ = \\(14, 24\\)" \ -+ "print ar2\(:2,4\)" -+gdb_test "print ar2\(3,4\)" \ -+ "\\$\[0-9\]+ = 34" \ -+ "print ar2\(3,4\)" -+ -+# Test subarrays of 3 dimensional arrays with literals and subrange variations -+gdb_test "print ar3\(2:4,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\ -+ \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \ -+ "print ar3\(2:4,3:4,7:8\)" -+gdb_test "print ar3\(2:3,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\ -+ \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \ -+ "print ar3\(2:3,4:5,8:\)" -+gdb_test "print ar3\(2:3,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\ -+ \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \ -+ "print ar3\(2:3,4:5,:2\)" -+ -+gdb_test "print ar3\(2:3,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\ -+ \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \ -+ "print ar3\(2:3,8:,7:8\)" -+gdb_test "print ar3\(2:3,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\ -+ \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \ -+ "print ar3\(2:3,8:,8:\)" -+gdb_test "print ar3\(2:3,8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\ -+ \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \ -+ "print ar3\(2:3,8:,:2\)" -+ -+gdb_test "print ar3\(2:3,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\ -+ \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \ -+ "print ar3\(2:3,:2,7:8\)" -+gdb_test "print ar3\(2:3,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\ -+ \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \ -+ "print ar3\(2:3,:2,8:\)" -+gdb_test "print ar3\(2:3,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\ -+ \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \ -+ "print ar3\(2:3,:2,:2\)" -+ -+gdb_test "print ar3\(8:,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\ -+ \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \ -+ "print ar3\(8:,3:4,7:8\)" -+gdb_test "print ar3\(8:,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\ -+ \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \ -+ "print ar3\(8:,4:5,8:\)" -+gdb_test "print ar3\(8:,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\ -+ \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \ -+ "print ar3\(8:,4:5,:2\)" -+ -+gdb_test "print ar3\(8:,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\ -+ \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \ -+ "print ar3\(8:,8:,7:8\)" -+gdb_test "print ar3\(8:,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\ -+ \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \ -+ "print ar3\(8:,8:,8:\)" -+gdb_test "print ar3\(8:,8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\ -+ \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \ -+ "print ar3\(8:,8:,:2\)" -+ -+gdb_test "print ar3\(8:,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\ -+ \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \ -+ "print ar3\(8:,:2,7:8\)" -+gdb_test "print ar3\(8:,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\ -+ \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \ -+ "print ar3\(8:,:2,8:\)" -+gdb_test "print ar3\(8:,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\ -+ \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \ -+ "print ar3\(8:,:2,:2\)" -+ -+ -+gdb_test "print ar3\(:2,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\ -+ \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \ -+ "print ar3 \(:2,3:4,7:8\)." -+gdb_test "print ar3\(:2,3:4,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\ -+ \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \ -+ "print ar3\(:2,3:4,8:\)" -+gdb_test "print ar3\(:2,3:4,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\ -+ \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \ -+ "print ar3\(:2,3:4,:2\)" -+ -+gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\ -+ 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \ -+ "print ar3\(:2,8:,7:8\)" -+gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\ -+ 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \ -+ "print ar3\(:2,8:,8:\)" -+gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\ -+ 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \ -+ "print ar3\(:2,8:,:2\)" -+ -+gdb_test "print ar3\(:2,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\ -+ \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \ -+ "print ar3\(:2,:2,7:8\)" -+gdb_test "print ar3\(:2,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\ -+ \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \ -+ "print ar3\(:2,:2,8:\)" -+gdb_test "print ar3\(:2,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\ -+ \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \ -+ "print ar3\(:2,:2,:2\)" -+ -+#Tests for subarrays of 3 dimensional arrays with literals and subranges -+gdb_test "print ar3\(3,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \ -+ "print ar3\(3,3:4,7:8\)" -+gdb_test "print ar3\(3,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \ -+ "print ar3\(3,4:5,8:\)" -+gdb_test "print ar3\(3,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \ -+ "print ar3\(3,4:5,:2\)" -+gdb_test "print ar3\(3,4:5,3\)" \ -+ "\\$\[0-9\]+ = \\(343, 353\\)" \ -+ "print ar3\(3,4:5,3\)" -+ -+gdb_test "print ar3\(2,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \ -+ "print ar3\(2,8:,7:8\)" -+gdb_test "print ar3\(2,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \ -+ "print ar3\(2,8:,8:\)" -+gdb_test "print ar3\(2,8:,:2\)"\ -+ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \ -+ "print ar3\(2,8:,:2\)" -+gdb_test "print ar3\(2,8:,3\)" \ -+ "\\$\[0-9\]+ = \\(283, 293\\)" \ -+ "print ar3\(2,8:,3\)" -+ -+gdb_test "print ar3\(2,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \ -+ "print ar3\(2,:2,7:8\)" -+gdb_test "print ar3\(2,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \ -+ "print ar3\(2,:2,8:\)" -+gdb_test "print ar3\(2,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \ -+ "print ar3\(2,:2,:2\)" -+gdb_test "print ar3\(2,:2,3\)" \ -+ "\\$\[0-9\]+ = \\(213, 223\\)" \ -+ "print ar3\(2,:2,3\)" -+ -+gdb_test "print ar3\(3,4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(347, 348\\)" \ -+ "print ar3\(3,4,7:8\)" -+gdb_test "print ar3\(3,4,8:\)" \ -+ "\\$\[0-9\]+ = \\(348, 349\\)" \ -+i "print ar3\(3,4,8:\)" -+gdb_test "print ar3\(3,4,:2\)" \ -+ "\\$\[0-9\]+ = \\(341, 342\\)" \ -+ "print ar3\(3,4,:2\)" -+gdb_test "print ar3\(5,6,7\)" \ -+ "\\$\[0-9\]+ = 567" \ -+ "print ar3\(5,6,7\)" -+ -+gdb_test "print ar3\(3:4,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \ -+ "print ar3\(3:4,6,7:8\)" -+gdb_test "print ar3\(3:4,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \ -+ "print ar3\(3:4,6,8:\)" -+gdb_test "print ar3\(3:4,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \ -+ "print ar3\(3:4,6,:2\)" -+gdb_test "print ar3\(3:4,6,5\)" \ -+ "\\$\[0-9\]+ = \\(365, 465\\)" \ -+ "print ar3\(3:4,6,5\)" -+ -+gdb_test "print ar3\(8:,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \ -+ "print ar3\(8:,6,7:8\)" -+gdb_test "print ar3\(8:,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \ -+ "print ar3\(8:,6,8:\)" -+gdb_test "print ar3\(8:,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \ -+ "print ar3\(8:,6,:2\)" -+gdb_test "print ar3\(8:,6,5\)" \ -+ "\\$\[0-9\]+ = \\(865, 965\\)" \ -+ "print ar3\(8:,6,5\)" -+ -+gdb_test "print ar3\(:2,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \ -+ "print ar3\(:2,6,7:8\)" -+gdb_test "print ar3\(:2,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \ -+ "print ar3\(:2,6,8:\)" -+gdb_test "print ar3\(:2,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \ -+ "print ar3\(:2,6,:2\)" -+gdb_test "print ar3\(:2,6,5\)" \ -+ "\\$\[0-9\]+ = \\(165, 265\\)" \ -+ "print ar3\(:2,6,5\)" -+ -+gdb_test "print ar3\(3:4,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \ -+ "print ar2\(3:4,5:6,4\)" -+gdb_test "print ar3\(8:,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \ -+ "print ar2\(8:,5:6,4\)" -+gdb_test "print ar3\(:2,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \ -+ "print ar2\(:2,5:6,4\)" -+ -+# Stride > 1 -+gdb_test "print ar1\(2:6:2\)" \ -+ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \ -+ "print ar1\(2:6:2\)" -+gdb_test "print ar2\(2:6:2,3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \ -+ "print ar2\(2:6:2,3:4\)" -+gdb_test "print ar2\(2:6:2,3\)" \ -+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ -+ "print ar2\(2:6:2,3\)" -+gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\ -+ \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \ -+ "print ar3\(2:6:2,3:5:2,4:7:3\)" -+gdb_test "print ar3\(2:6:2,5,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\ -+ \\)" \ -+ "print ar3\(2:6:2,5,4:7:3\)" -+ -+# Stride < 0 -+gdb_test "print ar1\(8:2:-2\)" \ -+ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \ -+ "print ar1\(8:2:-2\)" -+gdb_test "print ar2\(8:2:-2,3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\ -+ \\)" \ -+ "print ar2\(8:2:-2,3:4\)" -+gdb_test "print ar2\(2:6:2,3\)" \ -+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ -+ "print ar2\(2:6:2,3\)" -+gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\ -+ \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \ -+ "print ar3\(2:3,7:3:-4,4:7:3\)" -+gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\ -+ \\)" \ -+ "print ar3\(2:6:2,5,7:4:-3\)" -+ -+# Tests with negative and mixed indices -+gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\ -+ \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\ -+ 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\ -+ 392, 492\\) \\) \\)" \ -+ "print ar4(2:4, -2:1, -15:-14)" -+ -+gdb_test "p ar4\(7,-6:2:3,-7\)" \ -+ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \ -+ "print ar4(7,-6:2:3,-7)" -+ -+gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\ -+ 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\ -+ 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\ -+ 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\ -+ 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\ -+ 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\ -+ \\)" \ -+ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)" -+ -+gdb_test "p ar4\(:,:,:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\ -+ 811, .*" \ -+ "print ar4(:,:,:)" -+ -+# Provoke error messages for bad user input -+gdb_test "print ar1\(0:4\)" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ -+ "print ar1\(0:4\)" -+gdb_test "print ar1\(8:12\)" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ -+ "print ar1\(8:12\)" -+gdb_test "print ar1\(8:2:\)" \ -+ "A syntax error in expression, near `\\)'." \ -+ "print ar1\(8:2:\)" -+gdb_test "print ar1\(8:2:2\)" \ -+ "Wrong value provided for stride and boundaries" \ -+ "print ar1\(8:2:2\)" -+gdb_test "print ar1\(2:8:-2\)" \ -+ "Wrong value provided for stride and boundaries" \ -+ "print ar1\(2:8:-2\)" -+gdb_test "print ar1\(2:7:0\)" \ -+ "Stride must not be 0" \ -+ "print ar1\(2:7:0\)" -+gdb_test "print ar1\(3:7\) = 42" \ -+ "Invalid cast." \ -+ "Assignment of value to subarray" -diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90 -new file mode 100644 -index 0000000..f22fcbe ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90 -@@ -0,0 +1,55 @@ -+! Copyright 2015 Free Software Foundation, Inc. -+! -+! Contributed by Intel Corp. -+! -+! 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 . -+ -+subroutine sub -+ integer, dimension(9) :: ar1 -+ integer, dimension(9,9) :: ar2 -+ integer, dimension(9,9,9) :: ar3 -+ integer, dimension(10,-7:3, -15:-5) :: ar4 -+ integer :: i,j,k -+ -+ ar1 = 1 -+ ar2 = 1 -+ ar3 = 1 -+ ar4 = 4 -+ -+ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...))) -+ do i = 1, 9, 1 -+ ar1(i) = i -+ do j = 1, 9, 1 -+ ar2(i,j) = i*10 + j -+ do k = 1, 9, 1 -+ ar3(i,j,k) = i*100 + j*10 + k -+ end do -+ end do -+ end do -+ -+ do i = 1, 10, 1 -+ do j = -7, 3, 1 -+ do k = -15, -5, 1 -+ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16) -+ end do -+ end do -+ end do -+ -+ ar1(1) = 11 !BP1 -+ return -+end -+ -+program testprog -+ call sub -+end -diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp -new file mode 100644 -index 0000000..dcf15e5 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp -@@ -0,0 +1,44 @@ -+# 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 . -+ -+standard_testfile ".f90" -+ -+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ -+ {debug f90 quiet}] } { -+ return -1 -+} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"] -+gdb_continue_to_breakpoint "re-reverse-elements" -+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \ -+ "print re-reverse-elements" -+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element" -+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element" -+ -+gdb_breakpoint [gdb_get_line_number "odd-elements"] -+gdb_continue_to_breakpoint "odd-elements" -+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements" -+gdb_test "print pvla(1)" " = 1" "print first odd-element" -+gdb_test "print pvla(5)" " = 9" "print last odd-element" -+ -+gdb_breakpoint [gdb_get_line_number "single-element"] -+gdb_continue_to_breakpoint "single-element" -+gdb_test "print pvla" " = \\\(5\\\)" "print single-element" -+gdb_test "print pvla(1)" " = 5" "print one single-element" -diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90 -new file mode 100644 -index 0000000..eb0274c ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90 -@@ -0,0 +1,29 @@ -+! 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 . -+ -+program vla_stride -+ integer, target, allocatable :: vla (:) -+ integer, pointer :: pvla (:) -+ -+ allocate(vla(10)) -+ vla = (/ (I, I = 1,10) /) -+ -+ pvla => vla(10:1:-1) -+ pvla => pvla(10:1:-1) -+ pvla => vla(1:10:2) ! re-reverse-elements -+ pvla => vla(5:4:-2) ! odd-elements -+ -+ pvla => null() ! single-element -+end program vla_stride -diff --git a/gdb/valarith.c b/gdb/valarith.c -index de6fcfd..9093969 100644 ---- a/gdb/valarith.c -+++ b/gdb/valarith.c -@@ -193,9 +193,21 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) - struct type *array_type = check_typedef (value_type (array)); - struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); - ULONGEST elt_size = type_length_units (elt_type); -- ULONGEST elt_offs = elt_size * (index - lowerbound); -+ ULONGEST elt_offs = index - lowerbound; -+ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type)); - struct value *v; - -+ if (elt_stride > 0) -+ elt_offs *= elt_stride; -+ else if (elt_stride < 0) -+ { -+ int offs = (elt_offs + 1) * elt_stride; -+ -+ elt_offs = TYPE_LENGTH (array_type) + offs; -+ } -+ else -+ elt_offs *= elt_size; -+ - if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) - && elt_offs >= type_length_units (array_type))) - { -diff --git a/gdb/valops.c b/gdb/valops.c -index 40392e8..24ffacb 100644 ---- a/gdb/valops.c -+++ b/gdb/valops.c -@@ -3775,56 +3775,191 @@ value_of_this_silent (const struct language_defn *lang) - struct value * - value_slice (struct value *array, int lowbound, int length) - { -+ /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride -+ value of '1', which returns every element between LOWBOUND and -+ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1' -+ as we are only considering the highest dimension, or we are -+ working on a one dimensional array. So we call VALUE_SLICE_1 -+ exactly once. */ -+ return value_slice_1 (array, lowbound, length, 1, 1); -+} -+ -+/* VALUE_SLICE_1 is called for each array dimension to calculate the number -+ of elements as defined by the subscript expression. -+ CALL_COUNT is used to determine if we are calling the function once, e.g. -+ we are working on the current dimension of ARRAY, or if we are calling -+ the function repeatedly. In the later case we need to take elements -+ from the TARGET_TYPE of ARRAY. -+ With a CALL_COUNT greater than 1 we calculate the offsets for every element -+ that should be in the result array. Then we fetch the contents and then -+ copy them into the result array. The result array will have one dimension -+ less than the input array, so later on we need to recreate the indices and -+ ranges in the calling function. */ -+ -+struct value * -+value_slice_1 (struct value *array, int lowbound, int length, -+ int stride_length, int call_count) -+{ - struct type *slice_range_type, *slice_type, *range_type; -- LONGEST lowerbound, upperbound; -- struct value *slice; -- struct type *array_type; -+ struct type *array_type = check_typedef (value_type (array)); -+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); -+ unsigned int elt_size, elt_offs; -+ LONGEST ary_high_bound, ary_low_bound; -+ struct value *v; -+ int slice_range_size, i = 0, row_count = 1, elem_count = 1; - -- array_type = check_typedef (value_type (array)); -+ /* Check for legacy code if we are actually dealing with an array or -+ string. */ - if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY - && TYPE_CODE (array_type) != TYPE_CODE_STRING) - error (_("cannot take slice of non-array")); - -- range_type = TYPE_INDEX_TYPE (array_type); -- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) -- error (_("slice from bad array or bitstring")); -+ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type)); -+ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type)); -+ -+ /* When we are working on a multi-dimensional array, we need to get the -+ attributes of the underlying type. */ -+ if (call_count > 1) -+ { -+ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type)); -+ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type)); -+ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); -+ row_count = TYPE_LENGTH (array_type) -+ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); -+ } -+ -+ /* With a stride of '1', the number of elements per result row is equal to -+ the LENGTH of the subarray. With non-default stride values, we skip -+ elements, but have to add the start element to the total number of -+ elements per row. */ -+ if (stride_length == 1) -+ elem_count = length; -+ else -+ elem_count = ((length - 1) / stride_length) + 1; -+ -+ elt_size = TYPE_LENGTH (elt_type); -+ elt_offs = lowbound - ary_low_bound; - -- if (lowbound < lowerbound || length < 0 -- || lowbound + length - 1 > upperbound) -- error (_("slice out of range")); -+ elt_offs *= elt_size; -+ -+ /* Check for valid user input. In case of Fortran this was already done -+ in the calling function. */ -+ if (call_count == 1 -+ && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) -+ && elt_offs >= TYPE_LENGTH (array_type))) -+ error (_("no such vector element")); -+ -+ /* CALL_COUNT is 1 when we are dealing either with the highest dimension -+ of the array, or a one dimensional array. Set RANGE_TYPE accordingly. -+ In both cases we calculate how many rows/elements will be in the output -+ array by setting slice_range_size. */ -+ if (call_count == 1) -+ { -+ range_type = TYPE_INDEX_TYPE (array_type); -+ slice_range_size = ary_low_bound + elem_count - 1; -+ -+ /* Check if the array bounds are valid. */ -+ if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0) -+ error (_("slice from bad array or bitstring")); -+ } -+ /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays. -+ So we need to get the type below the current one and set the RANGE_TYPE -+ accordingly. */ -+ else -+ { -+ range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type)); -+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1; -+ ary_low_bound = TYPE_LOW_BOUND (range_type); -+ } - - /* FIXME-type-allocation: need a way to free this type when we are -- done with it. */ -- slice_range_type = create_static_range_type ((struct type *) NULL, -- TYPE_TARGET_TYPE (range_type), -- lowbound, -- lowbound + length - 1); -+ done with it. */ - -+ slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type), -+ ary_low_bound, slice_range_size); - { -- struct type *element_type = TYPE_TARGET_TYPE (array_type); -- LONGEST offset -- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type)); -+ struct type *element_type; -+ -+ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy -+ code for subarrays. */ -+ if (call_count == 1 && stride_length == 1) -+ { -+ element_type = TYPE_TARGET_TYPE (array_type); -+ -+ slice_type = create_array_type (NULL, element_type, slice_range_type); - -- slice_type = create_array_type ((struct type *) NULL, -- element_type, -- slice_range_type); -- TYPE_CODE (slice_type) = TYPE_CODE (array_type); -+ TYPE_CODE (slice_type) = TYPE_CODE (array_type); - -- if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) -- slice = allocate_value_lazy (slice_type); -+ if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) -+ v = allocate_value_lazy (slice_type); -+ else -+ { -+ v = allocate_value (slice_type); -+ value_contents_copy (v, -+ value_embedded_offset (v), -+ array, -+ value_embedded_offset (array) + elt_offs, -+ elt_size * longest_to_int (length)); -+ } -+ -+ } -+ /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working -+ on a range of ranges. So we copy the relevant elements into the -+ new array we return. */ - else - { -- slice = allocate_value (slice_type); -- value_contents_copy (slice, 0, array, offset, -- type_length_units (slice_type)); -+ int j, offs_store = elt_offs; -+ LONGEST dst_offset = 0; -+ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); -+ -+ if (call_count == 1) -+ { -+ /* When CALL_COUNT is equal to 1 we are working on the current range -+ and use these elements directly. */ -+ element_type = TYPE_TARGET_TYPE (array_type); -+ } -+ else -+ { -+ /* Working on an array of arrays, the type of the elements is the type -+ of the subarrays' type. */ -+ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); -+ } -+ -+ slice_type = create_array_type (NULL, element_type, slice_range_type); -+ -+ /* If we have a one dimensional array, we copy its TYPE_CODE. For a -+ multi dimensional array we copy the embedded type's TYPE_CODE. */ -+ if (call_count == 1) -+ TYPE_CODE (slice_type) = TYPE_CODE (array_type); -+ else -+ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type)); -+ -+ v = allocate_value (slice_type); -+ -+ /* Iterate through the rows of the outer array and set the new offset -+ for each row. */ -+ for (i = 0; i < row_count; i++) -+ { -+ elt_offs = offs_store + i * src_row_length; -+ -+ /* Iterate through the elements in each row to copy only those. */ -+ for (j = 1; j <= elem_count; j++) -+ { -+ /* Fetches the contents of ARRAY and copies them into V. */ -+ value_contents_copy (v, dst_offset, array, elt_offs, elt_size); -+ elt_offs += elt_size * stride_length; -+ dst_offset += elt_size; -+ } -+ } - } - -- set_value_component_location (slice, array); -- VALUE_FRAME_ID (slice) = VALUE_FRAME_ID (array); -- set_value_offset (slice, value_offset (array) + offset); -+ set_value_component_location (v, array); -+ VALUE_REGNUM (v) = VALUE_REGNUM (array); -+ VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array); -+ set_value_offset (v, value_offset (array) + elt_offs); - } - -- return slice; -+ return v; - } - - /* Create a value for a FORTRAN complex number. Currently most of the -diff --git a/gdb/value.h b/gdb/value.h -index 0b417b4..9c37713 100644 ---- a/gdb/value.h -+++ b/gdb/value.h -@@ -1057,6 +1057,8 @@ extern struct value *varying_to_slice (struct value *); - - extern struct value *value_slice (struct value *, int, int); - -+extern struct value *value_slice_1 (struct value *, int, int, int, int); -+ - extern struct value *value_literal_complex (struct value *, struct value *, - struct type *); - diff --git a/gdb-vla-intel-fortran-strides.patch b/gdb-vla-intel-fortran-strides.patch new file mode 100644 index 0000000..0479200 --- /dev/null +++ b/gdb-vla-intel-fortran-strides.patch @@ -0,0 +1,1977 @@ +git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides +dbfd7140bf4c0500d1f5d192be781f83f78f7922 + + gdb/dwarf2loc.c | 46 ++- + gdb/dwarf2loc.h | 6 + + gdb/dwarf2read.c | 13 +- + gdb/eval.c | 391 +++++++++++++++++++++----- + gdb/expprint.c | 20 +- + gdb/expression.h | 18 +- + gdb/f-exp.y | 42 ++- + gdb/f-valprint.c | 8 +- + gdb/gdbtypes.c | 34 ++- + gdb/gdbtypes.h | 18 +- + gdb/parse.c | 24 +- + gdb/rust-exp.y | 12 +- + gdb/rust-lang.c | 17 +- + gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++ + 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.f90 | 29 ++ + gdb/testsuite/gdb.fortran/vla.f90 | 10 + + gdb/valarith.c | 10 +- + gdb/valops.c | 197 +++++++++++-- + gdb/value.h | 2 + + 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 +index 6658a38..a1ac659 100644 +--- a/gdb/dwarf2read.c ++++ b/gdb/dwarf2read.c +@@ -14952,7 +14952,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + struct type *base_type, *orig_base_type; + struct type *range_type; + struct attribute *attr; +- struct dynamic_prop low, high; ++ struct dynamic_prop low, high, stride; + int low_default_is_valid; + int high_bound_is_count = 0; + const char *name; +@@ -14972,7 +14972,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + + low.kind = PROP_CONST; + high.kind = PROP_CONST; ++ stride.kind = PROP_CONST; + high.data.const_val = 0; ++ stride.data.const_val = 0; + + /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow + omitting DW_AT_lower_bound. */ +@@ -15006,6 +15008,13 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + break; + } + ++ attr = dwarf2_attr (die, DW_AT_byte_stride, cu); ++ if (attr) ++ if (!attr_to_dynamic_prop (attr, die, cu, &stride)) ++ complaint (&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); +@@ -15082,7 +15091,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask)) + high.data.const_val |= negative_mask; + +- range_type = create_range_type (NULL, orig_base_type, &low, &high); ++ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride); + + if (high_bound_is_count) + TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1; +diff --git a/gdb/eval.c b/gdb/eval.c +index 00a107c..91d8a03 100644 +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -399,29 +399,325 @@ init_array_element (struct value *array, struct value *element, + return index; + } + ++/* Evaluates any operation on Fortran arrays or strings with at least ++ one user provided parameter. Expects the input ARRAY to be either ++ an array, or a string. Evaluates EXP by incrementing POS, and ++ writes the content from the elt stack into a local struct. NARGS ++ specifies number of literal or range arguments the user provided. ++ NARGS must be the same number as ARRAY has dimensions. */ ++ + static struct value * +-value_f90_subarray (struct value *array, +- struct expression *exp, int *pos, enum noside noside) ++value_f90_subarray (struct value *array, struct expression *exp, ++ int *pos, int nargs, enum noside noside) + { +- int pc = (*pos) + 1; ++ int i, dim_count = 0; + LONGEST low_bound, high_bound; +- struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array))); +- enum range_type range_type +- = (enum range_type) longest_to_int (exp->elts[pc].longconst); +- +- *pos += 3; +- +- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- low_bound = TYPE_LOW_BOUND (range); +- else +- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ struct value *new_array = array; ++ struct type *array_type = check_typedef (value_type (new_array)); ++ struct type *elt_type; ++ ++ typedef struct subscript_range ++ { ++ enum range_type f90_range_type; ++ LONGEST low, high, stride; ++ } subscript_range; ++ ++ typedef enum subscript_kind ++ { ++ SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */ ++ SUBSCRIPT_INDEX /* e.g. "(literal)" */ ++ } kind; ++ ++ /* Local struct to hold user data for Fortran subarray dimensions. */ ++ struct subscript_store ++ { ++ /* For every dimension, we are either working on a range or an index ++ expression, so we store this info separately for later. */ ++ enum subscript_kind kind; ++ ++ /* We also store either the lower and upper bound info, or the index ++ number. Before evaluation of the input values, we do not know if we are ++ actually working on a range of ranges, or an index in a range. So as a ++ first step we store all input in a union. The array calculation itself ++ deals with this later on. */ ++ union element_range ++ { ++ subscript_range range; ++ LONGEST number; ++ } U; ++ } *subscript_array; ++ ++ /* Check if the number of arguments provided by the user matches ++ the number of dimension of the array. A string has only one ++ dimension. */ ++ if (nargs != calc_f77_array_dims (value_type (new_array))) ++ error (_("Wrong number of subscripts")); ++ ++ subscript_array = (struct subscript_store*) alloca (sizeof (*subscript_array) * nargs); ++ ++ /* Parse the user input into the SUBSCRIPT_ARRAY to store it. We need ++ to evaluate it first, as the input is from left-to-right. The ++ array is stored from right-to-left. So we have to use the user ++ input in reverse order. Later on, we need the input information to ++ re-calculate the output array. For multi-dimensional arrays, we ++ can be dealing with any possible combination of ranges and indices ++ for every dimension. */ ++ for (i = 0; i < nargs; i++) ++ { ++ struct subscript_store *index = &subscript_array[i]; + +- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- high_bound = TYPE_HIGH_BOUND (range); +- else +- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ /* The user input is a range, with or without lower and upper bound. ++ E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */ ++ if (exp->elts[*pos].opcode == OP_RANGE) ++ { ++ int pc = (*pos) + 1; ++ subscript_range *range; ++ ++ index->kind = SUBSCRIPT_RANGE; ++ range = &index->U.range; ++ ++ *pos += 3; ++ range->f90_range_type = (enum range_type) exp->elts[pc].longconst; ++ ++ /* If a lower bound was provided by the user, the bit has been ++ set and we can assign the value from the elt stack. Same for ++ upper bound. */ ++ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) ++ == SUBARRAY_LOW_BOUND) ++ range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) ++ == SUBARRAY_HIGH_BOUND) ++ range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ ++ /* Assign the user's stride value if provided. */ ++ if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) ++ range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ ++ /* Assign the default stride value '1'. */ ++ else ++ range->stride = 1; ++ ++ /* Check the provided stride value is illegal, aka '0'. */ ++ if (range->stride == 0) ++ error (_("Stride must not be 0")); ++ } ++ /* User input is an index. E.g.: "p arry(5)". */ ++ else ++ { ++ struct value *val; ++ ++ index->kind = SUBSCRIPT_INDEX; ++ ++ /* Evaluate each subscript; it must be a legal integer in F77. This ++ ensures the validity of the provided index. */ ++ val = evaluate_subexp_with_coercion (exp, pos, noside); ++ index->U.number = value_as_long (val); ++ } ++ ++ } ++ ++ /* Traverse the array from right to left and set the high and low bounds ++ for later use. */ ++ for (i = nargs - 1; i >= 0; i--) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ struct type *index_type = TYPE_INDEX_TYPE (array_type); ++ ++ switch (index->kind) ++ { ++ case SUBSCRIPT_RANGE: ++ { ++ ++ /* When we hit the first range specified by the user, we must ++ treat any subsequent user entry as a range. We simply ++ increment DIM_COUNT which tells us how many times we are ++ calling VALUE_SLICE_1. */ ++ subscript_range *range = &index->U.range; ++ ++ /* If no lower bound was provided by the user, we take the ++ default boundary. Same for the high bound. */ ++ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0) ++ range->low = TYPE_LOW_BOUND (index_type); ++ ++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0) ++ range->high = TYPE_HIGH_BOUND (index_type); ++ ++ /* Both user provided low and high bound have to be inside the ++ array bounds. Throw an error if not. */ ++ if (range->low < TYPE_LOW_BOUND (index_type) ++ || range->low > TYPE_HIGH_BOUND (index_type) ++ || range->high < TYPE_LOW_BOUND (index_type) ++ || range->high > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ /* For a negative stride the lower boundary must be larger than the ++ upper boundary. ++ For a positive stride the lower boundary must be smaller than the ++ upper boundary. */ ++ if ((range->stride < 0 && range->low < range->high) ++ || (range->stride > 0 && range->low > range->high)) ++ error (_("Wrong value provided for stride and boundaries")); ++ ++ } ++ break; ++ ++ case SUBSCRIPT_INDEX: ++ break; ++ ++ } ++ ++ array_type = TYPE_TARGET_TYPE (array_type); ++ } ++ ++ /* Reset ARRAY_TYPE before slicing.*/ ++ array_type = check_typedef (value_type (new_array)); ++ ++ /* Traverse the array from right to left and evaluate each corresponding ++ user input. VALUE_SUBSCRIPT is called for every index, until a range ++ expression is evaluated. After a range expression has been evaluated, ++ every subsequent expression is also treated as a range. */ ++ for (i = nargs - 1; i >= 0; i--) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ struct type *index_type = TYPE_INDEX_TYPE (array_type); ++ ++ switch (index->kind) ++ { ++ case SUBSCRIPT_RANGE: ++ { ++ ++ /* When we hit the first range specified by the user, we must ++ treat any subsequent user entry as a range. We simply ++ increment DIM_COUNT which tells us how many times we are ++ calling VALUE_SLICE_1. */ ++ subscript_range *range = &index->U.range; ++ ++ /* DIM_COUNT counts every user argument that is treated as a range. ++ This is necessary for expressions like 'print array(7, 8:9). ++ Here the first argument is a literal, but must be treated as a ++ range argument to allow the correct output representation. */ ++ dim_count++; ++ ++ new_array ++ = value_slice_1 (new_array, range->low, ++ range->high - range->low + 1, ++ range->stride, dim_count); ++ } ++ break; ++ ++ case SUBSCRIPT_INDEX: ++ { ++ /* DIM_COUNT only stays '0' when no range argument was processed ++ before, starting from the last dimension. This way we can ++ reduce the number of dimensions from the result array. ++ However, if a range has been processed before an index, we ++ treat the index like a range with equal low- and high bounds ++ to get the value offset right. */ ++ if (dim_count == 0) ++ new_array ++ = value_subscripted_rvalue (new_array, index->U.number, ++ f77_get_lowerbound (value_type ++ (new_array))); ++ else ++ { ++ dim_count++; ++ ++ /* We might end up here, because we have to treat the provided ++ index like a range. But now VALUE_SUBSCRIPTED_RVALUE ++ cannot do the range checks for us. So we have to make sure ++ ourselves that the user provided index is inside the ++ array bounds. Throw an error if not. */ ++ if (index->U.number < TYPE_LOW_BOUND (index_type) ++ && index->U.number > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ if (index->U.number > TYPE_LOW_BOUND (index_type) ++ && index->U.number > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ new_array = value_slice_1 (new_array, ++ index->U.number, ++ 1, /* COUNT is '1' element */ ++ 1, /* STRIDE set to '1' */ ++ dim_count); ++ } ++ ++ } ++ break; ++ } ++ array_type = TYPE_TARGET_TYPE (array_type); ++ } ++ ++ /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect ++ an array of arrays, depending on how many ranges have been provided by ++ the user. So we need to rebuild the array dimensions for printing it ++ correctly. ++ Starting from right to left in the user input, after we hit the first ++ range argument every subsequent argument is also treated as a range. ++ E.g.: ++ "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3 ++ ranges. ++ "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2 ++ ranges. ++ "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1 ++ range. */ ++ if (dim_count > 1) ++ { ++ struct value *v = NULL; ++ ++ elt_type = TYPE_TARGET_TYPE (value_type (new_array)); ++ ++ /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in ++ the output array. So we traverse the SUBSCRIPT_ARRAY again, looking ++ for a range entry. When we find one, we use the range info to create ++ an additional range_type to set the correct bounds and dimensions for ++ the output array. In addition, we may have a stride value that is not ++ '1', forcing us to adjust the number of elements in a range, according ++ to the stride value. */ ++ for (i = 0; i < nargs; i++) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ ++ if (index->kind == SUBSCRIPT_RANGE) ++ { ++ struct type *range_type, *interim_array_type; ++ ++ int new_length; + +- return value_slice (array, low_bound, high_bound - low_bound + 1); ++ /* The length of a sub-dimension with all elements between the ++ bounds plus the start element itself. It may be modified by ++ a user provided stride value. */ ++ new_length = index->U.range.high - index->U.range.low; ++ ++ new_length /= index->U.range.stride; ++ ++ range_type ++ = create_static_range_type (NULL, ++ elt_type, ++ index->U.range.low, ++ index->U.range.low + new_length); ++ ++ interim_array_type = create_array_type (NULL, ++ elt_type, ++ range_type); ++ ++ TYPE_CODE (interim_array_type) ++ = TYPE_CODE (value_type (new_array)); ++ ++ v = allocate_value (interim_array_type); ++ ++ elt_type = value_type (v); ++ } ++ ++ } ++ value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type)); ++ return v; ++ } ++ ++ return new_array; + } + + +@@ -1810,19 +2106,8 @@ evaluate_subexp_standard (struct type *expect_type, + switch (code) + { + case TYPE_CODE_ARRAY: +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- goto multi_f77_subscript; +- + case TYPE_CODE_STRING: +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- { +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- return value_subscript (arg1, value_as_long (arg2)); +- } ++ return value_f90_subarray (arg1, exp, pos, nargs, noside); + + case TYPE_CODE_PTR: + case TYPE_CODE_FUNC: +@@ -2223,49 +2508,6 @@ evaluate_subexp_standard (struct type *expect_type, + } + return (arg1); + +- multi_f77_subscript: +- { +- LONGEST subscript_array[MAX_FORTRAN_DIMS]; +- int ndimensions = 1, i; +- struct value *array = arg1; +- +- if (nargs > MAX_FORTRAN_DIMS) +- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); +- +- ndimensions = calc_f77_array_dims (type); +- +- if (nargs != ndimensions) +- error (_("Wrong number of subscripts")); +- +- gdb_assert (nargs > 0); +- +- /* Now that we know we have a legal array subscript expression +- let us actually find out where this element exists in the array. */ +- +- /* Take array indices left to right. */ +- for (i = 0; i < nargs; i++) +- { +- /* Evaluate each subscript; it must be a legal integer in F77. */ +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- +- /* Fill in the subscript array. */ +- +- subscript_array[i] = value_as_long (arg2); +- } +- +- /* Internal type of array is arranged right to left. */ +- for (i = nargs; i > 0; i--) +- { +- struct type *array_type = check_typedef (value_type (array)); +- LONGEST index = subscript_array[i - 1]; +- +- array = value_subscripted_rvalue (array, index, +- f77_get_lowerbound (array_type)); +- } +- +- return array; +- } +- + case BINOP_LOGICAL_AND: + arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); + if (noside == EVAL_SKIP) +@@ -3123,6 +3365,9 @@ calc_f77_array_dims (struct type *array_type) + int ndimen = 1; + struct type *tmp_type; + ++ if (TYPE_CODE (array_type) == TYPE_CODE_STRING) ++ return 1; ++ + if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY)) + error (_("Can't get dimensions for a non-array type")); + +diff --git a/gdb/expprint.c b/gdb/expprint.c +index c37ecb0..214d58e 100644 +--- a/gdb/expprint.c ++++ b/gdb/expprint.c +@@ -568,12 +568,10 @@ print_subexp_standard (struct expression *exp, int *pos, + *pos += 2; + + fputs_filtered ("RANGE(", stream); +- if (range_type == HIGH_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered ("..", stream); +- if (range_type == LOW_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered (")", stream); + return; +@@ -1055,16 +1053,16 @@ dump_subexp_body_standard (struct expression *exp, + + switch (range_type) + { +- case BOTH_BOUND_DEFAULT: ++ case SUBARRAY_NONE_BOUND: + fputs_filtered ("Range '..'", stream); + break; +- case LOW_BOUND_DEFAULT: ++ case SUBARRAY_HIGH_BOUND: + fputs_filtered ("Range '..EXP'", stream); + break; +- case HIGH_BOUND_DEFAULT: ++ case SUBARRAY_LOW_BOUND: + fputs_filtered ("Range 'EXP..'", stream); + break; +- case NONE_BOUND_DEFAULT: ++ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND): + fputs_filtered ("Range 'EXP..EXP'", stream); + break; + default: +@@ -1072,11 +1070,9 @@ dump_subexp_body_standard (struct expression *exp, + break; + } + +- if (range_type == HIGH_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) + elt = dump_subexp (exp, stream, elt); +- if (range_type == LOW_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) + elt = dump_subexp (exp, stream, elt); + } + break; +diff --git a/gdb/expression.h b/gdb/expression.h +index 4952d84..34ca54b 100644 +--- a/gdb/expression.h ++++ b/gdb/expression.h +@@ -152,17 +152,17 @@ extern void dump_raw_expression (struct expression *, + struct ui_file *, char *); + extern void dump_prefix_expression (struct expression *, struct ui_file *); + +-/* In an OP_RANGE expression, either bound could be empty, indicating +- that its value is by default that of the corresponding bound of the +- array or string. So we have four sorts of subrange. This +- enumeration type is to identify this. */ +- ++/* In an OP_RANGE expression, either bound can be provided by the user, or not. ++ In addition to this, the user can also specify a stride value to indicated ++ only certain elements of the array. This enumeration type is to identify ++ this. */ ++ + enum range_type + { +- BOTH_BOUND_DEFAULT, /* "(:)" */ +- LOW_BOUND_DEFAULT, /* "(:high)" */ +- HIGH_BOUND_DEFAULT, /* "(low:)" */ +- NONE_BOUND_DEFAULT /* "(low:high)" */ ++ SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */ ++ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ ++ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */ ++ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */ + }; + + #endif /* !defined (EXPRESSION_H) */ +diff --git a/gdb/f-exp.y b/gdb/f-exp.y +index e3148a3..71f1823 100644 +--- a/gdb/f-exp.y ++++ b/gdb/f-exp.y +@@ -253,31 +253,63 @@ arglist : subrange + + arglist : arglist ',' exp %prec ABOVE_COMMA + { arglist_len++; } ++ | arglist ',' subrange %prec ABOVE_COMMA ++ { arglist_len++; } + ; + + /* There are four sorts of subrange types in F90. */ + + subrange: exp ':' exp %prec ABOVE_COMMA +- { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT); ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, ++ SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: exp ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++/* Each subrange type can have a stride argument. */ ++subrange: exp ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND ++ | SUBARRAY_HIGH_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: exp ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + +diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c +index 08215e2..e6eca6a 100644 +--- a/gdb/f-valprint.c ++++ b/gdb/f-valprint.c +@@ -121,8 +121,14 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type, + + if (nss != ndimensions) + { +- size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); ++ size_t dim_size; + size_t offs = 0; ++ LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); ++ ++ if (byte_stride) ++ dim_size = byte_stride; ++ else ++ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); + + for (i = lowerbound; + (i < upperbound + 1 && (*elts) < options->print_max); +diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c +index ec5c17a..eb83791 100644 +--- a/gdb/gdbtypes.c ++++ b/gdb/gdbtypes.c +@@ -836,7 +836,8 @@ allocate_stub_method (struct type *type) + struct type * + create_range_type (struct type *result_type, struct type *index_type, + const struct dynamic_prop *low_bound, +- const struct dynamic_prop *high_bound) ++ const struct dynamic_prop *high_bound, ++ const struct dynamic_prop *stride) + { + if (result_type == NULL) + result_type = alloc_type_copy (index_type); +@@ -851,6 +852,7 @@ create_range_type (struct type *result_type, struct type *index_type, + TYPE_ZALLOC (result_type, sizeof (struct range_bounds)); + TYPE_RANGE_DATA (result_type)->low = *low_bound; + TYPE_RANGE_DATA (result_type)->high = *high_bound; ++ TYPE_RANGE_DATA (result_type)->stride = *stride; + + if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0) + TYPE_UNSIGNED (result_type) = 1; +@@ -879,7 +881,7 @@ struct type * + create_static_range_type (struct type *result_type, struct type *index_type, + LONGEST low_bound, LONGEST high_bound) + { +- struct dynamic_prop low, high; ++ struct dynamic_prop low, high, stride; + + low.kind = PROP_CONST; + low.data.const_val = low_bound; +@@ -887,7 +889,11 @@ create_static_range_type (struct type *result_type, struct type *index_type, + high.kind = PROP_CONST; + high.data.const_val = high_bound; + +- result_type = create_range_type (result_type, index_type, &low, &high); ++ stride.kind = PROP_CONST; ++ stride.data.const_val = 0; ++ ++ result_type = create_range_type (result_type, index_type, ++ &low, &high, &stride); + + return result_type; + } +@@ -1084,16 +1090,20 @@ create_array_type_with_stride (struct type *result_type, + && (!type_not_associated (result_type) + && !type_not_allocated (result_type))) + { +- LONGEST low_bound, high_bound; ++ LONGEST low_bound, high_bound, byte_stride; + + if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) + low_bound = high_bound = 0; + element_type = check_typedef (element_type); ++ byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); ++ + /* Be careful when setting the array length. Ada arrays can be + empty arrays with the high_bound being smaller than the low_bound. + In such cases, the array length should be zero. */ + if (high_bound < low_bound) + TYPE_LENGTH (result_type) = 0; ++ else if (byte_stride > 0) ++ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1); + else if (bit_stride > 0) + TYPE_LENGTH (result_type) = + (bit_stride * (high_bound - low_bound + 1) + 7) / 8; +@@ -1888,12 +1898,12 @@ resolve_dynamic_range (struct type *dyn_range_type, + CORE_ADDR value; + struct type *static_range_type, *static_target_type; + const struct dynamic_prop *prop; +- struct dynamic_prop low_bound, high_bound; ++ struct dynamic_prop low_bound, high_bound, stride; + + gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); + + prop = &TYPE_RANGE_DATA (dyn_range_type)->low; +- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) ++ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1)) + { + low_bound.kind = PROP_CONST; + low_bound.data.const_val = value; +@@ -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; + } + ++ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride; ++ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1)) ++ { ++ stride.kind = PROP_CONST; ++ stride.data.const_val = value; ++ } ++ + static_target_type + = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type), + addr_stack, 0); + static_range_type = create_range_type (copy_type (dyn_range_type), + static_target_type, +- &low_bound, &high_bound); ++ &low_bound, &high_bound, &stride); ++ + TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; + return static_range_type; + } +diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h +index 2dda074..bcc9200 100644 +--- a/gdb/gdbtypes.h ++++ b/gdb/gdbtypes.h +@@ -577,6 +577,10 @@ struct range_bounds + + struct dynamic_prop high; + ++ /* * Stride of range. */ ++ ++ struct dynamic_prop stride; ++ + /* True if HIGH range bound contains the number of elements in the + subrange. This affects how the final hight bound is computed. */ + +@@ -739,7 +743,6 @@ struct main_type + /* * Union member used for range types. */ + + struct range_bounds *bounds; +- + } flds_bnds; + + /* * Slot to point to additional language-specific fields of this +@@ -1255,6 +1258,15 @@ extern void allocate_gnat_aux_type (struct type *); + TYPE_RANGE_DATA(range_type)->high.kind + #define TYPE_LOW_BOUND_KIND(range_type) \ + TYPE_RANGE_DATA(range_type)->low.kind ++#define TYPE_BYTE_STRIDE(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.const_val ++#define TYPE_BYTE_STRIDE_BLOCK(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.locexpr ++#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.loclist ++#define TYPE_BYTE_STRIDE_KIND(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.kind ++ + + /* Property accessors for the type data location. */ + #define TYPE_DATA_LOCATION(thistype) \ +@@ -1289,6 +1301,9 @@ extern void allocate_gnat_aux_type (struct type *); + TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) + #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ + TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) ++#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \ ++ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0) ++ + + #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ + (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype)))) +@@ -1783,6 +1798,7 @@ extern struct type *create_array_type_with_stride + + extern struct type *create_range_type (struct type *, struct type *, + const struct dynamic_prop *, ++ const struct dynamic_prop *, + const struct dynamic_prop *); + + extern struct type *create_array_type (struct type *, struct type *, +diff --git a/gdb/parse.c b/gdb/parse.c +index 2b00708..992af87 100644 +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -1006,22 +1006,20 @@ operator_length_standard (const struct expression *expr, int endpos, + + case OP_RANGE: + oplen = 3; ++ args = 0; + range_type = (enum range_type) + longest_to_int (expr->elts[endpos - 2].longconst); + +- switch (range_type) +- { +- case LOW_BOUND_DEFAULT: +- case HIGH_BOUND_DEFAULT: +- args = 1; +- break; +- case BOTH_BOUND_DEFAULT: +- args = 0; +- break; +- case NONE_BOUND_DEFAULT: +- args = 2; +- break; +- } ++ /* Increment the argument counter for each argument ++ provided by the user. */ ++ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) ++ args++; ++ ++ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) ++ args++; ++ ++ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) ++ args++; + + break; + +diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y +index aeb6058..b1b9633 100644 +--- a/gdb/rust-exp.y ++++ b/gdb/rust-exp.y +@@ -2429,23 +2429,17 @@ convert_ast_to_expression (struct parser_state *state, + + case OP_RANGE: + { +- enum range_type kind = BOTH_BOUND_DEFAULT; ++ enum range_type kind = SUBARRAY_NONE_BOUND; + + if (operation->left.op != NULL) + { + convert_ast_to_expression (state, operation->left.op, top); +- kind = HIGH_BOUND_DEFAULT; ++ kind = SUBARRAY_LOW_BOUND; + } + if (operation->right.op != NULL) + { + convert_ast_to_expression (state, operation->right.op, top); +- if (kind == BOTH_BOUND_DEFAULT) +- kind = LOW_BOUND_DEFAULT; +- else +- { +- gdb_assert (kind == HIGH_BOUND_DEFAULT); +- kind = NONE_BOUND_DEFAULT; +- } ++ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND); + } + write_exp_elt_opcode (state, OP_RANGE); + write_exp_elt_longcst (state, kind); +diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c +index 17b20c6..295002f 100644 +--- a/gdb/rust-lang.c ++++ b/gdb/rust-lang.c +@@ -1241,9 +1241,9 @@ rust_range (struct expression *exp, int *pos, enum noside noside) + kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst); + *pos += 3; + +- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT) ++ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) + low = evaluate_subexp (NULL_TYPE, exp, pos, noside); +- if (kind == LOW_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT) ++ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) + high = evaluate_subexp (NULL_TYPE, exp, pos, noside); + + if (noside == EVAL_SKIP) +@@ -1332,7 +1332,7 @@ rust_compute_range (struct type *type, struct value *range, + + *low = 0; + *high = 0; +- *kind = BOTH_BOUND_DEFAULT; ++ *kind = SUBARRAY_NONE_BOUND; + + if (TYPE_NFIELDS (type) == 0) + return; +@@ -1340,15 +1340,14 @@ rust_compute_range (struct type *type, struct value *range, + i = 0; + if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0) + { +- *kind = HIGH_BOUND_DEFAULT; ++ *kind = SUBARRAY_LOW_BOUND; + *low = value_as_long (value_field (range, 0)); + ++i; + } + if (TYPE_NFIELDS (type) > i + && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0) + { +- *kind = (*kind == BOTH_BOUND_DEFAULT +- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT); ++ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND); + *high = value_as_long (value_field (range, i)); + } + } +@@ -1363,7 +1362,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + struct type *rhstype; + LONGEST low, high_bound; + /* Initialized to appease the compiler. */ +- enum range_type kind = BOTH_BOUND_DEFAULT; ++ enum range_type kind = SUBARRAY_NONE_BOUND; + LONGEST high = 0; + int want_slice = 0; + +@@ -1425,7 +1424,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + error (_("Cannot subscript non-array type")); + + if (want_slice +- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT)) ++ && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND)) + low = low_bound; + if (low < 0) + error (_("Index less than zero")); +@@ -1443,7 +1442,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + CORE_ADDR addr; + struct value *addrval, *tem; + +- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT) ++ if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND) + high = high_bound; + if (high < 0) + error (_("High index less than zero")); +diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp +new file mode 100644 +index 0000000..cc9ecc0 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/static-arrays.exp +@@ -0,0 +1,421 @@ ++# Copyright 2015 Free Software Foundation, Inc. ++# ++# Contributed by Intel Corp. ++# ++# 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 . ++ ++standard_testfile static-arrays.f90 ++ ++if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "BP1"] ++gdb_continue_to_breakpoint "BP1" ".*BP1.*" ++ ++# Tests subarrays of one dimensional arrays with subrange variations ++gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ ++ "print ar1." ++gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \ ++ "print ar1\(4:7\)" ++gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \ ++ "print ar1\(8:\)" ++gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \ ++ "print ar1\(:3\)" ++gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ ++ "print ar1\(:\)" ++ ++# Check assignment ++gdb_test_no_output "set \$my_ary = ar1\(3:8\)" ++gdb_test "print \$my_ary" \ ++ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ ++ "Assignment of subarray to variable" ++gdb_test_no_output "set ar1\(5\) = 42" ++ gdb_test "print ar1\(3:8\)" \ ++ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \ ++ "print ar1\(3:8\) after assignment" ++gdb_test "print \$my_ary" \ ++ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ ++ "Assignment of subarray to variable after original array changed" ++ ++# Test for subarrays of one dimensional arrays with literals ++ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \ ++ "print ar1\(3\)" ++ ++# Tests for subranges of 2 dimensional arrays with subrange variations ++gdb_test "print ar2\(2:3, 3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \ ++ "print ar2\(2:3, 3:4\)." ++gdb_test "print ar2\(8:9,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:9,8:\)" ++gdb_test "print ar2\(8:9,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ ++ "print ar2\(8:9,:2\)" ++ ++gdb_test "print ar2\(8:,8:9\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:,8:9\)" ++gdb_test "print ar2\(8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:,8:\)" ++gdb_test "print ar2\(8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ ++ "print ar2\(8:,:2\)" ++ ++gdb_test "print ar2\(:2,2:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \ ++ "print ar2\(:2,2:3\)" ++gdb_test "print ar2\(:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \ ++ "print ar2\(:2,8:\)" ++gdb_test "print ar2\(:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \ ++ "print ar2\(:2,:2\)" ++ ++# Test subranges of 2 dimensional arrays with literals and subrange variations ++gdb_test "print ar2\(7, 3:6\)" \ ++ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \ ++ "print ar2\(7, 3:6\)" ++gdb_test "print ar2\(7,8:\)" \ ++ "\\$\[0-9\]+ = \\(78, 79\\)" \ ++ "print ar2\(7,8:\)" ++gdb_test "print ar2\(7,:2\)" \ ++ "\\$\[0-9\]+ = \\(71, 72\\)" \ ++ "print ar2\(7,:2\)" ++ ++gdb_test "print ar2\(7:8,4\)" \ ++ "\\$\[0-9\]+ = \\(74, 84\\)" \ ++ "print ar2(7:8,4\)" ++gdb_test "print ar2\(8:,4\)" \ ++ "\\$\[0-9\]+ = \\(84, 94\\)" \ ++ "print ar2\(8:,4\)" ++gdb_test "print ar2\(:2,4\)" \ ++ "\\$\[0-9\]+ = \\(14, 24\\)" \ ++ "print ar2\(:2,4\)" ++gdb_test "print ar2\(3,4\)" \ ++ "\\$\[0-9\]+ = 34" \ ++ "print ar2\(3,4\)" ++ ++# Test subarrays of 3 dimensional arrays with literals and subrange variations ++gdb_test "print ar3\(2:4,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\ ++ \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \ ++ "print ar3\(2:4,3:4,7:8\)" ++gdb_test "print ar3\(2:3,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\ ++ \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \ ++ "print ar3\(2:3,4:5,8:\)" ++gdb_test "print ar3\(2:3,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\ ++ \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \ ++ "print ar3\(2:3,4:5,:2\)" ++ ++gdb_test "print ar3\(2:3,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\ ++ \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \ ++ "print ar3\(2:3,8:,7:8\)" ++gdb_test "print ar3\(2:3,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\ ++ \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \ ++ "print ar3\(2:3,8:,8:\)" ++gdb_test "print ar3\(2:3,8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\ ++ \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \ ++ "print ar3\(2:3,8:,:2\)" ++ ++gdb_test "print ar3\(2:3,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\ ++ \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \ ++ "print ar3\(2:3,:2,7:8\)" ++gdb_test "print ar3\(2:3,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\ ++ \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \ ++ "print ar3\(2:3,:2,8:\)" ++gdb_test "print ar3\(2:3,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\ ++ \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \ ++ "print ar3\(2:3,:2,:2\)" ++ ++gdb_test "print ar3\(8:,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\ ++ \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \ ++ "print ar3\(8:,3:4,7:8\)" ++gdb_test "print ar3\(8:,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\ ++ \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \ ++ "print ar3\(8:,4:5,8:\)" ++gdb_test "print ar3\(8:,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\ ++ \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \ ++ "print ar3\(8:,4:5,:2\)" ++ ++gdb_test "print ar3\(8:,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\ ++ \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \ ++ "print ar3\(8:,8:,7:8\)" ++gdb_test "print ar3\(8:,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\ ++ \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \ ++ "print ar3\(8:,8:,8:\)" ++gdb_test "print ar3\(8:,8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\ ++ \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \ ++ "print ar3\(8:,8:,:2\)" ++ ++gdb_test "print ar3\(8:,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\ ++ \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \ ++ "print ar3\(8:,:2,7:8\)" ++gdb_test "print ar3\(8:,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\ ++ \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \ ++ "print ar3\(8:,:2,8:\)" ++gdb_test "print ar3\(8:,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\ ++ \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \ ++ "print ar3\(8:,:2,:2\)" ++ ++ ++gdb_test "print ar3\(:2,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\ ++ \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \ ++ "print ar3 \(:2,3:4,7:8\)." ++gdb_test "print ar3\(:2,3:4,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\ ++ \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \ ++ "print ar3\(:2,3:4,8:\)" ++gdb_test "print ar3\(:2,3:4,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\ ++ \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \ ++ "print ar3\(:2,3:4,:2\)" ++ ++gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\ ++ 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \ ++ "print ar3\(:2,8:,7:8\)" ++gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\ ++ 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \ ++ "print ar3\(:2,8:,8:\)" ++gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\ ++ 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \ ++ "print ar3\(:2,8:,:2\)" ++ ++gdb_test "print ar3\(:2,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\ ++ \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \ ++ "print ar3\(:2,:2,7:8\)" ++gdb_test "print ar3\(:2,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\ ++ \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \ ++ "print ar3\(:2,:2,8:\)" ++gdb_test "print ar3\(:2,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\ ++ \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \ ++ "print ar3\(:2,:2,:2\)" ++ ++#Tests for subarrays of 3 dimensional arrays with literals and subranges ++gdb_test "print ar3\(3,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \ ++ "print ar3\(3,3:4,7:8\)" ++gdb_test "print ar3\(3,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \ ++ "print ar3\(3,4:5,8:\)" ++gdb_test "print ar3\(3,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \ ++ "print ar3\(3,4:5,:2\)" ++gdb_test "print ar3\(3,4:5,3\)" \ ++ "\\$\[0-9\]+ = \\(343, 353\\)" \ ++ "print ar3\(3,4:5,3\)" ++ ++gdb_test "print ar3\(2,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \ ++ "print ar3\(2,8:,7:8\)" ++gdb_test "print ar3\(2,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \ ++ "print ar3\(2,8:,8:\)" ++gdb_test "print ar3\(2,8:,:2\)"\ ++ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \ ++ "print ar3\(2,8:,:2\)" ++gdb_test "print ar3\(2,8:,3\)" \ ++ "\\$\[0-9\]+ = \\(283, 293\\)" \ ++ "print ar3\(2,8:,3\)" ++ ++gdb_test "print ar3\(2,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \ ++ "print ar3\(2,:2,7:8\)" ++gdb_test "print ar3\(2,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \ ++ "print ar3\(2,:2,8:\)" ++gdb_test "print ar3\(2,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \ ++ "print ar3\(2,:2,:2\)" ++gdb_test "print ar3\(2,:2,3\)" \ ++ "\\$\[0-9\]+ = \\(213, 223\\)" \ ++ "print ar3\(2,:2,3\)" ++ ++gdb_test "print ar3\(3,4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(347, 348\\)" \ ++ "print ar3\(3,4,7:8\)" ++gdb_test "print ar3\(3,4,8:\)" \ ++ "\\$\[0-9\]+ = \\(348, 349\\)" \ ++i "print ar3\(3,4,8:\)" ++gdb_test "print ar3\(3,4,:2\)" \ ++ "\\$\[0-9\]+ = \\(341, 342\\)" \ ++ "print ar3\(3,4,:2\)" ++gdb_test "print ar3\(5,6,7\)" \ ++ "\\$\[0-9\]+ = 567" \ ++ "print ar3\(5,6,7\)" ++ ++gdb_test "print ar3\(3:4,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \ ++ "print ar3\(3:4,6,7:8\)" ++gdb_test "print ar3\(3:4,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \ ++ "print ar3\(3:4,6,8:\)" ++gdb_test "print ar3\(3:4,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \ ++ "print ar3\(3:4,6,:2\)" ++gdb_test "print ar3\(3:4,6,5\)" \ ++ "\\$\[0-9\]+ = \\(365, 465\\)" \ ++ "print ar3\(3:4,6,5\)" ++ ++gdb_test "print ar3\(8:,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \ ++ "print ar3\(8:,6,7:8\)" ++gdb_test "print ar3\(8:,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \ ++ "print ar3\(8:,6,8:\)" ++gdb_test "print ar3\(8:,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \ ++ "print ar3\(8:,6,:2\)" ++gdb_test "print ar3\(8:,6,5\)" \ ++ "\\$\[0-9\]+ = \\(865, 965\\)" \ ++ "print ar3\(8:,6,5\)" ++ ++gdb_test "print ar3\(:2,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \ ++ "print ar3\(:2,6,7:8\)" ++gdb_test "print ar3\(:2,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \ ++ "print ar3\(:2,6,8:\)" ++gdb_test "print ar3\(:2,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \ ++ "print ar3\(:2,6,:2\)" ++gdb_test "print ar3\(:2,6,5\)" \ ++ "\\$\[0-9\]+ = \\(165, 265\\)" \ ++ "print ar3\(:2,6,5\)" ++ ++gdb_test "print ar3\(3:4,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \ ++ "print ar2\(3:4,5:6,4\)" ++gdb_test "print ar3\(8:,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \ ++ "print ar2\(8:,5:6,4\)" ++gdb_test "print ar3\(:2,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \ ++ "print ar2\(:2,5:6,4\)" ++ ++# Stride > 1 ++gdb_test "print ar1\(2:6:2\)" \ ++ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \ ++ "print ar1\(2:6:2\)" ++gdb_test "print ar2\(2:6:2,3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \ ++ "print ar2\(2:6:2,3:4\)" ++gdb_test "print ar2\(2:6:2,3\)" \ ++ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ ++ "print ar2\(2:6:2,3\)" ++gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\ ++ \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \ ++ "print ar3\(2:6:2,3:5:2,4:7:3\)" ++gdb_test "print ar3\(2:6:2,5,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\ ++ \\)" \ ++ "print ar3\(2:6:2,5,4:7:3\)" ++ ++# Stride < 0 ++gdb_test "print ar1\(8:2:-2\)" \ ++ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \ ++ "print ar1\(8:2:-2\)" ++gdb_test "print ar2\(8:2:-2,3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\ ++ \\)" \ ++ "print ar2\(8:2:-2,3:4\)" ++gdb_test "print ar2\(2:6:2,3\)" \ ++ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ ++ "print ar2\(2:6:2,3\)" ++gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\ ++ \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \ ++ "print ar3\(2:3,7:3:-4,4:7:3\)" ++gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\ ++ \\)" \ ++ "print ar3\(2:6:2,5,7:4:-3\)" ++ ++# Tests with negative and mixed indices ++gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\ ++ \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\ ++ 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\ ++ 392, 492\\) \\) \\)" \ ++ "print ar4(2:4, -2:1, -15:-14)" ++ ++gdb_test "p ar4\(7,-6:2:3,-7\)" \ ++ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \ ++ "print ar4(7,-6:2:3,-7)" ++ ++gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\ ++ 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\ ++ 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\ ++ 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\ ++ 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\ ++ 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\ ++ \\)" \ ++ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)" ++ ++gdb_test "p ar4\(:,:,:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\ ++ 811, .*" \ ++ "print ar4(:,:,:)" ++ ++# Provoke error messages for bad user input ++gdb_test "print ar1\(0:4\)" \ ++ "provided bound\\(s\\) outside array bound\\(s\\)" \ ++ "print ar1\(0:4\)" ++gdb_test "print ar1\(8:12\)" \ ++ "provided bound\\(s\\) outside array bound\\(s\\)" \ ++ "print ar1\(8:12\)" ++gdb_test "print ar1\(8:2:\)" \ ++ "A syntax error in expression, near `\\)'." \ ++ "print ar1\(8:2:\)" ++gdb_test "print ar1\(8:2:2\)" \ ++ "Wrong value provided for stride and boundaries" \ ++ "print ar1\(8:2:2\)" ++gdb_test "print ar1\(2:8:-2\)" \ ++ "Wrong value provided for stride and boundaries" \ ++ "print ar1\(2:8:-2\)" ++gdb_test "print ar1\(2:7:0\)" \ ++ "Stride must not be 0" \ ++ "print ar1\(2:7:0\)" ++gdb_test "print ar1\(3:7\) = 42" \ ++ "Invalid cast." \ ++ "Assignment of value to subarray" +diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90 +new file mode 100644 +index 0000000..f22fcbe +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/static-arrays.f90 +@@ -0,0 +1,55 @@ ++! Copyright 2015 Free Software Foundation, Inc. ++! ++! Contributed by Intel Corp. ++! ++! 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 . ++ ++subroutine sub ++ integer, dimension(9) :: ar1 ++ integer, dimension(9,9) :: ar2 ++ integer, dimension(9,9,9) :: ar3 ++ integer, dimension(10,-7:3, -15:-5) :: ar4 ++ integer :: i,j,k ++ ++ ar1 = 1 ++ ar2 = 1 ++ ar3 = 1 ++ ar4 = 4 ++ ++ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...))) ++ do i = 1, 9, 1 ++ ar1(i) = i ++ do j = 1, 9, 1 ++ ar2(i,j) = i*10 + j ++ do k = 1, 9, 1 ++ ar3(i,j,k) = i*100 + j*10 + k ++ end do ++ end do ++ end do ++ ++ do i = 1, 10, 1 ++ do j = -7, 3, 1 ++ do k = -15, -5, 1 ++ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16) ++ end do ++ end do ++ end do ++ ++ ar1(1) = 11 !BP1 ++ return ++end ++ ++program testprog ++ call sub ++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 = " "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 +new file mode 100644 +index 0000000..dcf15e5 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-stride.exp +@@ -0,0 +1,44 @@ ++# 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 . ++ ++standard_testfile ".f90" ++ ++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ ++ {debug f90 quiet}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "re-reverse-elements"] ++gdb_continue_to_breakpoint "re-reverse-elements" ++gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \ ++ "print re-reverse-elements" ++gdb_test "print pvla(1)" " = 1" "print first re-reverse-element" ++gdb_test "print pvla(10)" " = 10" "print last re-reverse-element" ++ ++gdb_breakpoint [gdb_get_line_number "odd-elements"] ++gdb_continue_to_breakpoint "odd-elements" ++gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements" ++gdb_test "print pvla(1)" " = 1" "print first odd-element" ++gdb_test "print pvla(5)" " = 9" "print last odd-element" ++ ++gdb_breakpoint [gdb_get_line_number "single-element"] ++gdb_continue_to_breakpoint "single-element" ++gdb_test "print pvla" " = \\\(5\\\)" "print single-element" ++gdb_test "print pvla(1)" " = 5" "print one single-element" +diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90 +new file mode 100644 +index 0000000..8d24252 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-stride.f90 +@@ -0,0 +1,29 @@ ++! 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 . ++ ++program vla_stride ++ integer, target, allocatable :: vla (:) ++ integer, pointer :: pvla (:) ++ ++ allocate(vla(10)) ++ vla = (/ (I, I = 1,10) /) ++ ++ pvla => vla(10:1:-1) ++ pvla => pvla(10:1:-1) ++ pvla => vla(1:10:2) ! re-reverse-elements ++ pvla => vla(5:4:-2) ! odd-elements ++ ++ pvla => null() ! single-element ++end program vla_stride +diff --git a/gdb/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 +index de6fcfd..9753506 100644 +--- a/gdb/valarith.c ++++ b/gdb/valarith.c +@@ -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 *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); + ULONGEST elt_size = type_length_units (elt_type); +- ULONGEST elt_offs = elt_size * (index - lowerbound); ++ LONGEST elt_offs = index - lowerbound; ++ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type)); + struct value *v; + ++ if (elt_stride != 0) ++ elt_offs *= elt_stride; ++ else ++ elt_offs *= elt_size; ++ + if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) +- && elt_offs >= type_length_units (array_type))) ++ && abs (elt_offs) >= type_length_units (array_type))) + { + if (type_not_associated (array_type)) + error (_("no such vector element (vector not associated)")); +diff --git a/gdb/valops.c b/gdb/valops.c +index 40392e8..24ffacb 100644 +--- a/gdb/valops.c ++++ b/gdb/valops.c +@@ -3775,56 +3775,191 @@ value_of_this_silent (const struct language_defn *lang) + struct value * + value_slice (struct value *array, int lowbound, int length) + { ++ /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride ++ value of '1', which returns every element between LOWBOUND and ++ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1' ++ as we are only considering the highest dimension, or we are ++ working on a one dimensional array. So we call VALUE_SLICE_1 ++ exactly once. */ ++ return value_slice_1 (array, lowbound, length, 1, 1); ++} ++ ++/* VALUE_SLICE_1 is called for each array dimension to calculate the number ++ of elements as defined by the subscript expression. ++ CALL_COUNT is used to determine if we are calling the function once, e.g. ++ we are working on the current dimension of ARRAY, or if we are calling ++ the function repeatedly. In the later case we need to take elements ++ from the TARGET_TYPE of ARRAY. ++ With a CALL_COUNT greater than 1 we calculate the offsets for every element ++ that should be in the result array. Then we fetch the contents and then ++ copy them into the result array. The result array will have one dimension ++ less than the input array, so later on we need to recreate the indices and ++ ranges in the calling function. */ ++ ++struct value * ++value_slice_1 (struct value *array, int lowbound, int length, ++ int stride_length, int call_count) ++{ + struct type *slice_range_type, *slice_type, *range_type; +- LONGEST lowerbound, upperbound; +- struct value *slice; +- struct type *array_type; ++ struct type *array_type = check_typedef (value_type (array)); ++ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); ++ unsigned int elt_size, elt_offs; ++ LONGEST ary_high_bound, ary_low_bound; ++ struct value *v; ++ int slice_range_size, i = 0, row_count = 1, elem_count = 1; + +- array_type = check_typedef (value_type (array)); ++ /* Check for legacy code if we are actually dealing with an array or ++ string. */ + if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY + && TYPE_CODE (array_type) != TYPE_CODE_STRING) + error (_("cannot take slice of non-array")); + +- range_type = TYPE_INDEX_TYPE (array_type); +- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) +- error (_("slice from bad array or bitstring")); ++ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type)); ++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type)); ++ ++ /* When we are working on a multi-dimensional array, we need to get the ++ attributes of the underlying type. */ ++ if (call_count > 1) ++ { ++ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type)); ++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type)); ++ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); ++ row_count = TYPE_LENGTH (array_type) ++ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); ++ } ++ ++ /* With a stride of '1', the number of elements per result row is equal to ++ the LENGTH of the subarray. With non-default stride values, we skip ++ elements, but have to add the start element to the total number of ++ elements per row. */ ++ if (stride_length == 1) ++ elem_count = length; ++ else ++ elem_count = ((length - 1) / stride_length) + 1; ++ ++ elt_size = TYPE_LENGTH (elt_type); ++ elt_offs = lowbound - ary_low_bound; + +- if (lowbound < lowerbound || length < 0 +- || lowbound + length - 1 > upperbound) +- error (_("slice out of range")); ++ elt_offs *= elt_size; ++ ++ /* Check for valid user input. In case of Fortran this was already done ++ in the calling function. */ ++ if (call_count == 1 ++ && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) ++ && elt_offs >= TYPE_LENGTH (array_type))) ++ error (_("no such vector element")); ++ ++ /* CALL_COUNT is 1 when we are dealing either with the highest dimension ++ of the array, or a one dimensional array. Set RANGE_TYPE accordingly. ++ In both cases we calculate how many rows/elements will be in the output ++ array by setting slice_range_size. */ ++ if (call_count == 1) ++ { ++ range_type = TYPE_INDEX_TYPE (array_type); ++ slice_range_size = ary_low_bound + elem_count - 1; ++ ++ /* Check if the array bounds are valid. */ ++ if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0) ++ error (_("slice from bad array or bitstring")); ++ } ++ /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays. ++ So we need to get the type below the current one and set the RANGE_TYPE ++ accordingly. */ ++ else ++ { ++ range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type)); ++ slice_range_size = ary_low_bound + (row_count * elem_count) - 1; ++ ary_low_bound = TYPE_LOW_BOUND (range_type); ++ } + + /* FIXME-type-allocation: need a way to free this type when we are +- done with it. */ +- slice_range_type = create_static_range_type ((struct type *) NULL, +- TYPE_TARGET_TYPE (range_type), +- lowbound, +- lowbound + length - 1); ++ done with it. */ + ++ slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type), ++ ary_low_bound, slice_range_size); + { +- struct type *element_type = TYPE_TARGET_TYPE (array_type); +- LONGEST offset +- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type)); ++ struct type *element_type; ++ ++ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy ++ code for subarrays. */ ++ if (call_count == 1 && stride_length == 1) ++ { ++ element_type = TYPE_TARGET_TYPE (array_type); ++ ++ slice_type = create_array_type (NULL, element_type, slice_range_type); + +- slice_type = create_array_type ((struct type *) NULL, +- element_type, +- slice_range_type); +- TYPE_CODE (slice_type) = TYPE_CODE (array_type); ++ TYPE_CODE (slice_type) = TYPE_CODE (array_type); + +- if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) +- slice = allocate_value_lazy (slice_type); ++ if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) ++ v = allocate_value_lazy (slice_type); ++ else ++ { ++ v = allocate_value (slice_type); ++ value_contents_copy (v, ++ value_embedded_offset (v), ++ array, ++ value_embedded_offset (array) + elt_offs, ++ elt_size * longest_to_int (length)); ++ } ++ ++ } ++ /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working ++ on a range of ranges. So we copy the relevant elements into the ++ new array we return. */ + else + { +- slice = allocate_value (slice_type); +- value_contents_copy (slice, 0, array, offset, +- type_length_units (slice_type)); ++ int j, offs_store = elt_offs; ++ LONGEST dst_offset = 0; ++ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); ++ ++ if (call_count == 1) ++ { ++ /* When CALL_COUNT is equal to 1 we are working on the current range ++ and use these elements directly. */ ++ element_type = TYPE_TARGET_TYPE (array_type); ++ } ++ else ++ { ++ /* Working on an array of arrays, the type of the elements is the type ++ of the subarrays' type. */ ++ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); ++ } ++ ++ slice_type = create_array_type (NULL, element_type, slice_range_type); ++ ++ /* If we have a one dimensional array, we copy its TYPE_CODE. For a ++ multi dimensional array we copy the embedded type's TYPE_CODE. */ ++ if (call_count == 1) ++ TYPE_CODE (slice_type) = TYPE_CODE (array_type); ++ else ++ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type)); ++ ++ v = allocate_value (slice_type); ++ ++ /* Iterate through the rows of the outer array and set the new offset ++ for each row. */ ++ for (i = 0; i < row_count; i++) ++ { ++ elt_offs = offs_store + i * src_row_length; ++ ++ /* Iterate through the elements in each row to copy only those. */ ++ for (j = 1; j <= elem_count; j++) ++ { ++ /* Fetches the contents of ARRAY and copies them into V. */ ++ value_contents_copy (v, dst_offset, array, elt_offs, elt_size); ++ elt_offs += elt_size * stride_length; ++ dst_offset += elt_size; ++ } ++ } + } + +- set_value_component_location (slice, array); +- VALUE_FRAME_ID (slice) = VALUE_FRAME_ID (array); +- set_value_offset (slice, value_offset (array) + offset); ++ set_value_component_location (v, array); ++ VALUE_REGNUM (v) = VALUE_REGNUM (array); ++ VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array); ++ set_value_offset (v, value_offset (array) + elt_offs); + } + +- return slice; ++ return v; + } + + /* Create a value for a FORTRAN complex number. Currently most of the +diff --git a/gdb/value.h b/gdb/value.h +index 0b417b4..9c37713 100644 +--- a/gdb/value.h ++++ b/gdb/value.h +@@ -1057,6 +1057,8 @@ extern struct value *varying_to_slice (struct value *); + + extern struct value *value_slice (struct value *, int, int); + ++extern struct value *value_slice_1 (struct value *, int, int, int, int); ++ + extern struct value *value_literal_complex (struct value *, struct value *, + struct type *); + diff --git a/gdb-vla-intel-fortran-vla-strings.patch b/gdb-vla-intel-fortran-vla-strings.patch new file mode 100644 index 0000000..6655390 --- /dev/null +++ b/gdb-vla-intel-fortran-vla-strings.patch @@ -0,0 +1,1488 @@ +git diff --stat -p gdb/master...gdb/users/bheckel/fortran-vla-strings +0ad7d8d1a3a36c6e04e3b6d37d8825f18d595723 + + gdb/NEWS | 2 + + gdb/c-valprint.c | 22 +++++ + gdb/dwarf2read.c | 158 +++++++++++++++++++++++++----- + gdb/f-typeprint.c | 93 +++++++++--------- + gdb/gdbtypes.c | 44 ++++++++- + gdb/testsuite/gdb.cp/vla-cxx.cc | 9 ++ + gdb/testsuite/gdb.cp/vla-cxx.exp | 9 ++ + gdb/testsuite/gdb.fortran/pointers.exp | 143 +++++++++++++++++++++++++++ + gdb/testsuite/gdb.fortran/pointers.f90 | 109 +++++++++++++++++++++ + gdb/testsuite/gdb.fortran/print_type.exp | 100 +++++++++++++++++++ + gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 +-- + gdb/testsuite/gdb.fortran/vla-strings.exp | 103 +++++++++++++++++++ + gdb/testsuite/gdb.fortran/vla-strings.f90 | 39 ++++++++ + gdb/testsuite/gdb.fortran/vla-type.exp | 7 +- + 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 | 27 ++--- + gdb/typeprint.c | 19 ++++ + gdb/valops.c | 16 ++- + gdb/valprint.c | 6 -- + 20 files changed, 827 insertions(+), 110 deletions(-) + +Index: gdb-7.11.90.20160907/gdb/NEWS +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/NEWS 2016-09-07 21:52:10.273563060 +0200 ++++ gdb-7.11.90.20160907/gdb/NEWS 2016-09-07 21:53:22.708210416 +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.20160907/gdb/c-valprint.c +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/c-valprint.c 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/c-valprint.c 2016-09-07 21:53:22.708210416 +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.20160907/gdb/dwarf2read.c +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/dwarf2read.c 2016-09-07 21:52:53.700951175 +0200 ++++ gdb-7.11.90.20160907/gdb/dwarf2read.c 2016-09-07 21:54:02.140562825 +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.20160907/gdb/f-typeprint.c +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/f-typeprint.c 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/f-typeprint.c 2016-09-07 21:53:22.713210461 +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.90.20160907/gdb/gdbtypes.c +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/gdbtypes.c 2016-09-07 21:52:53.703951202 +0200 ++++ gdb-7.11.90.20160907/gdb/gdbtypes.c 2016-09-07 21:53:22.714210470 +0200 +@@ -1816,7 +1816,8 @@ + 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 +@@ -1850,6 +1851,7 @@ + } + + case TYPE_CODE_ARRAY: ++ case TYPE_CODE_STRING: + { + gdb_assert (TYPE_NFIELDS (type) == 1); + +@@ -1962,7 +1964,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); + +@@ -1987,13 +1990,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 +@@ -2123,6 +2130,28 @@ + 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 * +@@ -2171,7 +2200,12 @@ + break; + } + ++ case TYPE_CODE_PTR: ++ resolved_type = resolve_dynamic_pointer (type, addr_stack); ++ break; ++ + case TYPE_CODE_ARRAY: ++ case TYPE_CODE_STRING: + resolved_type = resolve_dynamic_array (type, addr_stack); + break; + +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.cp/vla-cxx.cc +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/testsuite/gdb.cp/vla-cxx.cc 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.cp/vla-cxx.cc 2016-09-07 21:53:22.714210470 +0200 +@@ -15,6 +15,10 @@ + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + ++extern "C" { ++#include ++} ++ + struct container; + + struct element +@@ -40,11 +44,16 @@ + 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]; + } +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.cp/vla-cxx.exp +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/testsuite/gdb.cp/vla-cxx.exp 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.cp/vla-cxx.exp 2016-09-07 21:53:22.715210479 +0200 +@@ -23,6 +23,12 @@ + 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_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" + +@@ -33,3 +39,6 @@ + # bug being tested, it's better not to depend on the exact spelling. + gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}" + gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}" ++gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]" ++gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex" ++gdb_test "print *ptr" " = \\{5, 7, 9\\}" +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/pointers.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/pointers.exp 2016-09-07 21:53:22.715210479 +0200 +@@ -0,0 +1,143 @@ ++# 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 . ++ ++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 \\(:,:\\)\\)\\) \r\n$gdb_prompt $" { ++ pass $test ++ } ++ -re " = \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" ++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 = \\)\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 \\)\\) \r\n$gdb_prompt $" { ++ pass $test ++ } ++} ++ ++ ++gdb_breakpoint [gdb_get_line_number "Before value assignment"] ++gdb_continue_to_breakpoint "Before value assignment" ++gdb_test "print *(twop)%ivla2" "= " ++ ++ ++gdb_breakpoint [gdb_get_line_number "After value assignment"] ++gdb_continue_to_breakpoint "After value assignment" ++gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?" ++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 \\)\\) \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 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 " "Print program counter" +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/pointers.f90 +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/pointers.f90 2016-09-07 21:53:22.715210479 +0200 +@@ -0,0 +1,109 @@ ++! 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 . ++ ++program pointers ++ ++ type :: two ++ integer, allocatable :: ivla1 (:) ++ integer, allocatable :: ivla2 (:, :) ++ end type two ++ ++ type :: typeWithPointer ++ integer i ++ type(typeWithPointer), pointer:: p ++ end type typeWithPointer ++ ++ type :: twoPtr ++ type (two), pointer :: p ++ end type twoPtr ++ ++ logical, target :: logv ++ complex, target :: comv ++ character, target :: charv ++ character (len=3), target :: chara ++ integer, target :: intv ++ integer, target, dimension (10,2) :: inta ++ integer, target, allocatable, dimension (:) :: intvla ++ real, target :: realv ++ type(two), target :: twov ++ type(twoPtr) :: arrayOfPtr (3) ++ type(typeWithPointer), target:: cyclicp1,cyclicp2 ++ ++ logical, pointer :: logp ++ complex, pointer :: comp ++ character, pointer:: charp ++ character (len=3), pointer:: charap ++ integer, pointer :: intp ++ integer, pointer, dimension (:,:) :: intap ++ integer, pointer, dimension (:) :: intvlap ++ real, pointer :: realp ++ type(two), pointer :: twop ++ ++ nullify (logp) ++ nullify (comp) ++ nullify (charp) ++ nullify (charap) ++ nullify (intp) ++ nullify (intap) ++ nullify (intvlap) ++ nullify (realp) ++ nullify (twop) ++ nullify (arrayOfPtr(1)%p) ++ nullify (arrayOfPtr(2)%p) ++ nullify (arrayOfPtr(3)%p) ++ nullify (cyclicp1%p) ++ nullify (cyclicp2%p) ++ ++ logp => logv ! Before pointer assignment ++ comp => comv ++ charp => charv ++ charap => chara ++ intp => intv ++ intap => inta ++ intvlap => intvla ++ realp => realv ++ twop => twov ++ arrayOfPtr(2)%p => twov ++ cyclicp1%i = 1 ++ cyclicp1%p => cyclicp2 ++ cyclicp2%i = 2 ++ cyclicp2%p => cyclicp1 ++ ++ logv = associated(logp) ! Before value assignment ++ comv = cmplx(1,2) ++ charv = "a" ++ chara = "abc" ++ 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)) ++ 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.90.20160907/gdb/testsuite/gdb.fortran/print_type.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/print_type.exp 2016-09-07 21:53:22.715210479 +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 . ++ ++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.90.20160907/gdb/testsuite/gdb.fortran/vla-ptype.exp +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/testsuite/gdb.fortran/vla-ptype.exp 2016-09-07 21:52:53.705951220 +0200 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/vla-ptype.exp 2016-09-07 21:53:22.715210479 +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 = " "ptype vla1 not initialized" +-gdb_test "ptype vla2" "type = " "ptype vla2 not initialized" +-gdb_test "ptype pvla" "type = " "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 = " "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 = " "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 = " "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.90.20160907/gdb/testsuite/gdb.fortran/vla-strings.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/vla-strings.exp 2016-09-07 21:53:22.716210488 +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 . ++ ++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.20160907/gdb/testsuite/gdb.fortran/vla-strings.f90 +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/vla-strings.f90 2016-09-07 21:53:22.716210488 +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 . ++ ++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 +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/vla-type.exp +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/testsuite/gdb.fortran/vla-type.exp 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/vla-type.exp 2016-09-07 21:53:22.716210488 +0200 +@@ -132,7 +132,10 @@ + "End Type one" ] + + # Check allocation status of dynamic array and it's dynamic members +-gdb_test "ptype fivedynarr" "type = " ++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\\(\\)" \ ++ " $int :: ivla\\(:,:,:\\)" \ + "End Type one" ] \ + "ptype fivedynarr(2)%tone, not allocated" + +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/vla-value.exp +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/testsuite/gdb.fortran/vla-value.exp 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.fortran/vla-value.exp 2016-09-07 21:53:22.716210488 +0200 +@@ -14,6 +14,7 @@ + # along with this program. If not, see . + + standard_testfile "vla.f90" ++load_lib "fortran.exp" + + if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90 quiet}] } { +@@ -25,12 +26,15 @@ + 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" " = " "print non-allocated vla1" + gdb_test "print &vla1" \ +- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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)" +@@ -51,7 +55,7 @@ + "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 @@ + # Try to access values in undefined pointer to VLA (dangling) + gdb_test "print pvla" " = " "print undefined pvla" + gdb_test "print &pvla" \ +- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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)" +@@ -80,7 +84,7 @@ + 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)" +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.mi/mi-var-child-f.exp +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/testsuite/gdb.mi/mi-var-child-f.exp 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.mi/mi-var-child-f.exp 2016-09-07 21:53:22.716210488 +0200 +@@ -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_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\\)"] \ +Index: gdb-7.11.90.20160907/gdb/testsuite/gdb.mi/mi-vla-fortran.exp +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2016-09-07 21:53:22.716210488 +0200 +@@ -17,7 +17,9 @@ + # Array (VLA). + + load_lib mi-support.exp ++load_lib fortran.exp + set MIFLAGS "-i=mi" ++load_lib "fortran.exp" + + gdb_exit + if [mi_gdb_start] { +@@ -32,6 +34,9 @@ + 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} +@@ -46,10 +51,10 @@ + mi_gdb_test "500-data-evaluate-expression vla1" \ + "500\\^done,value=\"\"" "evaluate not allocated vla" + +-mi_create_varobj_checked vla1_not_allocated vla1 "" \ ++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=\"\"" \ ++ "501\\^done,type=\"$real \\(:\\)\"" \ + "info type variable vla1_not_allocated" + mi_gdb_test "502-var-show-format vla1_not_allocated" \ + "502\\^done,format=\"natural\"" \ +@@ -58,7 +63,7 @@ + "503\\^done,value=\"\\\[0\\\]\"" \ + "eval variable vla1_not_allocated" + mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \ +- "real\\\(kind=4\\\)" "get children of vla1_not_allocated" ++ "$real" "get children of vla1_not_allocated" + + + +@@ -71,10 +76,10 @@ + mi_gdb_test "510-data-evaluate-expression vla1" \ + "510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla" + +-mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \ ++mi_create_varobj_checked vla1_allocated vla1 "$real \\\(5\\\)" \ + "create local variable vla1_allocated" + mi_gdb_test "511-var-info-type vla1_allocated" \ +- "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \ ++ "511\\^done,type=\"$real \\\(5\\\)\"" \ + "info type variable vla1_allocated" + mi_gdb_test "512-var-show-format vla1_allocated" \ + "512\\^done,format=\"natural\"" \ +@@ -83,7 +88,7 @@ + "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"] +@@ -136,10 +141,10 @@ + -re "580\\^done,value=\"\".*${mi_gdb_prompt}$" { + pass $test + +- mi_create_varobj_checked pvla2_not_associated pvla2 "" \ ++ 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=\"\"" \ ++ "581\\^done,type=\"$real \\(:,:\\)\"" \ + "info type variable pvla2_not_associated" + mi_gdb_test "582-var-show-format pvla2_not_associated" \ + "582\\^done,format=\"natural\"" \ +@@ -148,7 +153,7 @@ + "583\\^done,value=\"\\\[0\\\]\"" \ + "eval variable pvla2_not_associated" + mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \ +- "real\\\(kind=4\\\)" "get children of pvla2_not_associated" ++ "$real" "get children of pvla2_not_associated" + } + -re "580\\^error,msg=\"value contents too large \\(\[0-9\]+ bytes\\).*${mi_gdb_prompt}$" { + # Undefined behaviour in gfortran. +@@ -173,9 +178,9 @@ + "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\"" \ +Index: gdb-7.11.90.20160907/gdb/typeprint.c +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/typeprint.c 2016-09-07 21:52:10.272563051 +0200 ++++ gdb-7.11.90.20160907/gdb/typeprint.c 2016-09-07 21:53:22.717210497 +0200 +@@ -485,6 +485,25 @@ + 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"); + +Index: gdb-7.11.90.20160907/gdb/valops.c +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/valops.c 2016-09-07 21:52:53.707951238 +0200 ++++ gdb-7.11.90.20160907/gdb/valops.c 2016-09-07 21:53:22.717210497 +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.20160907/gdb/valprint.c +=================================================================== +--- gdb-7.11.90.20160907.orig/gdb/valprint.c 2016-09-07 21:52:10.273563060 +0200 ++++ gdb-7.11.90.20160907/gdb/valprint.c 2016-09-07 21:53:22.718210506 +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); diff --git a/gdb.spec b/gdb.spec index 9971cab..4f0d515 100644 --- a/gdb.spec +++ b/gdb.spec @@ -22,13 +22,13 @@ Name: %{?scl_prefix}gdb %global snapsrc 20160801 # See timestamp of source gnulib installed into gdb/gnulib/ . %global snapgnulib 20150822 -%global tardate 20160904 +%global tardate 20160907 %global tarname gdb-7.11.90.%{tardate} Version: 7.12 # 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. -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 Group: Development/Debuggers @@ -521,16 +521,8 @@ Patch848: gdb-dts-rhel6-python-compat.patch Patch852: gdb-gnat-dwarf-crash-3of3.patch # VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests. -Patch1058: gdb-vla-intel-branch.patch -Patch1059: gdb-vla-intel-branch-fix-stride-1of2.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 +Patch1058: gdb-vla-intel-fortran-strides.patch +Patch1132: gdb-vla-intel-fortran-vla-strings.patch Patch889: gdb-vla-intel-stringbt-fix.patch Patch887: gdb-archer-vla-tests.patch Patch888: gdb-vla-intel-tests.patch @@ -789,15 +781,7 @@ find -name "*.info*"|xargs rm -f #patch232 -p1 %patch349 -p1 %patch1058 -p1 -%patch1059 -p1 -%patch1060 -p1 %patch1132 -p1 -%patch1133 -p1 -%patch1134 -p1 -%patch1135 -p1 -%patch1136 -p1 -%patch1137 -p1 -%patch1138 -p1 %patch889 -p1 %patch1 -p1 @@ -1468,6 +1452,10 @@ then fi %changelog +* Wed Sep 7 2016 Jan Kratochvil - 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 - 7.12-0.12.20160904.fc25 - [rhel6+7] Fix compatibility of bison <3.1 and gcc >=6. diff --git a/sources b/sources index c1950a5..6a0b0f0 100644 --- a/sources +++ b/sources @@ -1,3 +1,3 @@ 131d0dfd20cd6014c168fbcab9be2c43 gdb-libstdc++-v3-python-6.1.1-20160817.tar.xz 29efc08219d9d6a0536d58f9807c8722 v1.5.tar.gz -67e2a5a5c4faead18837fa54ae90576a gdb-7.11.90.20160904.tar.xz +731f09d7e3b5d40af3318a2970db0cc5 gdb-7.11.90.20160907.tar.xz