public inbox for git-commits@fedoraproject.org
help / color / mirror / Atom feed
From: Jan Kratochvil <jan.kratochvil@redhat.com>
To: git-commits@fedoraproject.org
Subject: [rpms/gdb] gdb-17.2-rebase-f44: Rebase to FSF GDB 7.11.90.20160907 (pre-7.12 branch snapshot).
Date: Sat, 27 Jun 2026 23:57:51 GMT [thread overview]
Message-ID: <178260467110.1.47494538002433036.rpms-gdb-d258670d645c@fedoraproject.org> (raw)
A new commit has been pushed.
Repo : rpms/gdb
Branch : gdb-17.2-rebase-f44
Commit : d258670d645c91c1124ef42a8f55bd6c810a417a
Author : Jan Kratochvil <jan.kratochvil@redhat.com>
Date : 2016-09-07T22:47:48+02:00
Stats : +3495/-4701 in 17 file(s)
URL : https://src.fedoraproject.org/rpms/gdb/c/d258670d645c91c1124ef42a8f55bd6c810a417a?branch=gdb-17.2-rebase-f44
Log:
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 <bernhard.heckel@intel.com>
-Date: Tue, 12 Jul 2016 08:19:34 +0200
-Subject: [PATCH 1/7] Fortran: Testsuite, fix differences in type naming.
-
-Continued on 0c13f7e559afe5f973a59311b0e401296c48d96c
-(fortran: Testsuite, fix different type naming across compilers).
-
-2016-06-08 Bernhard Heckel <bernhard.heckel@intel.com>
-
-gdb/Testsuite/Changelog:
- * gdb.fortran/vla-value.exp: Use type names defined in libfortran.
- * gdb.mi/mi-var-child-f.exp: Likewise.
- * gdb.mi/mi-vla-fortran.exp: Likewise.
-
-Change-Id: I7ee94587a992add27fec77c7726f9a69c8fdf373
----
- gdb/testsuite/gdb.fortran/vla-value.exp | 12 ++++++++----
- gdb/testsuite/gdb.mi/mi-var-child-f.exp | 7 +++----
- gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 18 +++++++++++-------
- 3 files changed, 22 insertions(+), 15 deletions(-)
-
-diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
-index 0945181..275f738 100644
---- a/gdb/testsuite/gdb.fortran/vla-value.exp
-+++ b/gdb/testsuite/gdb.fortran/vla-value.exp
-@@ -14,6 +14,7 @@
- # along with this program. If not, see <http://www.gnu.org/licenses/>.
-
- standard_testfile "vla.f90"
-+load_lib "fortran.exp"
-
- if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
- {debug f90 quiet}] } {
-@@ -25,12 +26,15 @@ if ![runto_main] {
- return -1
- }
-
-+# Depending on the compiler being used, the type names can be printed differently.
-+set real [fortran_real4]
-+
- # Try to access values in non allocated VLA
- gdb_breakpoint [gdb_get_line_number "vla1-init"]
- gdb_continue_to_breakpoint "vla1-init"
- gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
- gdb_test "print &vla1" \
-- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \
-+ " = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\)\\\)\\\) $hex" \
- "print non-allocated &vla1"
- gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \
- "print member in non-allocated vla1 (1)"
-@@ -51,7 +55,7 @@ with_timeout_factor 15 {
- "step over value assignment of vla1"
- }
- gdb_test "print &vla1" \
-- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
-+ " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \
- "print allocated &vla1"
- gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)"
- gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)"
-@@ -71,7 +75,7 @@ gdb_test "print vla1(9, 9, 9)" " = 999" \
- # Try to access values in undefined pointer to VLA (dangling)
- gdb_test "print pvla" " = <not associated>" "print undefined pvla"
- gdb_test "print &pvla" \
-- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \
-+ " = \\\(PTR TO -> \\\( $real \\\(<not associated>\\\)\\\)\\\) $hex" \
- "print non-associated &pvla"
- gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \
- "print undefined pvla(1,3,8)"
-@@ -80,7 +84,7 @@ gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated
- gdb_breakpoint [gdb_get_line_number "pvla-associated"]
- gdb_continue_to_breakpoint "pvla-associated"
- gdb_test "print &pvla" \
-- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
-+ " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\)\\\)\\\) $hex" \
- "print associated &pvla"
- gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)"
- gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)"
-diff --git a/gdb/testsuite/gdb.mi/mi-var-child-f.exp b/gdb/testsuite/gdb.mi/mi-var-child-f.exp
-index f3ed7c2..bc44c6b 100644
---- a/gdb/testsuite/gdb.mi/mi-var-child-f.exp
-+++ b/gdb/testsuite/gdb.mi/mi-var-child-f.exp
-@@ -17,6 +17,7 @@
-
- load_lib mi-support.exp
- set MIFLAGS "-i=mi"
-+load_lib "fortran.exp"
-
- if { [skip_fortran_tests] } { return -1 }
-
-@@ -40,10 +41,8 @@ mi_runto MAIN__
- mi_create_varobj "array" "array" "create local variable array"
-
-
--# Depending on the compiler version being used, the name of the 4-byte integer
--# and real types can be printed differently. For instance, gfortran-4.1 uses
--# "int4" whereas gfortran-4.3 uses "integer(kind=4)".
--set int4 "(int4|integer\\(kind=4\\))"
-+# Depending on the compiler being used, the type names can be printed differently.
-+set int4 [fortran_int4]
-
- set children [list [list "array.-1" "-1" 2 "$int4 \\(2\\)"] \
- [list "array.0" "0" 2 "$int4 \\(2\\)"] \
-diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
-index 333b71a..1779ec0 100644
---- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
-+++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
-@@ -18,6 +18,7 @@
-
- load_lib mi-support.exp
- set MIFLAGS "-i=mi"
-+load_lib "fortran.exp"
-
- gdb_exit
- if [mi_gdb_start] {
-@@ -32,6 +33,9 @@ if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \
- return -1
- }
-
-+# Depending on the compiler being used, the type names can be printed differently.
-+set real [fortran_real4]
-+
- mi_delete_breakpoints
- mi_gdb_reinitialize_dir $srcdir/$subdir
- mi_gdb_load ${binfile}
-@@ -58,7 +62,7 @@ mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \
- "503\\^done,value=\"\\\[0\\\]\"" \
- "eval variable vla1_not_allocated"
- mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
-- "real\\\(kind=4\\\)" "get children of vla1_not_allocated"
-+ "$real" "get children of vla1_not_allocated"
-
-
-
-@@ -71,10 +75,10 @@ mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
- mi_gdb_test "510-data-evaluate-expression vla1" \
- "510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla"
-
--mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \
-+mi_create_varobj_checked vla1_allocated vla1 "$real \\\(5\\\)" \
- "create local variable vla1_allocated"
- mi_gdb_test "511-var-info-type vla1_allocated" \
-- "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \
-+ "511\\^done,type=\"$real \\\(5\\\)\"" \
- "info type variable vla1_allocated"
- mi_gdb_test "512-var-show-format vla1_allocated" \
- "512\\^done,format=\"natural\"" \
-@@ -83,7 +87,7 @@ mi_gdb_test "513-var-evaluate-expression vla1_allocated" \
- "513\\^done,value=\"\\\[5\\\]\"" \
- "eval variable vla1_allocated"
- mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
-- "real\\\(kind=4\\\)" "get children of vla1_allocated"
-+ "$real" "get children of vla1_allocated"
-
-
- set bp_lineno [gdb_get_line_number "vla1-filled"]
-@@ -148,7 +152,7 @@ gdb_expect {
- "583\\^done,value=\"\\\[0\\\]\"" \
- "eval variable pvla2_not_associated"
- mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
-- "real\\\(kind=4\\\)" "get children of pvla2_not_associated"
-+ "$real" "get children of pvla2_not_associated"
- }
- -re "580\\^error,msg=\"value contents too large \\(\[0-9\]+ bytes\\).*${mi_gdb_prompt}$" {
- # Undefined behaviour in gfortran.
-@@ -173,9 +177,9 @@ mi_gdb_test "590-data-evaluate-expression pvla2" \
- "evaluate associated vla"
-
- mi_create_varobj_checked pvla2_associated pvla2 \
-- "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated"
-+ "$real \\\(5,2\\\)" "create local variable pvla2_associated"
- mi_gdb_test "591-var-info-type pvla2_associated" \
-- "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \
-+ "591\\^done,type=\"$real \\\(5,2\\\)\"" \
- "info type variable pvla2_associated"
- mi_gdb_test "592-var-show-format pvla2_associated" \
- "592\\^done,format=\"natural\"" \
---
-2.7.4
-
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 <bernhard.heckel@intel.com>
-Date: Tue, 12 Jul 2016 08:19:34 +0200
-Subject: [PATCH 2/7] Fortran: Resolve dynamic properties of pointer types.
-
-In Fortran a pointer may have a dynamic associated property.
-
-2016-07-08 Bernhard Heckel <bernhard.heckel@intel.com>
-
-gdb/Changelog:
- * gdbtypes.c (resolve_dynamic_types_internal): Resolve pointer types.
- (resolve_dynamic_pointer): New.
-
-Change-Id: Ie4b9d6397cfa089ee2e0db02beb18415a751c1c0
----
- gdb/gdbtypes.c | 29 ++++++++++++++++++++++++++++-
- 1 file changed, 28 insertions(+), 1 deletion(-)
-
-diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
-index ec5c17a..b53e649 100644
---- a/gdb/gdbtypes.c
-+++ b/gdb/gdbtypes.c
-@@ -1806,7 +1806,8 @@ is_dynamic_type_internal (struct type *type, int top_level)
- type = check_typedef (type);
-
- /* We only want to recognize references at the outermost level. */
-- if (top_level && TYPE_CODE (type) == TYPE_CODE_REF)
-+ if (top_level &&
-+ (TYPE_CODE (type) == TYPE_CODE_REF || TYPE_CODE (type) == TYPE_CODE_PTR))
- type = check_typedef (TYPE_TARGET_TYPE (type));
-
- /* Types that have a dynamic TYPE_DATA_LOCATION are considered
-@@ -2105,6 +2106,28 @@ resolve_dynamic_struct (struct type *type,
- return resolved_type;
- }
-
-+/* Worker for pointer types. */
-+
-+static struct type *
-+resolve_dynamic_pointer (struct type *type,
-+ struct property_addr_info *addr_stack)
-+{
-+ struct dynamic_prop *prop;
-+ CORE_ADDR value;
-+
-+ type = copy_type (type);
-+
-+ /* Resolve associated property. */
-+ prop = TYPE_ASSOCIATED_PROP (type);
-+ if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
-+ {
-+ TYPE_DYN_PROP_ADDR (prop) = value;
-+ TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
-+ }
-+
-+ return type;
-+}
-+
- /* Worker for resolved_dynamic_type. */
-
- static struct type *
-@@ -2153,6 +2176,10 @@ resolve_dynamic_type_internal (struct type *type,
- break;
- }
-
-+ case TYPE_CODE_PTR:
-+ resolved_type = resolve_dynamic_pointer (type, addr_stack);
-+ break;
-+
- case TYPE_CODE_ARRAY:
- resolved_type = resolve_dynamic_array (type, addr_stack);
- break;
---
-2.7.4
-
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 <bernhard.heckel@intel.com>
-Date: Tue, 12 Jul 2016 08:19:34 +0200
-Subject: [PATCH 3/7] Typeprint: Resolve any dynamic target type of a pointer.
-
-Before continuing with language specific type printing
-we have to resolve the target type of a pointer
-as we might wanna print more details of the target
-like the dimension of an array. We have to resolve it here
-as we don't have any address information later on.
-
-2016-07-08 Bernhard Heckel <bernhard.heckel@intel.com>
-
-gdb/Changelog:
- * typeprint.c (whatis_exp): Resolve dynamic target type
- of pointers.
-
-gdb/Testsuite/Changelog:
- * gdb.cp/vla-cxx.cc: Added pointer to dynamic type.
- * gdb.cp/vla-cxx.exp: Test pointer to dynamic type.
-
-Change-Id: Idff0d6dd0eab3125b45d470a12b5e66b392e42c3
----
- gdb/testsuite/gdb.cp/vla-cxx.cc | 9 +++++++++
- gdb/testsuite/gdb.cp/vla-cxx.exp | 5 +++++
- gdb/typeprint.c | 19 +++++++++++++++++++
- 3 files changed, 33 insertions(+)
-
-diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc
-index a1fd510..5f8f8ab 100644
---- a/gdb/testsuite/gdb.cp/vla-cxx.cc
-+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc
-@@ -15,6 +15,10 @@
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
-
-+extern "C" {
-+#include <stddef.h>
-+}
-+
- struct container;
-
- struct element
-@@ -40,11 +44,16 @@ int main(int argc, char **argv)
- typedef typeof (vla) &vlareftypedef;
- vlareftypedef vlaref2 (vla);
- container c;
-+ typeof (vla) *ptr = NULL;
-+
-+ // Before pointer assignment
-+ ptr = &vla;
-
- for (int i = 0; i < z; ++i)
- vla[i] = 5 + 2 * i;
-
- // vlas_filled
- vla[0] = 2 * vla[0];
-+
- return vla[2];
- }
-diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp
-index f6224dc..babdfb7 100644
---- a/gdb/testsuite/gdb.cp/vla-cxx.exp
-+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp
-@@ -23,6 +23,10 @@ if ![runto_main] {
- return -1
- }
-
-+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
-+gdb_continue_to_breakpoint "Before pointer assignment"
-+gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment"
-+
- gdb_breakpoint [gdb_get_line_number "vlas_filled"]
- gdb_continue_to_breakpoint "vlas_filled"
-
-@@ -33,3 +37,4 @@ gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}"
- # bug being tested, it's better not to depend on the exact spelling.
- gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}"
- gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}"
-+gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]"
-diff --git a/gdb/typeprint.c b/gdb/typeprint.c
-index e77513e..e3d84c7 100644
---- a/gdb/typeprint.c
-+++ b/gdb/typeprint.c
-@@ -485,6 +485,25 @@ whatis_exp (char *exp, int show)
- printf_filtered (" */\n");
- }
-
-+ /* Resolve any dynamic target type, as we might print
-+ additional information about the target.
-+ For example, in Fortran and C we are printing the dimension of the
-+ dynamic array the pointer is pointing to. */
-+ if (TYPE_CODE (type) == TYPE_CODE_PTR
-+ && is_dynamic_type (type) == 1)
-+ {
-+ CORE_ADDR addr;
-+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE(type)))
-+ addr = value_address (val);
-+ else
-+ addr = value_as_address (val);
-+
-+ if (addr != 0
-+ && type_not_associated (type) == 0)
-+ TYPE_TARGET_TYPE (type) = resolve_dynamic_type (TYPE_TARGET_TYPE (type),
-+ NULL, addr);
-+ }
-+
- LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags);
- printf_filtered ("\n");
-
---
-2.7.4
-
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 <bernhard.heckel@intel.com>
-Date: Tue, 12 Jul 2016 08:19:34 +0200
-Subject: [PATCH 4/7] Fortran: Typeprint, fix dangling types.
-
-Show the type of not-allocated and/or not-associated types
-as this is known. For array types and pointer to array types
-we are going to print the number of ranks.
-
-2016-06-30 Bernhard Heckel <bernhard.heckel@intel.com>
-
-gdb/ChangeLog:
- * f-typeprint.c (f_print_type): Don't bypass dangling types.
- (f_type_print_varspec_suffix): Add print_rank parameter.
- (f_type_print_varspec_suffix): Print ranks of array types
- in case they dangling.
- (f_type_print_base): Add print_rank parameter.
-
-gdb/Testsuite/ChangeLog:
- * gdb.fortran/pointers.f90: New.
- * gdb.fortran/print_type.exp: New.
- * gdb.fortran/vla-ptype.exp: Adapt expected results.
- * gdb.fortran/vla-type.exp: Likewise.
- * gdb.fortran/vla-value.exp: Likewise.
- * gdb.mi/mi-vla-fortran.exp: Likewise.
-
-Change-Id: Ib55f28b4092cf88e34918449a2ebb6e5daafe512
----
- gdb/f-typeprint.c | 95 +++++++++++++++--------------
- gdb/testsuite/gdb.fortran/pointers.f90 | 80 +++++++++++++++++++++++++
- gdb/testsuite/gdb.fortran/print_type.exp | 100 +++++++++++++++++++++++++++++++
- gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 ++--
- gdb/testsuite/gdb.fortran/vla-type.exp | 7 ++-
- gdb/testsuite/gdb.fortran/vla-value.exp | 4 +-
- gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 9 +--
- 7 files changed, 248 insertions(+), 59 deletions(-)
- create mode 100644 gdb/testsuite/gdb.fortran/pointers.f90
- create mode 100755 gdb/testsuite/gdb.fortran/print_type.exp
-
-Index: gdb-7.11.50.20160630/gdb/f-typeprint.c
-===================================================================
---- gdb-7.11.50.20160630.orig/gdb/f-typeprint.c 2016-07-16 10:54:48.749099150 +0200
-+++ gdb-7.11.50.20160630/gdb/f-typeprint.c 2016-07-16 10:55:59.763667355 +0200
-@@ -37,7 +37,7 @@
- #endif
-
- static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
-- int, int, int);
-+ int, int, int, int);
-
- void f_type_print_varspec_prefix (struct type *, struct ui_file *,
- int, int);
-@@ -54,18 +54,6 @@
- enum type_code code;
- int demangled_args;
-
-- if (type_not_associated (type))
-- {
-- val_print_not_associated (stream);
-- return;
-- }
--
-- if (type_not_allocated (type))
-- {
-- val_print_not_allocated (stream);
-- return;
-- }
--
- f_type_print_base (type, stream, show, level);
- code = TYPE_CODE (type);
- if ((varstring != NULL && *varstring != '\0')
-@@ -87,7 +75,7 @@
- so don't print an additional pair of ()'s. */
-
- demangled_args = varstring[strlen (varstring) - 1] == ')';
-- f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
-+ f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0, 0);
- }
- }
-
-@@ -157,7 +145,7 @@
- static void
- f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
- int show, int passed_a_ptr, int demangled_args,
-- int arrayprint_recurse_level)
-+ int arrayprint_recurse_level, int print_rank_only)
- {
- int upper_bound, lower_bound;
-
-@@ -181,34 +169,50 @@
- fprintf_filtered (stream, "(");
-
- if (type_not_associated (type))
-- val_print_not_associated (stream);
-+ print_rank_only = 1;
- else if (type_not_allocated (type))
-- val_print_not_allocated (stream);
-+ print_rank_only = 1;
-+ else if ((TYPE_ASSOCIATED_PROP (type)
-+ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type)))
-+ || (TYPE_ALLOCATED_PROP (type)
-+ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type)))
-+ || (TYPE_DATA_LOCATION (type)
-+ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_DATA_LOCATION (type))))
-+ /* This case exist when we ptype a typename which has the
-+ dynamic properties but cannot be resolved as there is
-+ no object. */
-+ print_rank_only = 1;
-+
-+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
-+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
-+ 0, 0, arrayprint_recurse_level,
-+ print_rank_only);
-+
-+ if (print_rank_only == 1)
-+ fprintf_filtered (stream, ":");
- else
-- {
-- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
-- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
-- 0, 0, arrayprint_recurse_level);
--
-- lower_bound = f77_get_lowerbound (type);
-- if (lower_bound != 1) /* Not the default. */
-- fprintf_filtered (stream, "%d:", lower_bound);
--
-- /* Make sure that, if we have an assumed size array, we
-- print out a warning and print the upperbound as '*'. */
--
-- if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
-- fprintf_filtered (stream, "*");
-- else
-- {
-- upper_bound = f77_get_upperbound (type);
-- fprintf_filtered (stream, "%d", upper_bound);
-- }
--
-- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
-- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
-- 0, 0, arrayprint_recurse_level);
-- }
-+ {
-+ lower_bound = f77_get_lowerbound (type);
-+ if (lower_bound != 1) /* Not the default. */
-+ fprintf_filtered (stream, "%d:", lower_bound);
-+
-+ /* Make sure that, if we have an assumed size array, we
-+ print out a warning and print the upperbound as '*'. */
-+
-+ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
-+ fprintf_filtered (stream, "*");
-+ else
-+ {
-+ upper_bound = f77_get_upperbound (type);
-+ fprintf_filtered (stream, "%d", upper_bound);
-+ }
-+ }
-+
-+ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
-+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
-+ 0, 0, arrayprint_recurse_level,
-+ print_rank_only);
-+
- if (arrayprint_recurse_level == 1)
- fprintf_filtered (stream, ")");
- else
-@@ -219,13 +223,14 @@
- case TYPE_CODE_PTR:
- case TYPE_CODE_REF:
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
-- arrayprint_recurse_level);
-+ arrayprint_recurse_level, 0);
- fprintf_filtered (stream, ")");
- break;
-
- case TYPE_CODE_FUNC:
- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
-- passed_a_ptr, 0, arrayprint_recurse_level);
-+ passed_a_ptr, 0, arrayprint_recurse_level,
-+ 0);
- if (passed_a_ptr)
- fprintf_filtered (stream, ")");
-
-@@ -376,7 +381,7 @@
- fputs_filtered (" :: ", stream);
- fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
- f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
-- stream, show - 1, 0, 0, 0);
-+ stream, show - 1, 0, 0, 0, 0);
- fputs_filtered ("\n", stream);
- }
- fprintfi_filtered (level, stream, "End Type ");
-Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/pointers.f90
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/pointers.f90 2016-07-16 10:55:42.079525860 +0200
-@@ -0,0 +1,80 @@
-+! Copyright 2016 Free Software Foundation, Inc.
-+!
-+! This program is free software; you can redistribute it and/or modify
-+! it under the terms of the GNU General Public License as published by
-+! the Free Software Foundation; either version 3 of the License, or
-+! (at your option) any later version.
-+!
-+! This program is distributed in the hope that it will be useful,
-+! but WITHOUT ANY WARRANTY; without even the implied warranty of
-+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+! GNU General Public License for more details.
-+!
-+! You should have received a copy of the GNU General Public License
-+! along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+program pointers
-+
-+ type :: two
-+ integer, allocatable :: ivla1 (:)
-+ integer, allocatable :: ivla2 (:, :)
-+ end type two
-+
-+ logical, target :: logv
-+ complex, target :: comv
-+ character, target :: charv
-+ character (len=3), target :: chara
-+ integer, target :: intv
-+ integer, target, dimension (10,2) :: inta
-+ real, target :: realv
-+ type(two), target :: twov
-+
-+ logical, pointer :: logp
-+ complex, pointer :: comp
-+ character, pointer:: charp
-+ character (len=3), pointer:: charap
-+ integer, pointer :: intp
-+ integer, pointer, dimension (:,:) :: intap
-+ real, pointer :: realp
-+ type(two), pointer :: twop
-+
-+ nullify (logp)
-+ nullify (comp)
-+ nullify (charp)
-+ nullify (charap)
-+ nullify (intp)
-+ nullify (intap)
-+ nullify (realp)
-+ nullify (twop)
-+
-+ logp => logv ! Before pointer assignment
-+ comp => comv
-+ charp => charv
-+ charap => chara
-+ intp => intv
-+ intap => inta
-+ realp => realv
-+ twop => twov
-+
-+ logv = associated(logp) ! Before value assignment
-+ comv = cmplx(1,2)
-+ charv = "a"
-+ chara = "abc"
-+ intv = 10
-+ inta(:,:) = 1
-+ inta(3,1) = 3
-+ realv = 3.14
-+
-+ allocate (twov%ivla1(3))
-+ allocate (twov%ivla2(2,2))
-+ twov%ivla1(1) = 11
-+ twov%ivla1(2) = 12
-+ twov%ivla1(3) = 13
-+ twov%ivla2(1,1) = 211
-+ twov%ivla2(2,1) = 221
-+ twov%ivla2(1,2) = 212
-+ twov%ivla2(2,2) = 222
-+
-+ intv = intv + 1 ! After value assignment
-+
-+end program pointers
-Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/print_type.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/print_type.exp 2016-07-16 10:55:42.079525860 +0200
-@@ -0,0 +1,100 @@
-+# Copyright 2016 Free Software Foundation, Inc.
-+
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 3 of the License, or
-+# (at your option) any later version.
-+#
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+# GNU General Public License for more details.
-+#
-+# You should have received a copy of the GNU General Public License
-+# along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+standard_testfile "pointers.f90"
-+load_lib fortran.exp
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+
-+if ![runto_main] {
-+ untested "could not run to main"
-+ return -1
-+}
-+
-+# Depending on the compiler being used, the type names can be printed differently.
-+set logical [fortran_logical4]
-+set real [fortran_real4]
-+set int [fortran_int4]
-+set complex [fortran_complex4]
-+
-+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
-+gdb_continue_to_breakpoint "Before pointer assignment"
-+gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)" "ptype logp, not associated"
-+gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" "ptype comp, not associated"
-+gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" "ptype charp, not associated"
-+gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" "ptype charap, not associated"
-+gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" "ptype intp, not associated"
-+set test "ptype intap, not associated"
-+gdb_test_multiple "ptype intap" $test {
-+ -re "type = PTR TO -> \\( $int \\(:,:\\)\\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "type = $int \\(:,:\\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" "ptype realp, not associated"
-+gdb_test "ptype twop" \
-+ [multi_line "type = PTR TO -> \\( Type two" \
-+ " $int :: ivla1\\(:\\)" \
-+ " $int :: ivla2\\(:,:\\)" \
-+ "End Type two \\)"] \
-+ "ptype twop, not associated"
-+gdb_test "ptype two" \
-+ [multi_line "type = Type two" \
-+ " $int :: ivla1\\(:\\)" \
-+ " $int :: ivla2\\(:,:\\)" \
-+ "End Type two"]
-+
-+
-+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
-+gdb_continue_to_breakpoint "Before value assignment"
-+gdb_test "ptype twop" \
-+ [multi_line "type = PTR TO -> \\( Type two" \
-+ " $int :: ivla1\\(:\\)" \
-+ " $int :: ivla2\\(:,:\\)" \
-+ "End Type two \\)"]
-+
-+
-+gdb_breakpoint [gdb_get_line_number "After value assignment"]
-+gdb_continue_to_breakpoint "After value assignment"
-+gdb_test "ptype logv" "type = $logical"
-+gdb_test "ptype comv" "type = $complex"
-+gdb_test "ptype charv" "type = character\\*1"
-+gdb_test "ptype chara" "type = character\\*3"
-+gdb_test "ptype intv" "type = $int"
-+gdb_test "ptype inta" "type = $int \\(10,2\\)"
-+gdb_test "ptype realv" "type = $real"
-+
-+
-+gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)"
-+gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)"
-+gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)"
-+gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)"
-+gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)"
-+set test "ptype intap"
-+gdb_test_multiple $test $test {
-+ -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "type = PTR TO -> \\( $int \\(10,2\\)\\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)"
-Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-ptype.exp
-===================================================================
---- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.fortran/vla-ptype.exp 2016-07-16 10:54:48.749099150 +0200
-+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-ptype.exp 2016-07-16 10:55:42.079525860 +0200
-@@ -32,9 +32,9 @@
- # Check the ptype of various VLA states and pointer to VLA's.
- gdb_breakpoint [gdb_get_line_number "vla1-init"]
- gdb_continue_to_breakpoint "vla1-init"
--gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized"
--gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
--gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
-+gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not initialized"
-+gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not initialized"
-+gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla not initialized"
- gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
- "ptype vla1(3, 6, 9) not initialized"
- gdb_test "ptype vla2(5, 45, 20)" \
-@@ -81,20 +81,20 @@
-
- gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
- gdb_continue_to_breakpoint "pvla-deassociated"
--gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
-+gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla deassociated"
- gdb_test "ptype pvla(5, 45, 20)" \
- "no such vector element \\\(vector not associated\\\)" \
- "ptype pvla(5, 45, 20) not associated"
-
- gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
- gdb_continue_to_breakpoint "vla1-deallocated"
--gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
-+gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not allocated"
- gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
- "ptype vla1(3, 6, 9) not allocated"
-
- gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
- gdb_continue_to_breakpoint "vla2-deallocated"
--gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
-+gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not allocated"
- gdb_test "ptype vla2(5, 45, 20)" \
- "no such vector element \\\(vector not allocated\\\)" \
- "ptype vla2(5, 45, 20) not allocated"
-Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-type.exp
-===================================================================
---- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.fortran/vla-type.exp 2016-07-16 10:54:48.749099150 +0200
-+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-type.exp 2016-07-16 10:55:42.080525868 +0200
-@@ -132,7 +132,10 @@
- "End Type one" ]
-
- # Check allocation status of dynamic array and it's dynamic members
--gdb_test "ptype fivedynarr" "type = <not allocated>"
-+gdb_test "ptype fivedynarr" \
-+ [multi_line "type = Type five" \
-+ " Type one :: tone" \
-+ "End Type five \\(:\\)" ]
- gdb_test "next" ""
- gdb_test "ptype fivedynarr(2)" \
- [multi_line "type = Type five" \
-@@ -141,7 +144,7 @@
- "ptype fivedynarr(2), tone is not allocated"
- gdb_test "ptype fivedynarr(2)%tone" \
- [multi_line "type = Type one" \
-- " $int :: ivla\\(<not allocated>\\)" \
-+ " $int :: ivla\\(:,:,:\\)" \
- "End Type one" ] \
- "ptype fivedynarr(2)%tone, not allocated"
-
-Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-value.exp
-===================================================================
---- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.fortran/vla-value.exp 2016-07-16 10:54:48.749099150 +0200
-+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.fortran/vla-value.exp 2016-07-16 10:55:42.080525868 +0200
-@@ -34,7 +34,7 @@
- gdb_continue_to_breakpoint "vla1-init"
- gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
- gdb_test "print &vla1" \
-- " = \\\(PTR TO -> \\\( $real \\\(<not allocated>\\\)\\\)\\\) $hex" \
-+ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \
- "print non-allocated &vla1"
- gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \
- "print member in non-allocated vla1 (1)"
-@@ -75,7 +75,7 @@
- # Try to access values in undefined pointer to VLA (dangling)
- gdb_test "print pvla" " = <not associated>" "print undefined pvla"
- gdb_test "print &pvla" \
-- " = \\\(PTR TO -> \\\( $real \\\(<not associated>\\\)\\\)\\\) $hex" \
-+ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \
- "print non-associated &pvla"
- gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \
- "print undefined pvla(1,3,8)"
-Index: gdb-7.11.50.20160630/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
-===================================================================
---- gdb-7.11.50.20160630.orig/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2016-07-16 10:54:48.749099150 +0200
-+++ gdb-7.11.50.20160630/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2016-07-16 10:55:42.080525868 +0200
-@@ -17,6 +17,7 @@
- # Array (VLA).
-
- load_lib mi-support.exp
-+load_lib fortran.exp
- set MIFLAGS "-i=mi"
- load_lib "fortran.exp"
-
-@@ -50,10 +51,10 @@
- mi_gdb_test "500-data-evaluate-expression vla1" \
- "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
-
--mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
-+mi_create_varobj_checked vla1_not_allocated vla1 "$real \\(:\\)" \
- "create local variable vla1_not_allocated"
- mi_gdb_test "501-var-info-type vla1_not_allocated" \
-- "501\\^done,type=\"<not allocated>\"" \
-+ "501\\^done,type=\"$real \\(:\\)\"" \
- "info type variable vla1_not_allocated"
- mi_gdb_test "502-var-show-format vla1_not_allocated" \
- "502\\^done,format=\"natural\"" \
-@@ -140,10 +141,10 @@
- -re "580\\^done,value=\"<not associated>\".*${mi_gdb_prompt}$" {
- pass $test
-
-- mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
-+ mi_create_varobj_checked pvla2_not_associated pvla2 "$real \\(:,:\\)" \
- "create local variable pvla2_not_associated"
- mi_gdb_test "581-var-info-type pvla2_not_associated" \
-- "581\\^done,type=\"<not associated>\"" \
-+ "581\\^done,type=\"$real \\(:,:\\)\"" \
- "info type variable pvla2_not_associated"
- mi_gdb_test "582-var-show-format pvla2_not_associated" \
- "582\\^done,format=\"natural\"" \
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 <bernhard.heckel@intel.com>
-Date: Tue, 12 Jul 2016 08:19:34 +0200
-Subject: [PATCH 5/7] Resolve dynamic target types of pointers.
-
-When dereferencing pointers to dynamic target types,
-resolve the target type.
-
-2016-06-30 Bernhard Heckel <bernhard.heckel@intel.com>
-
-gdb/Changelog:
- * NEWS: Added entry.
- * c-valprint.c (c_print_val): Resolve dynamic target types.
- * valops.c (value_ind): Resolve dynamic target types.
- * valprint.c (check_printable): Don't shortcut not associated
- pointers.
-
-gdb/Testsuite/Changelog:
- * pointers.f90: Added pointer to dynamic types.
- * gdb.fortran/pointers.exp: New.
-
-Change-Id: I998d4da4a5ba4899b8cb2115576f44efa741e698
----
- gdb/NEWS | 2 +
- gdb/c-valprint.c | 22 ++++++
- gdb/testsuite/gdb.cp/vla-cxx.exp | 4 ++
- gdb/testsuite/gdb.fortran/pointers.exp | 123 +++++++++++++++++++++++++++++++++
- gdb/testsuite/gdb.fortran/pointers.f90 | 17 +++++
- gdb/valops.c | 16 ++++-
- gdb/valprint.c | 6 --
- 7 files changed, 182 insertions(+), 8 deletions(-)
- create mode 100644 gdb/testsuite/gdb.fortran/pointers.exp
-
-Index: gdb-7.11.90.20160807/gdb/NEWS
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/NEWS 2016-08-07 21:18:44.032409065 +0200
-+++ gdb-7.11.90.20160807/gdb/NEWS 2016-08-07 21:19:17.178715116 +0200
-@@ -1,6 +1,8 @@
- What has changed in GDB?
- (Organized release by release)
-
-+* Fortran: Support pointers to dynamic types.
-+
- *** Changes in GDB 7.12
-
- * GDB and GDBserver now build with a C++ compiler by default.
-Index: gdb-7.11.90.20160807/gdb/c-valprint.c
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/c-valprint.c 2016-08-07 21:18:44.032409065 +0200
-+++ gdb-7.11.90.20160807/gdb/c-valprint.c 2016-08-07 21:18:51.087474207 +0200
-@@ -645,6 +645,28 @@
- else
- {
- /* normal case */
-+ if (TYPE_CODE (type) == TYPE_CODE_PTR
-+ && 1 == is_dynamic_type (type))
-+ {
-+ CORE_ADDR addr;
-+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type)))
-+ addr = value_address (val);
-+ else
-+ addr = value_as_address (val);
-+
-+ /* We resolve the target-type only when the
-+ pointer is associated. */
-+ if ((addr != 0)
-+ && (0 == type_not_associated (type)))
-+ TYPE_TARGET_TYPE (type) =
-+ resolve_dynamic_type (TYPE_TARGET_TYPE (type),
-+ NULL, addr);
-+ }
-+ else
-+ {
-+ /* Do nothing. References are already resolved from the beginning,
-+ only pointers are resolved when we actual need the target. */
-+ }
- fprintf_filtered (stream, "(");
- type_print (value_type (val), "", stream, -1);
- fprintf_filtered (stream, ") ");
-Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.cp/vla-cxx.exp
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.cp/vla-cxx.exp 2016-08-07 21:18:44.033409074 +0200
-+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.cp/vla-cxx.exp 2016-08-07 21:18:51.088474216 +0200
-@@ -26,6 +26,8 @@
- gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
- gdb_continue_to_breakpoint "Before pointer assignment"
- gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment"
-+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" "print ptr, Before pointer assignment"
-+gdb_test "print *ptr" "Cannot access memory at address 0x0" "print *ptr, Before pointer assignment"
-
- gdb_breakpoint [gdb_get_line_number "vlas_filled"]
- gdb_continue_to_breakpoint "vlas_filled"
-@@ -38,3 +40,5 @@
- gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}"
- gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}"
- gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]"
-+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex"
-+gdb_test "print *ptr" " = \\{5, 7, 9\\}"
-Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.exp 2016-08-07 21:18:51.088474216 +0200
-@@ -0,0 +1,123 @@
-+# Copyright 2016 Free Software Foundation, Inc.
-+
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 3 of the License, or
-+# (at your option) any later version.
-+#
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+# GNU General Public License for more details.
-+#
-+# You should have received a copy of the GNU General Public License
-+# along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+standard_testfile "pointers.f90"
-+load_lib fortran.exp
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+if ![runto_main] {
-+ untested "could not run to main"
-+ return -1
-+}
-+
-+# Depending on the compiler being used, the type names can be printed differently.
-+set logical [fortran_logical4]
-+set real [fortran_real4]
-+set int [fortran_int4]
-+set complex [fortran_complex4]
-+
-+
-+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
-+gdb_continue_to_breakpoint "Before pointer assignment"
-+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) 0x0" "print logp, not associated"
-+gdb_test "print *logp" "Cannot access memory at address 0x0" "print *logp, not associated"
-+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) 0x0" "print comp, not associated"
-+gdb_test "print *comp" "Cannot access memory at address 0x0" "print *comp, not associated"
-+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) 0x0" "print charp, not associated"
-+gdb_test "print *charp" "Cannot access memory at address 0x0" "print *charp, not associated"
-+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) 0x0" "print charap, not associated"
-+gdb_test "print *charap" "Cannot access memory at address 0x0" "print *charap, not associated"
-+gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" "print intp, not associated"
-+gdb_test "print *intp" "Cannot access memory at address 0x0" "print *intp, not associated"
-+set test "print intap, not associated"
-+gdb_test_multiple "print intap" $test {
-+ -re " = \\(PTR TO -> \\( $int \\(:,:\\)\\)\\) <not associated>\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re " = <not associated>\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" "print realp, not associated"
-+gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated"
-+gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
-+
-+
-+gdb_breakpoint [gdb_get_line_number "Before value assignment"]
-+gdb_continue_to_breakpoint "Before value assignment"
-+gdb_test "print *(twop)%ivla2" "= <not allocated>"
-+
-+
-+gdb_breakpoint [gdb_get_line_number "After value assignment"]
-+gdb_continue_to_breakpoint "After value assignment"
-+gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?"
-+gdb_test "print *logp" "= \\.TRUE\\."
-+gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?"
-+gdb_test "print *comp" "= \\(1,2\\)"
-+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?"
-+gdb_test "print *charp" "= 'a'"
-+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?"
-+gdb_test "print *charap" "= 'abc'"
-+gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?"
-+gdb_test "print *intp" "= 10"
-+set test_name "print intap, associated"
-+gdb_test_multiple "print intap" $test_name {
-+ -re "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)\r\n$gdb_prompt $" {
-+ pass $test_name
-+ }
-+ -re "= \\(PTR TO -> \\( $int \\(10,2\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
-+ gdb_test "print *intap" "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)"
-+ pass $test_name
-+ }
-+}
-+set test_name "print intvlap, associated"
-+gdb_test_multiple "print intvlap" $test_name {
-+ -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" {
-+ pass $test_name
-+ }
-+ -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
-+ gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)"
-+ pass $test_name
-+ }
-+}
-+gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?"
-+gdb_test "print *realp" "= 3\\.14000\\d+"
-+gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?"
-+gdb_test "print *(arrayOfPtr(2)%p)" "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)"
-+set test_name "print arrayOfPtr(3)%p"
-+gdb_test_multiple $test_name $test_name {
-+ -re "= \\(PTR TO -> \\( Type two \\)\\) <not associated>\r\n$gdb_prompt $" {
-+ pass $test_name
-+ }
-+ -re "= \\(PTR TO -> \\( Type two \\)\\) 0x0\r\n$gdb_prompt $" {
-+ pass $test_name
-+ }
-+}
-+set test_name "print *(arrayOfPtr(3)%p), associated"
-+gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name {
-+ -re "Cannot access memory at address 0x0\r\n$gdb_prompt $" {
-+ pass $test_name
-+ }
-+ -re "Attempt to take contents of a not associated pointer.\r\n$gdb_prompt $" {
-+ pass $test_name
-+ }
-+}
-+gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array"
-+gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla"
-+gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\)\\(\\)\\)\\) $hex <pointers\\+\\d+>" "Print program counter"
-Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.f90
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.fortran/pointers.f90 2016-08-07 21:18:44.033409074 +0200
-+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/pointers.f90 2016-08-07 21:18:51.088474216 +0200
-@@ -20,14 +20,20 @@
- integer, allocatable :: ivla2 (:, :)
- end type two
-
-+ type :: twoPtr
-+ type (two), pointer :: p
-+ end type twoPtr
-+
- logical, target :: logv
- complex, target :: comv
- character, target :: charv
- character (len=3), target :: chara
- integer, target :: intv
- integer, target, dimension (10,2) :: inta
-+ integer, target, allocatable, dimension (:) :: intvla
- real, target :: realv
- type(two), target :: twov
-+ type(twoPtr) :: arrayOfPtr (3)
-
- logical, pointer :: logp
- complex, pointer :: comp
-@@ -35,6 +41,7 @@
- character (len=3), pointer:: charap
- integer, pointer :: intp
- integer, pointer, dimension (:,:) :: intap
-+ integer, pointer, dimension (:) :: intvlap
- real, pointer :: realp
- type(two), pointer :: twop
-
-@@ -44,8 +51,12 @@
- nullify (charap)
- nullify (intp)
- nullify (intap)
-+ nullify (intvlap)
- nullify (realp)
- nullify (twop)
-+ nullify (arrayOfPtr(1)%p)
-+ nullify (arrayOfPtr(2)%p)
-+ nullify (arrayOfPtr(3)%p)
-
- logp => logv ! Before pointer assignment
- comp => comv
-@@ -53,8 +64,10 @@
- charap => chara
- intp => intv
- intap => inta
-+ intvlap => intvla
- realp => realv
- twop => twov
-+ arrayOfPtr(2)%p => twov
-
- logv = associated(logp) ! Before value assignment
- comv = cmplx(1,2)
-@@ -63,6 +76,10 @@
- intv = 10
- inta(:,:) = 1
- inta(3,1) = 3
-+ allocate (intvla(10))
-+ intvla(:) = 2
-+ intvla(4) = 4
-+ intvlap => intvla
- realv = 3.14
-
- allocate (twov%ivla1(3))
-Index: gdb-7.11.90.20160807/gdb/valops.c
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/valops.c 2016-08-07 21:18:44.035409093 +0200
-+++ gdb-7.11.90.20160807/gdb/valops.c 2016-08-07 21:18:51.089474225 +0200
-@@ -1562,6 +1562,19 @@
- if (TYPE_CODE (base_type) == TYPE_CODE_PTR)
- {
- struct type *enc_type;
-+ CORE_ADDR addr;
-+
-+ if (type_not_associated (base_type))
-+ error (_("Attempt to take contents of a not associated pointer."));
-+
-+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type)))
-+ addr = value_address (arg1);
-+ else
-+ addr = value_as_address (arg1);
-+
-+ if (addr != 0)
-+ TYPE_TARGET_TYPE (base_type) =
-+ resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), NULL, addr);
-
- /* We may be pointing to something embedded in a larger object.
- Get the real type of the enclosing object. */
-@@ -1577,8 +1590,7 @@
- else
- /* Retrieve the enclosing object pointed to. */
- arg2 = value_at_lazy (enc_type,
-- (value_as_address (arg1)
-- - value_pointed_to_offset (arg1)));
-+ (addr - value_pointed_to_offset (arg1)));
-
- enc_type = value_type (arg2);
- return readjust_indirect_value_type (arg2, enc_type, base_type, arg1);
-Index: gdb-7.11.90.20160807/gdb/valprint.c
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/valprint.c 2016-08-07 04:00:01.000000000 +0200
-+++ gdb-7.11.90.20160807/gdb/valprint.c 2016-08-07 21:18:51.090474235 +0200
-@@ -1141,12 +1141,6 @@
- return 0;
- }
-
-- if (type_not_associated (value_type (val)))
-- {
-- val_print_not_associated (stream);
-- return 0;
-- }
--
- if (type_not_allocated (value_type (val)))
- {
- val_print_not_allocated (stream);
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 <bernhard.heckel@intel.com>
-Date: Tue, 12 Jul 2016 08:19:34 +0200
-Subject: [PATCH 6/7] Fortran: Testsuite, add cyclic pointers.
-
-2016-05-25 Bernhard Heckel <bernhard.heckel@intel.com>
-
-gdb/testsuite/Changelog:
- * pointers.f90: Add cylic pointers.
- * pointers.exp: Add print of cyclic pointers.
-
-Change-Id: Ic3b6187c5980fd6c37e2e94787f8321e5b7f2d75
----
- gdb/testsuite/gdb.fortran/pointers.exp | 20 ++++++++++++++++++++
- gdb/testsuite/gdb.fortran/pointers.f90 | 12 ++++++++++++
- 2 files changed, 32 insertions(+)
-
-diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp
-index c19d7e0..67cf999 100644
---- a/gdb/testsuite/gdb.fortran/pointers.exp
-+++ b/gdb/testsuite/gdb.fortran/pointers.exp
-@@ -57,6 +57,24 @@ gdb_test_multiple "print intap" $test {
- gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" "print realp, not associated"
- gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated"
- gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
-+set test "print cyclicp1, not associated"
-+gdb_test_multiple "print cyclicp1" $test {
-+ -re "= \\( i = -?\\d+, p = 0x0 \\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "= \\( i = -?\\d+, p = <not associated> \\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+set test "print cyclicp1%p, not associated"
-+gdb_test_multiple "print cyclicp1%p" $test {
-+ -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) <not associated>\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-
-
- gdb_breakpoint [gdb_get_line_number "Before value assignment"]
-@@ -118,6 +136,8 @@ gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name {
- pass $test_name
- }
- }
-+gdb_test "print cyclicp1" "= \\( i = 1, p = $hex\( <.*>\)? \\)"
-+gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer \\)\\) $hex\( <.*>\)?"
- gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array"
- gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla"
- gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\)\\(\\)\\)\\) $hex <pointers\\+\\d+>" "Print program counter"
-diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90
-index 000193c..6240c87 100644
---- a/gdb/testsuite/gdb.fortran/pointers.f90
-+++ b/gdb/testsuite/gdb.fortran/pointers.f90
-@@ -20,6 +20,11 @@ program pointers
- integer, allocatable :: ivla2 (:, :)
- end type two
-
-+ type :: typeWithPointer
-+ integer i
-+ type(typeWithPointer), pointer:: p
-+ end type typeWithPointer
-+
- type :: twoPtr
- type (two), pointer :: p
- end type twoPtr
-@@ -34,6 +39,7 @@ program pointers
- real, target :: realv
- type(two), target :: twov
- type(twoPtr) :: arrayOfPtr (3)
-+ type(typeWithPointer), target:: cyclicp1,cyclicp2
-
- logical, pointer :: logp
- complex, pointer :: comp
-@@ -57,6 +63,8 @@ program pointers
- nullify (arrayOfPtr(1)%p)
- nullify (arrayOfPtr(2)%p)
- nullify (arrayOfPtr(3)%p)
-+ nullify (cyclicp1%p)
-+ nullify (cyclicp2%p)
-
- logp => logv ! Before pointer assignment
- comp => comv
-@@ -68,6 +76,10 @@ program pointers
- realp => realv
- twop => twov
- arrayOfPtr(2)%p => twov
-+ cyclicp1%i = 1
-+ cyclicp1%p => cyclicp2
-+ cyclicp2%i = 2
-+ cyclicp2%p => cyclicp1
-
- logv = associated(logp) ! Before value assignment
- comv = cmplx(1,2)
---
-2.7.4
-
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 <bernhard.heckel@intel.com>
-Date: Tue, 12 Jul 2016 08:19:34 +0200
-Subject: [PATCH 7/7] fort_dyn_array: Fortran dynamic string support
-
-This patch changes the semantic of the Dwarf string length
-attribute to reflect the standard as well as enables
-correct string length calculation of dynamic strings. Add
-tests for varous dynamic string evaluations.
-
-Old:
-(gdb) p my_dyn_string
-Cannot access memory at address 0x605fc0
-
-New:
-(gdb) p *my_dyn_string
-$1 = 'foo'
-
-gdb/Changlog:
- * dwarf2read.c (read_tag_string_type): changed
- semantic of DW_AT_string_length to be able to
- handle Dwarf blocks as well. Support for
- DW_AT_byte_length added to get correct length
- if specified in combination with
- DW_AT_string_length.
- (attr_to_dynamic_prop): added
- functionality to add Dwarf operators to baton
- data attribute. Added post values to baton
- as required by the string evaluation case.
- (read_subrange_type): Adapt caller.
- (set_die_type): Adapt caller.
- (add_post_values_to_baton): New function.
- * gdbtypes.c (resolve_dynamic_type): Add
- conditions to support string types.
- (resolve_dynamic_array): Add conditions for dynamic
- strings and create a new string type.
- (is_dynamic_type): Follow pointer if a string type
- was detected, as Fortran strings are represented
- as pointers to strings internally.
-
-gdb/testsuite/Changelog:
- * vla-strings.f90: New file.
- * vla-strings.exp: New file.
-
-Change-Id: I7d7f47c7a4900a7fdb51102032455b53d60e60d7
----
- gdb/dwarf2read.c | 158 +++++++++++++++++++++++++-----
- gdb/gdbtypes.c | 15 ++-
- gdb/testsuite/gdb.fortran/vla-strings.exp | 103 +++++++++++++++++++
- gdb/testsuite/gdb.fortran/vla-strings.f90 | 39 ++++++++
- 4 files changed, 285 insertions(+), 30 deletions(-)
- create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.exp
- create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.f90
-
-Index: gdb-7.11.90.20160807/gdb/dwarf2read.c
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/dwarf2read.c 2016-08-25 16:08:17.397714936 +0200
-+++ gdb-7.11.90.20160807/gdb/dwarf2read.c 2016-08-25 16:09:56.703580597 +0200
-@@ -1764,7 +1764,8 @@
-
- static int attr_to_dynamic_prop (const struct attribute *attr,
- struct die_info *die, struct dwarf2_cu *cu,
-- struct dynamic_prop *prop);
-+ struct dynamic_prop *prop, const gdb_byte *additional_data,
-+ int additional_data_size);
-
- /* memory allocation interface */
-
-@@ -11446,7 +11447,7 @@
- {
- newobj->static_link
- = XOBNEW (&objfile->objfile_obstack, struct dynamic_prop);
-- attr_to_dynamic_prop (attr, die, cu, newobj->static_link);
-+ attr_to_dynamic_prop (attr, die, cu, newobj->static_link, NULL, 0);
- }
-
- cu->list_in_scope = &local_symbols;
-@@ -14512,29 +14513,94 @@
- struct gdbarch *gdbarch = get_objfile_arch (objfile);
- struct type *type, *range_type, *index_type, *char_type;
- struct attribute *attr;
-- unsigned int length;
-+ unsigned int length = UINT_MAX;
-
-+ index_type = objfile_type (objfile)->builtin_int;
-+ range_type = create_static_range_type (NULL, index_type, 1, length);
-+
-+ /* If DW_AT_string_length is defined, the length is stored in memory. */
- attr = dwarf2_attr (die, DW_AT_string_length, cu);
- if (attr)
- {
-- length = DW_UNSND (attr);
-+ if (attr_form_is_block (attr))
-+ {
-+ struct attribute *byte_size, *bit_size;
-+ struct dynamic_prop high;
-+
-+ byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
-+ bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
-+
-+ /* DW_AT_byte_size should never occur in combination with
-+ DW_AT_bit_size. */
-+ if (byte_size != NULL && bit_size != NULL)
-+ complaint (&symfile_complaints,
-+ _("DW_AT_byte_size AND "
-+ "DW_AT_bit_size found together at the same time."));
-+
-+ /* If DW_AT_string_length AND DW_AT_byte_size exist together,
-+ DW_AT_byte_size describes the number of bytes that should be read
-+ from the length memory location. */
-+ if (byte_size != NULL)
-+ {
-+ /* Build new dwarf2_locexpr_baton structure with additions to the
-+ data attribute, to reflect DWARF specialities to get address
-+ sizes. */
-+ const gdb_byte append_ops[] =
-+ {
-+ /* DW_OP_deref_size: size of an address on the target machine
-+ (bytes), where the size will be specified by the next
-+ operand. */
-+ DW_OP_deref_size,
-+ /* Operand for DW_OP_deref_size. */
-+ DW_UNSND(byte_size) };
-+
-+ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
-+ ARRAY_SIZE(append_ops)))
-+ complaint (&symfile_complaints,
-+ _("Could not parse DW_AT_byte_size"));
-+ }
-+ else if (bit_size != NULL)
-+ complaint (&symfile_complaints,
-+ _("DW_AT_string_length AND "
-+ "DW_AT_bit_size found but not supported yet."));
-+ /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
-+ is the address size of the target machine. */
-+ else
-+ {
-+ const gdb_byte append_ops[] =
-+ { DW_OP_deref };
-+
-+ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
-+ ARRAY_SIZE(append_ops)))
-+ complaint (&symfile_complaints,
-+ _("Could not parse DW_AT_string_length"));
-+ }
-+
-+ TYPE_RANGE_DATA (range_type)->high = high;
-+ }
-+ else
-+ {
-+ TYPE_HIGH_BOUND (range_type) = DW_UNSND(attr);
-+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
-+ }
- }
- else
- {
-- /* Check for the DW_AT_byte_size attribute. */
-+ /* Check for the DW_AT_byte_size attribute, which represents the length
-+ in this case. */
- attr = dwarf2_attr (die, DW_AT_byte_size, cu);
- if (attr)
-- {
-- length = DW_UNSND (attr);
-- }
-+ {
-+ TYPE_HIGH_BOUND (range_type) = DW_UNSND(attr);
-+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
-+ }
- else
-- {
-- length = 1;
-- }
-+ {
-+ TYPE_HIGH_BOUND (range_type) = 1;
-+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
-+ }
- }
-
-- index_type = objfile_type (objfile)->builtin_int;
-- range_type = create_static_range_type (NULL, index_type, 1, length);
- char_type = language_string_char_type (cu->language_defn, gdbarch);
- type = create_string_type (NULL, char_type, range_type);
-
-@@ -14864,7 +14930,8 @@
-
- static int
- attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
-- struct dwarf2_cu *cu, struct dynamic_prop *prop)
-+ struct dwarf2_cu *cu, struct dynamic_prop *prop,
-+ const gdb_byte *additional_data, int additional_data_size)
- {
- struct dwarf2_property_baton *baton;
- struct obstack *obstack = &cu->objfile->objfile_obstack;
-@@ -14874,14 +14941,33 @@
-
- if (attr_form_is_block (attr))
- {
-- baton = XOBNEW (obstack, struct dwarf2_property_baton);
-+ baton = XOBNEW(obstack, struct dwarf2_property_baton);
- baton->referenced_type = NULL;
- baton->locexpr.per_cu = cu->per_cu;
-- baton->locexpr.size = DW_BLOCK (attr)->size;
-- baton->locexpr.data = DW_BLOCK (attr)->data;
-+
-+ if (additional_data != NULL && additional_data_size > 0)
-+ {
-+ gdb_byte *data;
-+
-+ data = (gdb_byte *) obstack_alloc(
-+ &cu->objfile->objfile_obstack,
-+ DW_BLOCK (attr)->size + additional_data_size);
-+ memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
-+ memcpy (data + DW_BLOCK (attr)->size, additional_data,
-+ additional_data_size);
-+
-+ baton->locexpr.data = data;
-+ baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
-+ }
-+ else
-+ {
-+ baton->locexpr.data = DW_BLOCK (attr)->data;
-+ baton->locexpr.size = DW_BLOCK (attr)->size;
-+ }
-+
- prop->data.baton = baton;
- prop->kind = PROP_LOCEXPR;
-- gdb_assert (prop->data.baton != NULL);
-+ gdb_assert(prop->data.baton != NULL);
- }
- else if (attr_form_is_ref (attr))
- {
-@@ -14914,8 +15000,28 @@
- baton = XOBNEW (obstack, struct dwarf2_property_baton);
- baton->referenced_type = die_type (target_die, target_cu);
- baton->locexpr.per_cu = cu->per_cu;
-- baton->locexpr.size = DW_BLOCK (target_attr)->size;
-- baton->locexpr.data = DW_BLOCK (target_attr)->data;
-+
-+ if (additional_data != NULL && additional_data_size > 0)
-+ {
-+ gdb_byte *data;
-+
-+ data = (gdb_byte *) obstack_alloc (&cu->objfile->objfile_obstack,
-+ DW_BLOCK (target_attr)->size + additional_data_size);
-+ memcpy (data, DW_BLOCK (target_attr)->data,
-+ DW_BLOCK (target_attr)->size);
-+ memcpy (data + DW_BLOCK (target_attr)->size,
-+ additional_data, additional_data_size);
-+
-+ baton->locexpr.data = data;
-+ baton->locexpr.size = (DW_BLOCK (target_attr)->size
-+ + additional_data_size);
-+ }
-+ else
-+ {
-+ baton->locexpr.data = DW_BLOCK (target_attr)->data;
-+ baton->locexpr.size = DW_BLOCK (target_attr)->size;
-+ }
-+
- prop->data.baton = baton;
- prop->kind = PROP_LOCEXPR;
- gdb_assert (prop->data.baton != NULL);
-@@ -15027,24 +15133,24 @@
-
- attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
- if (attr)
-- if (!attr_to_dynamic_prop (attr, die, cu, &stride))
-+ if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0))
- complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
- "- DIE at 0x%x [in module %s]"),
- die->offset.sect_off, objfile_name (cu->objfile));
-
- attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
- if (attr)
-- attr_to_dynamic_prop (attr, die, cu, &low);
-+ attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
- else if (!low_default_is_valid)
- complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
- "- DIE at 0x%x [in module %s]"),
- die->offset.sect_off, objfile_name (cu->objfile));
-
- attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
-- if (!attr_to_dynamic_prop (attr, die, cu, &high))
-+ if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
- {
- attr = dwarf2_attr (die, DW_AT_count, cu);
-- if (attr_to_dynamic_prop (attr, die, cu, &high))
-+ if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
- {
- /* If bounds are constant do the final calculation here. */
- if (low.kind == PROP_CONST && high.kind == PROP_CONST)
-@@ -22416,7 +22522,7 @@
- attr = dwarf2_attr (die, DW_AT_allocated, cu);
- if (attr_form_is_block (attr))
- {
-- if (attr_to_dynamic_prop (attr, die, cu, &prop))
-+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
- add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile);
- }
- else if (attr != NULL)
-@@ -22431,7 +22537,7 @@
- attr = dwarf2_attr (die, DW_AT_associated, cu);
- if (attr_form_is_block (attr))
- {
-- if (attr_to_dynamic_prop (attr, die, cu, &prop))
-+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
- add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile);
- }
- else if (attr != NULL)
-@@ -22444,7 +22550,7 @@
-
- /* Read DW_AT_data_location and set in type. */
- attr = dwarf2_attr (die, DW_AT_data_location, cu);
-- if (attr_to_dynamic_prop (attr, die, cu, &prop))
-+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
- add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile);
-
- if (dwarf2_per_objfile->die_type_hash == NULL)
-Index: gdb-7.11.90.20160807/gdb/gdbtypes.c
-===================================================================
---- gdb-7.11.90.20160807.orig/gdb/gdbtypes.c 2016-08-25 16:08:17.397714936 +0200
-+++ gdb-7.11.90.20160807/gdb/gdbtypes.c 2016-08-25 16:09:11.623187626 +0200
-@@ -1851,6 +1851,7 @@
- }
-
- case TYPE_CODE_ARRAY:
-+ case TYPE_CODE_STRING:
- {
- gdb_assert (TYPE_NFIELDS (type) == 1);
-
-@@ -1964,7 +1965,8 @@
- struct type *ary_dim;
- struct dynamic_prop *prop;
-
-- gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
-+ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
-+ || TYPE_CODE (type) == TYPE_CODE_STRING);
-
- type = copy_type (type);
-
-@@ -1989,13 +1991,17 @@
-
- ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
-
-- if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
-+ if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
-+ || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
- elt_type = resolve_dynamic_array (ary_dim, addr_stack);
- else
- elt_type = TYPE_TARGET_TYPE (type);
-
-- return create_array_type_with_stride (type, elt_type, range_type,
-- TYPE_FIELD_BITSIZE (type, 0));
-+ if (TYPE_CODE (type) == TYPE_CODE_STRING)
-+ return create_string_type (type, elt_type, range_type);
-+ else
-+ return create_array_type_with_stride (type, elt_type, range_type,
-+ TYPE_FIELD_BITSIZE (type, 0));
- }
-
- /* Resolve dynamic bounds of members of the union TYPE to static
-@@ -2200,6 +2206,7 @@
- break;
-
- case TYPE_CODE_ARRAY:
-+ case TYPE_CODE_STRING:
- resolved_type = resolve_dynamic_array (type, addr_stack);
- break;
-
-Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.exp 2016-08-25 16:09:11.624187635 +0200
-@@ -0,0 +1,103 @@
-+# Copyright 2016 Free Software Foundation, Inc.
-+
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 3 of the License, or
-+# (at your option) any later version.
-+#
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+# GNU General Public License for more details.
-+#
-+# You should have received a copy of the GNU General Public License
-+# along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+standard_testfile ".f90"
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+# check that all fortran standard datatypes will be
-+# handled correctly when using as VLA's
-+
-+if ![runto_main] {
-+ untested "could not run to main"
-+ return -1
-+}
-+
-+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
-+gdb_continue_to_breakpoint "var_char-allocated-1"
-+set test "whatis var_char first time"
-+gdb_test_multiple "whatis var_char" $test {
-+ -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "type = character\\*10\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+set test "ptype var_char first time"
-+gdb_test_multiple "ptype var_char" $test {
-+ -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "type = character\\*10\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+
-+
-+gdb_test "next" "\\d+.*var_char = 'foo'.*" \
-+ "next to allocation status of var_char"
-+gdb_test "print l" " = \\.TRUE\\." "print allocation status first time"
-+
-+
-+gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
-+gdb_continue_to_breakpoint "var_char-filled-1"
-+set test "print var_char, var_char-filled-1"
-+gdb_test_multiple "print var_char" $test {
-+ -re "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\r\n$gdb_prompt $" {
-+ gdb_test "print *var_char" "= 'foo'" "print *var_char, var_char-filled-1"
-+ pass $test
-+ }
-+ -re "= 'foo'\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+set test "ptype var_char, var_char-filled-1"
-+gdb_test_multiple "ptype var_char" $test {
-+ -re "type = PTR TO -> \\( character\\*3 \\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "type = character\\*3\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
-+gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
-+
-+
-+gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
-+gdb_continue_to_breakpoint "var_char-filled-2"
-+set test "print var_char, var_char-filled-2"
-+gdb_test_multiple "print var_char" $test {
-+ -re "= \\(PTR TO -> \\( character\\*6 \\)\\) $hex\r\n$gdb_prompt $" {
-+ gdb_test "print *var_char" "= 'foobar'" "print *var_char, var_char-filled-2"
-+ pass $test
-+ }
-+ -re "= 'foobar'\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-+set test "ptype var_char, var_char-filled-2"
-+gdb_test_multiple "ptype var_char" $test {
-+ -re "type = PTR TO -> \\( character\\*6 \\)\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+ -re "type = character\\*6\r\n$gdb_prompt $" {
-+ pass $test
-+ }
-+}
-Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.f90
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/vla-strings.f90 2016-08-25 16:09:11.624187635 +0200
-@@ -0,0 +1,39 @@
-+! Copyright 2016 Free Software Foundation, Inc.
-+!
-+! This program is free software; you can redistribute it and/or modify
-+! it under the terms of the GNU General Public License as published by
-+! the Free Software Foundation; either version 3 of the License, or
-+! (at your option) any later version.
-+!
-+! This program is distributed in the hope that it will be useful,
-+! but WITHOUT ANY WARRANTY; without even the implied warranty of
-+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+! GNU General Public License for more details.
-+!
-+! You should have received a copy of the GNU General Public License
-+! along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+program vla_strings
-+ character(len=:), target, allocatable :: var_char
-+ character(len=:), pointer :: var_char_p
-+ logical :: l
-+
-+ allocate(character(len=10) :: var_char)
-+ l = allocated(var_char) ! var_char-allocated-1
-+ var_char = 'foo'
-+ deallocate(var_char) ! var_char-filled-1
-+ l = allocated(var_char) ! var_char-deallocated
-+ allocate(character(len=42) :: var_char)
-+ l = allocated(var_char)
-+ var_char = 'foobar'
-+ var_char = '' ! var_char-filled-2
-+ var_char = 'bar' ! var_char-empty
-+ deallocate(var_char)
-+ allocate(character(len=21) :: var_char)
-+ l = allocated(var_char) ! var_char-allocated-3
-+ var_char = 'johndoe'
-+ var_char_p => var_char
-+ l = associated(var_char_p) ! var_char_p-associated
-+ var_char_p => null()
-+ l = associated(var_char_p) ! var_char_p-not-associated
-+end program vla_strings
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. <christoph.t.weinmann@intel.com>
-+#
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 3 of the License, or
-+# (at your option) any later version.
-+#
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+# GNU General Public License for more details.
-+#
-+# You should have received a copy of the GNU General Public License
-+# along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+standard_testfile 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. <christoph.t.weinmann@intel.com>
-+!
-+! This program is free software; you can redistribute it and/or modify
-+! it under the terms of the GNU General Public License as published by
-+! the Free Software Foundation; either version 3 of the License, or
-+! (at your option) any later version.
-+!
-+! This program is distributed in the hope that it will be useful,
-+! but WITHOUT ANY WARRANTY; without even the implied warranty of
-+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+! GNU General Public License for more details.
-+!
-+! You should have received a copy of the GNU General Public License
-+! along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+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 <http://www.gnu.org/licenses/>.
-+
-+standard_testfile ".f90"
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+if ![runto MAIN__] then {
-+ perror "couldn't run to breakpoint MAIN__"
-+ continue
-+}
-+
-+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
-+gdb_continue_to_breakpoint "re-reverse-elements"
-+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
-+ "print re-reverse-elements"
-+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
-+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
-+
-+gdb_breakpoint [gdb_get_line_number "odd-elements"]
-+gdb_continue_to_breakpoint "odd-elements"
-+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
-+gdb_test "print pvla(1)" " = 1" "print first odd-element"
-+gdb_test "print pvla(5)" " = 9" "print last odd-element"
-+
-+gdb_breakpoint [gdb_get_line_number "single-element"]
-+gdb_continue_to_breakpoint "single-element"
-+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
-+gdb_test "print pvla(1)" " = 5" "print one single-element"
-diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
-new file mode 100644
-index 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 <http://www.gnu.org/licenses/>.
-+
-+program vla_stride
-+ integer, target, allocatable :: vla (:)
-+ integer, pointer :: pvla (:)
-+
-+ allocate(vla(10))
-+ vla = (/ (I, I = 1,10) /)
-+
-+ pvla => vla(10:1:-1)
-+ pvla => pvla(10:1:-1)
-+ pvla => vla(1:10:2) ! re-reverse-elements
-+ pvla => vla(5:4:-2) ! odd-elements
-+
-+ pvla => null() ! single-element
-+end program vla_stride
-diff --git a/gdb/valarith.c b/gdb/valarith.c
-index 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. <christoph.t.weinmann@intel.com>
++#
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++standard_testfile 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. <christoph.t.weinmann@intel.com>
++!
++! This program is free software; you can redistribute it and/or modify
++! it under the terms of the GNU General Public License as published by
++! the Free Software Foundation; either version 3 of the License, or
++! (at your option) any later version.
++!
++! This program is distributed in the hope that it will be useful,
++! but WITHOUT ANY WARRANTY; without even the implied warranty of
++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++! GNU General Public License for more details.
++!
++! You should have received a copy of the GNU General Public License
++! along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++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 = <not allocated>" "ptype vla2 not allocated"
+ gdb_test "ptype vla2(5, 45, 20)" \
+ "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla2(5, 45, 20) not allocated"
++
++gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
++gdb_continue_to_breakpoint "vla1-neg-bounds"
++gdb_test "ptype vla1" "type = $real \\(-2:1,-5:4,-3:-1\\)" "ptype vla1 negative bounds"
+diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+index 8010c0a..f8258a1 100644
+--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp
++++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+@@ -44,3 +44,7 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
+ gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+ gdb_continue_to_breakpoint "pvla-associated"
+ gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
++
++gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
++gdb_continue_to_breakpoint "vla1-neg-bounds"
++gdb_test "print sizeof(vla1)" " = 480" "print sizeof vla1 negative bounds"
+diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
+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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
++gdb_continue_to_breakpoint "re-reverse-elements"
++gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
++ "print re-reverse-elements"
++gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
++gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
++
++gdb_breakpoint [gdb_get_line_number "odd-elements"]
++gdb_continue_to_breakpoint "odd-elements"
++gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
++gdb_test "print pvla(1)" " = 1" "print first odd-element"
++gdb_test "print pvla(5)" " = 9" "print last odd-element"
++
++gdb_breakpoint [gdb_get_line_number "single-element"]
++gdb_continue_to_breakpoint "single-element"
++gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
++gdb_test "print pvla(1)" " = 5" "print one single-element"
+diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
+new file mode 100644
+index 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 <http://www.gnu.org/licenses/>.
++
++program vla_stride
++ integer, target, allocatable :: vla (:)
++ integer, pointer :: pvla (:)
++
++ allocate(vla(10))
++ vla = (/ (I, I = 1,10) /)
++
++ pvla => vla(10:1:-1)
++ pvla => pvla(10:1:-1)
++ pvla => vla(1:10:2) ! re-reverse-elements
++ pvla => vla(5:4:-2) ! odd-elements
++
++ pvla => null() ! single-element
++end program vla_stride
+diff --git a/gdb/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 <http://www.gnu.org/licenses/>. */
+
++extern "C" {
++#include <stddef.h>
++}
++
+ 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "pointers.f90"
++load_lib fortran.exp
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++if ![runto_main] {
++ untested "could not run to main"
++ return -1
++}
++
++# Depending on the compiler being used, the type names can be printed differently.
++set logical [fortran_logical4]
++set real [fortran_real4]
++set int [fortran_int4]
++set complex [fortran_complex4]
++
++
++gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
++gdb_continue_to_breakpoint "Before pointer assignment"
++gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) 0x0" "print logp, not associated"
++gdb_test "print *logp" "Cannot access memory at address 0x0" "print *logp, not associated"
++gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) 0x0" "print comp, not associated"
++gdb_test "print *comp" "Cannot access memory at address 0x0" "print *comp, not associated"
++gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) 0x0" "print charp, not associated"
++gdb_test "print *charp" "Cannot access memory at address 0x0" "print *charp, not associated"
++gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) 0x0" "print charap, not associated"
++gdb_test "print *charap" "Cannot access memory at address 0x0" "print *charap, not associated"
++gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0" "print intp, not associated"
++gdb_test "print *intp" "Cannot access memory at address 0x0" "print *intp, not associated"
++set test "print intap, not associated"
++gdb_test_multiple "print intap" $test {
++ -re " = \\(PTR TO -> \\( $int \\(:,:\\)\\)\\) <not associated>\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re " = <not associated>\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) 0x0" "print realp, not associated"
++gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated"
++gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int \\)\\) 0x0"
++set test "print cyclicp1, not associated"
++gdb_test_multiple "print cyclicp1" $test {
++ -re "= \\( i = -?\\d+, p = 0x0 \\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "= \\( i = -?\\d+, p = <not associated> \\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++set test "print cyclicp1%p, not associated"
++gdb_test_multiple "print cyclicp1%p" $test {
++ -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) 0x0\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "= \\(PTR TO -> \\( Type typewithpointer \\)\\) <not associated>\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++
++
++gdb_breakpoint [gdb_get_line_number "Before value assignment"]
++gdb_continue_to_breakpoint "Before value assignment"
++gdb_test "print *(twop)%ivla2" "= <not allocated>"
++
++
++gdb_breakpoint [gdb_get_line_number "After value assignment"]
++gdb_continue_to_breakpoint "After value assignment"
++gdb_test "print logp" "= \\(PTR TO -> \\( $logical \\)\\) $hex\( <.*>\)?"
++gdb_test "print *logp" "= \\.TRUE\\."
++gdb_test "print comp" "= \\(PTR TO -> \\( $complex \\)\\) $hex\( <.*>\)?"
++gdb_test "print *comp" "= \\(1,2\\)"
++gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1 \\)\\) $hex\( <.*>\)?"
++gdb_test "print *charp" "= 'a'"
++gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\( <.*>\)?"
++gdb_test "print *charap" "= 'abc'"
++gdb_test "print intp" "= \\(PTR TO -> \\( $int \\)\\) $hex\( <.*>\)?"
++gdb_test "print *intp" "= 10"
++set test_name "print intap, associated"
++gdb_test_multiple "print intap" $test_name {
++ -re "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)\r\n$gdb_prompt $" {
++ pass $test_name
++ }
++ -re "= \\(PTR TO -> \\( $int \\(10,2\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
++ gdb_test "print *intap" "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)"
++ pass $test_name
++ }
++}
++set test_name "print intvlap, associated"
++gdb_test_multiple "print intvlap" $test_name {
++ -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" {
++ pass $test_name
++ }
++ -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" {
++ gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)"
++ pass $test_name
++ }
++}
++gdb_test "print realp" "= \\(PTR TO -> \\( $real \\)\\) $hex\( <.*>\)?"
++gdb_test "print *realp" "= 3\\.14000\\d+"
++gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two \\)\\) $hex\( <.*>\)?"
++gdb_test "print *(arrayOfPtr(2)%p)" "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)"
++set test_name "print arrayOfPtr(3)%p"
++gdb_test_multiple $test_name $test_name {
++ -re "= \\(PTR TO -> \\( Type two \\)\\) <not associated>\r\n$gdb_prompt $" {
++ pass $test_name
++ }
++ -re "= \\(PTR TO -> \\( Type two \\)\\) 0x0\r\n$gdb_prompt $" {
++ pass $test_name
++ }
++}
++set test_name "print *(arrayOfPtr(3)%p), associated"
++gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name {
++ -re "Cannot access memory at address 0x0\r\n$gdb_prompt $" {
++ pass $test_name
++ }
++ -re "Attempt to take contents of a not associated pointer.\r\n$gdb_prompt $" {
++ pass $test_name
++ }
++}
++gdb_test "print cyclicp1" "= \\( i = 1, p = $hex\( <.*>\)? \\)"
++gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer \\)\\) $hex\( <.*>\)?"
++gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array"
++gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla"
++gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\)\\(\\)\\)\\) $hex <pointers\\+\\d+>" "Print program counter"
+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 <http://www.gnu.org/licenses/>.
++
++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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "pointers.f90"
++load_lib fortran.exp
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++
++if ![runto_main] {
++ untested "could not run to main"
++ return -1
++}
++
++# Depending on the compiler being used, the type names can be printed differently.
++set logical [fortran_logical4]
++set real [fortran_real4]
++set int [fortran_int4]
++set complex [fortran_complex4]
++
++gdb_breakpoint [gdb_get_line_number "Before pointer assignment"]
++gdb_continue_to_breakpoint "Before pointer assignment"
++gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)" "ptype logp, not associated"
++gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" "ptype comp, not associated"
++gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" "ptype charp, not associated"
++gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" "ptype charap, not associated"
++gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" "ptype intp, not associated"
++set test "ptype intap, not associated"
++gdb_test_multiple "ptype intap" $test {
++ -re "type = PTR TO -> \\( $int \\(:,:\\)\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = $int \\(:,:\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" "ptype realp, not associated"
++gdb_test "ptype twop" \
++ [multi_line "type = PTR TO -> \\( Type two" \
++ " $int :: ivla1\\(:\\)" \
++ " $int :: ivla2\\(:,:\\)" \
++ "End Type two \\)"] \
++ "ptype twop, not associated"
++gdb_test "ptype two" \
++ [multi_line "type = Type two" \
++ " $int :: ivla1\\(:\\)" \
++ " $int :: ivla2\\(:,:\\)" \
++ "End Type two"]
++
++
++gdb_breakpoint [gdb_get_line_number "Before value assignment"]
++gdb_continue_to_breakpoint "Before value assignment"
++gdb_test "ptype twop" \
++ [multi_line "type = PTR TO -> \\( Type two" \
++ " $int :: ivla1\\(:\\)" \
++ " $int :: ivla2\\(:,:\\)" \
++ "End Type two \\)"]
++
++
++gdb_breakpoint [gdb_get_line_number "After value assignment"]
++gdb_continue_to_breakpoint "After value assignment"
++gdb_test "ptype logv" "type = $logical"
++gdb_test "ptype comv" "type = $complex"
++gdb_test "ptype charv" "type = character\\*1"
++gdb_test "ptype chara" "type = character\\*3"
++gdb_test "ptype intv" "type = $int"
++gdb_test "ptype inta" "type = $int \\(10,2\\)"
++gdb_test "ptype realv" "type = $real"
++
++
++gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)"
++gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)"
++gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)"
++gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)"
++gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)"
++set test "ptype intap"
++gdb_test_multiple $test $test {
++ -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = PTR TO -> \\( $int \\(10,2\\)\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)"
+Index: gdb-7.11.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 = <not allocated>" "ptype vla1 not initialized"
+-gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
+-gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
++gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not initialized"
++gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not initialized"
++gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla not initialized"
+ gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla1(3, 6, 9) not initialized"
+ gdb_test "ptype vla2(5, 45, 20)" \
+@@ -81,20 +81,20 @@
+
+ gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
+ gdb_continue_to_breakpoint "pvla-deassociated"
+-gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
++gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla deassociated"
+ gdb_test "ptype pvla(5, 45, 20)" \
+ "no such vector element \\\(vector not associated\\\)" \
+ "ptype pvla(5, 45, 20) not associated"
+
+ gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
+ gdb_continue_to_breakpoint "vla1-deallocated"
+-gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
++gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not allocated"
+ gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla1(3, 6, 9) not allocated"
+
+ gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
+ gdb_continue_to_breakpoint "vla2-deallocated"
+-gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
++gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not allocated"
+ gdb_test "ptype vla2(5, 45, 20)" \
+ "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla2(5, 45, 20) not allocated"
+Index: gdb-7.11.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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++# check that all fortran standard datatypes will be
++# handled correctly when using as VLA's
++
++if ![runto_main] {
++ untested "could not run to main"
++ return -1
++}
++
++gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
++gdb_continue_to_breakpoint "var_char-allocated-1"
++set test "whatis var_char first time"
++gdb_test_multiple "whatis var_char" $test {
++ -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = character\\*10\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++set test "ptype var_char first time"
++gdb_test_multiple "ptype var_char" $test {
++ -re "type = PTR TO -> \\( character\\*10 \\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = character\\*10\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++
++
++gdb_test "next" "\\d+.*var_char = 'foo'.*" \
++ "next to allocation status of var_char"
++gdb_test "print l" " = \\.TRUE\\." "print allocation status first time"
++
++
++gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
++gdb_continue_to_breakpoint "var_char-filled-1"
++set test "print var_char, var_char-filled-1"
++gdb_test_multiple "print var_char" $test {
++ -re "= \\(PTR TO -> \\( character\\*3 \\)\\) $hex\r\n$gdb_prompt $" {
++ gdb_test "print *var_char" "= 'foo'" "print *var_char, var_char-filled-1"
++ pass $test
++ }
++ -re "= 'foo'\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++set test "ptype var_char, var_char-filled-1"
++gdb_test_multiple "ptype var_char" $test {
++ -re "type = PTR TO -> \\( character\\*3 \\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = character\\*3\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
++gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
++
++
++gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
++gdb_continue_to_breakpoint "var_char-filled-2"
++set test "print var_char, var_char-filled-2"
++gdb_test_multiple "print var_char" $test {
++ -re "= \\(PTR TO -> \\( character\\*6 \\)\\) $hex\r\n$gdb_prompt $" {
++ gdb_test "print *var_char" "= 'foobar'" "print *var_char, var_char-filled-2"
++ pass $test
++ }
++ -re "= 'foobar'\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++set test "ptype var_char, var_char-filled-2"
++gdb_test_multiple "ptype var_char" $test {
++ -re "type = PTR TO -> \\( character\\*6 \\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = character\\*6\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
+Index: gdb-7.11.90.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 <http://www.gnu.org/licenses/>.
++
++program vla_strings
++ character(len=:), target, allocatable :: var_char
++ character(len=:), pointer :: var_char_p
++ logical :: l
++
++ allocate(character(len=10) :: var_char)
++ l = allocated(var_char) ! var_char-allocated-1
++ var_char = 'foo'
++ deallocate(var_char) ! var_char-filled-1
++ l = allocated(var_char) ! var_char-deallocated
++ allocate(character(len=42) :: var_char)
++ l = allocated(var_char)
++ var_char = 'foobar'
++ var_char = '' ! var_char-filled-2
++ var_char = 'bar' ! var_char-empty
++ deallocate(var_char)
++ allocate(character(len=21) :: var_char)
++ l = allocated(var_char) ! var_char-allocated-3
++ var_char = 'johndoe'
++ var_char_p => var_char
++ l = associated(var_char_p) ! var_char_p-associated
++ var_char_p => null()
++ l = associated(var_char_p) ! var_char_p-not-associated
++end program vla_strings
+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 = <not allocated>"
++gdb_test "ptype fivedynarr" \
++ [multi_line "type = Type five" \
++ " Type one :: tone" \
++ "End Type five \\(:\\)" ]
+ gdb_test "next" ""
+ gdb_test "ptype fivedynarr(2)" \
+ [multi_line "type = Type five" \
+@@ -141,7 +144,7 @@
+ "ptype fivedynarr(2), tone is not allocated"
+ gdb_test "ptype fivedynarr(2)%tone" \
+ [multi_line "type = Type one" \
+- " $int :: ivla\\(<not allocated>\\)" \
++ " $int :: ivla\\(:,:,:\\)" \
+ "End Type one" ] \
+ "ptype fivedynarr(2)%tone, not allocated"
+
+Index: gdb-7.11.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 <http://www.gnu.org/licenses/>.
+
+ standard_testfile "vla.f90"
++load_lib "fortran.exp"
+
+ if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+@@ -25,12 +26,15 @@
+ return -1
+ }
+
++# Depending on the compiler being used, the type names can be printed differently.
++set real [fortran_real4]
++
+ # Try to access values in non allocated VLA
+ gdb_breakpoint [gdb_get_line_number "vla1-init"]
+ gdb_continue_to_breakpoint "vla1-init"
+ gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
+ gdb_test "print &vla1" \
+- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \
++ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $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" " = <not associated>" "print undefined pvla"
+ gdb_test "print &pvla" \
+- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \
++ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \
+ "print non-associated &pvla"
+ gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \
+ "print undefined pvla(1,3,8)"
+@@ -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=\"<not allocated>\"" "evaluate not allocated vla"
+
+-mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
++mi_create_varobj_checked vla1_not_allocated vla1 "$real \\(:\\)" \
+ "create local variable vla1_not_allocated"
+ mi_gdb_test "501-var-info-type vla1_not_allocated" \
+- "501\\^done,type=\"<not allocated>\"" \
++ "501\\^done,type=\"$real \\(:\\)\"" \
+ "info type variable vla1_not_allocated"
+ mi_gdb_test "502-var-show-format vla1_not_allocated" \
+ "502\\^done,format=\"natural\"" \
+@@ -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=\"<not associated>\".*${mi_gdb_prompt}$" {
+ pass $test
+
+- mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
++ mi_create_varobj_checked pvla2_not_associated pvla2 "$real \\(:,:\\)" \
+ "create local variable pvla2_not_associated"
+ mi_gdb_test "581-var-info-type pvla2_not_associated" \
+- "581\\^done,type=\"<not associated>\"" \
++ "581\\^done,type=\"$real \\(:,:\\)\"" \
+ "info type variable pvla2_not_associated"
+ mi_gdb_test "582-var-show-format pvla2_not_associated" \
+ "582\\^done,format=\"natural\"" \
+@@ -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 <jan.kratochvil@redhat.com> - 7.12-0.13.20160907.fc25
+- Rebase to FSF GDB 7.11.90.20160907 (pre-7.12 branch snapshot).
+- Rebase Intel VLA patchset.
+
* Wed Sep 7 2016 Jan Kratochvil <jan.kratochvil@redhat.com> - 7.12-0.12.20160904.fc25
- [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
reply other threads:[~2026-06-27 23:57 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=178260467110.1.47494538002433036.rpms-gdb-d258670d645c@fedoraproject.org \
--to=jan.kratochvil@redhat.com \
--cc=git-commits@fedoraproject.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox