From 72aed9dc5ed96eeda145acc6b2c8a88bbd291564 Mon Sep 17 00:00:00 2001 From: Jan Kratochvil Date: Aug 26 2016 15:09:47 +0000 Subject: Fix Intel VLA patchset regression: dynamic.exp: p varw filled --- diff --git a/gdb-archer-vla-tests.patch b/gdb-archer-vla-tests.patch index 7f7e184..f30180a 100644 --- a/gdb-archer-vla-tests.patch +++ b/gdb-archer-vla-tests.patch @@ -1,7 +1,7 @@ -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.ada/packed_array.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.ada/packed_array.exp =================================================================== ---- gdb-7.11.50.20160716.orig/gdb/testsuite/gdb.ada/packed_array.exp 2016-07-16 03:48:59.000000000 +0200 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.ada/packed_array.exp 2016-07-16 16:53:33.736172889 +0200 +--- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.ada/packed_array.exp 2016-08-07 04:00:01.000000000 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.ada/packed_array.exp 2016-08-25 18:44:42.058789058 +0200 @@ -56,5 +56,11 @@ # are. Observed with (FSF GNU Ada 4.5.3 20110124). xfail $test @@ -14,10 +14,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.ada/packed_array.exp + } } -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S 2016-08-25 18:44:42.058789058 +0200 @@ -0,0 +1,455 @@ + .file "x86_64-vla-typedef.c" + .section .debug_abbrev,"",@progbits @@ -474,10 +474,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S + .string "GNU C 4.3.2 20081105 (Red Hat 4.3.2-7)" + .ident "GCC: (GNU) 4.3.2 20081105 (Red Hat 4.3.2-7)" + .section .note.GNU-stack,"",@progbits -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c 2016-08-25 18:44:42.058789058 +0200 @@ -0,0 +1,45 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -524,10 +524,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c +} + +#endif -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp 2016-08-25 18:44:42.058789058 +0200 @@ -0,0 +1,64 @@ +# Copyright 2009 Free Software Foundation, Inc. + @@ -593,10 +593,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp +gdb_test "whatis array" "type = array_t" "second: whatis array" + +gdb_test "ptype array" "type = char \\\[78\\\]" "second: ptype array" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/arrayidx.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/arrayidx.c =================================================================== ---- gdb-7.11.50.20160716.orig/gdb/testsuite/gdb.base/arrayidx.c 2016-07-16 03:48:59.000000000 +0200 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/arrayidx.c 2016-07-16 16:53:33.737172897 +0200 +--- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.base/arrayidx.c 2016-08-07 04:00:01.000000000 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/arrayidx.c 2016-08-25 18:44:42.058789058 +0200 @@ -17,6 +17,13 @@ int array[] = {1, 2, 3, 4}; @@ -611,10 +611,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/arrayidx.c int main (void) { -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/arrayidx.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/arrayidx.exp =================================================================== ---- gdb-7.11.50.20160716.orig/gdb/testsuite/gdb.base/arrayidx.exp 2016-07-16 03:48:59.000000000 +0200 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/arrayidx.exp 2016-07-16 16:53:33.737172897 +0200 +--- gdb-7.11.90.20160807.orig/gdb/testsuite/gdb.base/arrayidx.exp 2016-08-07 04:00:01.000000000 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/arrayidx.exp 2016-08-25 18:44:42.059789067 +0200 @@ -49,4 +49,12 @@ "\\{\\\[0\\\] = 1, \\\[1\\\] = 2, \\\[2\\\] = 3, \\\[3\\\] = 4\\}" \ "Print array with array-indexes on" @@ -629,10 +629,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/arrayidx.exp + unsupported "$test (no GCC)" + } +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/internal-var-field-address.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/internal-var-field-address.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/internal-var-field-address.c 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/internal-var-field-address.c 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,20 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -654,10 +654,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/internal-var-field-address.c +struct { + int field; +} staticstruct = { 1 }; -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/internal-var-field-address.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/internal-var-field-address.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/internal-var-field-address.exp 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/internal-var-field-address.exp 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,26 @@ +# Copyright 2009 Free Software Foundation, Inc. + @@ -685,10 +685,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/internal-var-field-address.ex + +gdb_test {set $varstruct = staticstruct} +gdb_test {p $varstruct.field} " = 1" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-frame.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-frame.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-frame.c 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-frame.c 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,31 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -721,10 +721,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-frame.c + f (s); + return 0; +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-frame.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-frame.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-frame.exp 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-frame.exp 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,38 @@ +# Copyright 2011 Free Software Foundation, Inc. +# @@ -764,10 +764,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-frame.exp +} + +gdb_test "bt full" "\r\n +s = \"X\\\\000\"\r\n.*" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-overflow.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-overflow.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-overflow.c 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-overflow.c 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,30 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -799,10 +799,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-overflow.c + + return 0; +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-overflow.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-overflow.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-overflow.exp 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla-overflow.exp 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,109 @@ +# Copyright 2008 Free Software Foundation, Inc. + @@ -913,10 +913,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla-overflow.exp +gdb_test "bt" "in \[^ \]*abort \\(.* in main \\(.*" "Backtrace after abort()" + +verbose -log "kb_found in bt after abort() = [expr [memory_v_pages_get] * $pagesize / 1024]" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla.c 2016-07-16 16:53:33.737172897 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla.c 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,55 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -973,10 +973,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla.c + foo (78); + return 0; +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla.exp 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.base/vla.exp 2016-08-25 18:44:42.059789067 +0200 @@ -0,0 +1,62 @@ +# Copyright 2008 Free Software Foundation, Inc. + @@ -1040,10 +1040,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.base/vla.exp +gdb_test "p temp1" " = '1' " "second: print temp1" +gdb_test "p temp2" " = '2' " "second: print temp2" +gdb_test "p temp3" " = '3' " "second: print temp3" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,246 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -1291,10 +1291,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S + .string "char" +.Luint_str: + .string "unsigned int" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,66 @@ +# Copyright 2010 Free Software Foundation, Inc. + @@ -1362,10 +1362,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp + +# The register contains unpredictable value - the array size. +gdb_test "ptype reg_string" {type = char \[-?[0-9]+\]} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-stripped.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-stripped.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-stripped.c 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-stripped.c 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,42 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -1409,10 +1409,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-stripped.c + func1 (1, 2); + return 0; +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,79 @@ +# Copyright 2006 Free Software Foundation, Inc. + @@ -1493,10 +1493,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp +gdb_test "step" \ + "func.* \\(.*\\) at .*" \ + "step" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,83 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -1581,10 +1581,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-loca + + .byte 0x0 /* Terminator */ + .byte 0x0 /* Terminator */ -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,37 @@ +# Copyright 2009 Free Software Foundation, Inc. + @@ -1623,10 +1623,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-loca +clean_restart $binfile + +gdb_test "ptype struct some_struct" "type = struct some_struct {\[\r\n \t\]*void field;\[\r\n \t\]*}" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,121 @@ +/* This testcase is part of GDB, the GNU debugger. + @@ -1749,10 +1749,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S + .byte 0x0 /* Terminator */ + + .byte 0x0 /* Terminator */ -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp 2016-07-16 16:53:33.738172906 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp 2016-08-25 18:44:42.060789076 +0200 @@ -0,0 +1,39 @@ +# Copyright 2012 Free Software Foundation, Inc. + @@ -1793,10 +1793,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp + +gdb_test "ptype notype_string" {type = char \[129\]} +gdb_test "p notype_string" " = 'x' " -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dwarf-stride.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dwarf-stride.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dwarf-stride.exp 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dwarf-stride.exp 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,42 @@ +# Copyright 2009 Free Software Foundation, Inc. + @@ -1840,10 +1840,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dwarf-stride.exp +gdb_continue_to_breakpoint "break-here" ".*break-here.*" +gdb_test "p c40pt(1)" " = '0-hello.*" +gdb_test "p c40pt(2)" " = '1-hello.*" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dwarf-stride.f90 +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dwarf-stride.f90 =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dwarf-stride.f90 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dwarf-stride.f90 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,40 @@ +! Copyright 2009 Free Software Foundation, Inc. +! @@ -1885,11 +1885,11 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dwarf-stride.f90 + print *, c40pt ! break-here + +end program repro -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dynamic.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.exp 2016-07-16 17:19:24.255202013 +0200 -@@ -0,0 +1,151 @@ ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dynamic.exp 2016-08-25 18:54:25.957258024 +0200 +@@ -0,0 +1,154 @@ +# Copyright 2007 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify @@ -1934,11 +1934,13 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.exp + +gdb_breakpoint [gdb_get_line_number "varx-init"] +gdb_continue_to_breakpoint "varx-init" -+gdb_test "p varx" "\\$\[0-9\]* = " "p varx unallocated" -+gdb_test "ptype varx" {type = real\(kind=4\) \(:,:,:\)} "ptype varx unallocated" -+gdb_test "p varx(1,5,17)" {no such vector element \(vector not allocated\)} "p varx(1,5,17) unallocated" -+gdb_test "p varx(1,5,17)=1" {no such vector element \(vector not allocated\)} "p varx(1,5,17)=1 unallocated" -+gdb_test "ptype varx(1,5,17)" {no such vector element \(vector not allocated\)} "ptype varx(1,5,17) unallocated" ++ ++# http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#5 ++# Do not: gdb_test "p varx" "\\$\[0-9\]* = " "p varx unallocated" ++# Do not: gdb_test "ptype varx" {type = real\(kind=4\) \(:,:,:\)} "ptype varx unallocated" ++# Do not: gdb_test "p varx(1,5,17)" {no such vector element \(vector not allocated\)} "p varx(1,5,17) unallocated" ++# Do not: gdb_test "p varx(1,5,17)=1" {no such vector element \(vector not allocated\)} "p varx(1,5,17)=1 unallocated" ++# Do not: gdb_test "ptype varx(1,5,17)" {no such vector element \(vector not allocated\)} "ptype varx(1,5,17) unallocated" + +gdb_breakpoint [gdb_get_line_number "varx-allocated"] +gdb_continue_to_breakpoint "varx-allocated" @@ -1953,8 +1955,9 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.exp +gdb_test "p varx(1, 5, 17)" "\\$\[0-9\]* = 7" +gdb_test "p varx(2, 6, 18)" "\\$\[0-9\]* = 8" +gdb_test "p varx(6, 15, 28)" "\\$\[0-9\]* = 9" -+gdb_test "p varv" "\\$\[0-9\]* = " "p varv unassociated" -+gdb_test "ptype varv" {type = real\(kind=4\) \(:,:,:\)} "ptype varv unassociated" ++# http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#5 ++# Do not: gdb_test "p varv" "\\$\[0-9\]* = " "p varv unassociated" ++# Do not: gdb_test "ptype varv" {type = real\(kind=4\) \(:,:,:\)} "ptype varv unassociated" + +set test "output varx" +gdb_test_multiple $test $test { @@ -2041,10 +2044,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.exp +gdb_test "p vart(3,8)" "\\$\[0-9\]* = 9" +# maps to foo::vary(1,3) +gdb_test "p vart(2,9)" "\\$\[0-9\]* = 10" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.f90 +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dynamic.f90 =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.f90 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/dynamic.f90 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,98 @@ +! Copyright 2007 Free Software Foundation, Inc. +! @@ -2144,10 +2147,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/dynamic.f90 + if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort + if (x (3, 1) .ne. 10) call abort +end -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/string.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/string.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/string.exp 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/string.exp 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,59 @@ +# Copyright 2008 Free Software Foundation, Inc. + @@ -2208,10 +2211,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/string.exp +gdb_continue_to_breakpoint "var-finish" +gdb_test "p e" "\\$\[0-9\]* = 'e '" "p e re-set" +gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f2 ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\)" "p *f re-set" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/string.f90 +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/string.f90 =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/string.f90 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/string.f90 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,37 @@ +! Copyright 2008 Free Software Foundation, Inc. +! @@ -2250,10 +2253,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/string.f90 + h = 'h' + call foo (g, h) +end -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/subrange.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/subrange.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/subrange.exp 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/subrange.exp 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,72 @@ +# Copyright 2011 Free Software Foundation, Inc. + @@ -2327,10 +2330,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/subrange.exp +gdb_unload +setup_kfail "*-*-*" "vlaregression/9999" +gdb_test {p $a (3, 2:2)} { = \(23\)} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/subrange.f90 +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/subrange.f90 =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/subrange.f90 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.fortran/subrange.f90 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,28 @@ +! Copyright 2011 Free Software Foundation, Inc. +! @@ -2360,10 +2363,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.fortran/subrange.f90 + ptr => a + write (*,*) a ! break-static +end -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.mi/mi2-var-stale-type.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.mi/mi2-var-stale-type.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.mi/mi2-var-stale-type.c 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.mi/mi2-var-stale-type.c 2016-08-25 18:44:42.061789086 +0200 @@ -0,0 +1,26 @@ +/* Copyright 2011 Free Software Foundation, Inc. + @@ -2391,10 +2394,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.mi/mi2-var-stale-type.c + + return 0; +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp 2016-08-25 18:44:42.062789095 +0200 @@ -0,0 +1,57 @@ +# Copyright 2011 Free Software Foundation, Inc. +# @@ -2453,10 +2456,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp +mi_create_varobj "vla" "vla" "create local variable vla" + +mi_gdb_test "-var-update *" "\\^done,changelist=.*" "-var-update *" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register-func.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.opt/array-from-register-func.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register-func.c 2016-07-16 16:53:33.739172914 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.opt/array-from-register-func.c 2016-08-25 18:44:42.062789095 +0200 @@ -0,0 +1,22 @@ +/* This file is part of GDB, the GNU debugger. + @@ -2480,10 +2483,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register-func.c +{ + return arr[0]; +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register.c +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.opt/array-from-register.c =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register.c 2016-07-16 16:53:33.740172922 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.opt/array-from-register.c 2016-08-25 18:44:42.062789095 +0200 @@ -0,0 +1,28 @@ +/* This file is part of GDB, the GNU debugger. + @@ -2513,10 +2516,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register.c + + return 0; +} -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.opt/array-from-register.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register.exp 2016-07-16 16:53:33.740172922 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.opt/array-from-register.exp 2016-08-25 18:44:42.062789095 +0200 @@ -0,0 +1,33 @@ +# Copyright 2009 Free Software Foundation, Inc. +# @@ -2551,10 +2554,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.opt/array-from-register.exp +# Seen regression: +# Address requested for identifier "arr" which is in register $rdi +gdb_test "p arr\[0\]" "\\$\[0-9\]+ = 42" -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.pascal/arrays.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.pascal/arrays.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.pascal/arrays.exp 2016-07-16 16:53:33.740172922 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.pascal/arrays.exp 2016-08-25 18:44:42.062789095 +0200 @@ -0,0 +1,104 @@ +# Copyright 2008, 2009 Free Software Foundation, Inc. +# @@ -2660,10 +2663,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.pascal/arrays.exp +} +gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char" + -Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.pascal/arrays.pas +Index: gdb-7.11.90.20160807/gdb/testsuite/gdb.pascal/arrays.pas =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.11.50.20160716/gdb/testsuite/gdb.pascal/arrays.pas 2016-07-16 16:53:33.740172922 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/gdb.pascal/arrays.pas 2016-08-25 18:44:42.062789095 +0200 @@ -0,0 +1,82 @@ +{ + Copyright 2008, 2009 Free Software Foundation, Inc. @@ -2747,10 +2750,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/gdb.pascal/arrays.pas + s := 'test'#0'string'; + writeln(s); { set breakpoint 2 here } +end. -Index: gdb-7.11.50.20160716/gdb/testsuite/lib/gdb.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/lib/gdb.exp =================================================================== ---- gdb-7.11.50.20160716.orig/gdb/testsuite/lib/gdb.exp 2016-07-16 16:53:33.063167315 +0200 -+++ gdb-7.11.50.20160716/gdb/testsuite/lib/gdb.exp 2016-07-16 16:53:33.741172930 +0200 +--- gdb-7.11.90.20160807.orig/gdb/testsuite/lib/gdb.exp 2016-08-25 18:44:41.424783148 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/lib/gdb.exp 2016-08-25 18:44:42.063789104 +0200 @@ -173,6 +173,11 @@ send_gdb "y\n" exp_continue @@ -2763,10 +2766,10 @@ Index: gdb-7.11.50.20160716/gdb/testsuite/lib/gdb.exp -re "Discard symbol table from .*y or n.*$" { send_gdb "y\n" exp_continue -Index: gdb-7.11.50.20160716/gdb/testsuite/lib/pascal.exp +Index: gdb-7.11.90.20160807/gdb/testsuite/lib/pascal.exp =================================================================== ---- gdb-7.11.50.20160716.orig/gdb/testsuite/lib/pascal.exp 2016-07-16 03:48:59.000000000 +0200 -+++ gdb-7.11.50.20160716/gdb/testsuite/lib/pascal.exp 2016-07-16 16:53:33.741172930 +0200 +--- gdb-7.11.90.20160807.orig/gdb/testsuite/lib/pascal.exp 2016-08-07 04:00:01.000000000 +0200 ++++ gdb-7.11.90.20160807/gdb/testsuite/lib/pascal.exp 2016-08-25 18:44:42.063789104 +0200 @@ -37,6 +37,9 @@ global pascal_compiler_is_fpc global gpc_compiler diff --git a/gdb-fortran-stride-intel-1of6.patch b/gdb-fortran-stride-intel-1of6.patch deleted file mode 100644 index 2101cdd..0000000 --- a/gdb-fortran-stride-intel-1of6.patch +++ /dev/null @@ -1,618 +0,0 @@ -RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides -https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html - -From 993834469f1e64e5461e1e1bef917fd388fe428e Mon Sep 17 00:00:00 2001 -From: Christoph Weinmann -Date: Thu, 12 Nov 2015 15:45:52 +0100 -Subject: [PATCH 1/6] fortran: allow multi-dimensional subarrays - -Add an argument count for subrange expressions in Fortran. -Based on the counted value calculate a new array with the -elements specified by the user. First parse the user input, -secondly copy the desired array values into the return -array, thirdly re-create the necessary ranges and bounds. - -1| program prog -2| integer :: ary(10,5) = (/ (i,i=1,10) (j, j=1,5) /) -3| end program prog - -(gdb) print ary(2:4,1:3) -old> Syntax error in expression near ':3' -new> $3 = ( ( 21, 31, 41) ( 22, 32, 42) ( 23, 33, 43) ) - -2013-11-25 Christoph Weinmann - - * eval.c (multi_f77_subscript): Remove function. - * eval.c (evaluate_subrange_expr): When evaluating - an array or string expression, call - value_f90_subarray. - * eval.c (value_f90_subarray): Add argument parsing - and compute result array based on user input. - * f-exp.y: Increment argument counter for every subrange - expression entered by the user. - * valops.c (value_slice): Call value_slice_1 with - additional default argument. - * valops.c (value_slice_1): Add functionality to - copy and return result values based on input. - * value.h: Add function definition. - - -Signed-off-by: Christoph Weinmann ---- - gdb/eval.c | 314 ++++++++++++++++++++++++++++++++++++++++++++++------------- - gdb/f-exp.y | 2 + - gdb/valops.c | 159 ++++++++++++++++++++++++------ - gdb/value.h | 2 + - 4 files changed, 380 insertions(+), 97 deletions(-) - -Index: gdb-7.11.90.20160807/gdb/eval.c -=================================================================== ---- gdb-7.11.90.20160807.orig/gdb/eval.c 2016-08-07 22:06:45.266836619 +0200 -+++ gdb-7.11.90.20160807/gdb/eval.c 2016-08-07 22:08:21.708688259 +0200 -@@ -399,29 +399,254 @@ - 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; -+ 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; -+ } 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 == 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)); -+ /* 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; - -- 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)); -+ index->kind = SUBSCRIPT_RANGE; -+ range = &index->U.range; -+ -+ *pos += 3; -+ range->f90_range_type = (enum range_type) longest_to_int (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 == HIGH_BOUND_DEFAULT) -+ || range->f90_range_type == NONE_BOUND_DEFAULT) -+ range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp, -+ pos, noside)); -+ if ((range->f90_range_type == LOW_BOUND_DEFAULT) -+ || range->f90_range_type == NONE_BOUND_DEFAULT) -+ range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, -+ pos, noside)); -+ } -+ /* 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 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; -+ -+ /* If no lower bound was provided by the user, we take the -+ default boundary. Same for the high bound. */ -+ if ((range->f90_range_type == LOW_BOUND_DEFAULT) -+ || (range->f90_range_type == BOTH_BOUND_DEFAULT)) -+ range->low = TYPE_LOW_BOUND (index_type); -+ -+ if ((range->f90_range_type == HIGH_BOUND_DEFAULT) -+ || (range->f90_range_type == BOTH_BOUND_DEFAULT)) -+ 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)")); -+ -+ /* 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, -+ longest_to_int (range->low), -+ longest_to_int (range->high - range->low + 1), -+ 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 -+ { -+ /* Check for valid index input. */ -+ if (index->U.number < TYPE_LOW_BOUND (index_type) -+ || index->U.number > TYPE_HIGH_BOUND (index_type)) -+ error (_("error no such vector element")); -+ -+ dim_count++; -+ new_array = value_slice_1 (new_array, -+ longest_to_int (index->U.number), -+ 1, /* length is '1' element */ -+ dim_count); -+ } -+ -+ } -+ break; -+ } -+ } -+ -+ /* 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. */ -+ 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; -+ -+ range_type -+ = create_static_range_type (NULL, -+ elt_type, -+ 1, -+ index->U.range.high -+ - index->U.range.low + 1); -+ -+ interim_array_type = create_array_type (NULL, -+ elt_type, -+ range_type); -+ -+ TYPE_CODE (interim_array_type) -+ = TYPE_CODE (value_type (new_array)); - -- return value_slice (array, low_bound, high_bound - low_bound + 1); -+ 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,14 +2035,11 @@ - 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; -+ return value_f90_subarray (arg1, exp, pos, nargs, noside); - - case TYPE_CODE_STRING: - if (exp->elts[*pos].opcode == OP_RANGE) -- return value_f90_subarray (arg1, exp, pos, noside); -+ return value_f90_subarray (arg1, exp, pos, 1, noside); - else - { - arg2 = evaluate_subexp_with_coercion (exp, pos, noside); -@@ -2223,49 +2445,6 @@ - } - 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 +3302,9 @@ - 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")); - -Index: gdb-7.11.90.20160807/gdb/f-exp.y -=================================================================== ---- gdb-7.11.90.20160807.orig/gdb/f-exp.y 2016-08-07 22:06:45.266836619 +0200 -+++ gdb-7.11.90.20160807/gdb/f-exp.y 2016-08-07 22:08:21.709688268 +0200 -@@ -253,6 +253,8 @@ - - arglist : arglist ',' exp %prec ABOVE_COMMA - { arglist_len++; } -+ | arglist ',' subrange %prec ABOVE_COMMA -+ { arglist_len++; } - ; - - /* There are four sorts of subrange types in F90. */ -Index: gdb-7.11.90.20160807/gdb/valops.c -=================================================================== ---- gdb-7.11.90.20160807.orig/gdb/valops.c 2016-08-07 22:06:45.266836619 +0200 -+++ gdb-7.11.90.20160807/gdb/valops.c 2016-08-07 22:13:22.083340750 +0200 -@@ -3775,56 +3775,154 @@ - struct value * - value_slice (struct value *array, int lowbound, int length) - { -+ /* Pass unaltered arguments to VALUE_SLICE_1, plus a 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); -+} -+ -+/* 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 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; -+ /* ATTRIBUTE_UNUSED: VLA bug: https://sourceware.org/ml/gdb-patches/2016-08/msg00099.html */ -+ LONGEST elt_stride ATTRIBUTE_UNUSED, 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")); -- -- if (lowbound < lowerbound || length < 0 -- || lowbound + length - 1 > upperbound) -- error (_("slice out of range")); -+ 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) -+ { -+ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); -+ row_count = TYPE_LENGTH (array_type) -+ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); -+ } -+ -+ elem_count = length; -+ elt_size = TYPE_LENGTH (elt_type); -+ elt_offs = longest_to_int (lowbound - ary_low_bound); -+ elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type)); -+ -+ 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 = elem_count; -+ -+ /* 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 - 1) * (elem_count); -+ 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)); -- -- slice_type = create_array_type ((struct type *) NULL, -- element_type, -- slice_range_type); -- TYPE_CODE (slice_type) = TYPE_CODE (array_type); -+ struct type *element_type; -+ -+ /* When CALL_COUNT equals 1 we can use the legacy code for subarrays. */ -+ if (call_count == 1) -+ { -+ element_type = TYPE_TARGET_TYPE (array_type); - -- if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) -- slice = allocate_value_lazy (slice_type); -+ slice_type = create_array_type (NULL, element_type, slice_range_type); -+ -+ TYPE_CODE (slice_type) = TYPE_CODE (array_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)); -+ } -+ -+ } -+ /* When CALL_COUNT is larger 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)); -+ LONGEST dst_offset = 0; -+ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); -+ -+ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); -+ slice_type = create_array_type (NULL, element_type, slice_range_type); -+ -+ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type)); -+ -+ v = allocate_value (slice_type); -+ for (i = 0; i < longest_to_int (row_count); i++) -+ { -+ /* Fetches the contents of ARRAY and copies them into V. */ -+ value_contents_copy (v, -+ dst_offset, -+ array, -+ elt_offs, -+ elt_size * elem_count); -+ elt_offs += src_row_length; -+ dst_offset += elt_size * elem_count; -+ } - } - -- 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 -Index: gdb-7.11.90.20160807/gdb/value.h -=================================================================== ---- gdb-7.11.90.20160807.orig/gdb/value.h 2016-08-07 22:06:45.266836619 +0200 -+++ gdb-7.11.90.20160807/gdb/value.h 2016-08-07 22:08:21.710688276 +0200 -@@ -1064,6 +1064,8 @@ - - extern struct value *value_slice (struct value *, int, int); - -+extern struct value *value_slice_1 (struct value *, int, int, int); -+ - extern struct value *value_literal_complex (struct value *, struct value *, - struct type *); - diff --git a/gdb-fortran-stride-intel-2of6.patch b/gdb-fortran-stride-intel-2of6.patch deleted file mode 100644 index b4100fe..0000000 --- a/gdb-fortran-stride-intel-2of6.patch +++ /dev/null @@ -1,48 +0,0 @@ -RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides -https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html - -From 733b3b60be5c8d23fa7e47498d35e4701528f3ae Mon Sep 17 00:00:00 2001 -From: Christoph Weinmann -Date: Fri, 13 Nov 2015 09:00:33 +0100 -Subject: [PATCH 2/6] fortran: combine subarray and string computation - -Strings types are handled like array types with only one dimension. -Therefore the same algorithm to calculate subsets is used. - -2013-11-26 Christoph Weinmann - - * eval.c (evaluate_subexp_standard): Call - value_f90_subarray for print expressions on array and - string types. - - -Signed-off-by: Christoph Weinmann ---- - gdb/eval.c | 10 +--------- - 1 file changed, 1 insertion(+), 9 deletions(-) - -diff --git a/gdb/eval.c b/gdb/eval.c -index 35815a4..5c20fee 100644 ---- a/gdb/eval.c -+++ b/gdb/eval.c -@@ -2035,16 +2035,8 @@ evaluate_subexp_standard (struct type *expect_type, - switch (code) - { - case TYPE_CODE_ARRAY: -- return value_f90_subarray (arg1, exp, pos, nargs, noside); -- - case TYPE_CODE_STRING: -- if (exp->elts[*pos].opcode == OP_RANGE) -- return value_f90_subarray (arg1, exp, pos, 1, 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: --- -2.5.5 - diff --git a/gdb-fortran-stride-intel-3of6.patch b/gdb-fortran-stride-intel-3of6.patch deleted file mode 100644 index 4e4de7d..0000000 --- a/gdb-fortran-stride-intel-3of6.patch +++ /dev/null @@ -1,341 +0,0 @@ -RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides -https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html - -From 058ed9e55db72244fe1c5346a11fa67eff61d318 Mon Sep 17 00:00:00 2001 -From: Christoph Weinmann -Date: Mon, 23 Nov 2015 10:31:44 +0100 -Subject: [PATCH 3/6] fortran: change subrange enum to bit field - -Change Fortran subrange enum for subrange expressions to -represent a bitfield for easier manipulation. Consequently -also change occurences and evaluation of said enum. The -behaviour of GDB is unchanged. - -2013-11-27 Christoph Weinmann - - * eval.c (value_f90_subarray): Change evaluation of the - subarray boundaries. Set boundaries to be either user - provided (bit in range_type was set), or take the default - value if the boundary was not provided by the user. - * expprint.c (print_subexp_standard): Alter boundary com- - putations to use updated range_type enum. - * expprint.h (dump_subexp_body_standard): Dito. - * expression.h (range_type): Change the enum to use bit - values for each boundary, if set by the user. - * f-exp.y (subrange): Change rules for subrange expressions - to write the relevant bit sequence onto the elt stack. - * parse.c (operator_length_standard): In case of OP_RANGE - change the calculation of the number of arguments on the - elt stack, depending on the number of boundaries provided - by the user. - * rust-exp.y (convert_ast_to_expression): Modify calcula- - tion of subscript elements to use altered range_type. - * rust-lang.c (rust_range): Dito. - * rust-lang.c (rust_subscript): Dito. - - -Signed-off-by: Christoph Weinmann ---- - gdb/eval.c | 14 ++++++-------- - gdb/expprint.c | 20 ++++++++------------ - gdb/expression.h | 15 ++++++--------- - gdb/f-exp.y | 11 ++++++----- - gdb/parse.c | 21 ++++++++------------- - gdb/rust-exp.y | 12 +++--------- - gdb/rust-lang.c | 17 ++++++++--------- - 7 files changed, 45 insertions(+), 65 deletions(-) - -diff --git a/gdb/eval.c b/gdb/eval.c -index 5c20fee..44e8600 100644 ---- a/gdb/eval.c -+++ b/gdb/eval.c -@@ -482,12 +482,12 @@ value_f90_subarray (struct value *array, struct expression *exp, - /* 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 == HIGH_BOUND_DEFAULT) -- || range->f90_range_type == NONE_BOUND_DEFAULT) -+ 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 == LOW_BOUND_DEFAULT) -- || range->f90_range_type == NONE_BOUND_DEFAULT) -+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) -+ == SUBARRAY_HIGH_BOUND) - range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, - pos, noside)); - } -@@ -528,12 +528,10 @@ value_f90_subarray (struct value *array, struct expression *exp, - - /* If no lower bound was provided by the user, we take the - default boundary. Same for the high bound. */ -- if ((range->f90_range_type == LOW_BOUND_DEFAULT) -- || (range->f90_range_type == BOTH_BOUND_DEFAULT)) -+ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0) - range->low = TYPE_LOW_BOUND (index_type); - -- if ((range->f90_range_type == HIGH_BOUND_DEFAULT) -- || (range->f90_range_type == BOTH_BOUND_DEFAULT)) -+ 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 -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..5a6b720 100644 ---- a/gdb/expression.h -+++ b/gdb/expression.h -@@ -152,17 +152,14 @@ 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. -+ 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)" */ - }; - - #endif /* !defined (EXPRESSION_H) */ -diff --git a/gdb/f-exp.y b/gdb/f-exp.y -index dc131c1..e2c54b6 100644 ---- a/gdb/f-exp.y -+++ b/gdb/f-exp.y -@@ -260,26 +260,27 @@ arglist : arglist ',' exp %prec ABOVE_COMMA - /* 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, 0); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - -diff --git a/gdb/parse.c b/gdb/parse.c -index 2b00708..6d54a77 100644 ---- a/gdb/parse.c -+++ b/gdb/parse.c -@@ -1006,22 +1006,17 @@ 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++; - - break; - -diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y -index c1a863c..760929b5 100644 ---- a/gdb/rust-exp.y -+++ b/gdb/rust-exp.y -@@ -2418,23 +2418,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 5df99ce..8d53e31 100644 ---- a/gdb/rust-lang.c -+++ b/gdb/rust-lang.c -@@ -1188,9 +1188,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) -@@ -1279,7 +1279,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; -@@ -1287,15 +1287,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)); - } - } -@@ -1310,7 +1309,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; - -@@ -1366,7 +1365,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")); -@@ -1384,7 +1383,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")); --- -2.5.5 - diff --git a/gdb-fortran-stride-intel-4of6.patch b/gdb-fortran-stride-intel-4of6.patch deleted file mode 100644 index 0e096e3..0000000 --- a/gdb-fortran-stride-intel-4of6.patch +++ /dev/null @@ -1,167 +0,0 @@ -RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides -https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html - -From 338e4c860ad205896b4a95c79f54470c79eeb348 Mon Sep 17 00:00:00 2001 -From: Christoph Weinmann -Date: Wed, 1 Jun 2016 15:11:24 +0200 -Subject: [PATCH 4/6] fortran: enable parsing of stride parameter for subranges - -Allow the user to provide a stride parameter for Fortran -subarrays. The stride parameter can be any integer except -'0'. The default stride value is '1'. - -2013-11-27 Christoph Weinmann - - * eval.c (value_f90_subarray): Add expression evaluation - for a stride parameter in a Fortran range expression. - * expression.h (range_type): Add field to enum to show when - a stride value was provided by the user. - * f-exp.y: Add yacc rules for writing info on the elt stack - when the user provided a stride argument. - * parse.c (operator_length_standard): Check if a stride - value was provided, and increment argument counter - accordingly. - - -Signed-off-by: Christoph Weinmann ---- - gdb/eval.c | 11 ++++++++++- - gdb/expression.h | 7 +++++-- - gdb/f-exp.y | 31 ++++++++++++++++++++++++++++++- - gdb/parse.c | 3 +++ - gdb/valops.c | 4 ++-- - 5 files changed, 50 insertions(+), 6 deletions(-) - -diff --git a/gdb/eval.c b/gdb/eval.c -index 44e8600..b5aaf1c 100644 ---- a/gdb/eval.c -+++ b/gdb/eval.c -@@ -419,7 +419,7 @@ value_f90_subarray (struct value *array, struct expression *exp, - typedef struct subscript_range - { - enum range_type f90_range_type; -- LONGEST low, high; -+ LONGEST low, high, stride; - } subscript_range; - - typedef enum subscript_kind -@@ -490,6 +490,15 @@ value_f90_subarray (struct value *array, struct expression *exp, - == 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; - } - /* User input is an index. E.g.: "p arry(5)". */ - else -diff --git a/gdb/expression.h b/gdb/expression.h -index 5a6b720..34ca54b 100644 ---- a/gdb/expression.h -+++ b/gdb/expression.h -@@ -153,13 +153,16 @@ extern void dump_raw_expression (struct expression *, - extern void dump_prefix_expression (struct expression *, struct ui_file *); - - /* In an OP_RANGE expression, either bound can be provided by the user, or not. -- This enumeration type is to identify this. */ -+ 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 - { - SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */ - SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ -- SUBARRAY_HIGH_BOUND = 0x2 /* "(:high)" */ -+ 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 e2c54b6..71f1823 100644 ---- a/gdb/f-exp.y -+++ b/gdb/f-exp.y -@@ -280,7 +280,36 @@ subrange: ':' exp %prec ABOVE_COMMA - - subrange: ':' %prec ABOVE_COMMA - { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, 0); -+ 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/parse.c b/gdb/parse.c -index 6d54a77..992af87 100644 ---- a/gdb/parse.c -+++ b/gdb/parse.c -@@ -1018,6 +1018,9 @@ operator_length_standard (const struct expression *expr, int endpos, - if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) - args++; - -+ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) -+ args++; -+ - break; - - default: -diff --git a/gdb/valops.c b/gdb/valops.c -index 817a4cf..fbc7dcb 100644 ---- a/gdb/valops.c -+++ b/gdb/valops.c -@@ -3834,7 +3834,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) - if (call_count == 1) - { - range_type = TYPE_INDEX_TYPE (array_type); -- slice_range_size = elem_count; -+ 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) -@@ -3846,7 +3846,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) - else - { - range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type)); -- slice_range_size = (ary_low_bound + row_count - 1) * (elem_count); -+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1; - ary_low_bound = TYPE_LOW_BOUND (range_type); - } - --- -2.5.5 - diff --git a/gdb-fortran-stride-intel-5of6.patch b/gdb-fortran-stride-intel-5of6.patch deleted file mode 100644 index 2b9a662..0000000 --- a/gdb-fortran-stride-intel-5of6.patch +++ /dev/null @@ -1,370 +0,0 @@ -RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides -https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html - -From 1189098c3cacc2ee69021de1a83ad3328821d755 Mon Sep 17 00:00:00 2001 -From: Christoph Weinmann -Date: Wed, 1 Jun 2016 15:04:01 +0200 -Subject: [PATCH 5/6] fortran: calculate elements of a subarray using a - provided stride value - -The stride value can be a positive or negative integer, but may -not be zero. If no stride is provided, use the default value -1 to print all elements inside the range. - -1| program prog -2| integer :: ary(10) = (/ (i, i=1, 10) /) -3| end program prog - -(gdb) print ary(1:10:2) -$3 = (1, 3, 5, 7, 9) - -2013-11-27 Christoph Weinmann - - * eval.c (value_f90_subarray): Add range size calculation - for stride based ranges, and evaluation of user stride - parameters. Add check for matching user input to array - bounds. - * valops.c (value_slice): Add call parameter with default - stride value for calling value_slice_1. - * valops.c (value_slice_1): Add function parameter for - stride length in the return subarray. Calculate array - elements based on stride value. - * value.h: Add stride parameter to declaration of - value_slice_1. - - -Signed-off-by: Christoph Weinmann ---- - gdb/eval.c | 102 ++++++++++++++++++++++++++++++++++++++++++++++++----------- - gdb/valops.c | 83 +++++++++++++++++++++++++++++++++++------------- - gdb/value.h | 2 +- - 3 files changed, 145 insertions(+), 42 deletions(-) - -diff --git a/gdb/eval.c b/gdb/eval.c -index b5aaf1c..1f27b6f 100644 ---- a/gdb/eval.c -+++ b/gdb/eval.c -@@ -477,7 +477,7 @@ value_f90_subarray (struct value *array, struct expression *exp, - range = &index->U.range; - - *pos += 3; -- range->f90_range_type = (enum range_type) longest_to_int (exp->elts[pc].longconst); -+ 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 -@@ -499,6 +499,10 @@ value_f90_subarray (struct value *array, struct expression *exp, - /* 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 -@@ -515,10 +519,8 @@ value_f90_subarray (struct value *array, struct expression *exp, - - } - -- /* 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. */ -+ /* 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]; -@@ -551,6 +553,48 @@ value_f90_subarray (struct value *array, struct expression *exp, - || 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 -@@ -558,10 +602,9 @@ value_f90_subarray (struct value *array, struct expression *exp, - dim_count++; - - new_array -- = value_slice_1 (new_array, -- longest_to_int (range->low), -- longest_to_int (range->high - range->low + 1), -- dim_count); -+ = value_slice_1 (new_array, range->low, -+ range->high - range->low + 1, -+ range->stride, dim_count); - } - break; - -@@ -580,21 +623,32 @@ value_f90_subarray (struct value *array, struct expression *exp, - (new_array))); - else - { -- /* Check for valid index input. */ -+ 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 (_("error no such vector element")); -+ && 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)")); - -- dim_count++; - new_array = value_slice_1 (new_array, -- longest_to_int (index->U.number), -- 1, /* length is '1' element */ -+ 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 -@@ -620,7 +674,9 @@ value_f90_subarray (struct value *array, struct expression *exp, - 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. */ -+ 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]; -@@ -629,12 +685,20 @@ value_f90_subarray (struct value *array, struct expression *exp, - { - struct type *range_type, *interim_array_type; - -+ int new_length; -+ -+ /* 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, -- 1, -- index->U.range.high -- - index->U.range.low + 1); -+ index->U.range.low, -+ index->U.range.low + new_length); - - interim_array_type = create_array_type (NULL, - elt_type, -diff --git a/gdb/valops.c b/gdb/valops.c -index fbc7dcb..ded8efc 100644 ---- a/gdb/valops.c -+++ b/gdb/valops.c -@@ -3766,10 +3766,13 @@ 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 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); -+ /* 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 -@@ -3785,7 +3788,8 @@ value_slice (struct value *array, int lowbound, int length) - ranges in the calling function. */ - - struct value * --value_slice_1 (struct value *array, int lowbound, int length, int call_count) -+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; - struct type *array_type = check_typedef (value_type (array)); -@@ -3808,14 +3812,24 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) - 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)); - } - -- elem_count = length; -+ /* 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 = longest_to_int (lowbound - ary_low_bound); -+ elt_offs = lowbound - ary_low_bound; - elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type)); - - elt_offs *= elt_size; -@@ -3858,8 +3872,9 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) - { - struct type *element_type; - -- /* When CALL_COUNT equals 1 we can use the legacy code for subarrays. */ -- if (call_count == 1) -+ /* 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); - -@@ -3880,29 +3895,53 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count) - } - - } -- /* When CALL_COUNT is larger than 1 we are working on a range of ranges. -- So we copy the relevant elements into the new array we return. */ -+ /* 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 - { -+ int j, offs_store = elt_offs; - LONGEST dst_offset = 0; - LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); - -- element_type = TYPE_TARGET_TYPE (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); - -- TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_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); -- for (i = 0; i < longest_to_int (row_count); i++) -+ -+ /* Iterate through the rows of the outer array and set the new offset -+ for each row. */ -+ for (i = 0; i < row_count; i++) - { -- /* Fetches the contents of ARRAY and copies them into V. */ -- value_contents_copy (v, -- dst_offset, -- array, -- elt_offs, -- elt_size * elem_count); -- elt_offs += src_row_length; -- dst_offset += elt_size * elem_count; -+ 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; -+ } - } - } - -diff --git a/gdb/value.h b/gdb/value.h -index 95588af..e417639 100644 ---- a/gdb/value.h -+++ b/gdb/value.h -@@ -1056,7 +1056,7 @@ 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); -+extern struct value *value_slice_1 (struct value *, int, int, int, int); - - extern struct value *value_literal_complex (struct value *, struct value *, - struct type *); --- -2.5.5 - diff --git a/gdb-fortran-stride-intel-6of6.patch b/gdb-fortran-stride-intel-6of6.patch deleted file mode 100644 index 777bbc9..0000000 --- a/gdb-fortran-stride-intel-6of6.patch +++ /dev/null @@ -1,518 +0,0 @@ -RE: [ping] [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides -https://sourceware.org/ml/gdb-patches/2016-07/msg00009.html - -From 982d582ee738cbcf252ba8eab59a9514edda75b9 Mon Sep 17 00:00:00 2001 -From: Christoph Weinmann -Date: Wed, 4 Dec 2013 11:47:15 +0000 -Subject: [PATCH 6/6] fortran: test cases for subarray strides and slices - -Add test cases for subarray creation with range, literal and -stride value permutations for one, two, and three dimensional -arrays. - -2013-12-04 Christoph Weinmann - -testsuite/gdb.fortran/ - * static-arrays.exp: New test. - * static-arrays.f90: New file. - - -Signed-off-by: Christoph Weinmann ---- - gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++ - 2 files changed, 476 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp - create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90 - -diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp -new file mode 100644 -index 0000000..cc9ecc0 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp -@@ -0,0 +1,421 @@ -+# Copyright 2015 Free Software Foundation, Inc. -+# -+# Contributed by Intel Corp. -+# -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+standard_testfile static-arrays.f90 -+ -+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } { -+ return -1 -+} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_breakpoint [gdb_get_line_number "BP1"] -+gdb_continue_to_breakpoint "BP1" ".*BP1.*" -+ -+# Tests subarrays of one dimensional arrays with subrange variations -+gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ -+ "print ar1." -+gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \ -+ "print ar1\(4:7\)" -+gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \ -+ "print ar1\(8:\)" -+gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \ -+ "print ar1\(:3\)" -+gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ -+ "print ar1\(:\)" -+ -+# Check assignment -+gdb_test_no_output "set \$my_ary = ar1\(3:8\)" -+gdb_test "print \$my_ary" \ -+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ -+ "Assignment of subarray to variable" -+gdb_test_no_output "set ar1\(5\) = 42" -+ gdb_test "print ar1\(3:8\)" \ -+ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \ -+ "print ar1\(3:8\) after assignment" -+gdb_test "print \$my_ary" \ -+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ -+ "Assignment of subarray to variable after original array changed" -+ -+# Test for subarrays of one dimensional arrays with literals -+ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \ -+ "print ar1\(3\)" -+ -+# Tests for subranges of 2 dimensional arrays with subrange variations -+gdb_test "print ar2\(2:3, 3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \ -+ "print ar2\(2:3, 3:4\)." -+gdb_test "print ar2\(8:9,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:9,8:\)" -+gdb_test "print ar2\(8:9,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ -+ "print ar2\(8:9,:2\)" -+ -+gdb_test "print ar2\(8:,8:9\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:,8:9\)" -+gdb_test "print ar2\(8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:,8:\)" -+gdb_test "print ar2\(8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ -+ "print ar2\(8:,:2\)" -+ -+gdb_test "print ar2\(:2,2:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \ -+ "print ar2\(:2,2:3\)" -+gdb_test "print ar2\(:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \ -+ "print ar2\(:2,8:\)" -+gdb_test "print ar2\(:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \ -+ "print ar2\(:2,:2\)" -+ -+# Test subranges of 2 dimensional arrays with literals and subrange variations -+gdb_test "print ar2\(7, 3:6\)" \ -+ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \ -+ "print ar2\(7, 3:6\)" -+gdb_test "print ar2\(7,8:\)" \ -+ "\\$\[0-9\]+ = \\(78, 79\\)" \ -+ "print ar2\(7,8:\)" -+gdb_test "print ar2\(7,:2\)" \ -+ "\\$\[0-9\]+ = \\(71, 72\\)" \ -+ "print ar2\(7,:2\)" -+ -+gdb_test "print ar2\(7:8,4\)" \ -+ "\\$\[0-9\]+ = \\(74, 84\\)" \ -+ "print ar2(7:8,4\)" -+gdb_test "print ar2\(8:,4\)" \ -+ "\\$\[0-9\]+ = \\(84, 94\\)" \ -+ "print ar2\(8:,4\)" -+gdb_test "print ar2\(:2,4\)" \ -+ "\\$\[0-9\]+ = \\(14, 24\\)" \ -+ "print ar2\(:2,4\)" -+gdb_test "print ar2\(3,4\)" \ -+ "\\$\[0-9\]+ = 34" \ -+ "print ar2\(3,4\)" -+ -+# Test subarrays of 3 dimensional arrays with literals and subrange variations -+gdb_test "print ar3\(2:4,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\ -+ \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \ -+ "print ar3\(2:4,3:4,7:8\)" -+gdb_test "print ar3\(2:3,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\ -+ \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \ -+ "print ar3\(2:3,4:5,8:\)" -+gdb_test "print ar3\(2:3,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\ -+ \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \ -+ "print ar3\(2:3,4:5,:2\)" -+ -+gdb_test "print ar3\(2:3,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\ -+ \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \ -+ "print ar3\(2:3,8:,7:8\)" -+gdb_test "print ar3\(2:3,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\ -+ \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \ -+ "print ar3\(2:3,8:,8:\)" -+gdb_test "print ar3\(2:3,8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\ -+ \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \ -+ "print ar3\(2:3,8:,:2\)" -+ -+gdb_test "print ar3\(2:3,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\ -+ \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \ -+ "print ar3\(2:3,:2,7:8\)" -+gdb_test "print ar3\(2:3,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\ -+ \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \ -+ "print ar3\(2:3,:2,8:\)" -+gdb_test "print ar3\(2:3,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\ -+ \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \ -+ "print ar3\(2:3,:2,:2\)" -+ -+gdb_test "print ar3\(8:,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\ -+ \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \ -+ "print ar3\(8:,3:4,7:8\)" -+gdb_test "print ar3\(8:,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\ -+ \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \ -+ "print ar3\(8:,4:5,8:\)" -+gdb_test "print ar3\(8:,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\ -+ \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \ -+ "print ar3\(8:,4:5,:2\)" -+ -+gdb_test "print ar3\(8:,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\ -+ \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \ -+ "print ar3\(8:,8:,7:8\)" -+gdb_test "print ar3\(8:,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\ -+ \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \ -+ "print ar3\(8:,8:,8:\)" -+gdb_test "print ar3\(8:,8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\ -+ \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \ -+ "print ar3\(8:,8:,:2\)" -+ -+gdb_test "print ar3\(8:,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\ -+ \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \ -+ "print ar3\(8:,:2,7:8\)" -+gdb_test "print ar3\(8:,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\ -+ \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \ -+ "print ar3\(8:,:2,8:\)" -+gdb_test "print ar3\(8:,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\ -+ \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \ -+ "print ar3\(8:,:2,:2\)" -+ -+ -+gdb_test "print ar3\(:2,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\ -+ \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \ -+ "print ar3 \(:2,3:4,7:8\)." -+gdb_test "print ar3\(:2,3:4,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\ -+ \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \ -+ "print ar3\(:2,3:4,8:\)" -+gdb_test "print ar3\(:2,3:4,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\ -+ \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \ -+ "print ar3\(:2,3:4,:2\)" -+ -+gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\ -+ 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \ -+ "print ar3\(:2,8:,7:8\)" -+gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\ -+ 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \ -+ "print ar3\(:2,8:,8:\)" -+gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\ -+ 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \ -+ "print ar3\(:2,8:,:2\)" -+ -+gdb_test "print ar3\(:2,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\ -+ \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \ -+ "print ar3\(:2,:2,7:8\)" -+gdb_test "print ar3\(:2,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\ -+ \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \ -+ "print ar3\(:2,:2,8:\)" -+gdb_test "print ar3\(:2,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\ -+ \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \ -+ "print ar3\(:2,:2,:2\)" -+ -+#Tests for subarrays of 3 dimensional arrays with literals and subranges -+gdb_test "print ar3\(3,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \ -+ "print ar3\(3,3:4,7:8\)" -+gdb_test "print ar3\(3,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \ -+ "print ar3\(3,4:5,8:\)" -+gdb_test "print ar3\(3,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \ -+ "print ar3\(3,4:5,:2\)" -+gdb_test "print ar3\(3,4:5,3\)" \ -+ "\\$\[0-9\]+ = \\(343, 353\\)" \ -+ "print ar3\(3,4:5,3\)" -+ -+gdb_test "print ar3\(2,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \ -+ "print ar3\(2,8:,7:8\)" -+gdb_test "print ar3\(2,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \ -+ "print ar3\(2,8:,8:\)" -+gdb_test "print ar3\(2,8:,:2\)"\ -+ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \ -+ "print ar3\(2,8:,:2\)" -+gdb_test "print ar3\(2,8:,3\)" \ -+ "\\$\[0-9\]+ = \\(283, 293\\)" \ -+ "print ar3\(2,8:,3\)" -+ -+gdb_test "print ar3\(2,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \ -+ "print ar3\(2,:2,7:8\)" -+gdb_test "print ar3\(2,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \ -+ "print ar3\(2,:2,8:\)" -+gdb_test "print ar3\(2,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \ -+ "print ar3\(2,:2,:2\)" -+gdb_test "print ar3\(2,:2,3\)" \ -+ "\\$\[0-9\]+ = \\(213, 223\\)" \ -+ "print ar3\(2,:2,3\)" -+ -+gdb_test "print ar3\(3,4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(347, 348\\)" \ -+ "print ar3\(3,4,7:8\)" -+gdb_test "print ar3\(3,4,8:\)" \ -+ "\\$\[0-9\]+ = \\(348, 349\\)" \ -+i "print ar3\(3,4,8:\)" -+gdb_test "print ar3\(3,4,:2\)" \ -+ "\\$\[0-9\]+ = \\(341, 342\\)" \ -+ "print ar3\(3,4,:2\)" -+gdb_test "print ar3\(5,6,7\)" \ -+ "\\$\[0-9\]+ = 567" \ -+ "print ar3\(5,6,7\)" -+ -+gdb_test "print ar3\(3:4,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \ -+ "print ar3\(3:4,6,7:8\)" -+gdb_test "print ar3\(3:4,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \ -+ "print ar3\(3:4,6,8:\)" -+gdb_test "print ar3\(3:4,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \ -+ "print ar3\(3:4,6,:2\)" -+gdb_test "print ar3\(3:4,6,5\)" \ -+ "\\$\[0-9\]+ = \\(365, 465\\)" \ -+ "print ar3\(3:4,6,5\)" -+ -+gdb_test "print ar3\(8:,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \ -+ "print ar3\(8:,6,7:8\)" -+gdb_test "print ar3\(8:,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \ -+ "print ar3\(8:,6,8:\)" -+gdb_test "print ar3\(8:,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \ -+ "print ar3\(8:,6,:2\)" -+gdb_test "print ar3\(8:,6,5\)" \ -+ "\\$\[0-9\]+ = \\(865, 965\\)" \ -+ "print ar3\(8:,6,5\)" -+ -+gdb_test "print ar3\(:2,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \ -+ "print ar3\(:2,6,7:8\)" -+gdb_test "print ar3\(:2,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \ -+ "print ar3\(:2,6,8:\)" -+gdb_test "print ar3\(:2,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \ -+ "print ar3\(:2,6,:2\)" -+gdb_test "print ar3\(:2,6,5\)" \ -+ "\\$\[0-9\]+ = \\(165, 265\\)" \ -+ "print ar3\(:2,6,5\)" -+ -+gdb_test "print ar3\(3:4,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \ -+ "print ar2\(3:4,5:6,4\)" -+gdb_test "print ar3\(8:,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \ -+ "print ar2\(8:,5:6,4\)" -+gdb_test "print ar3\(:2,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \ -+ "print ar2\(:2,5:6,4\)" -+ -+# Stride > 1 -+gdb_test "print ar1\(2:6:2\)" \ -+ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \ -+ "print ar1\(2:6:2\)" -+gdb_test "print ar2\(2:6:2,3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \ -+ "print ar2\(2:6:2,3:4\)" -+gdb_test "print ar2\(2:6:2,3\)" \ -+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ -+ "print ar2\(2:6:2,3\)" -+gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\ -+ \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \ -+ "print ar3\(2:6:2,3:5:2,4:7:3\)" -+gdb_test "print ar3\(2:6:2,5,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\ -+ \\)" \ -+ "print ar3\(2:6:2,5,4:7:3\)" -+ -+# Stride < 0 -+gdb_test "print ar1\(8:2:-2\)" \ -+ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \ -+ "print ar1\(8:2:-2\)" -+gdb_test "print ar2\(8:2:-2,3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\ -+ \\)" \ -+ "print ar2\(8:2:-2,3:4\)" -+gdb_test "print ar2\(2:6:2,3\)" \ -+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ -+ "print ar2\(2:6:2,3\)" -+gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\ -+ \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \ -+ "print ar3\(2:3,7:3:-4,4:7:3\)" -+gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\ -+ \\)" \ -+ "print ar3\(2:6:2,5,7:4:-3\)" -+ -+# Tests with negative and mixed indices -+gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\ -+ \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\ -+ 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\ -+ 392, 492\\) \\) \\)" \ -+ "print ar4(2:4, -2:1, -15:-14)" -+ -+gdb_test "p ar4\(7,-6:2:3,-7\)" \ -+ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \ -+ "print ar4(7,-6:2:3,-7)" -+ -+gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\ -+ 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\ -+ 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\ -+ 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\ -+ 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\ -+ 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\ -+ \\)" \ -+ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)" -+ -+gdb_test "p ar4\(:,:,:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\ -+ 811, .*" \ -+ "print ar4(:,:,:)" -+ -+# Provoke error messages for bad user input -+gdb_test "print ar1\(0:4\)" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ -+ "print ar1\(0:4\)" -+gdb_test "print ar1\(8:12\)" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ -+ "print ar1\(8:12\)" -+gdb_test "print ar1\(8:2:\)" \ -+ "A syntax error in expression, near `\\)'." \ -+ "print ar1\(8:2:\)" -+gdb_test "print ar1\(8:2:2\)" \ -+ "Wrong value provided for stride and boundaries" \ -+ "print ar1\(8:2:2\)" -+gdb_test "print ar1\(2:8:-2\)" \ -+ "Wrong value provided for stride and boundaries" \ -+ "print ar1\(2:8:-2\)" -+gdb_test "print ar1\(2:7:0\)" \ -+ "Stride must not be 0" \ -+ "print ar1\(2:7:0\)" -+gdb_test "print ar1\(3:7\) = 42" \ -+ "Invalid cast." \ -+ "Assignment of value to subarray" -diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90 -new file mode 100644 -index 0000000..f22fcbe ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90 -@@ -0,0 +1,55 @@ -+! Copyright 2015 Free Software Foundation, Inc. -+! -+! Contributed by Intel Corp. -+! -+! This program is free software; you can redistribute it and/or modify -+! it under the terms of the GNU General Public License as published by -+! the Free Software Foundation; either version 3 of the License, or -+! (at your option) any later version. -+! -+! This program is distributed in the hope that it will be useful, -+! but WITHOUT ANY WARRANTY; without even the implied warranty of -+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+! GNU General Public License for more details. -+! -+! You should have received a copy of the GNU General Public License -+! along with this program. If not, see . -+ -+subroutine sub -+ integer, dimension(9) :: ar1 -+ integer, dimension(9,9) :: ar2 -+ integer, dimension(9,9,9) :: ar3 -+ integer, dimension(10,-7:3, -15:-5) :: ar4 -+ integer :: i,j,k -+ -+ ar1 = 1 -+ ar2 = 1 -+ ar3 = 1 -+ ar4 = 4 -+ -+ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...))) -+ do i = 1, 9, 1 -+ ar1(i) = i -+ do j = 1, 9, 1 -+ ar2(i,j) = i*10 + j -+ do k = 1, 9, 1 -+ ar3(i,j,k) = i*100 + j*10 + k -+ end do -+ end do -+ end do -+ -+ do i = 1, 10, 1 -+ do j = -7, 3, 1 -+ do k = -15, -5, 1 -+ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16) -+ end do -+ end do -+ end do -+ -+ ar1(1) = 11 !BP1 -+ return -+end -+ -+program testprog -+ call sub -+end --- -2.5.5 - diff --git a/gdb-vla-intel-7of7.patch b/gdb-vla-intel-7of7.patch index 726c341..310ca60 100644 --- a/gdb-vla-intel-7of7.patch +++ b/gdb-vla-intel-7of7.patch @@ -52,11 +52,11 @@ Change-Id: I7d7f47c7a4900a7fdb51102032455b53d60e60d7 create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.exp create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.f90 -diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c -index 6658a38..678da8f 100644 ---- a/gdb/dwarf2read.c -+++ b/gdb/dwarf2read.c -@@ -1764,7 +1764,8 @@ static void read_signatured_type (struct signatured_type *); +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, @@ -66,7 +66,7 @@ index 6658a38..678da8f 100644 /* memory allocation interface */ -@@ -11437,7 +11438,7 @@ read_func_scope (struct die_info *die, struct dwarf2_cu *cu) +@@ -11446,7 +11447,7 @@ { newobj->static_link = XOBNEW (&objfile->objfile_obstack, struct dynamic_prop); @@ -75,16 +75,16 @@ index 6658a38..678da8f 100644 } cu->list_in_scope = &local_symbols; -@@ -14495,29 +14496,94 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu) +@@ -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) @@ -181,7 +181,7 @@ index 6658a38..678da8f 100644 char_type = language_string_char_type (cu->language_defn, gdbarch); type = create_string_type (NULL, char_type, range_type); -@@ -14847,7 +14913,8 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu) +@@ -14864,7 +14930,8 @@ static int attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, @@ -191,7 +191,7 @@ index 6658a38..678da8f 100644 { struct dwarf2_property_baton *baton; struct obstack *obstack = &cu->objfile->objfile_obstack; -@@ -14857,14 +14924,33 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, +@@ -14874,14 +14941,33 @@ if (attr_form_is_block (attr)) { @@ -229,7 +229,7 @@ index 6658a38..678da8f 100644 } else if (attr_form_is_ref (attr)) { -@@ -14897,8 +14983,28 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, +@@ -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; @@ -260,7 +260,15 @@ index 6658a38..678da8f 100644 prop->data.baton = baton; prop->kind = PROP_LOCEXPR; gdb_assert (prop->data.baton != NULL); -@@ -15008,17 +15114,17 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) +@@ -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) @@ -281,7 +289,7 @@ index 6658a38..678da8f 100644 { /* If bounds are constant do the final calculation here. */ if (low.kind == PROP_CONST && high.kind == PROP_CONST) -@@ -22389,7 +22495,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) +@@ -22416,7 +22522,7 @@ attr = dwarf2_attr (die, DW_AT_allocated, cu); if (attr_form_is_block (attr)) { @@ -290,7 +298,7 @@ index 6658a38..678da8f 100644 add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile); } else if (attr != NULL) -@@ -22404,7 +22510,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) +@@ -22431,7 +22537,7 @@ attr = dwarf2_attr (die, DW_AT_associated, cu); if (attr_form_is_block (attr)) { @@ -299,7 +307,7 @@ index 6658a38..678da8f 100644 add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile); } else if (attr != NULL) -@@ -22417,7 +22523,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) +@@ -22444,7 +22550,7 @@ /* Read DW_AT_data_location and set in type. */ attr = dwarf2_attr (die, DW_AT_data_location, cu); @@ -308,11 +316,11 @@ index 6658a38..678da8f 100644 add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile); if (dwarf2_per_objfile->die_type_hash == NULL) -diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c -index b53e649..0aa9113 100644 ---- a/gdb/gdbtypes.c -+++ b/gdb/gdbtypes.c -@@ -1841,6 +1841,7 @@ is_dynamic_type_internal (struct type *type, int top_level) +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: @@ -320,7 +328,7 @@ index b53e649..0aa9113 100644 { gdb_assert (TYPE_NFIELDS (type) == 1); -@@ -1945,7 +1946,8 @@ resolve_dynamic_array (struct type *type, +@@ -1964,7 +1965,8 @@ struct type *ary_dim; struct dynamic_prop *prop; @@ -330,7 +338,7 @@ index b53e649..0aa9113 100644 type = copy_type (type); -@@ -1970,13 +1972,17 @@ resolve_dynamic_array (struct type *type, +@@ -1989,13 +1991,17 @@ ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); @@ -351,7 +359,7 @@ index b53e649..0aa9113 100644 } /* Resolve dynamic bounds of members of the union TYPE to static -@@ -2181,6 +2187,7 @@ resolve_dynamic_type_internal (struct type *type, +@@ -2200,6 +2206,7 @@ break; case TYPE_CODE_ARRAY: @@ -359,11 +367,10 @@ index b53e649..0aa9113 100644 resolved_type = resolve_dynamic_array (type, addr_stack); break; -diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp -new file mode 100644 -index 0000000..484fdcb ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-strings.exp +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. + @@ -468,11 +475,10 @@ index 0000000..484fdcb + pass $test + } +} -diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90 -new file mode 100644 -index 0000000..3c22735 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-strings.f90 +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. +! @@ -513,6 +519,3 @@ index 0000000..3c22735 + var_char_p => null() + l = associated(var_char_p) ! var_char_p-not-associated +end program vla_strings --- -2.7.4 - diff --git a/gdb-vla-intel-branch-fix-stride-1of2.patch b/gdb-vla-intel-branch-fix-stride-1of2.patch new file mode 100644 index 0000000..f4c6670 --- /dev/null +++ b/gdb-vla-intel-branch-fix-stride-1of2.patch @@ -0,0 +1,64 @@ +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 new file mode 100644 index 0000000..9840d0e --- /dev/null +++ b/gdb-vla-intel-branch-fix-stride-2of2.patch @@ -0,0 +1,929 @@ +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 new file mode 100644 index 0000000..ee16e99 --- /dev/null +++ b/gdb-vla-intel-branch.patch @@ -0,0 +1,1832 @@ +git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides +2c392d41a3f2e38deeb9db5b7a93ca45682bbe3b + + gdb/dwarf2read.c | 13 +- + gdb/eval.c | 391 +++++++++++++++++++++----- + gdb/expprint.c | 20 +- + gdb/expression.h | 18 +- + gdb/f-exp.y | 42 ++- + gdb/f-valprint.c | 8 +- + gdb/gdbtypes.c | 45 ++- + gdb/gdbtypes.h | 18 ++ + gdb/parse.c | 24 +- + gdb/rust-exp.y | 12 +- + gdb/rust-lang.c | 17 +- + gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++ + gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++ + gdb/testsuite/gdb.fortran/vla-stride.exp | 44 +++ + gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++ + gdb/valarith.c | 14 +- + gdb/valops.c | 197 +++++++++++-- + gdb/value.h | 2 + + 18 files changed, 1197 insertions(+), 173 deletions(-) + +diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c +index 6658a38..a1ac659 100644 +--- a/gdb/dwarf2read.c ++++ b/gdb/dwarf2read.c +@@ -14952,7 +14952,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + struct type *base_type, *orig_base_type; + struct type *range_type; + struct attribute *attr; +- struct dynamic_prop low, high; ++ struct dynamic_prop low, high, stride; + int low_default_is_valid; + int high_bound_is_count = 0; + const char *name; +@@ -14972,7 +14972,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + + low.kind = PROP_CONST; + high.kind = PROP_CONST; ++ stride.kind = PROP_CONST; + high.data.const_val = 0; ++ stride.data.const_val = 0; + + /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow + omitting DW_AT_lower_bound. */ +@@ -15006,6 +15008,13 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + break; + } + ++ attr = dwarf2_attr (die, DW_AT_byte_stride, cu); ++ if (attr) ++ if (!attr_to_dynamic_prop (attr, die, cu, &stride)) ++ complaint (&symfile_complaints, _("Missing DW_AT_byte_stride " ++ "- DIE at 0x%x [in module %s]"), ++ die->offset.sect_off, objfile_name (cu->objfile)); ++ + attr = dwarf2_attr (die, DW_AT_lower_bound, cu); + if (attr) + attr_to_dynamic_prop (attr, die, cu, &low); +@@ -15082,7 +15091,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask)) + high.data.const_val |= negative_mask; + +- range_type = create_range_type (NULL, orig_base_type, &low, &high); ++ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride); + + if (high_bound_is_count) + TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1; +diff --git a/gdb/eval.c b/gdb/eval.c +index 00a107c..91d8a03 100644 +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -399,29 +399,325 @@ init_array_element (struct value *array, struct value *element, + return index; + } + ++/* Evaluates any operation on Fortran arrays or strings with at least ++ one user provided parameter. Expects the input ARRAY to be either ++ an array, or a string. Evaluates EXP by incrementing POS, and ++ writes the content from the elt stack into a local struct. NARGS ++ specifies number of literal or range arguments the user provided. ++ NARGS must be the same number as ARRAY has dimensions. */ ++ + static struct value * +-value_f90_subarray (struct value *array, +- struct expression *exp, int *pos, enum noside noside) ++value_f90_subarray (struct value *array, struct expression *exp, ++ int *pos, int nargs, enum noside noside) + { +- int pc = (*pos) + 1; ++ int i, dim_count = 0; + LONGEST low_bound, high_bound; +- struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array))); +- enum range_type range_type +- = (enum range_type) longest_to_int (exp->elts[pc].longconst); +- +- *pos += 3; +- +- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- low_bound = TYPE_LOW_BOUND (range); +- else +- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ struct value *new_array = array; ++ struct type *array_type = check_typedef (value_type (new_array)); ++ struct type *elt_type; ++ ++ typedef struct subscript_range ++ { ++ enum range_type f90_range_type; ++ LONGEST low, high, stride; ++ } subscript_range; ++ ++ typedef enum subscript_kind ++ { ++ SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */ ++ SUBSCRIPT_INDEX /* e.g. "(literal)" */ ++ } kind; ++ ++ /* Local struct to hold user data for Fortran subarray dimensions. */ ++ struct subscript_store ++ { ++ /* For every dimension, we are either working on a range or an index ++ expression, so we store this info separately for later. */ ++ enum subscript_kind kind; ++ ++ /* We also store either the lower and upper bound info, or the index ++ number. Before evaluation of the input values, we do not know if we are ++ actually working on a range of ranges, or an index in a range. So as a ++ first step we store all input in a union. The array calculation itself ++ deals with this later on. */ ++ union element_range ++ { ++ subscript_range range; ++ LONGEST number; ++ } U; ++ } *subscript_array; ++ ++ /* Check if the number of arguments provided by the user matches ++ the number of dimension of the array. A string has only one ++ dimension. */ ++ if (nargs != calc_f77_array_dims (value_type (new_array))) ++ error (_("Wrong number of subscripts")); ++ ++ subscript_array = (struct subscript_store*) alloca (sizeof (*subscript_array) * nargs); ++ ++ /* Parse the user input into the SUBSCRIPT_ARRAY to store it. We need ++ to evaluate it first, as the input is from left-to-right. The ++ array is stored from right-to-left. So we have to use the user ++ input in reverse order. Later on, we need the input information to ++ re-calculate the output array. For multi-dimensional arrays, we ++ can be dealing with any possible combination of ranges and indices ++ for every dimension. */ ++ for (i = 0; i < nargs; i++) ++ { ++ struct subscript_store *index = &subscript_array[i]; + +- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- high_bound = TYPE_HIGH_BOUND (range); +- else +- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); ++ /* The user input is a range, with or without lower and upper bound. ++ E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */ ++ if (exp->elts[*pos].opcode == OP_RANGE) ++ { ++ int pc = (*pos) + 1; ++ subscript_range *range; ++ ++ index->kind = SUBSCRIPT_RANGE; ++ range = &index->U.range; ++ ++ *pos += 3; ++ range->f90_range_type = (enum range_type) exp->elts[pc].longconst; ++ ++ /* If a lower bound was provided by the user, the bit has been ++ set and we can assign the value from the elt stack. Same for ++ upper bound. */ ++ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) ++ == SUBARRAY_LOW_BOUND) ++ range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) ++ == SUBARRAY_HIGH_BOUND) ++ range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ ++ /* Assign the user's stride value if provided. */ ++ if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) ++ range->stride = value_as_long (evaluate_subexp (NULL_TYPE, exp, ++ pos, noside)); ++ ++ /* Assign the default stride value '1'. */ ++ else ++ range->stride = 1; ++ ++ /* Check the provided stride value is illegal, aka '0'. */ ++ if (range->stride == 0) ++ error (_("Stride must not be 0")); ++ } ++ /* User input is an index. E.g.: "p arry(5)". */ ++ else ++ { ++ struct value *val; ++ ++ index->kind = SUBSCRIPT_INDEX; ++ ++ /* Evaluate each subscript; it must be a legal integer in F77. This ++ ensures the validity of the provided index. */ ++ val = evaluate_subexp_with_coercion (exp, pos, noside); ++ index->U.number = value_as_long (val); ++ } ++ ++ } ++ ++ /* Traverse the array from right to left and set the high and low bounds ++ for later use. */ ++ for (i = nargs - 1; i >= 0; i--) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ struct type *index_type = TYPE_INDEX_TYPE (array_type); ++ ++ switch (index->kind) ++ { ++ case SUBSCRIPT_RANGE: ++ { ++ ++ /* When we hit the first range specified by the user, we must ++ treat any subsequent user entry as a range. We simply ++ increment DIM_COUNT which tells us how many times we are ++ calling VALUE_SLICE_1. */ ++ subscript_range *range = &index->U.range; ++ ++ /* If no lower bound was provided by the user, we take the ++ default boundary. Same for the high bound. */ ++ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0) ++ range->low = TYPE_LOW_BOUND (index_type); ++ ++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0) ++ range->high = TYPE_HIGH_BOUND (index_type); ++ ++ /* Both user provided low and high bound have to be inside the ++ array bounds. Throw an error if not. */ ++ if (range->low < TYPE_LOW_BOUND (index_type) ++ || range->low > TYPE_HIGH_BOUND (index_type) ++ || range->high < TYPE_LOW_BOUND (index_type) ++ || range->high > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ /* For a negative stride the lower boundary must be larger than the ++ upper boundary. ++ For a positive stride the lower boundary must be smaller than the ++ upper boundary. */ ++ if ((range->stride < 0 && range->low < range->high) ++ || (range->stride > 0 && range->low > range->high)) ++ error (_("Wrong value provided for stride and boundaries")); ++ ++ } ++ break; ++ ++ case SUBSCRIPT_INDEX: ++ break; ++ ++ } ++ ++ array_type = TYPE_TARGET_TYPE (array_type); ++ } ++ ++ /* Reset ARRAY_TYPE before slicing.*/ ++ array_type = check_typedef (value_type (new_array)); ++ ++ /* Traverse the array from right to left and evaluate each corresponding ++ user input. VALUE_SUBSCRIPT is called for every index, until a range ++ expression is evaluated. After a range expression has been evaluated, ++ every subsequent expression is also treated as a range. */ ++ for (i = nargs - 1; i >= 0; i--) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ struct type *index_type = TYPE_INDEX_TYPE (array_type); ++ ++ switch (index->kind) ++ { ++ case SUBSCRIPT_RANGE: ++ { ++ ++ /* When we hit the first range specified by the user, we must ++ treat any subsequent user entry as a range. We simply ++ increment DIM_COUNT which tells us how many times we are ++ calling VALUE_SLICE_1. */ ++ subscript_range *range = &index->U.range; ++ ++ /* DIM_COUNT counts every user argument that is treated as a range. ++ This is necessary for expressions like 'print array(7, 8:9). ++ Here the first argument is a literal, but must be treated as a ++ range argument to allow the correct output representation. */ ++ dim_count++; ++ ++ new_array ++ = value_slice_1 (new_array, range->low, ++ range->high - range->low + 1, ++ range->stride, dim_count); ++ } ++ break; ++ ++ case SUBSCRIPT_INDEX: ++ { ++ /* DIM_COUNT only stays '0' when no range argument was processed ++ before, starting from the last dimension. This way we can ++ reduce the number of dimensions from the result array. ++ However, if a range has been processed before an index, we ++ treat the index like a range with equal low- and high bounds ++ to get the value offset right. */ ++ if (dim_count == 0) ++ new_array ++ = value_subscripted_rvalue (new_array, index->U.number, ++ f77_get_lowerbound (value_type ++ (new_array))); ++ else ++ { ++ dim_count++; ++ ++ /* We might end up here, because we have to treat the provided ++ index like a range. But now VALUE_SUBSCRIPTED_RVALUE ++ cannot do the range checks for us. So we have to make sure ++ ourselves that the user provided index is inside the ++ array bounds. Throw an error if not. */ ++ if (index->U.number < TYPE_LOW_BOUND (index_type) ++ && index->U.number > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ if (index->U.number > TYPE_LOW_BOUND (index_type) ++ && index->U.number > TYPE_HIGH_BOUND (index_type)) ++ error (_("provided bound(s) outside array bound(s)")); ++ ++ new_array = value_slice_1 (new_array, ++ index->U.number, ++ 1, /* COUNT is '1' element */ ++ 1, /* STRIDE set to '1' */ ++ dim_count); ++ } ++ ++ } ++ break; ++ } ++ array_type = TYPE_TARGET_TYPE (array_type); ++ } ++ ++ /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect ++ an array of arrays, depending on how many ranges have been provided by ++ the user. So we need to rebuild the array dimensions for printing it ++ correctly. ++ Starting from right to left in the user input, after we hit the first ++ range argument every subsequent argument is also treated as a range. ++ E.g.: ++ "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3 ++ ranges. ++ "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2 ++ ranges. ++ "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1 ++ range. */ ++ if (dim_count > 1) ++ { ++ struct value *v = NULL; ++ ++ elt_type = TYPE_TARGET_TYPE (value_type (new_array)); ++ ++ /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in ++ the output array. So we traverse the SUBSCRIPT_ARRAY again, looking ++ for a range entry. When we find one, we use the range info to create ++ an additional range_type to set the correct bounds and dimensions for ++ the output array. In addition, we may have a stride value that is not ++ '1', forcing us to adjust the number of elements in a range, according ++ to the stride value. */ ++ for (i = 0; i < nargs; i++) ++ { ++ struct subscript_store *index = &subscript_array[i]; ++ ++ if (index->kind == SUBSCRIPT_RANGE) ++ { ++ struct type *range_type, *interim_array_type; ++ ++ int new_length; + +- return value_slice (array, low_bound, high_bound - low_bound + 1); ++ /* The length of a sub-dimension with all elements between the ++ bounds plus the start element itself. It may be modified by ++ a user provided stride value. */ ++ new_length = index->U.range.high - index->U.range.low; ++ ++ new_length /= index->U.range.stride; ++ ++ range_type ++ = create_static_range_type (NULL, ++ elt_type, ++ index->U.range.low, ++ index->U.range.low + new_length); ++ ++ interim_array_type = create_array_type (NULL, ++ elt_type, ++ range_type); ++ ++ TYPE_CODE (interim_array_type) ++ = TYPE_CODE (value_type (new_array)); ++ ++ v = allocate_value (interim_array_type); ++ ++ elt_type = value_type (v); ++ } ++ ++ } ++ value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type)); ++ return v; ++ } ++ ++ return new_array; + } + + +@@ -1810,19 +2106,8 @@ evaluate_subexp_standard (struct type *expect_type, + switch (code) + { + case TYPE_CODE_ARRAY: +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- goto multi_f77_subscript; +- + case TYPE_CODE_STRING: +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- { +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- return value_subscript (arg1, value_as_long (arg2)); +- } ++ return value_f90_subarray (arg1, exp, pos, nargs, noside); + + case TYPE_CODE_PTR: + case TYPE_CODE_FUNC: +@@ -2223,49 +2508,6 @@ evaluate_subexp_standard (struct type *expect_type, + } + return (arg1); + +- multi_f77_subscript: +- { +- LONGEST subscript_array[MAX_FORTRAN_DIMS]; +- int ndimensions = 1, i; +- struct value *array = arg1; +- +- if (nargs > MAX_FORTRAN_DIMS) +- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); +- +- ndimensions = calc_f77_array_dims (type); +- +- if (nargs != ndimensions) +- error (_("Wrong number of subscripts")); +- +- gdb_assert (nargs > 0); +- +- /* Now that we know we have a legal array subscript expression +- let us actually find out where this element exists in the array. */ +- +- /* Take array indices left to right. */ +- for (i = 0; i < nargs; i++) +- { +- /* Evaluate each subscript; it must be a legal integer in F77. */ +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- +- /* Fill in the subscript array. */ +- +- subscript_array[i] = value_as_long (arg2); +- } +- +- /* Internal type of array is arranged right to left. */ +- for (i = nargs; i > 0; i--) +- { +- struct type *array_type = check_typedef (value_type (array)); +- LONGEST index = subscript_array[i - 1]; +- +- array = value_subscripted_rvalue (array, index, +- f77_get_lowerbound (array_type)); +- } +- +- return array; +- } +- + case BINOP_LOGICAL_AND: + arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); + if (noside == EVAL_SKIP) +@@ -3123,6 +3365,9 @@ calc_f77_array_dims (struct type *array_type) + int ndimen = 1; + struct type *tmp_type; + ++ if (TYPE_CODE (array_type) == TYPE_CODE_STRING) ++ return 1; ++ + if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY)) + error (_("Can't get dimensions for a non-array type")); + +diff --git a/gdb/expprint.c b/gdb/expprint.c +index c37ecb0..214d58e 100644 +--- a/gdb/expprint.c ++++ b/gdb/expprint.c +@@ -568,12 +568,10 @@ print_subexp_standard (struct expression *exp, int *pos, + *pos += 2; + + fputs_filtered ("RANGE(", stream); +- if (range_type == HIGH_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered ("..", stream); +- if (range_type == LOW_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered (")", stream); + return; +@@ -1055,16 +1053,16 @@ dump_subexp_body_standard (struct expression *exp, + + switch (range_type) + { +- case BOTH_BOUND_DEFAULT: ++ case SUBARRAY_NONE_BOUND: + fputs_filtered ("Range '..'", stream); + break; +- case LOW_BOUND_DEFAULT: ++ case SUBARRAY_HIGH_BOUND: + fputs_filtered ("Range '..EXP'", stream); + break; +- case HIGH_BOUND_DEFAULT: ++ case SUBARRAY_LOW_BOUND: + fputs_filtered ("Range 'EXP..'", stream); + break; +- case NONE_BOUND_DEFAULT: ++ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND): + fputs_filtered ("Range 'EXP..EXP'", stream); + break; + default: +@@ -1072,11 +1070,9 @@ dump_subexp_body_standard (struct expression *exp, + break; + } + +- if (range_type == HIGH_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) + elt = dump_subexp (exp, stream, elt); +- if (range_type == LOW_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) + elt = dump_subexp (exp, stream, elt); + } + break; +diff --git a/gdb/expression.h b/gdb/expression.h +index 4952d84..34ca54b 100644 +--- a/gdb/expression.h ++++ b/gdb/expression.h +@@ -152,17 +152,17 @@ extern void dump_raw_expression (struct expression *, + struct ui_file *, char *); + extern void dump_prefix_expression (struct expression *, struct ui_file *); + +-/* In an OP_RANGE expression, either bound could be empty, indicating +- that its value is by default that of the corresponding bound of the +- array or string. So we have four sorts of subrange. This +- enumeration type is to identify this. */ +- ++/* In an OP_RANGE expression, either bound can be provided by the user, or not. ++ In addition to this, the user can also specify a stride value to indicated ++ only certain elements of the array. This enumeration type is to identify ++ this. */ ++ + enum range_type + { +- BOTH_BOUND_DEFAULT, /* "(:)" */ +- LOW_BOUND_DEFAULT, /* "(:high)" */ +- HIGH_BOUND_DEFAULT, /* "(low:)" */ +- NONE_BOUND_DEFAULT /* "(low:high)" */ ++ SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */ ++ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ ++ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */ ++ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */ + }; + + #endif /* !defined (EXPRESSION_H) */ +diff --git a/gdb/f-exp.y b/gdb/f-exp.y +index e3148a3..71f1823 100644 +--- a/gdb/f-exp.y ++++ b/gdb/f-exp.y +@@ -253,31 +253,63 @@ arglist : subrange + + arglist : arglist ',' exp %prec ABOVE_COMMA + { arglist_len++; } ++ | arglist ',' subrange %prec ABOVE_COMMA ++ { arglist_len++; } + ; + + /* There are four sorts of subrange types in F90. */ + + subrange: exp ':' exp %prec ABOVE_COMMA +- { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT); ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, ++ SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: exp ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++/* Each subrange type can have a stride argument. */ ++subrange: exp ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND ++ | SUBARRAY_HIGH_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: exp ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND ++ | SUBARRAY_STRIDE); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + +diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c +index 08215e2..e6eca6a 100644 +--- a/gdb/f-valprint.c ++++ b/gdb/f-valprint.c +@@ -121,8 +121,14 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type, + + if (nss != ndimensions) + { +- size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); ++ size_t dim_size; + size_t offs = 0; ++ LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); ++ ++ if (byte_stride) ++ dim_size = byte_stride; ++ else ++ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); + + for (i = lowerbound; + (i < upperbound + 1 && (*elts) < options->print_max); +diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c +index ec5c17a..88801ac 100644 +--- a/gdb/gdbtypes.c ++++ b/gdb/gdbtypes.c +@@ -836,7 +836,8 @@ allocate_stub_method (struct type *type) + struct type * + create_range_type (struct type *result_type, struct type *index_type, + const struct dynamic_prop *low_bound, +- const struct dynamic_prop *high_bound) ++ const struct dynamic_prop *high_bound, ++ const struct dynamic_prop *stride) + { + if (result_type == NULL) + result_type = alloc_type_copy (index_type); +@@ -851,6 +852,7 @@ create_range_type (struct type *result_type, struct type *index_type, + TYPE_ZALLOC (result_type, sizeof (struct range_bounds)); + TYPE_RANGE_DATA (result_type)->low = *low_bound; + TYPE_RANGE_DATA (result_type)->high = *high_bound; ++ TYPE_RANGE_DATA (result_type)->stride = *stride; + + if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0) + TYPE_UNSIGNED (result_type) = 1; +@@ -879,7 +881,7 @@ struct type * + create_static_range_type (struct type *result_type, struct type *index_type, + LONGEST low_bound, LONGEST high_bound) + { +- struct dynamic_prop low, high; ++ struct dynamic_prop low, high, stride; + + low.kind = PROP_CONST; + low.data.const_val = low_bound; +@@ -887,7 +889,11 @@ create_static_range_type (struct type *result_type, struct type *index_type, + high.kind = PROP_CONST; + high.data.const_val = high_bound; + +- result_type = create_range_type (result_type, index_type, &low, &high); ++ stride.kind = PROP_CONST; ++ stride.data.const_val = 0; ++ ++ result_type = create_range_type (result_type, index_type, ++ &low, &high, &stride); + + return result_type; + } +@@ -1084,16 +1090,20 @@ create_array_type_with_stride (struct type *result_type, + && (!type_not_associated (result_type) + && !type_not_allocated (result_type))) + { +- LONGEST low_bound, high_bound; ++ LONGEST low_bound, high_bound, byte_stride; + + if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) + low_bound = high_bound = 0; + element_type = check_typedef (element_type); ++ byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); ++ + /* Be careful when setting the array length. Ada arrays can be + empty arrays with the high_bound being smaller than the low_bound. + In such cases, the array length should be zero. */ + if (high_bound < low_bound) + TYPE_LENGTH (result_type) = 0; ++ else if (byte_stride > 0) ++ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1); + else if (bit_stride > 0) + TYPE_LENGTH (result_type) = + (bit_stride * (high_bound - low_bound + 1) + 7) / 8; +@@ -1888,7 +1898,8 @@ resolve_dynamic_range (struct type *dyn_range_type, + CORE_ADDR value; + struct type *static_range_type, *static_target_type; + const struct dynamic_prop *prop; +- struct dynamic_prop low_bound, high_bound; ++ const struct dwarf2_locexpr_baton *baton; ++ struct dynamic_prop low_bound, high_bound, stride; + + gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); + +@@ -1919,13 +1930,21 @@ resolve_dynamic_range (struct type *dyn_range_type, + high_bound.kind = PROP_UNDEFINED; + high_bound.data.const_val = 0; + } ++ ++ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride; ++ if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) ++ { ++ stride.kind = PROP_CONST; ++ stride.data.const_val = value; ++ } + + static_target_type + = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type), + addr_stack, 0); + static_range_type = create_range_type (copy_type (dyn_range_type), + static_target_type, +- &low_bound, &high_bound); ++ &low_bound, &high_bound, &stride); ++ + TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; + return static_range_type; + } +@@ -2176,8 +2195,18 @@ resolve_dynamic_type_internal (struct type *type, + if (prop != NULL + && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) + { +- TYPE_DYN_PROP_ADDR (prop) = value; +- TYPE_DYN_PROP_KIND (prop) = PROP_CONST; ++ struct type *range_type = TYPE_INDEX_TYPE (resolved_type); ++ ++ /* Adjust the data location with the value of byte stride if set, which ++ can describe the separation between successive elements along the ++ dimension. */ ++ if (TYPE_BYTE_STRIDE (range_type) < 0) ++ value += (TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type)) ++ * TYPE_BYTE_STRIDE (range_type); ++ ++ TYPE_DATA_LOCATION_ADDR (resolved_type) = value; ++ TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST; ++ + } + + return resolved_type; +diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h +index 2dda074..97227c9 100644 +--- a/gdb/gdbtypes.h ++++ b/gdb/gdbtypes.h +@@ -577,6 +577,10 @@ struct range_bounds + + struct dynamic_prop high; + ++ /* * Stride of range. */ ++ ++ struct dynamic_prop stride; ++ + /* True if HIGH range bound contains the number of elements in the + subrange. This affects how the final hight bound is computed. */ + +@@ -740,6 +744,7 @@ struct main_type + + struct range_bounds *bounds; + ++ + } flds_bnds; + + /* * Slot to point to additional language-specific fields of this +@@ -1255,6 +1260,15 @@ extern void allocate_gnat_aux_type (struct type *); + TYPE_RANGE_DATA(range_type)->high.kind + #define TYPE_LOW_BOUND_KIND(range_type) \ + TYPE_RANGE_DATA(range_type)->low.kind ++#define TYPE_BYTE_STRIDE(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.const_val ++#define TYPE_BYTE_STRIDE_BLOCK(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.locexpr ++#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.loclist ++#define TYPE_BYTE_STRIDE_KIND(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.kind ++ + + /* Property accessors for the type data location. */ + #define TYPE_DATA_LOCATION(thistype) \ +@@ -1289,6 +1303,9 @@ extern void allocate_gnat_aux_type (struct type *); + TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) + #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ + TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) ++#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \ ++ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0) ++ + + #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ + (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype)))) +@@ -1783,6 +1800,7 @@ extern struct type *create_array_type_with_stride + + extern struct type *create_range_type (struct type *, struct type *, + const struct dynamic_prop *, ++ const struct dynamic_prop *, + const struct dynamic_prop *); + + extern struct type *create_array_type (struct type *, struct type *, +diff --git a/gdb/parse.c b/gdb/parse.c +index 2b00708..992af87 100644 +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -1006,22 +1006,20 @@ operator_length_standard (const struct expression *expr, int endpos, + + case OP_RANGE: + oplen = 3; ++ args = 0; + range_type = (enum range_type) + longest_to_int (expr->elts[endpos - 2].longconst); + +- switch (range_type) +- { +- case LOW_BOUND_DEFAULT: +- case HIGH_BOUND_DEFAULT: +- args = 1; +- break; +- case BOTH_BOUND_DEFAULT: +- args = 0; +- break; +- case NONE_BOUND_DEFAULT: +- args = 2; +- break; +- } ++ /* Increment the argument counter for each argument ++ provided by the user. */ ++ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) ++ args++; ++ ++ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) ++ args++; ++ ++ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) ++ args++; + + break; + +diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y +index aeb6058..b1b9633 100644 +--- a/gdb/rust-exp.y ++++ b/gdb/rust-exp.y +@@ -2429,23 +2429,17 @@ convert_ast_to_expression (struct parser_state *state, + + case OP_RANGE: + { +- enum range_type kind = BOTH_BOUND_DEFAULT; ++ enum range_type kind = SUBARRAY_NONE_BOUND; + + if (operation->left.op != NULL) + { + convert_ast_to_expression (state, operation->left.op, top); +- kind = HIGH_BOUND_DEFAULT; ++ kind = SUBARRAY_LOW_BOUND; + } + if (operation->right.op != NULL) + { + convert_ast_to_expression (state, operation->right.op, top); +- if (kind == BOTH_BOUND_DEFAULT) +- kind = LOW_BOUND_DEFAULT; +- else +- { +- gdb_assert (kind == HIGH_BOUND_DEFAULT); +- kind = NONE_BOUND_DEFAULT; +- } ++ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND); + } + write_exp_elt_opcode (state, OP_RANGE); + write_exp_elt_longcst (state, kind); +diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c +index 17b20c6..295002f 100644 +--- a/gdb/rust-lang.c ++++ b/gdb/rust-lang.c +@@ -1241,9 +1241,9 @@ rust_range (struct expression *exp, int *pos, enum noside noside) + kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst); + *pos += 3; + +- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT) ++ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) + low = evaluate_subexp (NULL_TYPE, exp, pos, noside); +- if (kind == LOW_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT) ++ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) + high = evaluate_subexp (NULL_TYPE, exp, pos, noside); + + if (noside == EVAL_SKIP) +@@ -1332,7 +1332,7 @@ rust_compute_range (struct type *type, struct value *range, + + *low = 0; + *high = 0; +- *kind = BOTH_BOUND_DEFAULT; ++ *kind = SUBARRAY_NONE_BOUND; + + if (TYPE_NFIELDS (type) == 0) + return; +@@ -1340,15 +1340,14 @@ rust_compute_range (struct type *type, struct value *range, + i = 0; + if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0) + { +- *kind = HIGH_BOUND_DEFAULT; ++ *kind = SUBARRAY_LOW_BOUND; + *low = value_as_long (value_field (range, 0)); + ++i; + } + if (TYPE_NFIELDS (type) > i + && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0) + { +- *kind = (*kind == BOTH_BOUND_DEFAULT +- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT); ++ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND); + *high = value_as_long (value_field (range, i)); + } + } +@@ -1363,7 +1362,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + struct type *rhstype; + LONGEST low, high_bound; + /* Initialized to appease the compiler. */ +- enum range_type kind = BOTH_BOUND_DEFAULT; ++ enum range_type kind = SUBARRAY_NONE_BOUND; + LONGEST high = 0; + int want_slice = 0; + +@@ -1425,7 +1424,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + error (_("Cannot subscript non-array type")); + + if (want_slice +- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT)) ++ && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND)) + low = low_bound; + if (low < 0) + error (_("Index less than zero")); +@@ -1443,7 +1442,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + CORE_ADDR addr; + struct value *addrval, *tem; + +- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT) ++ if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND) + high = high_bound; + if (high < 0) + error (_("High index less than zero")); +diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp +new file mode 100644 +index 0000000..cc9ecc0 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/static-arrays.exp +@@ -0,0 +1,421 @@ ++# Copyright 2015 Free Software Foundation, Inc. ++# ++# Contributed by Intel Corp. ++# ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++standard_testfile static-arrays.f90 ++ ++if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "BP1"] ++gdb_continue_to_breakpoint "BP1" ".*BP1.*" ++ ++# Tests subarrays of one dimensional arrays with subrange variations ++gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ ++ "print ar1." ++gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \ ++ "print ar1\(4:7\)" ++gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \ ++ "print ar1\(8:\)" ++gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \ ++ "print ar1\(:3\)" ++gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ ++ "print ar1\(:\)" ++ ++# Check assignment ++gdb_test_no_output "set \$my_ary = ar1\(3:8\)" ++gdb_test "print \$my_ary" \ ++ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ ++ "Assignment of subarray to variable" ++gdb_test_no_output "set ar1\(5\) = 42" ++ gdb_test "print ar1\(3:8\)" \ ++ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \ ++ "print ar1\(3:8\) after assignment" ++gdb_test "print \$my_ary" \ ++ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ ++ "Assignment of subarray to variable after original array changed" ++ ++# Test for subarrays of one dimensional arrays with literals ++ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \ ++ "print ar1\(3\)" ++ ++# Tests for subranges of 2 dimensional arrays with subrange variations ++gdb_test "print ar2\(2:3, 3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \ ++ "print ar2\(2:3, 3:4\)." ++gdb_test "print ar2\(8:9,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:9,8:\)" ++gdb_test "print ar2\(8:9,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ ++ "print ar2\(8:9,:2\)" ++ ++gdb_test "print ar2\(8:,8:9\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:,8:9\)" ++gdb_test "print ar2\(8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ ++ "print ar2\(8:,8:\)" ++gdb_test "print ar2\(8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ ++ "print ar2\(8:,:2\)" ++ ++gdb_test "print ar2\(:2,2:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \ ++ "print ar2\(:2,2:3\)" ++gdb_test "print ar2\(:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \ ++ "print ar2\(:2,8:\)" ++gdb_test "print ar2\(:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \ ++ "print ar2\(:2,:2\)" ++ ++# Test subranges of 2 dimensional arrays with literals and subrange variations ++gdb_test "print ar2\(7, 3:6\)" \ ++ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \ ++ "print ar2\(7, 3:6\)" ++gdb_test "print ar2\(7,8:\)" \ ++ "\\$\[0-9\]+ = \\(78, 79\\)" \ ++ "print ar2\(7,8:\)" ++gdb_test "print ar2\(7,:2\)" \ ++ "\\$\[0-9\]+ = \\(71, 72\\)" \ ++ "print ar2\(7,:2\)" ++ ++gdb_test "print ar2\(7:8,4\)" \ ++ "\\$\[0-9\]+ = \\(74, 84\\)" \ ++ "print ar2(7:8,4\)" ++gdb_test "print ar2\(8:,4\)" \ ++ "\\$\[0-9\]+ = \\(84, 94\\)" \ ++ "print ar2\(8:,4\)" ++gdb_test "print ar2\(:2,4\)" \ ++ "\\$\[0-9\]+ = \\(14, 24\\)" \ ++ "print ar2\(:2,4\)" ++gdb_test "print ar2\(3,4\)" \ ++ "\\$\[0-9\]+ = 34" \ ++ "print ar2\(3,4\)" ++ ++# Test subarrays of 3 dimensional arrays with literals and subrange variations ++gdb_test "print ar3\(2:4,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\ ++ \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \ ++ "print ar3\(2:4,3:4,7:8\)" ++gdb_test "print ar3\(2:3,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\ ++ \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \ ++ "print ar3\(2:3,4:5,8:\)" ++gdb_test "print ar3\(2:3,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\ ++ \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \ ++ "print ar3\(2:3,4:5,:2\)" ++ ++gdb_test "print ar3\(2:3,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\ ++ \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \ ++ "print ar3\(2:3,8:,7:8\)" ++gdb_test "print ar3\(2:3,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\ ++ \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \ ++ "print ar3\(2:3,8:,8:\)" ++gdb_test "print ar3\(2:3,8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\ ++ \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \ ++ "print ar3\(2:3,8:,:2\)" ++ ++gdb_test "print ar3\(2:3,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\ ++ \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \ ++ "print ar3\(2:3,:2,7:8\)" ++gdb_test "print ar3\(2:3,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\ ++ \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \ ++ "print ar3\(2:3,:2,8:\)" ++gdb_test "print ar3\(2:3,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\ ++ \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \ ++ "print ar3\(2:3,:2,:2\)" ++ ++gdb_test "print ar3\(8:,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\ ++ \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \ ++ "print ar3\(8:,3:4,7:8\)" ++gdb_test "print ar3\(8:,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\ ++ \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \ ++ "print ar3\(8:,4:5,8:\)" ++gdb_test "print ar3\(8:,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\ ++ \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \ ++ "print ar3\(8:,4:5,:2\)" ++ ++gdb_test "print ar3\(8:,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\ ++ \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \ ++ "print ar3\(8:,8:,7:8\)" ++gdb_test "print ar3\(8:,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\ ++ \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \ ++ "print ar3\(8:,8:,8:\)" ++gdb_test "print ar3\(8:,8:,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\ ++ \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \ ++ "print ar3\(8:,8:,:2\)" ++ ++gdb_test "print ar3\(8:,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\ ++ \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \ ++ "print ar3\(8:,:2,7:8\)" ++gdb_test "print ar3\(8:,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\ ++ \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \ ++ "print ar3\(8:,:2,8:\)" ++gdb_test "print ar3\(8:,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\ ++ \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \ ++ "print ar3\(8:,:2,:2\)" ++ ++ ++gdb_test "print ar3\(:2,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\ ++ \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \ ++ "print ar3 \(:2,3:4,7:8\)." ++gdb_test "print ar3\(:2,3:4,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\ ++ \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \ ++ "print ar3\(:2,3:4,8:\)" ++gdb_test "print ar3\(:2,3:4,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\ ++ \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \ ++ "print ar3\(:2,3:4,:2\)" ++ ++gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\ ++ 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \ ++ "print ar3\(:2,8:,7:8\)" ++gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\ ++ 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \ ++ "print ar3\(:2,8:,8:\)" ++gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\ ++ 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \ ++ "print ar3\(:2,8:,:2\)" ++ ++gdb_test "print ar3\(:2,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\ ++ \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \ ++ "print ar3\(:2,:2,7:8\)" ++gdb_test "print ar3\(:2,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\ ++ \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \ ++ "print ar3\(:2,:2,8:\)" ++gdb_test "print ar3\(:2,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\ ++ \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \ ++ "print ar3\(:2,:2,:2\)" ++ ++#Tests for subarrays of 3 dimensional arrays with literals and subranges ++gdb_test "print ar3\(3,3:4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \ ++ "print ar3\(3,3:4,7:8\)" ++gdb_test "print ar3\(3,4:5,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \ ++ "print ar3\(3,4:5,8:\)" ++gdb_test "print ar3\(3,4:5,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \ ++ "print ar3\(3,4:5,:2\)" ++gdb_test "print ar3\(3,4:5,3\)" \ ++ "\\$\[0-9\]+ = \\(343, 353\\)" \ ++ "print ar3\(3,4:5,3\)" ++ ++gdb_test "print ar3\(2,8:,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \ ++ "print ar3\(2,8:,7:8\)" ++gdb_test "print ar3\(2,8:,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \ ++ "print ar3\(2,8:,8:\)" ++gdb_test "print ar3\(2,8:,:2\)"\ ++ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \ ++ "print ar3\(2,8:,:2\)" ++gdb_test "print ar3\(2,8:,3\)" \ ++ "\\$\[0-9\]+ = \\(283, 293\\)" \ ++ "print ar3\(2,8:,3\)" ++ ++gdb_test "print ar3\(2,:2,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \ ++ "print ar3\(2,:2,7:8\)" ++gdb_test "print ar3\(2,:2,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \ ++ "print ar3\(2,:2,8:\)" ++gdb_test "print ar3\(2,:2,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \ ++ "print ar3\(2,:2,:2\)" ++gdb_test "print ar3\(2,:2,3\)" \ ++ "\\$\[0-9\]+ = \\(213, 223\\)" \ ++ "print ar3\(2,:2,3\)" ++ ++gdb_test "print ar3\(3,4,7:8\)" \ ++ "\\$\[0-9\]+ = \\(347, 348\\)" \ ++ "print ar3\(3,4,7:8\)" ++gdb_test "print ar3\(3,4,8:\)" \ ++ "\\$\[0-9\]+ = \\(348, 349\\)" \ ++i "print ar3\(3,4,8:\)" ++gdb_test "print ar3\(3,4,:2\)" \ ++ "\\$\[0-9\]+ = \\(341, 342\\)" \ ++ "print ar3\(3,4,:2\)" ++gdb_test "print ar3\(5,6,7\)" \ ++ "\\$\[0-9\]+ = 567" \ ++ "print ar3\(5,6,7\)" ++ ++gdb_test "print ar3\(3:4,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \ ++ "print ar3\(3:4,6,7:8\)" ++gdb_test "print ar3\(3:4,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \ ++ "print ar3\(3:4,6,8:\)" ++gdb_test "print ar3\(3:4,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \ ++ "print ar3\(3:4,6,:2\)" ++gdb_test "print ar3\(3:4,6,5\)" \ ++ "\\$\[0-9\]+ = \\(365, 465\\)" \ ++ "print ar3\(3:4,6,5\)" ++ ++gdb_test "print ar3\(8:,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \ ++ "print ar3\(8:,6,7:8\)" ++gdb_test "print ar3\(8:,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \ ++ "print ar3\(8:,6,8:\)" ++gdb_test "print ar3\(8:,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \ ++ "print ar3\(8:,6,:2\)" ++gdb_test "print ar3\(8:,6,5\)" \ ++ "\\$\[0-9\]+ = \\(865, 965\\)" \ ++ "print ar3\(8:,6,5\)" ++ ++gdb_test "print ar3\(:2,6,7:8\)" \ ++ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \ ++ "print ar3\(:2,6,7:8\)" ++gdb_test "print ar3\(:2,6,8:\)" \ ++ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \ ++ "print ar3\(:2,6,8:\)" ++gdb_test "print ar3\(:2,6,:2\)" \ ++ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \ ++ "print ar3\(:2,6,:2\)" ++gdb_test "print ar3\(:2,6,5\)" \ ++ "\\$\[0-9\]+ = \\(165, 265\\)" \ ++ "print ar3\(:2,6,5\)" ++ ++gdb_test "print ar3\(3:4,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \ ++ "print ar2\(3:4,5:6,4\)" ++gdb_test "print ar3\(8:,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \ ++ "print ar2\(8:,5:6,4\)" ++gdb_test "print ar3\(:2,5:6,4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \ ++ "print ar2\(:2,5:6,4\)" ++ ++# Stride > 1 ++gdb_test "print ar1\(2:6:2\)" \ ++ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \ ++ "print ar1\(2:6:2\)" ++gdb_test "print ar2\(2:6:2,3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \ ++ "print ar2\(2:6:2,3:4\)" ++gdb_test "print ar2\(2:6:2,3\)" \ ++ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ ++ "print ar2\(2:6:2,3\)" ++gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\ ++ \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \ ++ "print ar3\(2:6:2,3:5:2,4:7:3\)" ++gdb_test "print ar3\(2:6:2,5,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\ ++ \\)" \ ++ "print ar3\(2:6:2,5,4:7:3\)" ++ ++# Stride < 0 ++gdb_test "print ar1\(8:2:-2\)" \ ++ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \ ++ "print ar1\(8:2:-2\)" ++gdb_test "print ar2\(8:2:-2,3:4\)" \ ++ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\ ++ \\)" \ ++ "print ar2\(8:2:-2,3:4\)" ++gdb_test "print ar2\(2:6:2,3\)" \ ++ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ ++ "print ar2\(2:6:2,3\)" ++gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\ ++ \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \ ++ "print ar3\(2:3,7:3:-4,4:7:3\)" ++gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \ ++ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\ ++ \\)" \ ++ "print ar3\(2:6:2,5,7:4:-3\)" ++ ++# Tests with negative and mixed indices ++gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\ ++ \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\ ++ 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\ ++ 392, 492\\) \\) \\)" \ ++ "print ar4(2:4, -2:1, -15:-14)" ++ ++gdb_test "p ar4\(7,-6:2:3,-7\)" \ ++ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \ ++ "print ar4(7,-6:2:3,-7)" ++ ++gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\ ++ 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\ ++ 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\ ++ 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\ ++ 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\ ++ 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\ ++ \\)" \ ++ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)" ++ ++gdb_test "p ar4\(:,:,:\)" \ ++ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\ ++ 811, .*" \ ++ "print ar4(:,:,:)" ++ ++# Provoke error messages for bad user input ++gdb_test "print ar1\(0:4\)" \ ++ "provided bound\\(s\\) outside array bound\\(s\\)" \ ++ "print ar1\(0:4\)" ++gdb_test "print ar1\(8:12\)" \ ++ "provided bound\\(s\\) outside array bound\\(s\\)" \ ++ "print ar1\(8:12\)" ++gdb_test "print ar1\(8:2:\)" \ ++ "A syntax error in expression, near `\\)'." \ ++ "print ar1\(8:2:\)" ++gdb_test "print ar1\(8:2:2\)" \ ++ "Wrong value provided for stride and boundaries" \ ++ "print ar1\(8:2:2\)" ++gdb_test "print ar1\(2:8:-2\)" \ ++ "Wrong value provided for stride and boundaries" \ ++ "print ar1\(2:8:-2\)" ++gdb_test "print ar1\(2:7:0\)" \ ++ "Stride must not be 0" \ ++ "print ar1\(2:7:0\)" ++gdb_test "print ar1\(3:7\) = 42" \ ++ "Invalid cast." \ ++ "Assignment of value to subarray" +diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90 +new file mode 100644 +index 0000000..f22fcbe +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/static-arrays.f90 +@@ -0,0 +1,55 @@ ++! Copyright 2015 Free Software Foundation, Inc. ++! ++! Contributed by Intel Corp. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 3 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program. If not, see . ++ ++subroutine sub ++ integer, dimension(9) :: ar1 ++ integer, dimension(9,9) :: ar2 ++ integer, dimension(9,9,9) :: ar3 ++ integer, dimension(10,-7:3, -15:-5) :: ar4 ++ integer :: i,j,k ++ ++ ar1 = 1 ++ ar2 = 1 ++ ar3 = 1 ++ ar4 = 4 ++ ++ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...))) ++ do i = 1, 9, 1 ++ ar1(i) = i ++ do j = 1, 9, 1 ++ ar2(i,j) = i*10 + j ++ do k = 1, 9, 1 ++ ar3(i,j,k) = i*100 + j*10 + k ++ end do ++ end do ++ end do ++ ++ do i = 1, 10, 1 ++ do j = -7, 3, 1 ++ do k = -15, -5, 1 ++ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16) ++ end do ++ end do ++ end do ++ ++ ar1(1) = 11 !BP1 ++ return ++end ++ ++program testprog ++ call sub ++end +diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp +new file mode 100644 +index 0000000..dcf15e5 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-stride.exp +@@ -0,0 +1,44 @@ ++# Copyright 2016 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++standard_testfile ".f90" ++ ++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ ++ {debug f90 quiet}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "re-reverse-elements"] ++gdb_continue_to_breakpoint "re-reverse-elements" ++gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \ ++ "print re-reverse-elements" ++gdb_test "print pvla(1)" " = 1" "print first re-reverse-element" ++gdb_test "print pvla(10)" " = 10" "print last re-reverse-element" ++ ++gdb_breakpoint [gdb_get_line_number "odd-elements"] ++gdb_continue_to_breakpoint "odd-elements" ++gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements" ++gdb_test "print pvla(1)" " = 1" "print first odd-element" ++gdb_test "print pvla(5)" " = 9" "print last odd-element" ++ ++gdb_breakpoint [gdb_get_line_number "single-element"] ++gdb_continue_to_breakpoint "single-element" ++gdb_test "print pvla" " = \\\(5\\\)" "print single-element" ++gdb_test "print pvla(1)" " = 5" "print one single-element" +diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90 +new file mode 100644 +index 0000000..eb0274c +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-stride.f90 +@@ -0,0 +1,29 @@ ++! Copyright 2016 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 3 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program. If not, see . ++ ++program vla_stride ++ integer, target, allocatable :: vla (:) ++ integer, pointer :: pvla (:) ++ ++ allocate(vla(10)) ++ vla = (/ (I, I = 1,10) /) ++ ++ pvla => vla(10:1:-1) ++ pvla => pvla(10:1:-1) ++ pvla => vla(1:10:2) ! re-reverse-elements ++ pvla => vla(5:4:-2) ! odd-elements ++ ++ pvla => null() ! single-element ++end program vla_stride +diff --git a/gdb/valarith.c b/gdb/valarith.c +index de6fcfd..9093969 100644 +--- a/gdb/valarith.c ++++ b/gdb/valarith.c +@@ -193,9 +193,21 @@ value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound) + struct type *array_type = check_typedef (value_type (array)); + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); + ULONGEST elt_size = type_length_units (elt_type); +- ULONGEST elt_offs = elt_size * (index - lowerbound); ++ ULONGEST elt_offs = index - lowerbound; ++ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type)); + struct value *v; + ++ if (elt_stride > 0) ++ elt_offs *= elt_stride; ++ else if (elt_stride < 0) ++ { ++ int offs = (elt_offs + 1) * elt_stride; ++ ++ elt_offs = TYPE_LENGTH (array_type) + offs; ++ } ++ else ++ elt_offs *= elt_size; ++ + if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) + && elt_offs >= type_length_units (array_type))) + { +diff --git a/gdb/valops.c b/gdb/valops.c +index 40392e8..24ffacb 100644 +--- a/gdb/valops.c ++++ b/gdb/valops.c +@@ -3775,56 +3775,191 @@ value_of_this_silent (const struct language_defn *lang) + struct value * + value_slice (struct value *array, int lowbound, int length) + { ++ /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride ++ value of '1', which returns every element between LOWBOUND and ++ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1' ++ as we are only considering the highest dimension, or we are ++ working on a one dimensional array. So we call VALUE_SLICE_1 ++ exactly once. */ ++ return value_slice_1 (array, lowbound, length, 1, 1); ++} ++ ++/* VALUE_SLICE_1 is called for each array dimension to calculate the number ++ of elements as defined by the subscript expression. ++ CALL_COUNT is used to determine if we are calling the function once, e.g. ++ we are working on the current dimension of ARRAY, or if we are calling ++ the function repeatedly. In the later case we need to take elements ++ from the TARGET_TYPE of ARRAY. ++ With a CALL_COUNT greater than 1 we calculate the offsets for every element ++ that should be in the result array. Then we fetch the contents and then ++ copy them into the result array. The result array will have one dimension ++ less than the input array, so later on we need to recreate the indices and ++ ranges in the calling function. */ ++ ++struct value * ++value_slice_1 (struct value *array, int lowbound, int length, ++ int stride_length, int call_count) ++{ + struct type *slice_range_type, *slice_type, *range_type; +- LONGEST lowerbound, upperbound; +- struct value *slice; +- struct type *array_type; ++ struct type *array_type = check_typedef (value_type (array)); ++ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); ++ unsigned int elt_size, elt_offs; ++ LONGEST ary_high_bound, ary_low_bound; ++ struct value *v; ++ int slice_range_size, i = 0, row_count = 1, elem_count = 1; + +- array_type = check_typedef (value_type (array)); ++ /* Check for legacy code if we are actually dealing with an array or ++ string. */ + if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY + && TYPE_CODE (array_type) != TYPE_CODE_STRING) + error (_("cannot take slice of non-array")); + +- range_type = TYPE_INDEX_TYPE (array_type); +- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) +- error (_("slice from bad array or bitstring")); ++ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type)); ++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type)); ++ ++ /* When we are working on a multi-dimensional array, we need to get the ++ attributes of the underlying type. */ ++ if (call_count > 1) ++ { ++ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type)); ++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type)); ++ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); ++ row_count = TYPE_LENGTH (array_type) ++ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); ++ } ++ ++ /* With a stride of '1', the number of elements per result row is equal to ++ the LENGTH of the subarray. With non-default stride values, we skip ++ elements, but have to add the start element to the total number of ++ elements per row. */ ++ if (stride_length == 1) ++ elem_count = length; ++ else ++ elem_count = ((length - 1) / stride_length) + 1; ++ ++ elt_size = TYPE_LENGTH (elt_type); ++ elt_offs = lowbound - ary_low_bound; + +- if (lowbound < lowerbound || length < 0 +- || lowbound + length - 1 > upperbound) +- error (_("slice out of range")); ++ elt_offs *= elt_size; ++ ++ /* Check for valid user input. In case of Fortran this was already done ++ in the calling function. */ ++ if (call_count == 1 ++ && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) ++ && elt_offs >= TYPE_LENGTH (array_type))) ++ error (_("no such vector element")); ++ ++ /* CALL_COUNT is 1 when we are dealing either with the highest dimension ++ of the array, or a one dimensional array. Set RANGE_TYPE accordingly. ++ In both cases we calculate how many rows/elements will be in the output ++ array by setting slice_range_size. */ ++ if (call_count == 1) ++ { ++ range_type = TYPE_INDEX_TYPE (array_type); ++ slice_range_size = ary_low_bound + elem_count - 1; ++ ++ /* Check if the array bounds are valid. */ ++ if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0) ++ error (_("slice from bad array or bitstring")); ++ } ++ /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays. ++ So we need to get the type below the current one and set the RANGE_TYPE ++ accordingly. */ ++ else ++ { ++ range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type)); ++ slice_range_size = ary_low_bound + (row_count * elem_count) - 1; ++ ary_low_bound = TYPE_LOW_BOUND (range_type); ++ } + + /* FIXME-type-allocation: need a way to free this type when we are +- done with it. */ +- slice_range_type = create_static_range_type ((struct type *) NULL, +- TYPE_TARGET_TYPE (range_type), +- lowbound, +- lowbound + length - 1); ++ done with it. */ + ++ slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type), ++ ary_low_bound, slice_range_size); + { +- struct type *element_type = TYPE_TARGET_TYPE (array_type); +- LONGEST offset +- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type)); ++ struct type *element_type; ++ ++ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy ++ code for subarrays. */ ++ if (call_count == 1 && stride_length == 1) ++ { ++ element_type = TYPE_TARGET_TYPE (array_type); ++ ++ slice_type = create_array_type (NULL, element_type, slice_range_type); + +- slice_type = create_array_type ((struct type *) NULL, +- element_type, +- slice_range_type); +- TYPE_CODE (slice_type) = TYPE_CODE (array_type); ++ TYPE_CODE (slice_type) = TYPE_CODE (array_type); + +- if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) +- slice = allocate_value_lazy (slice_type); ++ if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) ++ v = allocate_value_lazy (slice_type); ++ else ++ { ++ v = allocate_value (slice_type); ++ value_contents_copy (v, ++ value_embedded_offset (v), ++ array, ++ value_embedded_offset (array) + elt_offs, ++ elt_size * longest_to_int (length)); ++ } ++ ++ } ++ /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working ++ on a range of ranges. So we copy the relevant elements into the ++ new array we return. */ + else + { +- slice = allocate_value (slice_type); +- value_contents_copy (slice, 0, array, offset, +- type_length_units (slice_type)); ++ int j, offs_store = elt_offs; ++ LONGEST dst_offset = 0; ++ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); ++ ++ if (call_count == 1) ++ { ++ /* When CALL_COUNT is equal to 1 we are working on the current range ++ and use these elements directly. */ ++ element_type = TYPE_TARGET_TYPE (array_type); ++ } ++ else ++ { ++ /* Working on an array of arrays, the type of the elements is the type ++ of the subarrays' type. */ ++ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); ++ } ++ ++ slice_type = create_array_type (NULL, element_type, slice_range_type); ++ ++ /* If we have a one dimensional array, we copy its TYPE_CODE. For a ++ multi dimensional array we copy the embedded type's TYPE_CODE. */ ++ if (call_count == 1) ++ TYPE_CODE (slice_type) = TYPE_CODE (array_type); ++ else ++ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type)); ++ ++ v = allocate_value (slice_type); ++ ++ /* Iterate through the rows of the outer array and set the new offset ++ for each row. */ ++ for (i = 0; i < row_count; i++) ++ { ++ elt_offs = offs_store + i * src_row_length; ++ ++ /* Iterate through the elements in each row to copy only those. */ ++ for (j = 1; j <= elem_count; j++) ++ { ++ /* Fetches the contents of ARRAY and copies them into V. */ ++ value_contents_copy (v, dst_offset, array, elt_offs, elt_size); ++ elt_offs += elt_size * stride_length; ++ dst_offset += elt_size; ++ } ++ } + } + +- set_value_component_location (slice, array); +- VALUE_FRAME_ID (slice) = VALUE_FRAME_ID (array); +- set_value_offset (slice, value_offset (array) + offset); ++ set_value_component_location (v, array); ++ VALUE_REGNUM (v) = VALUE_REGNUM (array); ++ VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array); ++ set_value_offset (v, value_offset (array) + elt_offs); + } + +- return slice; ++ return v; + } + + /* Create a value for a FORTRAN complex number. Currently most of the +diff --git a/gdb/value.h b/gdb/value.h +index 0b417b4..9c37713 100644 +--- a/gdb/value.h ++++ b/gdb/value.h +@@ -1057,6 +1057,8 @@ extern struct value *varying_to_slice (struct value *); + + extern struct value *value_slice (struct value *, int, int); + ++extern struct value *value_slice_1 (struct value *, int, int, int, int); ++ + extern struct value *value_literal_complex (struct value *, struct value *, + struct type *); + diff --git a/gdb-vla-intel-tests.patch b/gdb-vla-intel-tests.patch index fc8ab5b..bbba3c7 100644 --- a/gdb-vla-intel-tests.patch +++ b/gdb-vla-intel-tests.patch @@ -140,90 +140,6 @@ Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90 + + ret = .TRUE. ! func2-returned +end program vla_func -Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.exp -=================================================================== ---- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.exp 2016-01-08 19:15:44.984637686 +0100 -@@ -0,0 +1,44 @@ -+# Copyright 2014 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+standard_testfile ".f90" -+ -+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ -+ {debug f90 quiet}] } { -+ return -1 -+} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"] -+gdb_continue_to_breakpoint "re-reverse-elements" -+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \ -+ "print re-reverse-elements" -+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element" -+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element" -+ -+gdb_breakpoint [gdb_get_line_number "odd-elements"] -+gdb_continue_to_breakpoint "odd-elements" -+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements" -+gdb_test "print pvla(1)" " = 1" "print first odd-element" -+gdb_test "print pvla(5)" " = 9" "print last odd-element" -+ -+gdb_breakpoint [gdb_get_line_number "single-element"] -+gdb_continue_to_breakpoint "single-element" -+gdb_test "print pvla" " = \\\(5\\\)" "print single-element" -+gdb_test "print pvla(1)" " = 5" "print one single-element" -Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.f90 -=================================================================== ---- /dev/null 1970-01-01 00:00:00.000000000 +0000 -+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.f90 2016-01-08 19:15:44.984637686 +0100 -@@ -0,0 +1,30 @@ -+! Copyright 2014 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 2 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, write to the Free Software -+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -+ -+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 Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.exp =================================================================== --- /dev/null 1970-01-01 00:00:00.000000000 +0000 diff --git a/gdb.spec b/gdb.spec index 19d6a63..8571500 100644 --- a/gdb.spec +++ b/gdb.spec @@ -27,7 +27,7 @@ Version: 7.11.90.20160807 # 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: 6%{?dist} +Release: 7%{?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 @@ -520,12 +520,9 @@ 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-fortran-stride-intel-1of6.patch -Patch1059: gdb-fortran-stride-intel-2of6.patch -Patch1060: gdb-fortran-stride-intel-3of6.patch -Patch1061: gdb-fortran-stride-intel-4of6.patch -Patch1062: gdb-fortran-stride-intel-5of6.patch -Patch1063: gdb-fortran-stride-intel-6of6.patch +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 @@ -790,9 +787,6 @@ find -name "*.info*"|xargs rm -f %patch1058 -p1 %patch1059 -p1 %patch1060 -p1 -%patch1061 -p1 -%patch1062 -p1 -%patch1063 -p1 %patch1132 -p1 %patch1133 -p1 %patch1134 -p1 @@ -1469,6 +1463,9 @@ then fi %changelog +* Fri Aug 26 2016 Jan Kratochvil - 7.11.90.20160807-7.fc25 +- Fix Intel VLA patchset regression: dynamic.exp: p varw filled + * Tue Aug 23 2016 Jan Kratochvil - 7.11.90.20160807-6.fc25 - Merge Fedora packaging changes from Fedora 24 gdb-7.11.1-83.fc24: