--- /dev/null
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.ada/packed_array.exp
+===================================================================
+--- gdb-7.7.90.20140613.orig/gdb/testsuite/gdb.ada/packed_array.exp 2014-06-13 03:59:37.000000000 +0200
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.ada/packed_array.exp 2014-06-16 23:30:30.107940483 +0200
+@@ -56,5 +56,11 @@ gdb_test_multiple "$test" "$test" {
+ # are. Observed with (FSF GNU Ada 4.5.3 20110124).
+ xfail $test
+ }
++ -re "= \\(\\)\[\r\n\]+$gdb_prompt $" {
++ # archer-jankratochvil-vla resolves it as a dynamic type resolved as an
++ # empty array [0..-1].
++ # DW_AT_upper_bound : (DW_OP_fbreg: -48; DW_OP_deref)
++ xfail $test
++ }
+ }
+
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S 2014-06-16 23:30:30.108940484 +0200
+@@ -0,0 +1,455 @@
++ .file "x86_64-vla-typedef.c"
++ .section .debug_abbrev,"",@progbits
++.Ldebug_abbrev0:
++ .section .debug_info,"",@progbits
++.Ldebug_info0:
++ .section .debug_line,"",@progbits
++.Ldebug_line0:
++ .text
++.Ltext0:
++.globl foo
++ .type foo, @function
++foo:
++.LFB2:
++ .file 1 "x86_64-vla-typedef.c"
++ .loc 1 22 0
++ pushq %rbp
++.LCFI0:
++ movq %rsp, %rbp
++.LCFI1:
++ subq $64, %rsp
++.LCFI2:
++ movl %edi, -36(%rbp)
++ .loc 1 22 0
++ movq %rsp, %rax
++ movq %rax, -48(%rbp)
++ .loc 1 23 0
++ movl -36(%rbp), %edx
++ movslq %edx,%rax
++ subq $1, %rax
++ movq %rax, -24(%rbp)
++ .loc 1 24 0
++ movslq %edx,%rax
++ addq $15, %rax
++ addq $15, %rax
++ shrq $4, %rax
++ salq $4, %rax
++ subq %rax, %rsp
++ movq %rsp, -56(%rbp)
++ movq -56(%rbp), %rax
++ addq $15, %rax
++ shrq $4, %rax
++ salq $4, %rax
++ movq %rax, -56(%rbp)
++ movq -56(%rbp), %rax
++ movq %rax, -16(%rbp)
++ .loc 1 27 0
++ movl $0, -4(%rbp)
++ jmp .L2
++.L3:
++ .loc 1 28 0
++ movl -4(%rbp), %esi
++ movl -4(%rbp), %eax
++ movl %eax, %ecx
++ movq -16(%rbp), %rdx
++ movslq %esi,%rax
++ movb %cl, (%rdx,%rax)
++ .loc 1 27 0
++ addl $1, -4(%rbp)
++.L2:
++ movl -4(%rbp), %eax
++ cmpl -36(%rbp), %eax
++ jl .L3
++ .loc 1 30 0
++ .globl break_here
++break_here:
++ movq -16(%rbp), %rax
++ movb $0, (%rax)
++ movq -48(%rbp), %rsp
++ .loc 1 31 0
++ leave
++ ret
++.LFE2:
++ .size foo, .-foo
++ .section .debug_frame,"",@progbits
++.Lframe0:
++ .long .LECIE0-.LSCIE0
++.LSCIE0:
++ .long 0xffffffff
++ .byte 0x1
++ .string ""
++ .uleb128 0x1
++ .sleb128 -8
++ .byte 0x10
++ .byte 0xc
++ .uleb128 0x7
++ .uleb128 0x8
++ .byte 0x90
++ .uleb128 0x1
++ .align 8
++.LECIE0:
++.LSFDE0:
++ .long .LEFDE0-.LASFDE0
++.LASFDE0:
++ .long .Lframe0
++ .quad .LFB2
++ .quad .LFE2-.LFB2
++ .byte 0x4
++ .long .LCFI0-.LFB2
++ .byte 0xe
++ .uleb128 0x10
++ .byte 0x86
++ .uleb128 0x2
++ .byte 0x4
++ .long .LCFI1-.LCFI0
++ .byte 0xd
++ .uleb128 0x6
++ .align 8
++.LEFDE0:
++ .section .eh_frame,"a",@progbits
++.Lframe1:
++ .long .LECIE1-.LSCIE1
++.LSCIE1:
++ .long 0x0
++ .byte 0x1
++ .string "zR"
++ .uleb128 0x1
++ .sleb128 -8
++ .byte 0x10
++ .uleb128 0x1
++ .byte 0x3
++ .byte 0xc
++ .uleb128 0x7
++ .uleb128 0x8
++ .byte 0x90
++ .uleb128 0x1
++ .align 8
++.LECIE1:
++.LSFDE1:
++ .long .LEFDE1-.LASFDE1
++.LASFDE1:
++ .long .LASFDE1-.Lframe1
++ .long .LFB2
++ .long .LFE2-.LFB2
++ .uleb128 0x0
++ .byte 0x4
++ .long .LCFI0-.LFB2
++ .byte 0xe
++ .uleb128 0x10
++ .byte 0x86
++ .uleb128 0x2
++ .byte 0x4
++ .long .LCFI1-.LCFI0
++ .byte 0xd
++ .uleb128 0x6
++ .align 8
++.LEFDE1:
++ .text
++.Letext0:
++ .section .debug_loc,"",@progbits
++.Ldebug_loc0:
++.LLST0:
++ .quad .LFB2-.Ltext0
++ .quad .LCFI0-.Ltext0
++ .value 0x2
++ .byte 0x77
++ .sleb128 8
++ .quad .LCFI0-.Ltext0
++ .quad .LCFI1-.Ltext0
++ .value 0x2
++ .byte 0x77
++ .sleb128 16
++ .quad .LCFI1-.Ltext0
++ .quad .LFE2-.Ltext0
++ .value 0x2
++ .byte 0x76
++ .sleb128 16
++ .quad 0x0
++ .quad 0x0
++ .section .debug_info
++ .long .Ldebug_end - .Ldebug_start
++.Ldebug_start:
++ .value 0x2
++ .long .Ldebug_abbrev0
++ .byte 0x8
++ .uleb128 0x1
++ .long .LASF2
++ .byte 0x1
++ .long .LASF3
++ .long .LASF4
++ .quad .Ltext0
++ .quad .Letext0
++ .long .Ldebug_line0
++ .uleb128 0x2
++ .byte 0x1
++ .string "foo"
++ .byte 0x1
++ .byte 0x16
++ .byte 0x1
++ .quad .LFB2
++ .quad .LFE2
++ .long .LLST0
++ .long 0x83
++ .uleb128 0x3
++ .long .LASF5
++ .byte 0x1
++ .byte 0x15
++ .long 0x83
++ .byte 0x2
++ .byte 0x91
++ .sleb128 -52
++.Ltag_typedef:
++ .uleb128 0x4
++ .long .LASF6
++ .byte 0x1
++ .byte 0x17
++ .long .Ltag_array_type - .debug_info
++ .uleb128 0x5 /* Abbrev Number: 5 (DW_TAG_variable) */
++ .long .LASF0
++ .byte 0x1
++ .byte 0x18
++#if 1
++ .long .Ltag_typedef - .debug_info
++#else
++ /* Debugging only: Skip the typedef indirection. */
++ .long .Ltag_array_type - .debug_info
++#endif
++ /* DW_AT_location: DW_FORM_block1: start */
++ .byte 0x3
++ .byte 0x91
++ .sleb128 -32
++#if 0
++ .byte 0x6 /* DW_OP_deref */
++#else
++ .byte 0x96 /* DW_OP_nop */
++#endif
++ /* DW_AT_location: DW_FORM_block1: end */
++ .uleb128 0x6
++ .string "i"
++ .byte 0x1
++ .byte 0x19
++ .long 0x83
++ .byte 0x2
++ .byte 0x91
++ .sleb128 -20
++ .byte 0x0
++ .uleb128 0x7
++ .byte 0x4
++ .byte 0x5
++ .string "int"
++.Ltag_array_type:
++ .uleb128 0x8 /* Abbrev Number: 8 (DW_TAG_array_type) */
++ .long 0xa0 + (2f - 1f) /* DW_AT_type: DW_FORM_ref4 */
++ .long 0x9d + (2f - 1f) /* DW_AT_sibling: DW_FORM_ref4 */
++1: /* DW_AT_data_location: DW_FORM_block1: start */
++ .byte 2f - 3f /* length */
++3:
++ .byte 0x97 /* DW_OP_push_object_address */
++ .byte 0x6 /* DW_OP_deref */
++2: /* DW_AT_data_location: DW_FORM_block1: end */
++ .uleb128 0x9
++ .long 0x9d + (2b - 1b) /* DW_AT_type: DW_FORM_ref4 */
++ .byte 0x3
++ .byte 0x91
++ .sleb128 -40
++ .byte 0x6
++ .byte 0x0
++ .uleb128 0xa
++ .byte 0x8
++ .byte 0x7
++ .uleb128 0xb
++ .byte 0x1
++ .byte 0x6
++ .long .LASF1
++ .byte 0x0
++.Ldebug_end:
++ .section .debug_abbrev
++ .uleb128 0x1
++ .uleb128 0x11
++ .byte 0x1
++ .uleb128 0x25
++ .uleb128 0xe
++ .uleb128 0x13
++ .uleb128 0xb
++ .uleb128 0x3
++ .uleb128 0xe
++ .uleb128 0x1b
++ .uleb128 0xe
++ .uleb128 0x11
++ .uleb128 0x1
++ .uleb128 0x12
++ .uleb128 0x1
++ .uleb128 0x10
++ .uleb128 0x6
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x2
++ .uleb128 0x2e
++ .byte 0x1
++ .uleb128 0x3f
++ .uleb128 0xc
++ .uleb128 0x3
++ .uleb128 0x8
++ .uleb128 0x3a
++ .uleb128 0xb
++ .uleb128 0x3b
++ .uleb128 0xb
++ .uleb128 0x27
++ .uleb128 0xc
++ .uleb128 0x11
++ .uleb128 0x1
++ .uleb128 0x12
++ .uleb128 0x1
++ .uleb128 0x40
++ .uleb128 0x6
++ .uleb128 0x1
++ .uleb128 0x13
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x3
++ .uleb128 0x5
++ .byte 0x0
++ .uleb128 0x3
++ .uleb128 0xe
++ .uleb128 0x3a
++ .uleb128 0xb
++ .uleb128 0x3b
++ .uleb128 0xb
++ .uleb128 0x49
++ .uleb128 0x13
++ .uleb128 0x2
++ .uleb128 0xa
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x4
++ .uleb128 0x16
++ .byte 0x0
++ .uleb128 0x3
++ .uleb128 0xe
++ .uleb128 0x3a
++ .uleb128 0xb
++ .uleb128 0x3b
++ .uleb128 0xb
++ .uleb128 0x49
++ .uleb128 0x13
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x5
++ .uleb128 0x34
++ .byte 0x0
++ .uleb128 0x3
++ .uleb128 0xe
++ .uleb128 0x3a
++ .uleb128 0xb
++ .uleb128 0x3b
++ .uleb128 0xb
++ .uleb128 0x49
++ .uleb128 0x13
++ .uleb128 0x2
++ .uleb128 0xa
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x6
++ .uleb128 0x34
++ .byte 0x0
++ .uleb128 0x3
++ .uleb128 0x8
++ .uleb128 0x3a
++ .uleb128 0xb
++ .uleb128 0x3b
++ .uleb128 0xb
++ .uleb128 0x49
++ .uleb128 0x13
++ .uleb128 0x2
++ .uleb128 0xa
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x7
++ .uleb128 0x24
++ .byte 0x0
++ .uleb128 0xb
++ .uleb128 0xb
++ .uleb128 0x3e
++ .uleb128 0xb
++ .uleb128 0x3
++ .uleb128 0x8
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x8 /* Abbrev Number: 8 (DW_TAG_array_type) */
++ .uleb128 0x1
++ .byte 0x1
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x1 /* DW_AT_sibling */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x50 /* DW_AT_data_location */
++ .uleb128 0xa /* DW_FORM_block1 */
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0x9
++ .uleb128 0x21
++ .byte 0x0
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x2f
++ .uleb128 0xa
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0xa
++ .uleb128 0x24
++ .byte 0x0
++ .uleb128 0xb
++ .uleb128 0xb
++ .uleb128 0x3e
++ .uleb128 0xb
++ .byte 0x0
++ .byte 0x0
++ .uleb128 0xb
++ .uleb128 0x24
++ .byte 0x0
++ .uleb128 0xb
++ .uleb128 0xb
++ .uleb128 0x3e
++ .uleb128 0xb
++ .uleb128 0x3
++ .uleb128 0xe
++ .byte 0x0
++ .byte 0x0
++ .byte 0x0
++ .section .debug_pubnames,"",@progbits
++ .long 0x16
++ .value 0x2
++ .long .Ldebug_info0
++ .long 0xa8
++ .long 0x2d
++ .string "foo"
++ .long 0x0
++ .section .debug_aranges,"",@progbits
++ .long 0x2c
++ .value 0x2
++ .long .Ldebug_info0
++ .byte 0x8
++ .byte 0x0
++ .value 0x0
++ .value 0x0
++ .quad .Ltext0
++ .quad .Letext0-.Ltext0
++ .quad 0x0
++ .quad 0x0
++ .section .debug_str,"MS",@progbits,1
++.LASF0:
++ .string "array"
++.LASF5:
++ .string "size"
++.LASF3:
++ .string "x86_64-vla-typedef.c"
++.LASF6:
++ .string "array_t"
++.LASF1:
++ .string "char"
++.LASF4:
++ .string "gdb.arch"
++.LASF2:
++ .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.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c 2014-06-16 23:30:30.109940484 +0200
+@@ -0,0 +1,43 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2008 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++#if 0
++
++void
++foo (int size)
++{
++ typedef char array_t[size];
++ array_t array;
++ int i;
++
++ for (i = 0; i < size; i++)
++ array[i] = i;
++
++ array[0] = 0; /* break-here */
++}
++
++#else
++
++int
++main (void)
++{
++ foo (26);
++ foo (78);
++ return 0;
++}
++
++#endif
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp 2014-06-16 23:30:30.109940484 +0200
+@@ -0,0 +1,64 @@
++# Copyright 2009 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++# Test DW_AT_data_location accessed through DW_TAG_typedef intermediate.
++
++if ![istarget "x86_64-*-*"] then {
++ verbose "Skipping over gdb.arch/x86_64-vla-typedef.exp test made only for x86_64."
++ return
++}
++
++set testfile x86_64-vla-typedef
++set srcasmfile ${testfile}-foo.S
++set srcfile ${testfile}.c
++set binfile ${objdir}/${subdir}/${testfile}
++set binobjfile ${objdir}/${subdir}/${testfile}-foo.o
++if { [gdb_compile "${srcdir}/${subdir}/${srcasmfile}" "${binobjfile}" object {}] != "" } {
++ untested "Couldn't compile test program"
++ return -1
++}
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile} ${binobjfile}" "${binfile}" executable {debug}] != "" } {
++ untested "Couldn't compile test program"
++ return -1
++}
++
++gdb_exit
++gdb_start
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++
++if ![runto_main] {
++ untested x86_64-vla-typedef
++ return -1
++}
++
++gdb_breakpoint "break_here"
++
++gdb_continue_to_breakpoint "break_here"
++
++gdb_test "whatis array" "type = array_t" "first: whatis array"
++
++gdb_test "ptype array" "type = char \\\[26\\\]" "first: ptype array"
++
++gdb_test "p array\[1\]" "\\$\[0-9\] = 1 '\\\\001'"
++gdb_test "p array\[2\]" "\\$\[0-9\] = 2 '\\\\002'"
++gdb_test "p array\[3\]" "\\$\[0-9\] = 3 '\\\\003'"
++gdb_test "p array\[4\]" "\\$\[0-9\] = 4 '\\\\004'"
++
++gdb_continue_to_breakpoint "break_here"
++
++gdb_test "whatis array" "type = array_t" "second: whatis array"
++
++gdb_test "ptype array" "type = char \\\[78\\\]" "second: ptype array"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.c
+===================================================================
+--- gdb-7.7.90.20140613.orig/gdb/testsuite/gdb.base/arrayidx.c 2014-06-13 03:59:37.000000000 +0200
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.c 2014-06-16 23:30:30.109940484 +0200
+@@ -17,6 +17,13 @@
+
+ int array[] = {1, 2, 3, 4};
+
++#ifdef __GNUC__
++struct
++ {
++ int a[0];
++ } unbound;
++#endif
++
+ int
+ main (void)
+ {
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.exp
+===================================================================
+--- gdb-7.7.90.20140613.orig/gdb/testsuite/gdb.base/arrayidx.exp 2014-06-13 03:59:37.000000000 +0200
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.exp 2014-06-16 23:30:30.109940484 +0200
+@@ -49,4 +49,12 @@ gdb_test "print array" \
+ "\\{\\\[0\\\] = 1, \\\[1\\\] = 2, \\\[2\\\] = 3, \\\[3\\\] = 4\\}" \
+ "Print array with array-indexes on"
+
+-
++set test "p unbound.a == &unbound.a\[0\]"
++gdb_test_multiple $test $test {
++ -re " = 1\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "No symbol \"unbound\" in current context.\r\n$gdb_prompt $" {
++ unsupported "$test (no GCC)"
++ }
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.c 2014-06-16 23:30:30.109940484 +0200
+@@ -0,0 +1,20 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2009 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++struct {
++ int field;
++} staticstruct = { 1 };
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.exp 2014-06-16 23:30:30.109940484 +0200
+@@ -0,0 +1,26 @@
++# Copyright 2009 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++set test internal-var-field-address
++set binfile ${test}.x
++if { [gdb_compile "${srcdir}/${subdir}/${test}.c" "[standard_output_file ${binfile}]" object {debug}] != "" } {
++ untested "Couldn't compile test program"
++ return -1
++}
++
++clean_restart $binfile
++
++gdb_test {set $varstruct = staticstruct}
++gdb_test {p $varstruct.field} " = 1"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.c 2014-06-16 23:30:30.110940485 +0200
+@@ -0,0 +1,31 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2011 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++#include <string.h>
++
++int
++main (int argc, char **argv)
++{
++ char s[2 + argc];
++ void (*f) (char *) = 0;
++
++ memset (s, 0, sizeof (s));
++ s[0] = 'X';
++
++ f (s);
++ return 0;
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.exp 2014-06-16 23:30:30.110940485 +0200
+@@ -0,0 +1,38 @@
++# Copyright 2011 Free Software Foundation, Inc.
++#
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++set testfile vla-frame
++set executable ${testfile}
++
++if { [prepare_for_testing ${testfile}.exp ${executable}] } {
++ return -1
++}
++
++if ![runto_main] {
++ return -1
++}
++
++set test "continue"
++gdb_test_multiple $test $test {
++ -re "Continuing\\.\r\n\r\nProgram received signal SIGSEGV, Segmentation fault\\.\r\n0x0+ in \\?\\? \\(\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "\r\n$gdb_prompt $" {
++ untested ${testfile}.exp
++ return
++ }
++}
++
++gdb_test "bt full" "\r\n +s = \"X\\\\000\"\r\n.*"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.c 2014-06-16 23:30:30.110940485 +0200
+@@ -0,0 +1,30 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2008 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++#include <stdlib.h>
++
++int
++main (int argc, char **argv)
++{
++ int array[argc];
++
++ array[0] = array[0];
++
++ abort ();
++
++ return 0;
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.exp 2014-06-16 23:30:30.110940485 +0200
+@@ -0,0 +1,109 @@
++# Copyright 2008 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++# We could crash in:
++# #0 block_linkage_function (bl=0x0) at ../../gdb/block.c:69
++# #1 in dwarf_block_get_frame_base (...) at ../../gdb/dwarf2block.c:97
++# 97 framefunc = block_linkage_function (get_frame_block (frame, NULL));
++# #2 in execute_stack_op (...) at ../../gdb/dwarf2expr.c:496
++# #3 in dwarf_block_exec_core () at ../../gdb/dwarf2block.c:156
++# #4 dwarf_block_exec (...) at ../../gdb/dwarf2block.c:206
++# #5 in range_type_count_bound_internal (...) at ../../gdb/gdbtypes.c:1430
++# #6 in create_array_type (...) at ../../gdb/gdbtypes.c:840
++# ...
++# #21 in psymtab_to_symtab (...) at ../../gdb/symfile.c:292
++# ...
++# #29 in backtrace_command_1 () at ../../gdb/stack.c:1273
++
++set testfile vla-overflow
++set shfile ${objdir}/${subdir}/${testfile}-gdb.sh
++set srcfile ${testfile}.c
++set binfile ${objdir}/${subdir}/${testfile}
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {
++ untested "Couldn't compile test program"
++ return -1
++}
++
++set f [open "|getconf PAGESIZE" "r"]
++gets $f pagesize
++close $f
++
++gdb_exit
++gdb_start
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++
++set pid_of_gdb [exp_pid -i [board_info host fileid]]
++
++if { [runto_main] < 0 } {
++ untested vla-overflow
++ return -1
++}
++
++# Get the GDB memory size when we stay at main.
++
++proc memory_v_pages_get {} {
++ global pid_of_gdb pagesize
++ set fd [open "/proc/$pid_of_gdb/statm"]
++ gets $fd line
++ close $fd
++ # number of pages of virtual memory
++ scan $line "%d" drs
++ return $drs
++}
++
++set pages_found [memory_v_pages_get]
++
++# s390x with glibc-debuginfo.s390x installed used approx. 16MB.
++set mb_reserve 40
++verbose -log "pages_found = $pages_found, mb_reserve = $mb_reserve"
++set kb_found [expr $pages_found * $pagesize / 1024]
++set kb_permit [expr $kb_found + 1 * 1024 + $mb_reserve * 1024]
++verbose -log "kb_found = $kb_found, kb_permit = $kb_permit"
++
++# Create the ulimit wrapper.
++set f [open $shfile "w"]
++puts $f "#! /bin/sh"
++puts $f "ulimit -v $kb_permit"
++puts $f "exec $GDB \"\$@\""
++close $f
++remote_exec host "chmod +x $shfile"
++
++gdb_exit
++set GDBold $GDB
++set GDB "$shfile"
++gdb_start
++set GDB $GDBold
++
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++
++set pid_of_gdb [exp_pid -i [board_info host fileid]]
++
++# Check the size again after the second run.
++# We must not stop in main as it would cache `array' and never crash later.
++
++gdb_run_cmd
++
++verbose -log "kb_found before abort() = [expr [memory_v_pages_get] * $pagesize / 1024]"
++
++gdb_test "" "Program received signal SIGABRT, Aborted..*" "Enter abort()"
++
++verbose -log "kb_found in abort() = [expr [memory_v_pages_get] * $pagesize / 1024]"
++
++# `abort' can get expressed as `*__GI_abort'.
++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.7.90.20140613/gdb/testsuite/gdb.base/vla.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla.c 2014-06-16 23:30:30.110940485 +0200
+@@ -0,0 +1,55 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2008 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++#include <string.h>
++
++void
++marker (void)
++{
++}
++
++void
++bar (char *a, char *b, char *c, int size)
++{
++ memset (a, '1', size);
++ memset (b, '2', size);
++ memset (c, '3', 48);
++}
++
++void
++foo (int size)
++{
++ char temp1[size];
++ char temp3[48];
++
++ temp1[size - 1] = '\0';
++ {
++ char temp2[size];
++
++ bar (temp1, temp2, temp3, size);
++
++ marker (); /* break-here */
++ }
++}
++
++int
++main (void)
++{
++ foo (26);
++ foo (78);
++ return 0;
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla.exp 2014-06-16 23:30:30.110940485 +0200
+@@ -0,0 +1,62 @@
++# Copyright 2008 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++set testfile vla
++set srcfile ${testfile}.c
++set binfile ${objdir}/${subdir}/${testfile}
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {
++ untested "Couldn't compile test program"
++ return -1
++}
++
++gdb_exit
++gdb_start
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++
++if ![runto_main] {
++ untested vla
++ return -1
++}
++
++gdb_breakpoint [gdb_get_line_number "break-here"]
++
++gdb_continue_to_breakpoint "break-here"
++
++gdb_test "whatis temp1" "type = char \\\[26\\\]" "first: whatis temp1"
++gdb_test "whatis temp2" "type = char \\\[26\\\]" "first: whatis temp2"
++gdb_test "whatis temp3" "type = char \\\[48\\\]" "first: whatis temp3"
++
++gdb_test "ptype temp1" "type = char \\\[26\\\]" "first: ptype temp1"
++gdb_test "ptype temp2" "type = char \\\[26\\\]" "first: ptype temp2"
++gdb_test "ptype temp3" "type = char \\\[48\\\]" "first: ptype temp3"
++
++gdb_test "p temp1" " = '1' <repeats 26 times>" "first: print temp1"
++gdb_test "p temp2" " = '2' <repeats 26 times>" "first: print temp2"
++gdb_test "p temp3" " = '3' <repeats 48 times>" "first: print temp3"
++
++gdb_continue_to_breakpoint "break-here"
++
++gdb_test "whatis temp1" "type = char \\\[78\\\]" "second: whatis temp1"
++gdb_test "whatis temp2" "type = char \\\[78\\\]" "second: whatis temp2"
++gdb_test "whatis temp3" "type = char \\\[48\\\]" "second: whatis temp3"
++
++gdb_test "ptype temp1" "type = char \\\[78\\\]" "second: ptype temp1"
++gdb_test "ptype temp2" "type = char \\\[78\\\]" "second: ptype temp2"
++gdb_test "ptype temp3" "type = char \\\[48\\\]" "second: ptype temp3"
++
++gdb_test "p temp1" " = '1' <repeats 78 times>" "second: print temp1"
++gdb_test "p temp2" " = '2' <repeats 78 times>" "second: print temp2"
++gdb_test "p temp3" " = '3' <repeats 48 times>" "second: print temp3"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S 2014-06-16 23:30:30.111940487 +0200
+@@ -0,0 +1,246 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2010 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++/* Debug information */
++
++/* We will `break *main' at the very first instruction. */
++#define main_length 1
++
++ .section .data
++vardata:
++ /* See DW_OP_lit3 + 1 (0-based). */
++ .string "seennotseen"
++
++ .section .debug_info
++.Lcu1_begin:
++ .4byte .Lcu1_end - .Lcu1_start /* Length of Compilation Unit */
++.Lcu1_start:
++ .2byte 2 /* DWARF version number */
++ .4byte .Ldebug_abbrev0 /* Offset Into Abbrev. Section */
++ .byte 4 /* Pointer Size (in bytes) */
++
++ /* CU die */
++ .uleb128 1 /* Abbrev: DW_TAG_compile_unit */
++ .4byte .Lproducer /* DW_AT_producer */
++ /* Use C++ to exploit a bug in parsing DW_AT_name "". */
++ .byte 4 /* DW_AT_language (C++) - */
++ .4byte main /* DW_AT_low_pc */
++ .byte main_length /* DW_AT_high_pc */
++
++.Larray_type:
++ .uleb128 2 /* Abbrev: DW_TAG_array_type */
++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */
++
++ .uleb128 3 /* Abbrev: DW_TAG_subrange_type */
++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */
++ .byte 0 /* DW_AT_lower_bound */
++ .4byte .Llen_var-.Lcu1_begin /* DW_AT_upper_bound */
++ .byte 0 /* End of children of die */
++
++ /* DW_AT_upper_bound is referencing an optimized-out variable. */
++.Larrayb_type:
++ .uleb128 2 /* Abbrev: DW_TAG_array_type */
++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */
++
++ .uleb128 3 /* Abbrev: DW_TAG_subrange_type */
++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */
++ .byte 0 /* DW_AT_lower_bound */
++ .4byte .Llenb_var-.Lcu1_begin /* DW_AT_upper_bound */
++ .byte 0 /* End of children of die */
++
++ /* DW_AT_upper_bound is referencing register. */
++.Larrayreg_type:
++ .uleb128 2 /* Abbrev: DW_TAG_array_type */
++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */
++
++ .uleb128 8 /* Abbrev: DW_TAG_subrange_type with block */
++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */
++ .byte 0 /* DW_AT_lower_bound */
++ .byte 2f - 1f /* DW_AT_upper_bound */
++1: .byte 0x50 /* DW_OP_reg0 */
++2:
++ .byte 0 /* End of children of die */
++
++.Luint_type:
++ .uleb128 4 /* Abbrev: DW_TAG_base_type */
++ .4byte .Luint_str /* DW_AT_name */
++ .byte 4 /* DW_AT_byte_size */
++ .byte 7 /* DW_AT_encoding */
++
++.Lchar_type:
++ .uleb128 4 /* Abbrev: DW_TAG_base_type */
++ .4byte .Lchar_str /* DW_AT_name */
++ .byte 1 /* DW_AT_byte_size */
++ .byte 6 /* DW_AT_encoding */
++
++.Llen_var:
++ .uleb128 5 /* Abbrev: DW_TAG_variable artificial */
++ .byte 1 /* DW_AT_artificial */
++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */
++ .4byte .Llen_loclist-.Lloclist /* DW_AT_location */
++
++ /* optimized-out variable for b_string. */
++.Llenb_var:
++ .uleb128 7 /* Abbrev: DW_TAG_variable artificial no DW_AT_location */
++ .byte 1 /* DW_AT_artificial */
++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */
++
++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */
++ .string "a_string" /* DW_AT_name */
++ .4byte .Larray_type-.Lcu1_begin /* DW_AT_type */
++ .byte 2f - 1f /* DW_AT_location */
++1: .byte 3 /* DW_OP_addr */
++ .4byte vardata /* <addr> */
++2:
++
++ /* DW_AT_upper_bound is referencing an optimized-out variable. */
++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */
++ .string "b_string" /* DW_AT_name */
++ .4byte .Larrayb_type-.Lcu1_begin /* DW_AT_type */
++ .byte 2f - 1f /* DW_AT_location */
++1: .byte 3 /* DW_OP_addr */
++ .4byte vardata /* <addr> */
++2:
++
++ /* DW_AT_upper_bound is referencing register. */
++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */
++ .string "reg_string" /* DW_AT_name */
++ .4byte .Larrayreg_type-.Lcu1_begin /* DW_AT_type */
++ .byte 2f - 1f /* DW_AT_location */
++1: .byte 3 /* DW_OP_addr */
++ .4byte vardata /* <addr> */
++2:
++
++ .byte 0 /* End of children of CU */
++.Lcu1_end:
++
++ .section .debug_loc
++.Lloclist:
++.Llen_loclist:
++ .4byte 0 # Location list begin address
++ .4byte main_length # Location list end address
++ .value 2f-1f # Location expression size
++1: .byte 0x33 # DW_OP_lit3
++ .byte 0x9f # DW_OP_stack_value
++2:
++ .quad 0x0 # Location list terminator begin (*.LLST2)
++ .quad 0x0 # Location list terminator end (*.LLST2)
++
++ .section .debug_abbrev
++.Ldebug_abbrev0:
++ .uleb128 1 /* Abbrev code */
++ .uleb128 0x11 /* DW_TAG_compile_unit */
++ .byte 0x1 /* has_children */
++ .uleb128 0x25 /* DW_AT_producer */
++ .uleb128 0xe /* DW_FORM_strp */
++ .uleb128 0x13 /* DW_AT_language */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .uleb128 0x11 /* DW_AT_low_pc */
++ .uleb128 0x1 /* DW_FORM_addr */
++ .uleb128 0x12 /* DW_AT_high_pc */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 2 /* Abbrev code */
++ .uleb128 0x1 /* TAG: DW_TAG_array_type */
++ .byte 0x1 /* DW_children_yes */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 3 /* Abbrev code */
++ .uleb128 0x21 /* DW_TAG_subrange_type */
++ .byte 0x0 /* no children */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x22 /* DW_AT_lower_bound */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .uleb128 0x2f /* DW_AT_upper_bound */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 4 /* Abbrev code */
++ .uleb128 0x24 /* DW_TAG_base_type */
++ .byte 0x0 /* no_children */
++ .uleb128 0x3 /* DW_AT_name */
++ .uleb128 0xe /* DW_FORM_strp */
++ .uleb128 0xb /* DW_AT_byte_size */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .uleb128 0x3e /* DW_AT_encoding */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 5 /* Abbrev code */
++ .uleb128 0x34 /* DW_TAG_variable */
++ .byte 0x0 /* no_children */
++ .uleb128 0x34 /* DW_AT_artificial */
++ .uleb128 0x0c /* DW_FORM_flag */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x02 /* DW_AT_location */
++ .uleb128 0x06 /* DW_FORM_data4 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 6 /* Abbrev code */
++ .uleb128 0x34 /* DW_TAG_variable */
++ .byte 0x0 /* no_children */
++ .uleb128 0x3 /* DW_AT_name */
++ .uleb128 0x8 /* DW_FORM_string */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x2 /* DW_AT_location */
++ .uleb128 0xa /* DW_FORM_block1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 7 /* Abbrev code */
++ .uleb128 0x34 /* DW_TAG_variable */
++ .byte 0x0 /* no_children */
++ .uleb128 0x34 /* DW_AT_artificial */
++ .uleb128 0x0c /* DW_FORM_flag */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 8 /* Abbrev code */
++ .uleb128 0x21 /* DW_TAG_subrange_type with block */
++ .byte 0x0 /* no children */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x22 /* DW_AT_lower_bound */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .uleb128 0x2f /* DW_AT_upper_bound */
++ .uleb128 0xa /* DW_FORM_block1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .byte 0x0 /* Terminator */
++
++/* String table */
++ .section .debug_str
++.Lproducer:
++ .string "GNU C 3.3.3"
++.Lchar_str:
++ .string "char"
++.Luint_str:
++ .string "unsigned int"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp 2014-06-16 23:30:30.111940487 +0200
+@@ -0,0 +1,63 @@
++# Copyright 2010 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++# Test printing variable with dynamic bounds which reference a different
++# (artificial in the GCC case) variable containing loclist as its location.
++# This testcase uses value (not address) of the referenced variable:
++# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43762
++
++# This test can only be run on targets which support DWARF-2 and use gas.
++# For now pick a sampling of likely targets.
++if {![istarget *-*-linux*]
++ && ![istarget *-*-gnu*]
++ && ![istarget *-*-elf*]
++ && ![istarget *-*-openbsd*]
++ && ![istarget arm-*-eabi*]
++ && ![istarget powerpc-*-eabi*]} {
++ return 0
++}
++
++set testfile dw2-bound-loclist
++if { [prepare_for_testing ${testfile}.exp ${testfile} [list ${testfile}.S main.c] {}] } {
++ return -1
++}
++
++# Verify it behaves at least as an unbound array without inferior.
++
++set test "p a_string"
++gdb_test_multiple $test $test {
++ -re " = 0x\[0-9a-f\]+ \"seennotseen\"\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "No registers\\.\r\n$gdb_prompt $" {
++ kfail "vlaregression" $test
++ }
++}
++
++gdb_test "ptype a_string" {type = char \[variable length\]}
++
++# Not runto_main as dw2-bound-loclist.S handles only the first byte of main.
++if ![runto "*main"] {
++ return -1
++}
++
++gdb_test "p a_string" { = "seen"}
++gdb_test "ptype a_string" {type = char \[4\]}
++
++gdb_test "p b_string" { = (0x[0-9a-f]+ )?"seennotseen"}
++gdb_test "ptype b_string" {type = char \[\]}
++
++# The register contains unpredictable value - the array size.
++gdb_test "ptype reg_string" {type = char \[-?[0-9]+\]}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.c 2014-06-16 23:30:30.111940487 +0200
+@@ -0,0 +1,42 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2004 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. */
++
++
++/* The function `func1' traced into must have debug info on offset > 0;
++ (DW_UNSND (attr)). This is the reason of `func0' existence. */
++
++void
++func0(int a, int b)
++{
++}
++
++/* `func1' being traced into must have some arguments to dump. */
++
++void
++func1(int a, int b)
++{
++ func0 (a,b);
++}
++
++int
++main(void)
++{
++ func1 (1, 2);
++ return 0;
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 2014-06-16 23:30:30.111940487 +0200
+@@ -0,0 +1,79 @@
++# Copyright 2006 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.
++
++# Minimal DWARF-2 unit test
++
++# This test can only be run on targets which support DWARF-2.
++# For now pick a sampling of likely targets.
++if {![istarget *-*-linux*]
++ && ![istarget *-*-gnu*]
++ && ![istarget *-*-elf*]
++ && ![istarget *-*-openbsd*]
++ && ![istarget arm-*-eabi*]
++ && ![istarget powerpc-*-eabi*]} {
++ return 0
++}
++
++set testfile "dw2-stripped"
++set srcfile ${testfile}.c
++set binfile ${objdir}/${subdir}/${testfile}.x
++
++remote_exec build "rm -f ${binfile}"
++
++# get the value of gcc_compiled
++if [get_compiler_info ${binfile}] {
++ return -1
++}
++
++# This test can only be run on gcc as we use additional_flags=FIXME
++if {$gcc_compiled == 0} {
++ return 0
++}
++
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug additional_flags=-ggdb3}] != "" } {
++ return -1
++}
++
++remote_exec build "objcopy -R .debug_loc ${binfile}"
++set strip_output [remote_exec build "objdump -h ${binfile}"]
++
++set test "stripping test file preservation"
++if [ regexp ".debug_info " $strip_output] {
++ pass "$test (.debug_info preserved)"
++} else {
++ fail "$test (.debug_info got also stripped)"
++}
++
++set test "stripping test file functionality"
++if [ regexp ".debug_loc " $strip_output] {
++ fail "$test (.debug_loc still present)"
++} else {
++ pass "$test (.debug_loc stripped)"
++}
++
++gdb_exit
++gdb_start
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++
++# For C programs, "start" should stop in main().
++
++gdb_test "start" \
++ ".*main \\(\\) at .*" \
++ "start"
++gdb_test "step" \
++ "func.* \\(.*\\) at .*" \
++ "step"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S 2014-06-16 23:30:30.112940488 +0200
+@@ -0,0 +1,83 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2009 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++/* Debug information */
++
++ .section .debug_info
++.Lcu1_begin:
++ /* CU header */
++ .4byte .Lcu1_end - .Lcu1_start /* Length of Compilation Unit */
++.Lcu1_start:
++ .2byte 2 /* DWARF Version */
++ .4byte .Labbrev1_begin /* Offset into abbrev section */
++ .byte 4 /* Pointer size */
++
++ /* CU die */
++ .uleb128 1 /* Abbrev: DW_TAG_compile_unit */
++ .ascii "dw2-struct-member-data-location.c\0" /* DW_AT_name */
++ .ascii "GNU C 4.3.2\0" /* DW_AT_producer */
++ .byte 1 /* DW_AT_language (C) */
++
++.Ltype_uchar:
++ .uleb128 2 /* Abbrev: DW_TAG_structure_type */
++ .ascii "some_struct\0" /* DW_AT_name */
++
++ .uleb128 3 /* Abbrev: DW_TAG_member */
++ .ascii "field\0" /* DW_AT_name */
++ .byte 0 /* DW_AT_data_member_location */
++
++ .byte 0 /* End of children of some_struct */
++
++ .byte 0 /* End of children of CU */
++
++.Lcu1_end:
++
++/* Abbrev table */
++ .section .debug_abbrev
++.Labbrev1_begin:
++ .uleb128 1 /* Abbrev code */
++ .uleb128 0x11 /* DW_TAG_compile_unit */
++ .byte 1 /* has_children */
++ .uleb128 0x3 /* DW_AT_name */
++ .uleb128 0x8 /* DW_FORM_string */
++ .uleb128 0x25 /* DW_AT_producer */
++ .uleb128 0x8 /* DW_FORM_string */
++ .uleb128 0x13 /* DW_AT_language */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 2 /* Abbrev code */
++ .uleb128 0x13 /* DW_TAG_structure_type */
++ .byte 1 /* has_children */
++ .uleb128 0x3 /* DW_AT_name */
++ .uleb128 0x8 /* DW_FORM_string */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 3 /* Abbrev code */
++ .uleb128 0x0d /* DW_TAG_member */
++ .byte 0 /* has_children */
++ .uleb128 0x3 /* DW_AT_name */
++ .uleb128 0x8 /* DW_FORM_string */
++ .uleb128 0x38 /* DW_AT_data_member_location */
++ .uleb128 0x0b /* DW_FORM_data1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp 2014-06-16 23:30:30.112940488 +0200
+@@ -0,0 +1,37 @@
++# Copyright 2009 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++# This test can only be run on targets which support DWARF-2 and use gas.
++# For now pick a sampling of likely targets.
++if {![istarget *-*-linux*]
++ && ![istarget *-*-gnu*]
++ && ![istarget *-*-elf*]
++ && ![istarget *-*-openbsd*]
++ && ![istarget arm-*-eabi*]
++ && ![istarget powerpc-*-eabi*]} {
++ return 0
++}
++
++set testfile "dw2-struct-member-data-location"
++set srcfile ${testfile}.S
++set binfile ${testfile}.x
++
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "[standard_output_file ${binfile}]" object {nodebug}] != "" } {
++ return -1
++}
++
++clean_restart $binfile
++
++gdb_test "ptype struct some_struct" "type = struct some_struct {\[\r\n \t\]*void field;\[\r\n \t\]*}"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S 2014-06-16 23:30:30.112940488 +0200
+@@ -0,0 +1,121 @@
++/* This testcase is part of GDB, the GNU debugger.
++
++ Copyright 2012 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++/* Debug information */
++
++ .section .data
++vardata:
++ .rept 129
++ .ascii "x"
++ .endr
++ .ascii "UNSEEN\0"
++
++ .section .debug_info
++.Lcu1_begin:
++ .4byte .Lcu1_end - .Lcu1_start /* Length of Compilation Unit */
++.Lcu1_start:
++ .2byte 2 /* DWARF version number */
++ .4byte .Ldebug_abbrev0 /* Offset Into Abbrev. Section */
++ .byte 4 /* Pointer Size (in bytes) */
++
++ /* CU die */
++ .uleb128 1 /* Abbrev: DW_TAG_compile_unit */
++ .ascii "GNU C 3.3.3\0" /* DW_AT_producer */
++ .byte 2 /* DW_AT_language (C) - */
++
++.Larray_type:
++ .uleb128 2 /* Abbrev: DW_TAG_array_type */
++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */
++
++ .uleb128 8 /* Abbrev: DW_TAG_subrange_type without DW_AT_type */
++ .byte 0 /* DW_AT_lower_bound */
++ .byte 128 /* DW_AT_upper_bound */
++
++ .byte 0 /* End of children of die */
++
++.Lchar_type:
++ .uleb128 4 /* Abbrev: DW_TAG_base_type */
++ .ascii "char\0" /* DW_AT_name */
++ .byte 1 /* DW_AT_byte_size */
++ .byte 6 /* DW_AT_encoding */
++
++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */
++ .ascii "notype_string\0" /* DW_AT_name */
++ .4byte .Larray_type-.Lcu1_begin /* DW_AT_type */
++ .byte 2f - 1f /* DW_AT_location */
++1: .byte 3 /* DW_OP_addr */
++ .4byte vardata /* <addr> */
++2:
++
++ .byte 0 /* End of children of CU */
++.Lcu1_end:
++
++ .section .debug_abbrev
++.Ldebug_abbrev0:
++ .uleb128 1 /* Abbrev code */
++ .uleb128 0x11 /* DW_TAG_compile_unit */
++ .byte 0x1 /* has_children */
++ .uleb128 0x25 /* DW_AT_producer */
++ .uleb128 0x8 /* DW_FORM_string */
++ .uleb128 0x13 /* DW_AT_language */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 2 /* Abbrev code */
++ .uleb128 0x1 /* TAG: DW_TAG_array_type */
++ .byte 0x1 /* DW_children_yes */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 4 /* Abbrev code */
++ .uleb128 0x24 /* DW_TAG_base_type */
++ .byte 0x0 /* no_children */
++ .uleb128 0x3 /* DW_AT_name */
++ .uleb128 0x8 /* DW_FORM_string */
++ .uleb128 0xb /* DW_AT_byte_size */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .uleb128 0x3e /* DW_AT_encoding */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 6 /* Abbrev code */
++ .uleb128 0x34 /* DW_TAG_variable */
++ .byte 0x0 /* no_children */
++ .uleb128 0x3 /* DW_AT_name */
++ .uleb128 0x8 /* DW_FORM_string */
++ .uleb128 0x49 /* DW_AT_type */
++ .uleb128 0x13 /* DW_FORM_ref4 */
++ .uleb128 0x2 /* DW_AT_location */
++ .uleb128 0xa /* DW_FORM_block1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .uleb128 8 /* Abbrev code */
++ .uleb128 0x21 /* DW_TAG_subrange_type without DW_AT_type */
++ .byte 0x0 /* no children */
++ .uleb128 0x22 /* DW_AT_lower_bound */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .uleb128 0x2f /* DW_AT_upper_bound */
++ .uleb128 0xb /* DW_FORM_data1 */
++ .byte 0x0 /* Terminator */
++ .byte 0x0 /* Terminator */
++
++ .byte 0x0 /* Terminator */
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp 2014-06-16 23:30:30.112940488 +0200
+@@ -0,0 +1,39 @@
++# Copyright 2012 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++load_lib dwarf.exp
++
++# https://bugzilla.redhat.com/show_bug.cgi?id=806920
++# read_subrange_type <TYPE_CODE (base_type) == TYPE_CODE_VOID> reinitialization
++# of BASE_TYPE was done too late, it affects DW_TAG_subrange_type without
++# specified DW_AT_type, present only in XLF produced code.
++
++# This test can only be run on targets which support DWARF-2 and use gas.
++if {![dwarf2_support]} {
++ return 0
++}
++
++set testfile dw2-subrange-no-type
++set srcfile ${testfile}.S
++set executable ${testfile}.x
++set binfile [standard_output_file ${executable}]
++
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" object {}] != "" } {
++ return -1
++}
++
++clean_restart $executable
++
++gdb_test "ptype notype_string" {type = char \[129\]}
++gdb_test "p notype_string" " = 'x' <repeats 129 times>"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.exp 2014-06-16 23:30:30.112940488 +0200
+@@ -0,0 +1,42 @@
++# Copyright 2009 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.
++
++# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
++
++# This file is part of the gdb testsuite. Array element stride must not be
++# specified in the number of elements but in a number of bytes instead.
++# Original problem:
++# (gdb) p c40pt(1)
++# $1 = '0-hello', ' ' <repeats 33 times>
++# (gdb) p c40pt(2)
++# warning: Fortran array stride not divisible by the element size
++
++set testfile dwarf-stride
++set srcfile ${testfile}.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 "break-here"]
++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.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.f90 2014-06-16 23:30:30.112940488 +0200
+@@ -0,0 +1,40 @@
++! Copyright 2009 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.
++!
++! File written by Alan Matsuoka.
++
++program repro
++
++ type small_stride
++ character*40 long_string
++ integer small_pad
++ end type small_stride
++
++ type(small_stride), dimension (20), target :: unpleasant
++ character*40, pointer, dimension(:):: c40pt
++
++ integer i
++
++ do i = 0,19
++ unpleasant(i+1)%small_pad = i+1
++ unpleasant(i+1)%long_string = char (ichar('0') + i) // '-hello'
++ end do
++
++ c40pt => unpleasant%long_string
++
++ print *, c40pt ! break-here
++
++end program repro
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.exp 2014-06-16 23:37:45.568362563 +0200
+@@ -0,0 +1,151 @@
++# Copyright 2007 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.
++
++# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
++
++# This file is part of the gdb testsuite. It contains tests for dynamically
++# allocated Fortran arrays.
++# It depends on the GCC dynamic Fortran arrays DWARF support:
++# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=22244
++
++set testfile "dynamic"
++set srcfile ${testfile}.f90
++set binfile ${objdir}/${subdir}/${testfile}
++
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f90 quiet}] != "" } {
++ untested "Couldn't compile ${srcfile}"
++ return -1
++}
++
++gdb_exit
++gdb_start
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "varx-init"]
++gdb_continue_to_breakpoint "varx-init"
++gdb_test "p varx" "\\$\[0-9\]* = <not allocated>" "p varx unallocated"
++gdb_test "ptype varx" "type = <not allocated>" "ptype varx unallocated"
++gdb_test "p varx(1,5,17)" "no such vector element because not allocated" "p varx(1,5,17) unallocated"
++gdb_test "p varx(1,5,17)=1" "no such vector element because not allocated" "p varx(1,5,17)=1 unallocated"
++gdb_test "ptype varx(1,5,17)" "no such vector element because not allocated" "ptype varx(1,5,17) unallocated"
++
++gdb_breakpoint [gdb_get_line_number "varx-allocated"]
++gdb_continue_to_breakpoint "varx-allocated"
++# $1 = (( ( 0, 0, 0, 0, 0, 0) ( 0, 0, 0, 0, 0, 0) --- , 0) ) ( ( 0, 0, ...) ...) ...)
++gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx allocated"
++# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1.
++gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varx allocated"
++
++gdb_breakpoint [gdb_get_line_number "varx-filled"]
++gdb_continue_to_breakpoint "varx-filled"
++gdb_test "p varx(2, 5, 17)" "\\$\[0-9\]* = 6"
++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\]* = <not associated>" "p varv unassociated"
++gdb_test "ptype varv" "type = <not associated>" "ptype varv unassociated"
++
++set test "output varx"
++gdb_test_multiple $test $test {
++ -re "^output varx\r\n\[() ,6789.\]*$gdb_prompt $" {
++ pass $test
++ }
++}
++
++gdb_breakpoint [gdb_get_line_number "varv-associated"]
++gdb_continue_to_breakpoint "varv-associated"
++gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 6" "p varx(3, 7, 19) with varv associated"
++gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 6" "p varv(3, 7, 19) associated"
++# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1.
++gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varv associated"
++gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx with varv associated"
++# Intel Fortran Compiler 10.1.008 uses the pointer type.
++gdb_test "ptype varv" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)\\)?" "ptype varv associated"
++
++gdb_breakpoint [gdb_get_line_number "varv-filled"]
++gdb_continue_to_breakpoint "varv-filled"
++gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 10" "p varx(3, 7, 19) with varv filled"
++gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 10" "p varv(3, 7, 19) filled"
++
++gdb_breakpoint [gdb_get_line_number "varv-deassociated"]
++gdb_continue_to_breakpoint "varv-deassociated"
++# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type.
++gdb_test "p varv" "\\$\[0-9\]* = (<not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "p varv deassociated"
++gdb_test "ptype varv" "type = (<not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "ptype varv deassociated"
++gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varv deassociated"
++gdb_test "p varv(1,5,17)" "no such vector element because not associated"
++gdb_test "ptype varv(1,5,17)" "no such vector element because not associated"
++
++gdb_breakpoint [gdb_get_line_number "varx-deallocated"]
++gdb_continue_to_breakpoint "varx-deallocated"
++gdb_test "p varx" "\\$\[0-9\]* = <not allocated>" "p varx deallocated"
++gdb_test "ptype varx" "type = <not allocated>" "ptype varx deallocated"
++gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varx deallocated"
++gdb_test "p varx(1,5,17)" "no such vector element because not allocated" "p varx(1,5,17) deallocated"
++gdb_test "ptype varx(1,5,17)" "no such vector element because not allocated" "ptype varx(1,5,17) deallocated"
++
++gdb_breakpoint [gdb_get_line_number "vary-passed"]
++gdb_continue_to_breakpoint "vary-passed"
++# $1 = (( ( 1, 1, 1, 1, 1, 1) ( 1, 1, 1, 1, 1, 1) --- , 1) ) ( ( 1, 1, ...) ...) ...)
++gdb_test "p vary" "\\$\[0-9\]* = \\(\[()1, .\]*\\)"
++
++gdb_breakpoint [gdb_get_line_number "vary-filled"]
++gdb_continue_to_breakpoint "vary-filled"
++gdb_test "ptype vary" "type = real(\\(kind=4\\)|\\*4) \\(10,10\\)"
++gdb_test "p vary(1, 1)" "\\$\[0-9\]* = 8"
++gdb_test "p vary(2, 2)" "\\$\[0-9\]* = 9"
++gdb_test "p vary(1, 3)" "\\$\[0-9\]* = 10"
++# $1 = (( ( 3, 3, 3, 3, 3, 3) ( 3, 3, 3, 3, 3, 3) --- , 3) ) ( ( 3, 3, ...) ...) ...)
++gdb_test "p varw" "\\$\[0-9\]* = \\(\[()3, .\]*\\)"
++
++gdb_breakpoint [gdb_get_line_number "varw-almostfilled"]
++gdb_continue_to_breakpoint "varw-almostfilled"
++gdb_test "ptype varw" "type = real(\\(kind=4\\)|\\*4) \\(5,4,3\\)"
++gdb_test "p varw(3,1,1)=1" "\\$\[0-9\]* = 1"
++# $1 = (( ( 6, 5, 1, 5, 5, 5) ( 5, 5, 5, 5, 5, 5) --- , 5) ) ( ( 5, 5, ...) ...) ...)
++gdb_test "p varw" "\\$\[0-9\]* = \\( *\\( *\\( *6, *5, *1,\[()5, .\]*\\)" "p varw filled"
++# "up" works with GCC but other Fortran compilers may copy the values into the
++# outer function only on the exit of the inner function.
++# We need both variants as depending on the arch we optionally may still be
++# executing the caller line or not after `finish'.
++gdb_test "finish" ".*(call bar \\(y, x\\)|call foo \\(x, z\\(2:6, 4:7, 6:8\\)\\))"
++gdb_test "p z(2,4,5)" "\\$\[0-9\]* = 3"
++gdb_test "p z(2,4,6)" "\\$\[0-9\]* = 6"
++gdb_test "p z(2,4,7)" "\\$\[0-9\]* = 5"
++gdb_test "p z(4,4,6)" "\\$\[0-9\]* = 1"
++
++gdb_breakpoint [gdb_get_line_number "varz-almostfilled"]
++gdb_continue_to_breakpoint "varz-almostfilled"
++# GCC uses the pointer type here, Intel Fortran Compiler 10.1.008 does not.
++gdb_test "ptype varz" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?"
++# Intel Fortran Compiler 10.1.008 has a bug here - (2:11,7:7)
++# as it produces DW_AT_lower_bound == DW_AT_upper_bound == 7.
++gdb_test "ptype vart" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(2:11,7:\\*\\)\\)?"
++gdb_test "p varz" "\\$\[0-9\]* = \\(\\)"
++gdb_test "p vart" "\\$\[0-9\]* = \\(\\)"
++gdb_test "p varz(3)" "\\$\[0-9\]* = 4"
++# maps to foo::vary(1,1)
++gdb_test "p vart(2,7)" "\\$\[0-9\]* = 8"
++# maps to foo::vary(2,2)
++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.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.f90 2014-06-16 23:30:30.113940488 +0200
+@@ -0,0 +1,98 @@
++! Copyright 2007 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.
++!
++! Ihis file is the Fortran source file for dynamic.exp.
++! Original file written by Jakub Jelinek <jakub@redhat.com>.
++! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
++
++subroutine baz
++ real, target, allocatable :: varx (:, :, :)
++ real, pointer :: varv (:, :, :)
++ real, target :: varu (1, 2, 3)
++ logical :: l
++ allocate (varx (1:6, 5:15, 17:28)) ! varx-init
++ l = allocated (varx)
++ varx(:, :, :) = 6 ! varx-allocated
++ varx(1, 5, 17) = 7
++ varx(2, 6, 18) = 8
++ varx(6, 15, 28) = 9
++ varv => varx ! varx-filled
++ l = associated (varv)
++ varv(3, 7, 19) = 10 ! varv-associated
++ varv => null () ! varv-filled
++ l = associated (varv)
++ deallocate (varx) ! varv-deassociated
++ l = allocated (varx)
++ varu(:, :, :) = 10 ! varx-deallocated
++ allocate (varv (1:6, 5:15, 17:28))
++ l = associated (varv)
++ varv(:, :, :) = 6
++ varv(1, 5, 17) = 7
++ varv(2, 6, 18) = 8
++ varv(6, 15, 28) = 9
++ deallocate (varv)
++ l = associated (varv)
++ varv => varu
++ varv(1, 1, 1) = 6
++ varv(1, 2, 3) = 7
++ l = associated (varv)
++end subroutine baz
++subroutine foo (vary, varw)
++ real :: vary (:, :)
++ real :: varw (:, :, :)
++ vary(:, :) = 4 ! vary-passed
++ vary(1, 1) = 8
++ vary(2, 2) = 9
++ vary(1, 3) = 10
++ varw(:, :, :) = 5 ! vary-filled
++ varw(1, 1, 1) = 6
++ varw(2, 2, 2) = 7 ! varw-almostfilled
++end subroutine foo
++subroutine bar (varz, vart)
++ real :: varz (*)
++ real :: vart (2:11, 7:*)
++ varz(1:3) = 4
++ varz(2) = 5 ! varz-almostfilled
++ vart(2,7) = vart(2,7)
++end subroutine bar
++program test
++ interface
++ subroutine foo (vary, varw)
++ real :: vary (:, :)
++ real :: varw (:, :, :)
++ end subroutine
++ end interface
++ interface
++ subroutine bar (varz, vart)
++ real :: varz (*)
++ real :: vart (2:11, 7:*)
++ end subroutine
++ end interface
++ real :: x (10, 10), y (5), z(8, 8, 8)
++ x(:,:) = 1
++ y(:) = 2
++ z(:,:,:) = 3
++ call baz
++ call foo (x, z(2:6, 4:7, 6:8))
++ call bar (y, x)
++ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort
++ if (x (1, 3) .ne. 10) call abort
++ if (z (2, 4, 6) .ne. 6 .or. z (3, 5, 7) .ne. 7 .or. z (2, 4, 7) .ne. 5) call abort
++ if (any (y .ne. (/4, 5, 4, 2, 2/))) call abort
++ call foo (transpose (x), z)
++ 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.7.90.20140613/gdb/testsuite/gdb.fortran/string.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/string.exp 2014-06-16 23:30:30.114940489 +0200
+@@ -0,0 +1,59 @@
++# Copyright 2008 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.
++
++# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
++
++# This file is part of the gdb testsuite. It contains tests for Fortran
++# strings with dynamic length.
++
++set testfile "string"
++set srcfile ${testfile}.f90
++set binfile ${objdir}/${subdir}/${testfile}
++
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f90 quiet}] != "" } {
++ untested "Couldn't compile ${srcfile}"
++ return -1
++}
++
++gdb_exit
++gdb_start
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "var-init"]
++gdb_continue_to_breakpoint "var-init"
++gdb_test "ptype c" "type = character(\\(kind=1\\)|\\*1)"
++gdb_test "ptype d" "type = character(\\(kind=8\\)|\\*8)"
++gdb_test "ptype e" "type = character(\\(kind=4\\)|\\*4)"
++gdb_test "ptype f" "type = character(\\(kind=4\\)|\\*4) \\(7,8:10\\)"
++gdb_test "ptype *e" "Attempt to take contents of a non-pointer value."
++gdb_test "ptype *f" "type = character(\\(kind=4\\)|\\*4) \\(7\\)"
++gdb_test "p c" "\\$\[0-9\]* = 'c'"
++gdb_test "p d" "\\$\[0-9\]* = 'd '"
++gdb_test "p e" "\\$\[0-9\]* = 'g '"
++gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\)"
++gdb_test "p *e" "Attempt to take contents of a non-pointer value."
++gdb_test "p *f" "Attempt to take contents of a non-pointer value."
++
++gdb_breakpoint [gdb_get_line_number "var-finish"]
++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.7.90.20140613/gdb/testsuite/gdb.fortran/string.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/string.f90 2014-06-16 23:30:30.114940489 +0200
+@@ -0,0 +1,37 @@
++! Copyright 2008 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.
++!
++! Ihis file is the Fortran source file for dynamic.exp.
++! Original file written by Jakub Jelinek <jakub@redhat.com>.
++! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
++
++subroutine foo (e, f)
++ character (len=1) :: c
++ character (len=8) :: d
++ character (len=*) :: e
++ character (len=*) :: f (1:7, 8:10)
++ c = 'c'
++ d = 'd'
++ e = 'e' ! var-init
++ f = 'f'
++ f(1,9) = 'f2'
++ c = 'c' ! var-finish
++end subroutine foo
++ character (len=4) :: g, h (1:7, 8:10)
++ g = 'g'
++ h = 'h'
++ call foo (g, h)
++end
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.exp 2014-06-16 23:30:30.114940489 +0200
+@@ -0,0 +1,72 @@
++# Copyright 2011 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++if { [skip_fortran_tests] } { return -1 }
++
++set testfile "subrange"
++set srcfile ${testfile}.f90
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug f90}] } {
++ return -1
++}
++
++if ![runto MAIN__] {
++ perror "Couldn't run to MAIN__"
++ continue
++}
++
++# Depending on the compiler version being used, the name of the 4-byte integer
++# and real types can be printed differently. For instance, gfortran-4.1 uses
++# "int4" whereas gfortran-4.3 uses "int(kind=4)".
++set int4 "(int4|integer\\(kind=4\\))"
++
++gdb_breakpoint [gdb_get_line_number "break-static"]
++gdb_continue_to_breakpoint "break-static" ".*break-static.*"
++
++foreach var {a alloc ptr} {
++ global pf_prefix
++ set old_prefix $pf_prefix
++ lappend pf_prefix "$var:"
++
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (2, 2:3)" { = \(22, 32\)}
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (2:3, 3)" { = \(32, 33\)}
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (1, 2:)" { = \(21, 31\)}
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (2, :2)" { = \(12, 22\)}
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (3, 2:2)" { = \(23\)}
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "ptype $var (3, 2:2)" " = $int4 \\(2:2\\)"
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (4, :)" { = \(14, 24, 34\)}
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (:, :)" { = \(\( *11, 12, 13, 14\) \( *21, 22, 23, 24\) \( *31, 32, 33, 34\) *\)}
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "ptype $var (:, :)" " = $int4 \\(4,3\\)"
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (:)" "Wrong number of subscripts"
++ setup_kfail "*-*-*" "vlaregression/9999"
++ gdb_test "p $var (:, :, :)" "Wrong number of subscripts"
++
++ set pf_prefix $old_prefix
++}
++
++gdb_test_no_output {set $a=a}
++delete_breakpoints
++gdb_unload
++setup_kfail "*-*-*" "vlaregression/9999"
++gdb_test {p $a (3, 2:2)} { = \(23\)}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.f90 2014-06-16 23:30:30.114940489 +0200
+@@ -0,0 +1,28 @@
++! Copyright 2011 Free Software Foundation, Inc.
++!
++! This program is free software; you can redistribute it and/or modify
++! it under the terms of the GNU General Public License as published by
++! the Free Software Foundation; either version 3 of the License, or
++! (at your option) any later version.
++!
++! This program is distributed in the hope that it will be useful,
++! but WITHOUT ANY WARRANTY; without even the implied warranty of
++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++! GNU General Public License for more details.
++!
++! You should have received a copy of the GNU General Public License
++! along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++program test
++ integer, target :: a (4, 3)
++ integer, allocatable :: alloc (:, :)
++ integer, pointer :: ptr (:, :)
++ do 1 i = 1, 4
++ do 1 j = 1, 3
++ a (i, j) = j * 10 + i
++1 continue
++ allocate (alloc (4, 3))
++ alloc = a
++ ptr => a
++ write (*,*) a ! break-static
++end
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.c 2014-06-16 23:30:30.114940489 +0200
+@@ -0,0 +1,26 @@
++/* Copyright 2011 Free Software Foundation, Inc.
++
++ This file is part of GDB.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++int
++main (int argc, char **argv)
++{
++ char vla[argc];
++
++ vla[0] = 0; /* break-here */
++
++ return 0;
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp 2014-06-16 23:30:30.114940489 +0200
+@@ -0,0 +1,57 @@
++# Copyright 2011 Free Software Foundation, Inc.
++#
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++load_lib mi-support.exp
++set MIFLAGS "-i=mi2"
++
++gdb_exit
++if [mi_gdb_start] {
++ continue
++}
++
++set testfile "mi2-var-stale-type"
++set srcfile ${testfile}.c
++set binfile [standard_output_file ${testfile}]
++if {[build_executable ${testfile}.exp $testfile $srcfile] == -1} {
++ return -1
++}
++
++mi_delete_breakpoints
++mi_gdb_reinitialize_dir $srcdir/$subdir
++mi_gdb_load ${binfile}
++
++mi_gdb_test {-interpreter-exec console "maintenance set internal-error quit yes"} \
++ {\^done} \
++ "maintenance set internal-error quit yes"
++
++mi_gdb_test {-interpreter-exec console "maintenance set internal-error corefile yes"} \
++ {\^done} \
++ "maintenance set internal-error corefile yes"
++
++set line [gdb_get_line_number "break-here"]
++set func "main"
++
++mi_gdb_test "-break-insert -t $srcfile:$line" \
++ "\\^done,bkpt=\{number=\"\[0-9\]+\",type=\"breakpoint\",disp=\"del\",enabled=\"y\",addr=\"$hex\",func=\"$func\(\\\(.*\\\)\)?\",file=\".*\",fullname=\".*\",line=\"$line\",\[^\r\n\]*,original-location=\".*\"\}" \
++ "breakpoint at $func"
++
++if { [mi_run_cmd] < 0 } {
++ return -1
++}
++mi_expect_stop "breakpoint-hit" $func ".*" ".*" "\[0-9\]+" { "" "disp=\"del\"" } "stop after initializing vla"
++
++mi_create_varobj "vla" "vla" "create local variable vla"
++
++mi_gdb_test "-var-update *" "\\^done,changelist=.*" "-var-update *"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register-func.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register-func.c 2014-06-16 23:30:30.115940490 +0200
+@@ -0,0 +1,22 @@
++/* This file is part of GDB, the GNU debugger.
++
++ Copyright 2009 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++int
++func (int *arr)
++{
++ return arr[0];
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.c 2014-06-16 23:30:30.115940490 +0200
+@@ -0,0 +1,28 @@
++/* This file is part of GDB, the GNU debugger.
++
++ Copyright 2009 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++extern int func (int *arr);
++
++int
++main (void)
++{
++ int arr[] = { 42 };
++
++ func (arr);
++
++ return 0;
++}
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.exp 2014-06-16 23:30:30.115940490 +0200
+@@ -0,0 +1,33 @@
++# Copyright 2009 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.
++#
++# This file is part of the gdb testsuite.
++
++if { [prepare_for_testing array-from-register.exp "array-from-register" \
++ {array-from-register.c array-from-register-func.c} \
++ {debug optimize=-O2}] } {
++ return -1
++}
++
++if ![runto func] then {
++ return -1
++}
++
++gdb_test "p arr" "\\$\[0-9\]+ = \\(int \\*\\) *0x\[0-9a-f\]+"
++
++# Seen regression:
++# Address requested for identifier "arr" which is in register $rdi
++gdb_test "p arr\[0\]" "\\$\[0-9\]+ = 42"
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.exp 2014-06-16 23:30:30.115940490 +0200
+@@ -0,0 +1,104 @@
++# Copyright 2008, 2009 Free Software Foundation, Inc.
++#
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++if $tracelevel then {
++ strace $tracelevel
++}
++
++load_lib "pascal.exp"
++
++set testfile "arrays"
++set srcfile ${testfile}.pas
++set binfile ${objdir}/${subdir}/${testfile}$EXEEXT
++
++# These tests only work with fpc, using the -gw3 compile-option
++pascal_init
++if { $pascal_compiler_is_fpc != 1 } {
++ return -1
++}
++
++# Detect if the fpc version is below 2.3.0
++set fpc_generates_dwarf_for_dynamic_arrays 1
++if { ($fpcversion_major < 2) || ( ($fpcversion_major == 2) && ($fpcversion_minor < 3))} {
++ set fpc_generates_dwarf_for_dynamic_arrays 0
++}
++
++
++if {[gdb_compile_pascal "-gw3 ${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } {
++ return -1
++}
++
++gdb_exit
++gdb_start
++gdb_reinitialize_dir $srcdir/$subdir
++gdb_load ${binfile}
++set bp_location1 [gdb_get_line_number "set breakpoint 1 here"]
++set bp_location2 [gdb_get_line_number "set breakpoint 2 here"]
++
++
++if { [gdb_breakpoint ${srcfile}:${bp_location1}] } {
++ pass "setting breakpoint 1"
++}
++if { [gdb_breakpoint ${srcfile}:${bp_location2}] } {
++ pass "setting breakpoint 2"
++}
++
++# Verify that "start" lands inside the right procedure.
++if { [gdb_start_cmd] < 0 } {
++ untested start
++ return -1
++}
++
++gdb_test "" ".* at .*${srcfile}.*" "start"
++
++gdb_test "cont" "Breakpoint .*:${bp_location1}.*" "Going to first breakpoint"
++
++gdb_test "print StatArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer type"
++gdb_test "print StatArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer"
++
++gdb_test "cont" "Breakpoint .*:${bp_location2}.*" "Going to second breakpoint"
++
++gdb_test "print StatArrChar" ".* = 'abcdefghijkl'" "Print static array of char"
++gdb_test "print Stat2dArrInt" ".* = \\{\\{0, 1, 2, 3, 4\\}, \\{1, 2, 3, 4, 5\\}, \\{2, 3, 4, 5, 6\\}, \\{3, 4, 5, 6, 7\\}, \\{4, 5, 6, 7, 8\\}, \\{5, 6, 7, 8, 9\\}, \\{6, 7, 8, 9, 10\\}, \\{7, 8, 9, 10, 11\\}, \\{8, 9, 10, 11, 12\\}, \\{9, 10, 11, 12, 13\\}, \\{10, 11, 12, 13, 14\\}, \\{11, 12, 13, 14, 15\\}\\}" "Print static 2-dimensional array of integer"
++
++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
++ setup_xfail "*-*-*"
++}
++gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type"
++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
++ setup_xfail "*-*-*"
++}
++gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer"
++
++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
++ setup_xfail "*-*-*"
++}
++gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char"
++
++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
++ setup_xfail "*-*-*"
++}
++gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string"
++
++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
++ setup_xfail "*-*-*"
++}
++gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string"
++
++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
++ setup_xfail "*-*-*"
++}
++gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char"
++
+Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.pas
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.pas 2014-06-16 23:30:30.115940490 +0200
+@@ -0,0 +1,82 @@
++{
++ Copyright 2008, 2009 Free Software Foundation, Inc.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>.
++}
++
++program arrays;
++
++{$mode objfpc}{$h+}
++
++uses sysutils;
++
++type TStatArrInt= array[0..11] of integer;
++ TDynArrInt= array of integer;
++ TStatArrStr= array[0..12] of string;
++ TDynArrStr= array of string;
++ TDynArrChar = array of char;
++ TStatArrChar = array [0..11] of char;
++
++ TStat2dArrInt = array[0..11,0..4] of integer;
++
++var StatArrInt: TStatArrInt;
++ StatArrInt_: Array[0..11] of integer;
++ DynArrInt: TDynArrInt;
++ DynArrInt_: Array of integer;
++ StatArrStr: TStatArrStr;
++ DynArrStr: TDynArrStr;
++ StatArrChar: TStatArrChar;
++ DynArrChar: TDynArrChar;
++
++ Stat2dArrInt: TStat2dArrInt;
++
++ s: string;
++
++ i,j : integer;
++
++begin
++ for i := 0 to 11 do
++ begin
++ StatArrInt[i]:= i+50;
++ StatArrInt_[i]:= i+50;
++ StatArrChar[i]:= chr(ord('a')+i);
++ for j := 0 to 4 do
++ Stat2dArrInt[i,j]:=i+j;
++ end;
++ writeln(StatArrInt_[0]);
++ writeln(StatArrInt[0]); { set breakpoint 1 here }
++ writeln(StatArrChar[0]);
++ writeln(Stat2dArrInt[0,0]);
++
++ setlength(DynArrInt,13);
++ setlength(DynArrInt_,13);
++ setlength(DynArrStr,13);
++ setlength(DynArrChar,13);
++ for i := 0 to 12 do
++ begin
++ DynArrInt[i]:= i+50;
++ DynArrInt_[i]:= i+50;
++ DynArrChar[i]:= chr(ord('a')+i);
++ StatArrStr[i]:='str'+inttostr(i);
++ DynArrStr[i]:='dstr'+inttostr(i);
++ end;
++ writeln(DynArrInt_[1]);
++ writeln(DynArrInt[1]);
++ writeln(DynArrStr[1]);
++ writeln(StatArrStr[1]);
++ writeln(DynArrChar[1]);
++
++ s := 'test'#0'string';
++ writeln(s); { set breakpoint 2 here }
++end.
+Index: gdb-7.7.90.20140613/gdb/testsuite/lib/gdb.exp
+===================================================================
+--- gdb-7.7.90.20140613.orig/gdb/testsuite/lib/gdb.exp 2014-06-16 23:30:29.278939700 +0200
++++ gdb-7.7.90.20140613/gdb/testsuite/lib/gdb.exp 2014-06-16 23:30:30.117940492 +0200
+@@ -159,6 +159,11 @@ proc gdb_unload {} {
+ send_gdb "y\n"
+ exp_continue
+ }
++ -re "A program is being debugged already..*Are you sure you want to change the file.*y or n. $"\
++ { send_gdb "y\n"
++ verbose "\t\tUnloading symbols for program being debugged"
++ exp_continue
++ }
+ -re "Discard symbol table from .*y or n.*$" {
+ send_gdb "y\n"
+ exp_continue
+Index: gdb-7.7.90.20140613/gdb/testsuite/lib/pascal.exp
+===================================================================
+--- gdb-7.7.90.20140613.orig/gdb/testsuite/lib/pascal.exp 2014-06-13 03:59:37.000000000 +0200
++++ gdb-7.7.90.20140613/gdb/testsuite/lib/pascal.exp 2014-06-16 23:30:30.117940492 +0200
+@@ -37,6 +37,9 @@ proc pascal_init {} {
+ global pascal_compiler_is_fpc
+ global gpc_compiler
+ global fpc_compiler
++ global fpcversion_major
++ global fpcversion_minor
++ global fpcversion_release
+ global env
+
+ if { $pascal_init_done == 1 } {
+@@ -64,6 +67,20 @@ proc pascal_init {} {
+ set pascal_compiler_is_fpc 1
+ verbose -log "Free Pascal compiler found"
+ }
++
++ # Detect the fpc-version
++ if { $pascal_compiler_is_fpc == 1 } {
++ set fpcversion_major 1
++ set fpcversion_minor 0
++ set fpcversion_release 0
++ set fpcversion [ remote_exec host $fpc_compiler "-iV" ]
++ if [regexp {.*([0-9]+)\.([0-9]+)\.([0-9]+).?} $fpcversion] {
++ regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\1} fpcversion_major
++ regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\2} fpcversion_minor
++ regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\3} fpcversion_release
++ }
++ verbose -log "Freepascal version: $fpcversion_major.$fpcversion_minor.$fpcversion_release"
++ }
+ }
+ set pascal_init_done 1
+ }
--- /dev/null
+[PATCH 00/23] Fortran dynamic array support
+https://sourceware.org/ml/gdb-patches/2014-06/msg00108.html
+https://github.com/intel-gdb/vla/tree/vla-fortran
+
+GIT snapshot:
+commit 511bff520372ffc10fa2ff569c176bdf1e6e475d
+
+
+diff --git a/gdb/NEWS b/gdb/NEWS
+index d9a19ae..e6885d2 100644
+### a/gdb/NEWS
+### b/gdb/NEWS
+@@ -3,6 +3,9 @@
+
+ *** Changes since GDB 7.8
+
++* Fortran dynamic array support: It allows the user to evaluate
++ dynamic arrays like an ordinary static array.
++
+ *** Changes in GDB 7.8
+
+ * New command line options
+diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c
+index f4694b0..8c45276 100644
+--- a/gdb/c-valprint.c
++++ b/gdb/c-valprint.c
+@@ -538,7 +538,16 @@ c_value_print (struct value *val, struct ui_file *stream,
+ {
+ /* normal case */
+ fprintf_filtered (stream, "(");
+- type_print (value_type (val), "", stream, -1);
++ if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
++ {
++ struct value *v;
++
++ v = value_ind (val);
++ v = value_addr (v);
++ type_print (value_type (v), "", stream, -1);
++ }
++ else
++ type_print (value_type (val), "", stream, -1);
+ fprintf_filtered (stream, ") ");
+ }
+ }
+diff --git a/gdb/dwarf2expr.c b/gdb/dwarf2expr.c
+index 36c9f66..274ba62 100644
+--- a/gdb/dwarf2expr.c
++++ b/gdb/dwarf2expr.c
+@@ -1478,6 +1478,12 @@ execute_stack_op (struct dwarf_expr_context *ctx,
+ }
+ break;
+
++ case DW_OP_push_object_address:
++ /* Return the address of the object we are currently observing. */
++ result = (ctx->funcs->get_object_address) (ctx->baton);
++ result_val = value_from_ulongest (address_type, result);
++ break;
++
+ default:
+ error (_("Unhandled dwarf expression opcode 0x%x"), op);
+ }
+diff --git a/gdb/dwarf2expr.h b/gdb/dwarf2expr.h
+index 39dadf3..8cebbe8 100644
+--- a/gdb/dwarf2expr.h
++++ b/gdb/dwarf2expr.h
+@@ -84,12 +84,8 @@ struct dwarf_expr_context_funcs
+ This can throw an exception if the index is out of range. */
+ CORE_ADDR (*get_addr_index) (void *baton, unsigned int index);
+
+-#if 0
+- /* Not yet implemented. */
+-
+ /* Return the `object address' for DW_OP_push_object_address. */
+ CORE_ADDR (*get_object_address) (void *baton);
+-#endif
+ };
+
+ /* The location of a value. */
+diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c
+index fcab9b9..a624dac 100644
+--- a/gdb/dwarf2loc.c
++++ b/gdb/dwarf2loc.c
+@@ -306,6 +306,7 @@ struct dwarf_expr_baton
+ {
+ struct frame_info *frame;
+ struct dwarf2_per_cu_data *per_cu;
++ CORE_ADDR obj_address;
+ };
+
+ /* Helper functions for dwarf2_evaluate_loc_desc. */
+@@ -1209,6 +1210,7 @@ dwarf_expr_push_dwarf_reg_entry_value (struct dwarf_expr_context *ctx,
+
+ baton_local.frame = caller_frame;
+ baton_local.per_cu = caller_per_cu;
++ baton_local.obj_address = 0;
+
+ saved_ctx.gdbarch = ctx->gdbarch;
+ saved_ctx.addr_size = ctx->addr_size;
+@@ -1238,6 +1240,22 @@ dwarf_expr_get_addr_index (void *baton, unsigned int index)
+ return dwarf2_read_addr_index (debaton->per_cu, index);
+ }
+
++/* Callback function for get_object_address. Return the address of the VLA
++ object. */
++
++static CORE_ADDR
++dwarf_expr_get_obj_addr (void *baton)
++{
++ struct dwarf_expr_baton *debaton = baton;
++
++ gdb_assert (debaton != NULL);
++
++ if (debaton->obj_address == 0)
++ error (_("Location address is not set."));
++
++ return debaton->obj_address;
++}
++
+ /* VALUE must be of type lval_computed with entry_data_value_funcs. Perform
+ the indirect method on it, that is use its stored target value, the sole
+ purpose of entry_data_value_funcs.. */
+@@ -2202,7 +2220,8 @@ static const struct dwarf_expr_context_funcs dwarf_expr_ctx_funcs =
+ dwarf_expr_dwarf_call,
+ dwarf_expr_get_base_type,
+ dwarf_expr_push_dwarf_reg_entry_value,
+- dwarf_expr_get_addr_index
++ dwarf_expr_get_addr_index,
++ dwarf_expr_get_obj_addr
+ };
+
+ /* Evaluate a location description, starting at DATA and with length
+@@ -2231,6 +2250,7 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame,
+
+ baton.frame = frame;
+ baton.per_cu = per_cu;
++ baton.obj_address = 0;
+
+ ctx = new_dwarf_expr_context ();
+ old_chain = make_cleanup_free_dwarf_expr_context (ctx);
+@@ -2326,6 +2346,11 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame,
+ int in_stack_memory = dwarf_expr_fetch_in_stack_memory (ctx, 0);
+
+ do_cleanups (value_chain);
++
++ /* Select right frame to correctly evaluate VLA's during a backtrace. */
++ if (is_dynamic_type (type))
++ select_frame (frame);
++
+ retval = value_at_lazy (type, address + byte_offset);
+ if (in_stack_memory)
+ set_value_stack (retval, 1);
+@@ -2436,6 +2461,7 @@ dwarf2_evaluate_loc_desc (struct type *type, struct frame_info *frame,
+
+ static int
+ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
++ CORE_ADDR addr,
+ CORE_ADDR *valp)
+ {
+ struct dwarf_expr_context *ctx;
+@@ -2451,6 +2477,7 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
+
+ baton.frame = get_selected_frame (NULL);
+ baton.per_cu = dlbaton->per_cu;
++ baton.obj_address = addr;
+
+ objfile = dwarf2_per_cu_objfile (dlbaton->per_cu);
+
+@@ -2491,7 +2518,8 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton,
+ /* See dwarf2loc.h. */
+
+ int
+-dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
++dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR address,
++ CORE_ADDR *value)
+ {
+ if (prop == NULL)
+ return 0;
+@@ -2502,7 +2530,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
+ {
+ const struct dwarf2_property_baton *baton = prop->data.baton;
+
+- if (dwarf2_locexpr_baton_eval (&baton->locexpr, value))
++ if (dwarf2_locexpr_baton_eval (&baton->locexpr, address, value))
+ {
+ if (baton->referenced_type)
+ {
+@@ -2546,6 +2574,20 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
+ return 0;
+ }
+
++/* See dwarf2loc.h. */
++
++int
++dwarf2_address_data_valid (const struct type *type)
++{
++ if (TYPE_NOT_ASSOCIATED (type))
++ return 0;
++
++ if (TYPE_NOT_ALLOCATED (type))
++ return 0;
++
++ return 1;
++}
++
+ \f
+ /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */
+
+@@ -2653,6 +2695,15 @@ needs_get_addr_index (void *baton, unsigned int index)
+ return 1;
+ }
+
++/* DW_OP_push_object_address has a frame already passed through. */
++
++static CORE_ADDR
++needs_get_obj_addr (void *baton)
++{
++ /* Nothing to do. */
++ return 1;
++}
++
+ /* Virtual method table for dwarf2_loc_desc_needs_frame below. */
+
+ static const struct dwarf_expr_context_funcs needs_frame_ctx_funcs =
+@@ -2667,7 +2718,8 @@ static const struct dwarf_expr_context_funcs needs_frame_ctx_funcs =
+ needs_frame_dwarf_call,
+ NULL, /* get_base_type */
+ needs_dwarf_reg_entry_value,
+- needs_get_addr_index
++ needs_get_addr_index,
++ needs_get_obj_addr
+ };
+
+ /* Return non-zero iff the location expression at DATA (length SIZE)
+@@ -3316,6 +3368,10 @@ dwarf2_compile_expr_to_ax (struct agent_expr *expr, struct axs_value *loc,
+ unimplemented (op);
+ break;
+
++ case DW_OP_push_object_address:
++ unimplemented (op);
++ break;
++
+ case DW_OP_skip:
+ offset = extract_signed_integer (op_ptr, 2, byte_order);
+ op_ptr += 2;
+diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h
+index 8ad5fa9..fb65c5c 100644
+--- a/gdb/dwarf2loc.h
++++ b/gdb/dwarf2loc.h
+@@ -96,11 +96,18 @@ struct value *dwarf2_evaluate_loc_desc (struct type *type,
+ into VALUE, otherwise returns 0. */
+
+ int dwarf2_evaluate_property (const struct dynamic_prop *prop,
++ CORE_ADDR address,
+ CORE_ADDR *value);
+
+ CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu,
+ unsigned int addr_index);
+
++/* Checks if a dwarf location definition is valid.
++ Returns 1 if valid; 0 otherwise. */
++
++extern int dwarf2_address_data_valid (const struct type *type);
++
++
+ /* The symbol location baton types used by the DWARF-2 reader (i.e.
+ SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct
+ dwarf2_locexpr_baton" is for a symbol with a single location
+diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
+index 276d2f1..fbf13ce 100644
+--- a/gdb/dwarf2read.c
++++ b/gdb/dwarf2read.c
+@@ -1847,6 +1847,12 @@ static void free_dwo_file_cleanup (void *);
+ static void process_cu_includes (void);
+
+ static void check_producer (struct dwarf2_cu *cu);
++
++static int
++attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
++ struct dwarf2_cu *cu, struct dynamic_prop *prop,
++ const gdb_byte *additional_data, int additional_data_size);
++
+ \f
+ /* Various complaints about symbol reading that don't abort the process. */
+
+@@ -14201,29 +14207,92 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu)
+ 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 at some location
++ * in memory. */
+ attr = dwarf2_attr (die, DW_AT_string_length, cu);
+ if (attr)
+ {
+- length = DW_UNSND (attr);
++ if (attr_form_is_block (attr))
++ {
++ struct attribute *byte_size, *bit_size;
++ struct dynamic_prop high;
++
++ byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
++ bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
++
++ /* DW_AT_byte_size should never occur together in combination with
++ DW_AT_string_length. */
++ if ((byte_size == NULL && bit_size != NULL) ||
++ (byte_size != NULL && bit_size == NULL))
++ complaint (&symfile_complaints, _("DW_AT_byte_size AND "
++ "DW_AT_bit_size found together at the same time."));
++
++ /* If DW_AT_string_length AND DW_AT_byte_size exist together, it
++ describes the number of bytes that should be read from the length
++ memory location. */
++ if (byte_size != NULL && bit_size == NULL)
++ {
++ /* Build new dwarf2_locexpr_baton structure with additions to the
++ data attribute, to reflect DWARF specialities to get address
++ sizes. */
++ const gdb_byte append_ops[] = {
++ /* DW_OP_deref_size: size of an address on the target machine
++ (bytes), where the size will be specified by the next
++ operand. */
++ DW_OP_deref_size,
++ /* Operand for DW_OP_deref_size. */
++ DW_UNSND (byte_size) };
++
++ if (!attr_to_dynamic_prop (attr, die, cu, &high,
++ append_ops, ARRAY_SIZE (append_ops)))
++ complaint (&symfile_complaints,
++ _("Could not parse DW_AT_byte_size"));
++ }
++ else if (bit_size != NULL && byte_size == NULL)
++ complaint (&symfile_complaints, _("DW_AT_string_length AND "
++ "DW_AT_bit_size found but not supported yet."));
++ /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
++ is the address size of the target machine. */
++ else
++ {
++ const gdb_byte append_ops[] = { DW_OP_deref };
++
++ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
++ ARRAY_SIZE (append_ops)))
++ complaint (&symfile_complaints,
++ _("Could not parse DW_AT_string_length"));
++ }
++
++ TYPE_RANGE_DATA (range_type)->high = high;
++ }
++ else
++ {
++ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
++ }
+ }
+ else
+ {
+- /* Check for the DW_AT_byte_size attribute. */
++ /* Check for the DW_AT_byte_size attribute, which represents the length
++ in this case. */
+ attr = dwarf2_attr (die, DW_AT_byte_size, cu);
+ if (attr)
+ {
+- length = DW_UNSND (attr);
++ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
+ }
+ else
+ {
+- length = 1;
++ TYPE_HIGH_BOUND (range_type) = 1;
++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
+ }
+ }
+
+- index_type = objfile_type (objfile)->builtin_int;
+- range_type = create_static_range_type (NULL, index_type, 1, length);
+ char_type = language_string_char_type (cu->language_defn, gdbarch);
+ type = create_string_type (NULL, char_type, range_type);
+
+@@ -14540,13 +14609,15 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
+ return set_die_type (die, type, cu);
+ }
+
++
+ /* Parse dwarf attribute if it's a block, reference or constant and put the
+ resulting value of the attribute into struct bound_prop.
+ Returns 1 if ATTR could be resolved into PROP, 0 otherwise. */
+
+ static int
+ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
+- struct dwarf2_cu *cu, struct dynamic_prop *prop)
++ struct dwarf2_cu *cu, struct dynamic_prop *prop,
++ const gdb_byte *additional_data, int additional_data_size)
+ {
+ struct dwarf2_property_baton *baton;
+ struct obstack *obstack = &cu->objfile->objfile_obstack;
+@@ -14559,8 +14630,25 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
+ baton = obstack_alloc (obstack, sizeof (*baton));
+ baton->referenced_type = NULL;
+ baton->locexpr.per_cu = cu->per_cu;
+- baton->locexpr.size = DW_BLOCK (attr)->size;
+- baton->locexpr.data = DW_BLOCK (attr)->data;
++
++ if (additional_data != NULL && additional_data_size > 0)
++ {
++ gdb_byte *data;
++
++ data = obstack_alloc (&cu->objfile->objfile_obstack,
++ DW_BLOCK (attr)->size + additional_data_size);
++ memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
++ memcpy (data + DW_BLOCK (attr)->size,
++ additional_data, additional_data_size);
++
++ baton->locexpr.data = data;
++ baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
++ }
++ else
++ {
++ baton->locexpr.data = DW_BLOCK (attr)->data;
++ baton->locexpr.size = DW_BLOCK (attr)->size;
++ }
+ prop->data.baton = baton;
+ prop->kind = PROP_LOCEXPR;
+ gdb_assert (prop->data.baton != NULL);
+@@ -14590,8 +14678,28 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
+ baton = obstack_alloc (obstack, sizeof (*baton));
+ baton->referenced_type = die_type (target_die, target_cu);
+ baton->locexpr.per_cu = cu->per_cu;
+- baton->locexpr.size = DW_BLOCK (target_attr)->size;
+- baton->locexpr.data = DW_BLOCK (target_attr)->data;
++
++ if (additional_data != NULL && additional_data_size > 0)
++ {
++ gdb_byte *data;
++
++ data = obstack_alloc (&cu->objfile->objfile_obstack,
++ DW_BLOCK (target_attr)->size + additional_data_size);
++ memcpy (data, DW_BLOCK (target_attr)->data,
++ DW_BLOCK (target_attr)->size);
++ memcpy (data + DW_BLOCK (target_attr)->size,
++ additional_data, additional_data_size);
++
++ baton->locexpr.data = data;
++ baton->locexpr.size = (DW_BLOCK (target_attr)->size
++ + additional_data_size);
++ }
++ else
++ {
++ baton->locexpr.data = DW_BLOCK (target_attr)->data;
++ baton->locexpr.size = DW_BLOCK (target_attr)->size;
++ }
++
+ prop->data.baton = baton;
+ prop->kind = PROP_LOCEXPR;
+ gdb_assert (prop->data.baton != NULL);
+@@ -14626,7 +14734,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;
+@@ -14646,7 +14754,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. */
+@@ -14679,19 +14789,26 @@ 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, NULL, 0))
++ complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
++ "- DIE at 0x%x [in module %s]"),
++ die->offset.sect_off, objfile_name (cu->objfile));
++
+ attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
+ if (attr)
+- attr_to_dynamic_prop (attr, die, cu, &low);
++ attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
+ else if (!low_default_is_valid)
+ complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
+ "- DIE at 0x%x [in module %s]"),
+ die->offset.sect_off, objfile_name (cu->objfile));
+
+ attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
+- if (!attr_to_dynamic_prop (attr, die, cu, &high))
++ if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
+ {
+ attr = dwarf2_attr (die, DW_AT_count, cu);
+- if (attr_to_dynamic_prop (attr, die, cu, &high))
++ if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
+ {
+ /* If bounds are constant do the final calculation here. */
+ if (low.kind == PROP_CONST && high.kind == PROP_CONST)
+@@ -14755,7 +14872,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;
+@@ -21673,6 +21790,8 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
+ {
+ struct dwarf2_per_cu_offset_and_type **slot, ofs;
+ struct objfile *objfile = cu->objfile;
++ struct attribute *attr;
++ struct dynamic_prop prop;
+
+ /* For Ada types, make sure that the gnat-specific data is always
+ initialized (if not already set). There are a few types where
+@@ -21687,6 +21806,43 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
+ && !HAVE_GNAT_AUX_INFO (type))
+ INIT_GNAT_SPECIFIC (type);
+
++ /* Read DW_AT_allocated and set in type. */
++ attr = dwarf2_attr (die, DW_AT_allocated, cu);
++ if (attr_form_is_block (attr))
++ {
++ struct dynamic_prop prop;
++
++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
++ {
++ TYPE_ALLOCATED_PROP (type)
++ = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
++ *TYPE_ALLOCATED_PROP (type) = prop;
++ }
++ }
++
++ /* Read DW_AT_associated and set in type. */
++ attr = dwarf2_attr (die, DW_AT_associated, cu);
++ if (attr_form_is_block (attr))
++ {
++ struct dynamic_prop prop;
++
++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
++ {
++ TYPE_ASSOCIATED_PROP (type)
++ = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
++ *TYPE_ASSOCIATED_PROP (type) = prop;
++ }
++ }
++
++ /* Read DW_AT_data_location and set in type. */
++ attr = dwarf2_attr (die, DW_AT_data_location, cu);
++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
++ {
++ TYPE_DATA_LOCATION (type)
++ = obstack_alloc (&objfile->objfile_obstack, sizeof (prop));
++ *TYPE_DATA_LOCATION (type) = prop;
++ }
++
+ if (dwarf2_per_objfile->die_type_hash == NULL)
+ {
+ dwarf2_per_objfile->die_type_hash =
+diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
+index 8356aab..69e67f4 100644
+--- a/gdb/f-typeprint.c
++++ b/gdb/f-typeprint.c
+@@ -30,6 +30,7 @@
+ #include "gdbcore.h"
+ #include "target.h"
+ #include "f-lang.h"
++#include "valprint.h"
+
+ #include <string.h>
+ #include <errno.h>
+@@ -56,6 +57,17 @@ f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
+ enum type_code code;
+ int demangled_args;
+
++ if (TYPE_NOT_ASSOCIATED (type))
++ {
++ val_print_not_associated (stream);
++ return;
++ }
++ if (TYPE_NOT_ALLOCATED (type))
++ {
++ val_print_not_allocated (stream);
++ return;
++ }
++
+ f_type_print_base (type, stream, show, level);
+ code = TYPE_CODE (type);
+ if ((varstring != NULL && *varstring != '\0')
+@@ -170,28 +182,36 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
+ if (arrayprint_recurse_level == 1)
+ fprintf_filtered (stream, "(");
+
+- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
+- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+- arrayprint_recurse_level);
+-
+- lower_bound = f77_get_lowerbound (type);
+- if (lower_bound != 1) /* Not the default. */
+- fprintf_filtered (stream, "%d:", lower_bound);
+-
+- /* Make sure that, if we have an assumed size array, we
+- print out a warning and print the upperbound as '*'. */
+-
+- if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+- fprintf_filtered (stream, "*");
++ if (TYPE_NOT_ASSOCIATED (type))
++ val_print_not_associated (stream);
++ else if (TYPE_NOT_ALLOCATED (type))
++ val_print_not_allocated (stream);
+ else
+- {
+- upper_bound = f77_get_upperbound (type);
+- fprintf_filtered (stream, "%d", upper_bound);
+- }
+-
+- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
+- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
+- arrayprint_recurse_level);
++ {
++
++ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
++ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
++ arrayprint_recurse_level);
++
++ lower_bound = f77_get_lowerbound (type);
++ if (lower_bound != 1) /* Not the default. */
++ fprintf_filtered (stream, "%d:", lower_bound);
++
++ /* Make sure that, if we have an assumed size array, we
++ print out a warning and print the upperbound as '*'. */
++
++ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
++ fprintf_filtered (stream, "*");
++ else
++ {
++ upper_bound = f77_get_upperbound (type);
++ fprintf_filtered (stream, "%d", upper_bound);
++ }
++
++ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
++ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
++ arrayprint_recurse_level);
++ }
+ if (arrayprint_recurse_level == 1)
+ fprintf_filtered (stream, ")");
+ else
+diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
+index 408c8cc..38f32e0 100644
+--- a/gdb/f-valprint.c
++++ b/gdb/f-valprint.c
+@@ -39,8 +39,6 @@
+
+ extern void _initialize_f_valprint (void);
+ static void info_common_command (char *, int);
+-static void f77_create_arrayprint_offset_tbl (struct type *,
+- struct ui_file *);
+ static void f77_get_dynamic_length_of_aggregate (struct type *);
+
+ int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
+@@ -48,15 +46,6 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
+ /* Array which holds offsets to be applied to get a row's elements
+ for a given array. Array also holds the size of each subarray. */
+
+-/* The following macro gives us the size of the nth dimension, Where
+- n is 1 based. */
+-
+-#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
+-
+-/* The following gives us the offset for row n where n is 1-based. */
+-
+-#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
+-
+ int
+ f77_get_lowerbound (struct type *type)
+ {
+@@ -114,47 +103,6 @@ f77_get_dynamic_length_of_aggregate (struct type *type)
+ * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
+ }
+
+-/* Function that sets up the array offset,size table for the array
+- type "type". */
+-
+-static void
+-f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
+-{
+- struct type *tmp_type;
+- int eltlen;
+- int ndimen = 1;
+- int upper, lower;
+-
+- tmp_type = type;
+-
+- while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
+- {
+- upper = f77_get_upperbound (tmp_type);
+- lower = f77_get_lowerbound (tmp_type);
+-
+- F77_DIM_SIZE (ndimen) = upper - lower + 1;
+-
+- tmp_type = TYPE_TARGET_TYPE (tmp_type);
+- ndimen++;
+- }
+-
+- /* Now we multiply eltlen by all the offsets, so that later we
+- can print out array elements correctly. Up till now we
+- know an offset to apply to get the item but we also
+- have to know how much to add to get to the next item. */
+-
+- ndimen--;
+- eltlen = TYPE_LENGTH (tmp_type);
+- F77_DIM_OFFSET (ndimen) = eltlen;
+- while (--ndimen > 0)
+- {
+- eltlen *= F77_DIM_SIZE (ndimen + 1);
+- F77_DIM_OFFSET (ndimen) = eltlen;
+- }
+-}
+-
+-
+-
+ /* Actual function which prints out F77 arrays, Valaddr == address in
+ the superior. Address == the address in the inferior. */
+
+@@ -167,41 +115,62 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
+ const struct value_print_options *options,
+ int *elts)
+ {
++ struct type *range_type = TYPE_INDEX_TYPE (check_typedef (type));
++ CORE_ADDR addr = address + embedded_offset;
++ LONGEST lowerbound, upperbound;
+ int i;
+
++ get_discrete_bounds (range_type, &lowerbound, &upperbound);
++
+ if (nss != ndimensions)
+ {
+- for (i = 0;
+- (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max);
++ 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);
+ i++)
+ {
++ struct value *subarray = value_from_contents_and_address
++ (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
++ + offs, addr + offs);
++
+ fprintf_filtered (stream, "( ");
+- f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
+- valaddr,
+- embedded_offset + i * F77_DIM_OFFSET (nss),
+- address,
+- stream, recurse, val, options, elts);
++ f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
++ value_contents_for_printing (subarray),
++ value_embedded_offset (subarray),
++ value_address (subarray),
++ stream, recurse, subarray, options, elts);
++ offs += dim_size;
+ fprintf_filtered (stream, ") ");
+ }
+- if (*elts >= options->print_max && i < F77_DIM_SIZE (nss))
++ if (*elts >= options->print_max && i < upperbound)
+ fprintf_filtered (stream, "...");
+ }
+ else
+ {
+- for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max;
++ for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
+ i++, (*elts)++)
+ {
+- val_print (TYPE_TARGET_TYPE (type),
+- valaddr,
+- embedded_offset + i * F77_DIM_OFFSET (ndimensions),
+- address, stream, recurse,
+- val, options, current_language);
++ struct value *elt = value_subscript ((struct value *)val, i);
++
++ val_print (value_type (elt),
++ value_contents_for_printing (elt),
++ value_embedded_offset (elt),
++ value_address (elt), stream, recurse,
++ elt, options, current_language);
+
+- if (i != (F77_DIM_SIZE (nss) - 1))
++ if (i != upperbound)
+ fprintf_filtered (stream, ", ");
+
+ if ((*elts == options->print_max - 1)
+- && (i != (F77_DIM_SIZE (nss) - 1)))
++ && (i != upperbound))
+ fprintf_filtered (stream, "...");
+ }
+ }
+@@ -228,12 +197,6 @@ f77_print_array (struct type *type, const gdb_byte *valaddr,
+ Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
+ ndimensions, MAX_FORTRAN_DIMS);
+
+- /* Since F77 arrays are stored column-major, we set up an
+- offset table to get at the various row's elements. The
+- offset table contains entries for both offset and subarray size. */
+-
+- f77_create_arrayprint_offset_tbl (type, stream);
+-
+ f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
+ address, stream, recurse, val, options, &elts);
+ }
+@@ -378,12 +341,15 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
+ fprintf_filtered (stream, "( ");
+ for (index = 0; index < TYPE_NFIELDS (type); index++)
+ {
+- int offset = TYPE_FIELD_BITPOS (type, index) / 8;
++ struct value *field = value_field
++ ((struct value *)original_value, index);
++
++ val_print (value_type (field),
++ value_contents_for_printing (field),
++ value_embedded_offset (field),
++ value_address (field), stream, recurse + 1,
++ field, options, current_language);
+
+- val_print (TYPE_FIELD_TYPE (type, index), valaddr,
+- embedded_offset + offset,
+- address, stream, recurse + 1,
+- original_value, options, current_language);
+ if (index != TYPE_NFIELDS (type) - 1)
+ fputs_filtered (", ", stream);
+ }
+diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
+index e99a2f3..53cae2c 100644
+--- a/gdb/gdbtypes.c
++++ b/gdb/gdbtypes.c
+@@ -805,7 +805,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);
+@@ -820,6 +821,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;
+@@ -841,7 +843,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;
+@@ -849,7 +851,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;
+ }
+@@ -1003,18 +1009,24 @@ create_array_type_with_stride (struct type *result_type,
+
+ TYPE_CODE (result_type) = TYPE_CODE_ARRAY;
+ TYPE_TARGET_TYPE (result_type) = element_type;
+- if (has_static_range (TYPE_RANGE_DATA (range_type)))
++ if (has_static_range (TYPE_RANGE_DATA (range_type))
++ && dwarf2_address_data_valid (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;
+ 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;
+@@ -1616,12 +1628,31 @@ stub_noname_complaint (void)
+ static int
+ is_dynamic_type_internal (struct type *type, int top_level)
+ {
++ int index;
++
++ if (!type)
++ return 0;
++
+ type = check_typedef (type);
+
+ /* We only want to recognize references at the outermost level. */
+ if (top_level && TYPE_CODE (type) == TYPE_CODE_REF)
+ type = check_typedef (TYPE_TARGET_TYPE (type));
+
++ if (TYPE_ASSOCIATED_PROP (type))
++ return 1;
++
++ if (TYPE_ALLOCATED_PROP (type))
++ return 1;
++
++ /* Scan field types in the Fortran case for nested dynamic types.
++ This will be done only for Fortran as in the C++ case an endless recursion
++ can occur in the area of classes. */
++ if (current_language->la_language == language_fortran)
++ for (index = 0; index < TYPE_NFIELDS (type); index++)
++ if (is_dynamic_type (TYPE_FIELD_TYPE (type, index)))
++ return 1;
++
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_RANGE:
+@@ -1631,11 +1662,19 @@ is_dynamic_type_internal (struct type *type, int top_level)
+ {
+ gdb_assert (TYPE_NFIELDS (type) == 1);
+
+- /* The array is dynamic if either the bounds are dynamic,
+- or the elements it contains have a dynamic contents. */
++ /* The array is dynamic if either
++ - the bounds are dynamic,
++ - the elements it contains have a dynamic contents
++ - a data_locaton attribute was found. */
+ if (is_dynamic_type_internal (TYPE_INDEX_TYPE (type), 0))
+ return 1;
+- return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
++ else if (TYPE_DATA_LOCATION (type) != NULL
++ && (TYPE_DATA_LOCATION_KIND (type) == PROP_LOCEXPR
++ || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST))
++ return 1;
++ else
++ return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
++ break;
+ }
+
+ case TYPE_CODE_STRUCT:
+@@ -1648,6 +1687,17 @@ is_dynamic_type_internal (struct type *type, int top_level)
+ && is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0))
+ return 1;
+ }
++ case TYPE_CODE_PTR:
++ {
++ if (TYPE_TARGET_TYPE (type)
++ && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING)
++ return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type)));
++
++ return 0;
++ break;
++ }
++ default:
++ return 0;
+ break;
+ }
+
+@@ -1666,22 +1716,23 @@ static struct type *resolve_dynamic_type_internal (struct type *type,
+ CORE_ADDR addr,
+ int top_level);
+
+-/* Given a dynamic range type (dyn_range_type), return a static version
+- of that type. */
++/* Given a dynamic range type (dyn_range_type) and address,
++ return a static version of that type. */
+
+ static struct type *
+-resolve_dynamic_range (struct type *dyn_range_type)
++resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr)
+ {
+ CORE_ADDR value;
+ struct type *static_range_type;
+ const struct dynamic_prop *prop;
+ const struct dwarf2_locexpr_baton *baton;
+- struct dynamic_prop low_bound, high_bound;
++ struct dynamic_prop low_bound, high_bound, stride;
++ struct type *range_copy = copy_type (dyn_range_type);
+
+ gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
+
+ prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
+- if (dwarf2_evaluate_property (prop, &value))
++ if (dwarf2_evaluate_property (prop, addr, &value))
+ {
+ low_bound.kind = PROP_CONST;
+ low_bound.data.const_val = value;
+@@ -1693,7 +1744,7 @@ resolve_dynamic_range (struct type *dyn_range_type)
+ }
+
+ prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
+- if (dwarf2_evaluate_property (prop, &value))
++ if (dwarf2_evaluate_property (prop, addr, &value))
+ {
+ high_bound.kind = PROP_CONST;
+ high_bound.data.const_val = value;
+@@ -1707,10 +1758,17 @@ 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, addr, &value))
++ {
++ stride.kind = PROP_CONST;
++ stride.data.const_val = value;
++ }
+
+- static_range_type = create_range_type (copy_type (dyn_range_type),
+- TYPE_TARGET_TYPE (dyn_range_type),
+- &low_bound, &high_bound);
++ static_range_type = create_range_type (range_copy,
++ TYPE_TARGET_TYPE (range_copy),
++ &low_bound, &high_bound, &stride);
+ TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
+ return static_range_type;
+ }
+@@ -1720,29 +1778,52 @@ resolve_dynamic_range (struct type *dyn_range_type)
+ of the associated array. */
+
+ static struct type *
+-resolve_dynamic_array (struct type *type)
++resolve_dynamic_array (struct type *type, CORE_ADDR addr)
+ {
+ CORE_ADDR value;
+ struct type *elt_type;
+ struct type *range_type;
+ struct type *ary_dim;
++ struct dynamic_prop *prop;
++ struct type *copy = copy_type (type);
+
+- gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
++ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
++ || TYPE_CODE (type) == TYPE_CODE_STRING);
+
+ elt_type = type;
+ range_type = check_typedef (TYPE_INDEX_TYPE (elt_type));
+- range_type = resolve_dynamic_range (range_type);
++ range_type = resolve_dynamic_range (range_type, addr);
++
++ prop = TYPE_ALLOCATED_PROP (type);
++ if (dwarf2_evaluate_property (prop, addr, &value))
++ {
++ TYPE_ALLOCATED_PROP (copy)->kind = PROP_CONST;
++ TYPE_ALLOCATED_PROP (copy)->data.const_val = value;
++ }
++
++ prop = TYPE_ASSOCIATED_PROP (type);
++ if (dwarf2_evaluate_property (prop, addr, &value))
++ {
++ TYPE_ASSOCIATED_PROP (copy)->kind = PROP_CONST;
++ TYPE_ASSOCIATED_PROP (copy)->data.const_val = value;
++ }
+
+ ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
+
+- if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
+- elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type));
++ if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
++ || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
++ elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr);
+ else
+ elt_type = TYPE_TARGET_TYPE (type);
+
+- return create_array_type (copy_type (type),
+- elt_type,
+- range_type);
++ if (TYPE_CODE (type) == TYPE_CODE_STRING)
++ return create_string_type (copy,
++ elt_type,
++ range_type);
++ else
++ return create_array_type (copy,
++ elt_type,
++ range_type);
+ }
+
+ /* Resolve dynamic bounds of members of the union TYPE to static
+@@ -1846,6 +1927,8 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
+ {
+ struct type *real_type = check_typedef (type);
+ struct type *resolved_type = type;
++ const struct dynamic_prop *prop;
++ CORE_ADDR value;
+
+ if (!is_dynamic_type_internal (real_type, top_level))
+ return type;
+@@ -1871,11 +1954,12 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
+ }
+
+ case TYPE_CODE_ARRAY:
+- resolved_type = resolve_dynamic_array (type);
++ case TYPE_CODE_STRING:
++ resolved_type = resolve_dynamic_array (type, addr);
+ break;
+
+ case TYPE_CODE_RANGE:
+- resolved_type = resolve_dynamic_range (type);
++ resolved_type = resolve_dynamic_range (type, addr);
+ break;
+
+ case TYPE_CODE_UNION:
+@@ -1887,6 +1971,25 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr,
+ break;
+ }
+
++ /* Resolve data_location attribute. */
++ prop = TYPE_DATA_LOCATION (resolved_type);
++ if (dwarf2_evaluate_property (prop, addr, &value))
++ {
++ 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;
++ }
++ else
++ TYPE_DATA_LOCATION (resolved_type) = NULL;
++
+ return resolved_type;
+ }
+
+@@ -4104,6 +4207,27 @@ copy_type_recursive (struct objfile *objfile,
+ *TYPE_RANGE_DATA (new_type) = *TYPE_RANGE_DATA (type);
+ }
+
++ /* Copy the data location information. */
++ if (TYPE_DATA_LOCATION (type) != NULL)
++ {
++ TYPE_DATA_LOCATION (new_type) = xmalloc (sizeof (struct dynamic_prop));
++ *TYPE_DATA_LOCATION (new_type) = *TYPE_DATA_LOCATION (type);
++ }
++
++ /* Copy allocated information. */
++ if (TYPE_ALLOCATED_PROP (type) != NULL)
++ {
++ TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
++ *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type);
++ }
++
++ /* Copy associated information. */
++ if (TYPE_ASSOCIATED_PROP (type) != NULL)
++ {
++ TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop));
++ *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type);
++ }
++
+ /* Copy pointers to other types. */
+ if (TYPE_TARGET_TYPE (type))
+ TYPE_TARGET_TYPE (new_type) =
+@@ -4150,6 +4274,44 @@ copy_type (const struct type *type)
+ memcpy (TYPE_MAIN_TYPE (new_type), TYPE_MAIN_TYPE (type),
+ sizeof (struct main_type));
+
++ if (TYPE_ALLOCATED_PROP (type))
++ {
++ TYPE_ALLOCATED_PROP (new_type)
++ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
++ struct dynamic_prop);
++ memcpy (TYPE_ALLOCATED_PROP (new_type), TYPE_ALLOCATED_PROP (type),
++ sizeof (struct dynamic_prop));
++ }
++
++ if (TYPE_ASSOCIATED_PROP (type))
++ {
++ TYPE_ASSOCIATED_PROP (new_type)
++ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
++ struct dynamic_prop);
++ memcpy (TYPE_ASSOCIATED_PROP (new_type), TYPE_ASSOCIATED_PROP (type),
++ sizeof (struct dynamic_prop));
++ }
++
++ if (TYPE_DATA_LOCATION (type))
++ {
++ TYPE_DATA_LOCATION (new_type)
++ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
++ struct dynamic_prop);
++ memcpy (TYPE_DATA_LOCATION (new_type), TYPE_DATA_LOCATION (type),
++ sizeof (struct dynamic_prop));
++ }
++
++ if (TYPE_NFIELDS (type))
++ {
++ int nfields = TYPE_NFIELDS (type);
++
++ TYPE_FIELDS (new_type)
++ = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack,
++ nfields, struct field);
++ memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type),
++ nfields * sizeof (struct field));
++ }
++
+ return new_type;
+ }
+ \f
+diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
+index 5008ef4..436edf8 100644
+--- a/gdb/gdbtypes.h
++++ b/gdb/gdbtypes.h
+@@ -669,6 +669,10 @@ struct main_type
+
+ 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. */
+
+@@ -724,6 +728,23 @@ struct main_type
+
+ struct func_type *func_stuff;
+ } type_specific;
++
++ /* * Contains a location description value for the current type. Evaluating
++ this field yields to the location of the data for an object. */
++
++ struct dynamic_prop *data_location;
++
++ /* Structure for DW_AT_allocated.
++ The presence of this attribute indicates that the object of the type
++ can be allocated/deallocated. The value can be a dwarf expression,
++ reference, or a constant. */
++ struct dynamic_prop *allocated;
++
++ /* Structure for DW_AT_associated.
++ The presence of this attribute indicated that the object of the type
++ can be associated. The value can be a dwarf expression,
++ reference, or a constant. */
++ struct dynamic_prop *associated;
+ };
+
+ /* * A ``struct type'' describes a particular instance of a type, with
+@@ -1202,6 +1223,39 @@ 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
++
++
++/* Attribute accessors for the type data location. */
++#define TYPE_DATA_LOCATION(thistype) \
++ TYPE_MAIN_TYPE(thistype)->data_location
++#define TYPE_DATA_LOCATION_BATON(thistype) \
++ TYPE_DATA_LOCATION (thistype)->data.baton
++#define TYPE_DATA_LOCATION_ADDR(thistype) \
++ TYPE_DATA_LOCATION (thistype)->data.const_val
++#define TYPE_DATA_LOCATION_KIND(thistype) \
++ TYPE_DATA_LOCATION (thistype)->kind
++#define TYPE_ALLOCATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->allocated
++#define TYPE_ASSOCIATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->associated
++
++/* Allocated status of type object. If set to non-zero it means the object
++ is allocated. A zero value means it is not allocated. */
++#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \
++ && TYPE_ALLOCATED_PROP (t)->kind == PROP_CONST \
++ && !TYPE_ALLOCATED_PROP (t)->data.const_val)
++
++/* Associated status of type object. If set to non-zero it means the object
++ is associated. A zero value means it is not associated. */
++#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \
++ && TYPE_ASSOCIATED_PROP (t)->kind == PROP_CONST \
++ && !TYPE_ASSOCIATED_PROP (t)->data.const_val)
+
+ /* Moto-specific stuff for FORTRAN arrays. */
+
+@@ -1209,6 +1263,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))))
+@@ -1677,6 +1734,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/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp
+new file mode 100644
+index 0000000..20607c3
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp
+@@ -0,0 +1,65 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla.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
++}
++
++# Check the association status of various types of VLA's
++# and pointer to VLA's.
++gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
++gdb_continue_to_breakpoint "vla1-allocated"
++gdb_test "print l" " = \\.TRUE\\." \
++ "print vla1 allocation status (allocated)"
++
++gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
++gdb_continue_to_breakpoint "vla2-allocated"
++gdb_test "print l" " = \\.TRUE\\." \
++ "print vla2 allocation status (allocated)"
++
++gdb_breakpoint [gdb_get_line_number "pvla-associated"]
++gdb_continue_to_breakpoint "pvla-associated"
++gdb_test "print l" " = \\.TRUE\\." \
++ "print pvla associated status (associated)"
++
++gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
++gdb_continue_to_breakpoint "pvla-re-associated"
++gdb_test "print l" " = \\.TRUE\\." \
++ "print pvla associated status (re-associated)"
++
++gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
++gdb_continue_to_breakpoint "pvla-deassociated"
++gdb_test "print l" " = \\.FALSE\\." \
++ "print pvla allocation status (deassociated)"
++
++gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
++gdb_continue_to_breakpoint "vla1-deallocated"
++gdb_test "print l" " = \\.FALSE\\." \
++ "print vla1 allocation status (deallocated)"
++gdb_test "print vla1" " = <not allocated>" \
++ "print deallocated vla1"
++
++gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
++gdb_continue_to_breakpoint "vla2-deallocated"
++gdb_test "print l" " = \\.FALSE\\." "print vla2 deallocated"
++gdb_test "print vla2" " = <not allocated>" "print deallocated vla2"
+diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.exp b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
+new file mode 100644
+index 0000000..20276d6
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-datatypes.exp
+@@ -0,0 +1,82 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++# check that all fortran standard datatypes will be
++# handled correctly when using as VLA's
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "vlas-allocated"]
++gdb_continue_to_breakpoint "vlas-allocated"
++gdb_test "next" " = allocated\\\(realvla\\\)" \
++ "next to allocation status of intvla"
++gdb_test "print l" " = \\.TRUE\\." "intvla allocated"
++gdb_test "next" " = allocated\\\(complexvla\\\)" \
++ "next to allocation status of realvla"
++gdb_test "print l" " = \\.TRUE\\." "realvla allocated"
++gdb_test "next" " = allocated\\\(logicalvla\\\)" \
++ "next to allocation status of complexvla"
++gdb_test "print l" " = \\.TRUE\\." "complexvla allocated"
++gdb_test "next" " = allocated\\\(charactervla\\\)" \
++ "next to allocation status of logicalvla"
++gdb_test "print l" " = \\.TRUE\\." "logicalvla allocated"
++gdb_test "next" "intvla\\\(:,:,:\\\) = 1" \
++ "next to allocation status of charactervla"
++gdb_test "print l" " = \\.TRUE\\." "charactervla allocated"
++
++gdb_breakpoint [gdb_get_line_number "vlas-initialized"]
++gdb_continue_to_breakpoint "vlas-initialized"
++gdb_test "ptype intvla" "type = integer\\\(kind=4\\\) \\\(11,22,33\\\)" \
++ "ptype intvla"
++gdb_test "ptype realvla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \
++ "ptype realvla"
++gdb_test "ptype complexvla" "type = complex\\\(kind=4\\\) \\\(11,22,33\\\)" \
++ "ptype complexvla"
++gdb_test "ptype logicalvla" "type = logical\\\(kind=4\\\) \\\(11,22,33\\\)" \
++ "ptype logicalvla"
++gdb_test "ptype charactervla" "type = character\\\*1 \\\(11,22,33\\\)" \
++ "ptype charactervla"
++
++gdb_test "print intvla(5,5,5)" " = 1" "print intvla(5,5,5) (1st)"
++gdb_test "print realvla(5,5,5)" " = 3.14\\d+" \
++ "print realvla(5,5,5) (1st)"
++gdb_test "print complexvla(5,5,5)" " = \\\(2,-3\\\)" \
++ "print complexvla(5,5,5) (1st)"
++gdb_test "print logicalvla(5,5,5)" " = \\.TRUE\\." \
++ "print logicalvla(5,5,5) (1st)"
++gdb_test "print charactervla(5,5,5)" " = 'K'" \
++ "print charactervla(5,5,5) (1st)"
++
++gdb_breakpoint [gdb_get_line_number "vlas-modified"]
++gdb_continue_to_breakpoint "vlas-modified"
++gdb_test "print intvla(5,5,5)" " = 42" "print intvla(5,5,5) (2nd)"
++gdb_test "print realvla(5,5,5)" " = 4.13\\d+" \
++ "print realvla(5,5,5) (2nd)"
++gdb_test "print complexvla(5,5,5)" " = \\\(-3,2\\\)" \
++ "print complexvla(5,5,5) (2nd)"
++gdb_test "print logicalvla(5,5,5)" " = \\.FALSE\\." \
++ "print logicalvla(5,5,5) (2nd)"
++gdb_test "print charactervla(5,5,5)" " = 'X'" \
++ "print charactervla(5,5,5) (2nd)"
+diff --git a/gdb/testsuite/gdb.fortran/vla-datatypes.f90 b/gdb/testsuite/gdb.fortran/vla-datatypes.f90
+new file mode 100644
+index 0000000..b11879a
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-datatypes.f90
+@@ -0,0 +1,51 @@
++! 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_primitives
++ integer, allocatable :: intvla(:, :, :)
++ real, allocatable :: realvla(:, :, :)
++ complex, allocatable :: complexvla(:, :, :)
++ logical, allocatable :: logicalvla(:, :, :)
++ character, allocatable :: charactervla(:, :, :)
++ logical :: l
++
++ allocate (intvla (11,22,33))
++ allocate (realvla (11,22,33))
++ allocate (complexvla (11,22,33))
++ allocate (logicalvla (11,22,33))
++ allocate (charactervla (11,22,33))
++
++ l = allocated(intvla) ! vlas-allocated
++ l = allocated(realvla)
++ l = allocated(complexvla)
++ l = allocated(logicalvla)
++ l = allocated(charactervla)
++
++ intvla(:,:,:) = 1
++ realvla(:,:,:) = 3.14
++ complexvla(:,:,:) = cmplx(2.0,-3.0)
++ logicalvla(:,:,:) = .TRUE.
++ charactervla(:,:,:) = char(75)
++
++ intvla(5,5,5) = 42 ! vlas-initialized
++ realvla(5,5,5) = 4.13
++ complexvla(5,5,5) = cmplx(-3.0,2.0)
++ logicalvla(5,5,5) = .FALSE.
++ charactervla(5,5,5) = 'X'
++
++ ! dummy statement for bp
++ l = .FALSE. ! vlas-modified
++end program vla_primitives
+diff --git a/gdb/testsuite/gdb.fortran/vla-func.exp b/gdb/testsuite/gdb.fortran/vla-func.exp
+new file mode 100644
+index 0000000..f0f236b
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-func.exp
+@@ -0,0 +1,61 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++# Check VLA passed to first Fortran function.
++gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]
++gdb_continue_to_breakpoint "func1-vla-passed"
++gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \
++ "print vla (func1)"
++gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \
++ "ptype vla (func1)"
++
++gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]
++gdb_continue_to_breakpoint "func1-vla-modified"
++gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"
++gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"
++
++# Check if the values are correct after returning from func1
++gdb_breakpoint [gdb_get_line_number "func1-returned"]
++gdb_continue_to_breakpoint "func1-returned"
++gdb_test "print ret" " = .TRUE." "print ret after func1 returned"
++
++# Check VLA passed to second Fortran function
++gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]
++gdb_continue_to_breakpoint "func2-vla-passed"
++gdb_test "print vla" \
++ " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \
++ "print vla (func2)"
++gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
++ "ptype vla (func2)"
++
++# Check if the returned VLA has the correct values and ptype.
++gdb_breakpoint [gdb_get_line_number "func2-returned"]
++gdb_continue_to_breakpoint "func2-returned"
++gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \
++ "print vla3 (after func2)"
++gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
++ "ptype vla3 (after func2)"
+diff --git a/gdb/testsuite/gdb.fortran/vla-func.f90 b/gdb/testsuite/gdb.fortran/vla-func.f90
+new file mode 100644
+index 0000000..4f45da1
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-func.f90
+@@ -0,0 +1,71 @@
++! 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.
++
++logical function func1 (vla)
++ implicit none
++ integer, allocatable :: vla (:, :)
++ func1 = allocated(vla)
++ vla(5,5) = 55 ! func1-vla-passed
++ vla(7,7) = 77
++ return ! func1-vla-modified
++end function func1
++
++function func2(vla)
++ implicit none
++ integer :: vla (:)
++ integer :: func2(size(vla))
++ integer :: k
++
++ vla(1) = 1 ! func2-vla-passed
++ vla(2) = 2
++ vla(4) = 4
++ vla(8) = 8
++
++ func2 = vla
++end function func2
++
++program vla_func
++ implicit none
++ interface
++ logical function func1 (vla)
++ integer :: vla (:, :)
++ end function
++ end interface
++ interface
++ function func2 (vla)
++ integer :: vla (:)
++ integer func2(size(vla))
++ end function
++ end interface
++
++ logical :: ret
++ integer, allocatable :: vla1 (:, :)
++ integer, allocatable :: vla2 (:)
++ integer, allocatable :: vla3 (:)
++
++ ret = .FALSE.
++
++ allocate (vla1 (10,10))
++ vla1(:,:) = 22
++
++ allocate (vla2 (10))
++ vla2(:) = 44
++
++ ret = func1(vla1)
++ vla3 = func2(vla2) ! func1-returned
++
++ ret = .TRUE. ! func2-returned
++end program vla_func
+diff --git a/gdb/testsuite/gdb.fortran/vla-history.exp b/gdb/testsuite/gdb.fortran/vla-history.exp
+new file mode 100644
+index 0000000..170e1eb
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-history.exp
+@@ -0,0 +1,62 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla.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
++}
++
++# Set some breakpoints and print complete vla.
++gdb_breakpoint [gdb_get_line_number "vla1-init"]
++gdb_continue_to_breakpoint "vla1-init"
++gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
++
++gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
++gdb_continue_to_breakpoint "vla2-allocated"
++gdb_test "print vla1" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
++ "print vla1 allocated"
++gdb_test "print vla2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
++ "print vla2 allocated"
++
++gdb_breakpoint [gdb_get_line_number "vla1-filled"]
++gdb_continue_to_breakpoint "vla1-filled"
++gdb_test "print vla1" \
++ " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \
++ "print vla1 filled"
++
++# Try to access history values for full vla prints.
++gdb_test "print \$1" " = <not allocated>" "print \$1"
++gdb_test "print \$2" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
++ "print \$2"
++gdb_test "print \$3" " = \\( *\\( *\\( *0, *0, *0,\[()0, .\]*\\)" \
++ "print \$3"
++gdb_test "print \$4" \
++ " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" "print \$4"
++
++gdb_breakpoint [gdb_get_line_number "vla2-filled"]
++gdb_continue_to_breakpoint "vla2-filled"
++gdb_test "print vla2(1,43,20)" " = 1311" "print vla2(1,43,20)"
++gdb_test "print vla1(1,3,8)" " = 1001" "print vla2(1,3,8)"
++
++# Try to access history values for vla values.
++gdb_test "print \$9" " = 1311" "print \$9"
++gdb_test "print \$10" " = 1001" "print \$10"
+diff --git a/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp
+new file mode 100644
+index 0000000..2ee2914
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-ptype-sub.exp
+@@ -0,0 +1,87 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla-sub.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
++}
++
++# Pass fixed array to function and handle them as vla in function.
++gdb_breakpoint [gdb_get_line_number "not-filled"]
++gdb_continue_to_breakpoint "not-filled (1st)"
++gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(42,42\\\)" \
++ "ptype array1 (passed fixed)"
++gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(42,42,42\\\)" \
++ "ptype array2 (passed fixed)"
++gdb_test "ptype array1(40, 10)" "type = integer\\\(kind=4\\\)" \
++ "ptype array1(40, 10) (passed fixed)"
++gdb_test "ptype array2(13, 11, 5)" "type = real\\\(kind=4\\\)" \
++ "ptype array2(13, 11, 5) (passed fixed)"
++
++# Pass sub arrays to function and handle them as vla in function.
++gdb_continue_to_breakpoint "not-filled (2nd)"
++gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(6,6\\\)" \
++ "ptype array1 (passed sub-array)"
++gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(6,6,6\\\)" \
++ "ptype array2 (passed sub-array)"
++gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \
++ "ptype array1(3, 3) (passed sub-array)"
++gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \
++ "ptype array2(4, 4, 4) (passed sub-array)"
++
++# Check ptype outside of bounds. This should not crash GDB.
++gdb_test "ptype array1(100, 100)" "no such vector element" \
++ "ptype array1(100, 100) subarray do not crash (passed sub-array)"
++gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
++ "ptype array2(100, 100, 100) subarray do not crash (passed sub-array)"
++
++# Pass vla to function.
++gdb_continue_to_breakpoint "not-filled (3rd)"
++gdb_test "ptype array1" "type = integer\\\(kind=4\\\) \\\(20,20\\\)" \
++ "ptype array1 (passed vla)"
++gdb_test "ptype array2" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
++ "ptype array2 (passed vla)"
++gdb_test "ptype array1(3, 3)" "type = integer\\\(kind=4\\\)" \
++ "ptype array1(3, 3) (passed vla)"
++gdb_test "ptype array2(4, 4, 4)" "type = real\\\(kind=4\\\)" \
++ "ptype array2(4, 4, 4) (passed vla)"
++
++# Check ptype outside of bounds. This should not crash GDB.
++gdb_test "ptype array1(100, 100)" "no such vector element" \
++ "ptype array1(100, 100) VLA do not crash (passed vla)"
++gdb_test "ptype array2(100, 100, 100)" "no such vector element" \
++ "ptype array2(100, 100, 100) VLA do not crash (passed vla)"
++
++# Pass fixed array to function and handle it as VLA of arbitrary length in
++# function.
++gdb_breakpoint [gdb_get_line_number "end-of-bar"]
++gdb_continue_to_breakpoint "end-of-bar"
++gdb_test "ptype array1" \
++ "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" \
++ "ptype array1 (arbitrary length)"
++gdb_test "ptype array2" \
++ "type = (PTR TO -> \\( )?integer(\\(kind=4\\)|\\*4) \\(4:9,10:\\*\\)\\)?" \
++ "ptype array2 (arbitrary length)"
++gdb_test "ptype array1(100)" "type = integer\\\(kind=4\\\)" \
++ "ptype array1(100) (arbitrary length)"
++gdb_test "ptype array2(4,100)" "type = integer\\\(kind=4\\\)" \
++ "ptype array2(4,100) (arbitrary length)"
+diff --git a/gdb/testsuite/gdb.fortran/vla-ptype.exp b/gdb/testsuite/gdb.fortran/vla-ptype.exp
+new file mode 100644
+index 0000000..9267723
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-ptype.exp
+@@ -0,0 +1,96 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla.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
++}
++
++# Check the ptype of various VLA states and pointer to VLA's.
++gdb_breakpoint [gdb_get_line_number "vla1-init"]
++gdb_continue_to_breakpoint "vla1-init"
++gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized"
++gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
++gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
++gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
++ "ptype vla1(3, 6, 9) not initialized"
++gdb_test "ptype vla2(5, 45, 20)" \
++ "no such vector element because not allocated" \
++ "ptype vla1(5, 45, 20) not initialized"
++
++gdb_breakpoint [gdb_get_line_number "vla1-allocated"]
++gdb_continue_to_breakpoint "vla1-allocated"
++gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
++ "ptype vla1 allocated"
++
++gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
++gdb_continue_to_breakpoint "vla2-allocated"
++gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
++ "ptype vla2 allocated"
++
++gdb_breakpoint [gdb_get_line_number "vla1-filled"]
++gdb_continue_to_breakpoint "vla1-filled"
++gdb_test "ptype vla1" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
++ "ptype vla1 filled"
++gdb_test "ptype vla1(3, 6, 9)" "type = real\\\(kind=4\\\)" \
++ "ptype vla1(3, 6, 9)"
++
++gdb_breakpoint [gdb_get_line_number "vla2-filled"]
++gdb_continue_to_breakpoint "vla2-filled"
++gdb_test "ptype vla2" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
++ "ptype vla2 filled"
++gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \
++ "ptype vla1(5, 45, 20) filled"
++
++gdb_breakpoint [gdb_get_line_number "pvla-associated"]
++gdb_continue_to_breakpoint "pvla-associated"
++gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(10,10,10\\\)" \
++ "ptype pvla associated"
++gdb_test "ptype pvla(3, 6, 9)" "type = real\\\(kind=4\\\)" \
++ "ptype pvla(3, 6, 9)"
++
++gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
++gdb_continue_to_breakpoint "pvla-re-associated"
++gdb_test "ptype pvla" "type = real\\\(kind=4\\\) \\\(7,42:50,13:35\\\)" \
++ "ptype pvla re-associated"
++gdb_test "ptype vla2(5, 45, 20)" "type = real\\\(kind=4\\\)" \
++ "ptype vla1(5, 45, 20) re-associated"
++
++gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
++gdb_continue_to_breakpoint "pvla-deassociated"
++gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
++gdb_test "ptype pvla(5, 45, 20)" \
++ "no such vector element because not associated" \
++ "ptype pvla(5, 45, 20) not associated"
++
++gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
++gdb_continue_to_breakpoint "vla1-deallocated"
++gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
++gdb_test "ptype vla1(3, 6, 9)" "no such vector element because not allocated" \
++ "ptype vla1(3, 6, 9) not allocated"
++
++gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
++gdb_continue_to_breakpoint "vla2-deallocated"
++gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
++gdb_test "ptype vla2(5, 45, 20)" \
++ "no such vector element because not allocated" \
++ "ptype vla2(5, 45, 20) not allocated"
+diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+new file mode 100644
+index 0000000..6053c17
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+@@ -0,0 +1,46 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla.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
++}
++
++# Try to access values in non allocated VLA
++gdb_breakpoint [gdb_get_line_number "vla1-init"]
++gdb_continue_to_breakpoint "vla1-init"
++gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1"
++
++# Try to access value in allocated VLA
++gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
++gdb_continue_to_breakpoint "vla2-allocated"
++gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1"
++
++# Try to access values in undefined pointer to VLA (dangling)
++gdb_breakpoint [gdb_get_line_number "vla1-filled"]
++gdb_continue_to_breakpoint "vla1-filled"
++gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla"
++
++# Try to access values in pointer to VLA and compare them
++gdb_breakpoint [gdb_get_line_number "pvla-associated"]
++gdb_continue_to_breakpoint "pvla-associated"
++gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
+diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp
+new file mode 100644
+index 0000000..35f585d
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
+@@ -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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
++gdb_continue_to_breakpoint "re-reverse-elements"
++gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
++ "print re-reverse-elements"
++gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
++gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
++
++gdb_breakpoint [gdb_get_line_number "odd-elements"]
++gdb_continue_to_breakpoint "odd-elements"
++gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
++gdb_test "print pvla(1)" " = 1" "print first odd-element"
++gdb_test "print pvla(5)" " = 9" "print last odd-element"
++
++gdb_breakpoint [gdb_get_line_number "single-element"]
++gdb_continue_to_breakpoint "single-element"
++gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
++gdb_test "print pvla(1)" " = 5" "print one single-element"
+diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90
+new file mode 100644
+index 0000000..6aa4f2b
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-stride.f90
+@@ -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
+diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp
+new file mode 100644
+index 0000000..7fc1734
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-strings.exp
+@@ -0,0 +1,104 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++# check that all fortran standard datatypes will be
++# handled correctly when using as VLA's
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
++gdb_continue_to_breakpoint "var_char-allocated-1"
++gdb_test "print var_char" \
++ " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \
++ "print var_char after allocated first time"
++gdb_test "print *var_char" \
++ " = '\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000\\\\000'" \
++ "print *var_char after allocated first time"
++gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10 \\)" \
++ "whatis var_char first time"
++gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10 \\)" \
++ "ptype var_char first time"
++gdb_test "next" "\\d+.*var_char = 'foo'.*" \
++ "next to allocation status of var_char"
++gdb_test "print l" " = .TRUE." "print allocation status first time"
++
++gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]
++gdb_continue_to_breakpoint "var_char-filled-1"
++gdb_test "print var_char" \
++ " = \\(PTR TO -> \\( character\\*3 \\)\\) ${hex}" \
++ "print var_char after filled first time"
++gdb_test "print *var_char" " = 'foo'" \
++ "print *var_char after filled first time"
++gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3 \\)" \
++ "whatis var_char after filled first time"
++gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3 \\)" \
++ "ptype var_char after filled first time"
++gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"
++gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"
++
++gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]
++gdb_continue_to_breakpoint "var_char-filled-2"
++gdb_test "print var_char" \
++ " = \\(PTR TO -> \\( character\\*6 \\)\\) ${hex}" \
++ "print var_char after allocated second time"
++gdb_test "print *var_char" " = 'foobar'" \
++ "print *var_char after allocated second time"
++gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6 \\)" \
++ "whatis var_char second time"
++gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6 \\)" \
++ "ptype var_char second time"
++
++gdb_breakpoint [gdb_get_line_number "var_char-empty"]
++gdb_continue_to_breakpoint "var_char-empty"
++gdb_test "print var_char" \
++ " = \\(PTR TO -> \\( character\\*0 \\)\\) ${hex}" \
++ "print var_char after set empty"
++gdb_test "print *var_char" " = \"\"" "print *var_char after set empty"
++gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0 \\)" \
++ "whatis var_char after set empty"
++gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0 \\)" \
++ "ptype var_char after set empty"
++
++gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"]
++gdb_continue_to_breakpoint "var_char-allocated-3"
++gdb_test "print var_char" \
++ " = \\(PTR TO -> \\( character\\*21 \\)\\) ${hex}" \
++ "print var_char after allocated third time"
++gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21 \\)" \
++ "whatis var_char after allocated third time"
++gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21 \\)" \
++ "ptype var_char after allocated third time"
++
++gdb_breakpoint [gdb_get_line_number "var_char_p-associated"]
++gdb_continue_to_breakpoint "var_char_p-associated"
++gdb_test "print var_char_p" \
++ " = \\(PTR TO -> \\( character\\*7 \\)\\) ${hex}" \
++ "print var_char_p after associated"
++gdb_test "print *var_char_p" " = 'johndoe'" \
++ "print *var_char_ after associated"
++gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
++ "whatis var_char_p after associated"
++gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7 \\)" \
++ "ptype var_char_p after associated"
+diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90
+new file mode 100644
+index 0000000..0a1d522
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-strings.f90
+@@ -0,0 +1,40 @@
++! 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_strings
++ character(len=:), target, allocatable :: var_char
++ character(len=:), pointer :: var_char_p
++ logical :: l
++
++ allocate(character(len=10) :: var_char)
++ l = allocated(var_char) ! var_char-allocated-1
++ var_char = 'foo'
++ deallocate(var_char) ! var_char-filled-1
++ l = allocated(var_char) ! var_char-deallocated
++ allocate(character(len=42) :: var_char)
++ l = allocated(var_char)
++ var_char = 'foobar'
++ var_char = '' ! var_char-filled-2
++ var_char = 'bar' ! var_char-empty
++ deallocate(var_char)
++ allocate(character(len=21) :: var_char)
++ l = allocated(var_char) ! var_char-allocated-3
++ var_char = 'johndoe'
++ var_char_p => var_char
++ l = associated(var_char_p) ! var_char_p-associated
++ var_char_p => null()
++ l = associated(var_char_p) ! var_char_p-not-associated
++end program vla_strings
+diff --git a/gdb/testsuite/gdb.fortran/vla-sub.f90 b/gdb/testsuite/gdb.fortran/vla-sub.f90
+new file mode 100644
+index 0000000..8c2c9ff
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-sub.f90
+@@ -0,0 +1,82 @@
++! 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.
++!
++! Original file written by Jakub Jelinek <jakub@redhat.com> and
++! Jan Kratochvil <jan.kratochvil@redhat.com>.
++! Modified for the GDB testcases by Keven Boell <keven.boell@intel.com>.
++
++subroutine foo (array1, array2)
++ integer :: array1 (:, :)
++ real :: array2 (:, :, :)
++
++ array1(:,:) = 5 ! not-filled
++ array1(1, 1) = 30
++
++ array2(:,:,:) = 6 ! array1-filled
++ array2(:,:,:) = 3
++ array2(1,1,1) = 30
++ array2(3,3,3) = 90 ! array2-almost-filled
++end subroutine
++
++subroutine bar (array1, array2)
++ integer :: array1 (*)
++ integer :: array2 (4:9, 10:*)
++
++ array1(5:10) = 1311
++ array1(7) = 1
++ array1(100) = 100
++ array2(4,10) = array1(7)
++ array2(4,100) = array1(7)
++ return ! end-of-bar
++end subroutine
++
++program vla_sub
++ interface
++ subroutine foo (array1, array2)
++ integer :: array1 (:, :)
++ real :: array2 (:, :, :)
++ end subroutine
++ end interface
++ interface
++ subroutine bar (array1, array2)
++ integer :: array1 (*)
++ integer :: array2 (4:9, 10:*)
++ end subroutine
++ end interface
++
++ real, allocatable :: vla1 (:, :, :)
++ integer, allocatable :: vla2 (:, :)
++
++ ! used for subroutine
++ integer :: sub_arr1(42, 42)
++ real :: sub_arr2(42, 42, 42)
++ integer :: sub_arr3(42)
++
++ sub_arr1(:,:) = 1 ! vla2-deallocated
++ sub_arr2(:,:,:) = 2
++ sub_arr3(:) = 3
++
++ call foo(sub_arr1, sub_arr2)
++ call foo(sub_arr1(5:10, 5:10), sub_arr2(10:15,10:15,10:15))
++
++ allocate (vla1 (10,10,10))
++ allocate (vla2 (20,20))
++ vla1(:,:,:) = 1311
++ vla2(:,:) = 42
++ call foo(vla2, vla1)
++
++ call bar(sub_arr3, sub_arr1)
++end program vla_sub
+diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp
+new file mode 100644
+index 0000000..fd11adb
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp
+@@ -0,0 +1,35 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla-sub.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
++}
++
++# Check VLA with arbitary length and check that elements outside of
++# bounds of the passed VLA can be accessed correctly.
++gdb_breakpoint [gdb_get_line_number "end-of-bar"]
++gdb_continue_to_breakpoint "end-of-bar"
++gdb_test "p array1(42)" " = 3" "print arbitary array1(42)"
++gdb_test "p array1(100)" " = 100" "print arbitary array1(100)"
++gdb_test "p array2(4,10)" " = 1" "print arbitary array2(4,10)"
++gdb_test "p array2(4,100)" " = 1" "print arbitary array2(4,100)"
+diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp
+new file mode 100644
+index 0000000..a163617
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp
+@@ -0,0 +1,49 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla-sub.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
++}
++
++# "up" works with GCC but other Fortran compilers may copy the values into the
++# outer function only on the exit of the inner function.
++# We need both variants as depending on the arch we optionally may still be
++# executing the caller line or not after `finish'.
++
++gdb_breakpoint [gdb_get_line_number "array2-almost-filled"]
++gdb_continue_to_breakpoint "array2-almost-filled"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was filled"
++gdb_test "print array2(2,1,1)=20" " = 20" \
++ "set array(2,2,2) to 20 in subroutine"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was mofified in debugger"
++
++gdb_test "finish" \
++ ".*foo\\\(sub_arr1\\\(5:10, 5:10\\\), sub_arr2\\\(10:15,10:15,10:15\\\)\\\)" \
++ "finish function"
++gdb_test "p sub_arr1(5, 7)" " = 5" "sub_arr1(5, 7) after finish"
++gdb_test "p sub_arr1(1, 1)" " = 30" "sub_arr1(1, 1) after finish"
++gdb_test "p sub_arr2(1, 1, 1)" " = 30" "sub_arr2(1, 1, 1) after finish"
++gdb_test "p sub_arr2(2, 1, 1)" " = 20" "sub_arr2(2, 1, 1) after finish"
++
+diff --git a/gdb/testsuite/gdb.fortran/vla-value-sub.exp b/gdb/testsuite/gdb.fortran/vla-value-sub.exp
+new file mode 100644
+index 0000000..848f9d7
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-value-sub.exp
+@@ -0,0 +1,90 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla-sub.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
++}
++
++# Check the values of VLA's in subroutine can be evaluated correctly
++
++# Try to access values from a fixed array handled as VLA in subroutine.
++gdb_breakpoint [gdb_get_line_number "not-filled"]
++gdb_continue_to_breakpoint "not-filled (1st)"
++gdb_test "print array1" " = \\(\[()1, .\]*\\)" \
++ "print passed array1 in foo (passed fixed array)"
++
++gdb_breakpoint [gdb_get_line_number "array1-filled"]
++gdb_continue_to_breakpoint "array1-filled (1st)"
++gdb_test "print array1(5, 7)" " = 5" \
++ "print array1(5, 7) after filled in foo (passed fixed array)"
++gdb_test "print array1(1, 1)" " = 30" \
++ "print array1(1, 1) after filled in foo (passed fixed array)"
++
++gdb_breakpoint [gdb_get_line_number "array2-almost-filled"]
++gdb_continue_to_breakpoint "array2-almost-filled (1st)"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was filled (passed fixed array)"
++gdb_test "print array2(2,1,1)=20" " = 20" \
++ "set array(2,2,2) to 20 in subroutine (passed fixed array)"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was mofified in debugger (passed fixed array)"
++
++
++# Try to access values from a fixed sub-array handled as VLA in subroutine.
++gdb_continue_to_breakpoint "not-filled (2nd)"
++gdb_test "print array1" " = \\(\[()5, .\]*\\)" \
++ "print passed array1 in foo (passed sub-array)"
++
++gdb_continue_to_breakpoint "array1-filled (2nd)"
++gdb_test "print array1(5, 5)" " = 5" \
++ "print array1(5, 5) after filled in foo (passed sub-array)"
++gdb_test "print array1(1, 1)" " = 30" \
++ "print array1(1, 1) after filled in foo (passed sub-array)"
++
++gdb_continue_to_breakpoint "array2-almost-filled (2nd)"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was filled (passed sub-array)"
++gdb_test "print array2(2,1,1)=20" " = 20" \
++ "set array(2,2,2) to 20 in subroutine (passed sub-array)"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was mofified in debugger (passed sub-array)"
++
++
++# Try to access values from a VLA passed to subroutine.
++gdb_continue_to_breakpoint "not-filled (3rd)"
++gdb_test "print array1" " = \\(\[()42, .\]*\\)" \
++ "print passed array1 in foo (passed vla)"
++
++gdb_continue_to_breakpoint "array1-filled (3rd)"
++gdb_test "print array1(5, 5)" " = 5" \
++ "print array1(5, 5) after filled in foo (passed vla)"
++gdb_test "print array1(1, 1)" " = 30" \
++ "print array1(1, 1) after filled in foo (passed vla)"
++
++gdb_continue_to_breakpoint "array2-almost-filled (3rd)"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *3, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was filled (passed vla)"
++gdb_test "print array2(2,1,1)=20" " = 20" \
++ "set array(2,2,2) to 20 in subroutine (passed vla)"
++gdb_test "print array2" " = \\( *\\( *\\( *30, *20, *3,\[()3, .\]*\\)" \
++ "print array2 in foo after it was mofified in debugger (passed vla)"
+diff --git a/gdb/testsuite/gdb.fortran/vla-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp
+new file mode 100644
+index 0000000..d7b8a1e
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-value.exp
+@@ -0,0 +1,148 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile "vla.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
++}
++
++# Try to access values in non allocated VLA
++gdb_breakpoint [gdb_get_line_number "vla1-init"]
++gdb_continue_to_breakpoint "vla1-init"
++gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
++gdb_test "print &vla1" \
++ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \
++ "print non-allocated &vla1"
++gdb_test "print vla1(1,1,1)" "no such vector element because not allocated" \
++ "print member in non-allocated vla1 (1)"
++gdb_test "print vla1(101,202,303)" \
++ "no such vector element because not allocated" \
++ "print member in non-allocated vla1 (2)"
++gdb_test "print vla1(5,2,18)=1" "no such vector element because not allocated" \
++ "set member in non-allocated vla1"
++
++# Try to access value in allocated VLA
++gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
++gdb_continue_to_breakpoint "vla2-allocated"
++gdb_test "next" "\\d+(\\t|\\s)+vla1\\\(3, 6, 9\\\) = 42" \
++ "step over value assignment of vla1"
++gdb_test "print &vla1" \
++ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
++ "print allocated &vla1"
++gdb_test "print vla1(3, 6, 9)" " = 1311" "print allocated vla1(3,6,9)"
++gdb_test "print vla1(1, 3, 8)" " = 1311" "print allocated vla1(1,3,8)"
++gdb_test "print vla1(9, 9, 9) = 999" " = 999" \
++ "print allocated vla1(9,9,9)=1"
++
++# Try to access values in allocated VLA after specific assignment
++gdb_breakpoint [gdb_get_line_number "vla1-filled"]
++gdb_continue_to_breakpoint "vla1-filled"
++gdb_test "print vla1(3, 6, 9)" " = 42" \
++ "print allocated vla1(3,6,9) after specific assignment (filled)"
++gdb_test "print vla1(1, 3, 8)" " = 1001" \
++ "print allocated vla1(1,3,8) after specific assignment (filled)"
++gdb_test "print vla1(9, 9, 9)" " = 999" \
++ "print allocated vla1(9,9,9) after assignment in debugger (filled)"
++
++# Try to access values in undefined pointer to VLA (dangling)
++gdb_test "print pvla" " = <not associated>" "print undefined pvla"
++gdb_test "print &pvla" \
++ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \
++ "print non-associated &pvla"
++gdb_test "print pvla(1, 3, 8)" "no such vector element because not associated" \
++ "print undefined pvla(1,3,8)"
++
++# Try to access values in pointer to VLA and compare them
++gdb_breakpoint [gdb_get_line_number "pvla-associated"]
++gdb_continue_to_breakpoint "pvla-associated"
++gdb_test "print &pvla" \
++ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
++ "print associated &pvla"
++gdb_test "print pvla(3, 6, 9)" " = 42" "print associated pvla(3,6,9)"
++gdb_test "print pvla(1, 3, 8)" " = 1001" "print associated pvla(1,3,8)"
++gdb_test "print pvla(9, 9, 9)" " = 999" "print associated pvla(9,9,9)"
++
++# Fill values to VLA using pointer and check
++gdb_breakpoint [gdb_get_line_number "pvla-re-associated"]
++gdb_continue_to_breakpoint "pvla-re-associated"
++gdb_test "print pvla(5, 45, 20)" \
++ " = 1" "print pvla(5, 45, 20) after filled using pointer"
++gdb_test "print vla2(5, 45, 20)" \
++ " = 1" "print vla2(5, 45, 20) after filled using pointer"
++gdb_test "print pvla(7, 45, 14)" " = 2" \
++ "print pvla(7, 45, 14) after filled using pointer"
++gdb_test "print vla2(7, 45, 14)" " = 2" \
++ "print vla2(7, 45, 14) after filled using pointer"
++
++# Try to access values of deassociated VLA pointer
++gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
++gdb_continue_to_breakpoint "pvla-deassociated"
++gdb_test "print pvla(5, 45, 20)" \
++ "no such vector element because not associated" \
++ "print pvla(5, 45, 20) after deassociated"
++gdb_test "print pvla(7, 45, 14)" \
++ "no such vector element because not associated" \
++ "print pvla(7, 45, 14) after dissasociated"
++gdb_test "print pvla" " = <not associated>" \
++ "print vla1 after deassociated"
++
++# Try to access values of deallocated VLA
++gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
++gdb_continue_to_breakpoint "vla1-deallocated"
++gdb_test "print vla1(3, 6, 9)" "no such vector element because not allocated" \
++ "print allocated vla1(3,6,9) after specific assignment (deallocated)"
++gdb_test "print vla1(1, 3, 8)" "no such vector element because not allocated" \
++ "print allocated vla1(1,3,8) after specific assignment (deallocated)"
++gdb_test "print vla1(9, 9, 9)" "no such vector element because not allocated" \
++ "print allocated vla1(9,9,9) after assignment in debugger (deallocated)"
++
++
++# Try to assign VLA to user variable
++clean_restart ${testfile}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++gdb_breakpoint [gdb_get_line_number "vla2-allocated"]
++gdb_continue_to_breakpoint "vla2-allocated"
++gdb_test "next" "\\d+.*vla1\\(3, 6, 9\\) = 42" "next (1)"
++
++gdb_test_no_output "set \$myvar = vla1" "set \$myvar = vla1"
++gdb_test "print \$myvar" \
++ " = \\( *\\( *\\( *1311, *1311, *1311,\[()1311, .\]*\\)" \
++ "print \$myvar set to vla1"
++
++gdb_test "next" "\\d+.*vla1\\(1, 3, 8\\) = 1001" "next (2)"
++gdb_test "print \$myvar(3,6,9)" " = 1311" "print \$myvar(3,6,9)"
++
++gdb_breakpoint [gdb_get_line_number "pvla-associated"]
++gdb_continue_to_breakpoint "pvla-associated"
++gdb_test_no_output "set \$mypvar = pvla" "set \$mypvar = pvla"
++gdb_test "print \$mypvar(1,3,8)" " = 1001" "print \$mypvar(1,3,8)"
++
++# deallocate pointer and make sure user defined variable still has the
++# right value.
++gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
++gdb_continue_to_breakpoint "pvla-deassociated"
++gdb_test "print \$mypvar(1,3,8)" " = 1001" \
++ "print \$mypvar(1,3,8) after deallocated"
+diff --git a/gdb/testsuite/gdb.fortran/vla.f90 b/gdb/testsuite/gdb.fortran/vla.f90
+new file mode 100644
+index 0000000..73425f3
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla.f90
+@@ -0,0 +1,56 @@
++! 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 <http://www.gnu.org/licenses/>.
++
++program vla
++ real, target, allocatable :: vla1 (:, :, :)
++ real, target, allocatable :: vla2 (:, :, :)
++ real, target, allocatable :: vla3 (:, :)
++ real, pointer :: pvla (:, :, :)
++ logical :: l
++
++ allocate (vla1 (10,10,10)) ! vla1-init
++ l = allocated(vla1)
++
++ allocate (vla2 (1:7,42:50,13:35)) ! vla1-allocated
++ l = allocated(vla2)
++
++ vla1(:, :, :) = 1311 ! vla2-allocated
++ vla1(3, 6, 9) = 42
++ vla1(1, 3, 8) = 1001
++ vla1(6, 2, 7) = 13
++
++ vla2(:, :, :) = 1311 ! vla1-filled
++ vla2(5, 45, 20) = 42
++
++ pvla => vla1 ! vla2-filled
++ l = associated(pvla)
++
++ pvla => vla2 ! pvla-associated
++ l = associated(pvla)
++ pvla(5, 45, 20) = 1
++ pvla(7, 45, 14) = 2
++
++ pvla => null() ! pvla-re-associated
++ l = associated(pvla)
++
++ deallocate (vla1) ! pvla-deassociated
++ l = allocated(vla1)
++
++ deallocate (vla2) ! vla1-deallocated
++ l = allocated(vla2)
++
++ allocate (vla3 (2,2)) ! vla2-deallocated
++ vla3(:,:) = 13
++end program vla
+diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+new file mode 100644
+index 0000000..72b0be2
+--- /dev/null
++++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+@@ -0,0 +1,182 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++# Verify that, using the MI, we can evaluate a simple C Variable Length
++# Array (VLA).
++
++load_lib mi-support.exp
++set MIFLAGS "-i=mi"
++
++gdb_exit
++if [mi_gdb_start] {
++ continue
++}
++
++standard_testfile vla.f90
++
++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable \
++ {debug f90}] != "" } {
++ untested mi-vla-fortran.exp
++ return -1
++}
++
++mi_delete_breakpoints
++mi_gdb_reinitialize_dir $srcdir/$subdir
++mi_gdb_load ${binfile}
++
++set bp_lineno [gdb_get_line_number "vla1-not-allocated"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 1 "del" "vla" \
++ ".*vla.f90" $bp_lineno $hex \
++ "insert breakpoint at line $bp_lineno (vla not allocated)"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "500-data-evaluate-expression vla1" \
++ "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
++
++mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
++ "create local variable vla1_not_allocated"
++mi_gdb_test "501-var-info-type vla1_not_allocated" \
++ "501\\^done,type=\"<not allocated>\"" \
++ "info type variable vla1_not_allocated"
++mi_gdb_test "502-var-show-format vla1_not_allocated" \
++ "502\\^done,format=\"natural\"" \
++ "show format variable vla1_not_allocated"
++mi_gdb_test "503-var-evaluate-expression vla1_not_allocated" \
++ "503\\^done,value=\"\\\[0\\\]\"" \
++ "eval variable vla1_not_allocated"
++mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
++ "real\\\(kind=4\\\)" "get children of vla1_not_allocated"
++
++
++
++set bp_lineno [gdb_get_line_number "vla1-allocated"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 2 "del" "vla" ".*vla.f90" \
++ $bp_lineno $hex "insert breakpoint at line $bp_lineno (vla allocated)"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "510-data-evaluate-expression vla1" \
++ "510\\^done,value=\"\\(0, 0, 0, 0, 0\\)\"" "evaluate allocated vla"
++
++mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \
++ "create local variable vla1_allocated"
++mi_gdb_test "511-var-info-type vla1_allocated" \
++ "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \
++ "info type variable vla1_allocated"
++mi_gdb_test "512-var-show-format vla1_allocated" \
++ "512\\^done,format=\"natural\"" \
++ "show format variable vla1_allocated"
++mi_gdb_test "513-var-evaluate-expression vla1_allocated" \
++ "513\\^done,value=\"\\\[5\\\]\"" \
++ "eval variable vla1_allocated"
++mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
++ "real\\\(kind=4\\\)" "get children of vla1_allocated"
++
++
++set bp_lineno [gdb_get_line_number "vla1-filled"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 3 "del" "vla" ".*vla.f90" \
++ $bp_lineno $hex "insert breakpoint at line $bp_lineno"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "520-data-evaluate-expression vla1" \
++ "520\\^done,value=\"\\(1, 1, 1, 1, 1\\)\"" "evaluate filled vla"
++
++
++set bp_lineno [gdb_get_line_number "vla1-modified"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 4 "del" "vla" ".*vla.f90" \
++ $bp_lineno $hex "insert breakpoint at line $bp_lineno"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "530-data-evaluate-expression vla1" \
++ "530\\^done,value=\"\\(1, 42, 1, 24, 1\\)\"" "evaluate filled vla"
++mi_gdb_test "540-data-evaluate-expression vla1(1)" \
++ "540\\^done,value=\"1\"" "evaluate filled vla"
++mi_gdb_test "550-data-evaluate-expression vla1(2)" \
++ "550\\^done,value=\"42\"" "evaluate filled vla"
++mi_gdb_test "560-data-evaluate-expression vla1(4)" \
++ "560\\^done,value=\"24\"" "evaluate filled vla"
++
++
++set bp_lineno [gdb_get_line_number "vla1-deallocated"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 5 "del" "vla" ".*vla.f90" \
++ $bp_lineno $hex "insert breakpoint at line $bp_lineno"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "570-data-evaluate-expression vla1" \
++ "570\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
++
++
++set bp_lineno [gdb_get_line_number "pvla2-not-associated"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 6 "del" "vla" ".*vla.f90" \
++ $bp_lineno $hex "insert breakpoint at line $bp_lineno"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "580-data-evaluate-expression pvla2" \
++ "580\\^done,value=\"<not associated>\"" "evaluate not associated vla"
++
++mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
++ "create local variable pvla2_not_associated"
++mi_gdb_test "581-var-info-type pvla2_not_associated" \
++ "581\\^done,type=\"<not associated>\"" \
++ "info type variable pvla2_not_associated"
++mi_gdb_test "582-var-show-format pvla2_not_associated" \
++ "582\\^done,format=\"natural\"" \
++ "show format variable pvla2_not_associated"
++mi_gdb_test "583-var-evaluate-expression pvla2_not_associated" \
++ "583\\^done,value=\"\\\[0\\\]\"" \
++ "eval variable pvla2_not_associated"
++mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
++ "real\\\(kind=4\\\)" "get children of pvla2_not_associated"
++
++
++set bp_lineno [gdb_get_line_number "pvla2-associated"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 7 "del" "vla" ".*vla.f90" \
++ $bp_lineno $hex "insert breakpoint at line $bp_lineno"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "590-data-evaluate-expression pvla2" \
++ "590\\^done,value=\"\\(\\( 2, 2, 2, 2, 2\\) \\( 2, 2, 2, 2, 2\\) \\)\"" \
++ "evaluate associated vla"
++
++mi_create_varobj_checked pvla2_associated pvla2 \
++ "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated"
++mi_gdb_test "591-var-info-type pvla2_associated" \
++ "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \
++ "info type variable pvla2_associated"
++mi_gdb_test "592-var-show-format pvla2_associated" \
++ "592\\^done,format=\"natural\"" \
++ "show format variable pvla2_associated"
++mi_gdb_test "593-var-evaluate-expression pvla2_associated" \
++ "593\\^done,value=\"\\\[2\\\]\"" \
++ "eval variable pvla2_associated"
++
++
++set bp_lineno [gdb_get_line_number "pvla2-set-to-null"]
++mi_create_breakpoint "-t vla.f90:$bp_lineno" 8 "del" "vla" ".*vla.f90" \
++ $bp_lineno $hex "insert breakpoint at line $bp_lineno"
++mi_run_cmd
++mi_expect_stop "breakpoint-hit" "vla" "" ".*vla.f90" "$bp_lineno" \
++ { "" "disp=\"del\"" } "run to breakpoint at line $bp_lineno"
++mi_gdb_test "600-data-evaluate-expression pvla2" \
++ "600\\^done,value=\"<not associated>\"" "evaluate vla pointer set to null"
++
++mi_gdb_exit
++return 0
+diff --git a/gdb/testsuite/gdb.mi/vla.f90 b/gdb/testsuite/gdb.mi/vla.f90
+new file mode 100644
+index 0000000..46edad2
+--- /dev/null
++++ b/gdb/testsuite/gdb.mi/vla.f90
+@@ -0,0 +1,42 @@
++! 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 <http://www.gnu.org/licenses/>.
++
++program vla
++ real, allocatable :: vla1 (:)
++ real, target, allocatable :: vla2(:, :)
++ real, pointer :: pvla2 (:, :)
++ logical :: l
++
++ allocate (vla1 (5)) ! vla1-not-allocated
++ l = allocated(vla1) ! vla1-allocated
++
++ vla1(:) = 1
++ vla1(2) = 42 ! vla1-filled
++ vla1(4) = 24
++
++ deallocate (vla1) ! vla1-modified
++ l = allocated(vla1) ! vla1-deallocated
++
++ allocate (vla2 (5, 2))
++ vla2(:, :) = 2
++
++ pvla2 => vla2 ! pvla2-not-associated
++ l = associated(pvla2) ! pvla2-associated
++
++ pvla2(2, 1) = 42
++
++ pvla2 => null()
++ l = associated(pvla2) ! pvla2-set-to-null
++end program vla
+diff --git a/gdb/typeprint.c b/gdb/typeprint.c
+index 026f3a2..4c861ac 100644
+--- a/gdb/typeprint.c
++++ b/gdb/typeprint.c
+@@ -459,6 +459,13 @@ whatis_exp (char *exp, int show)
+
+ type = value_type (val);
+
++ if (TYPE_CODE (type) == TYPE_CODE_PTR)
++ if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
++ {
++ val = value_addr (value_ind (val));
++ type = value_type (val);
++ }
++
+ get_user_print_options (&opts);
+ if (opts.objectprint)
+ {
+diff --git a/gdb/valarith.c b/gdb/valarith.c
+index 4da41cb..fb9671b 100644
+--- a/gdb/valarith.c
++++ b/gdb/valarith.c
+@@ -195,12 +195,31 @@ 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));
+ unsigned int elt_size = TYPE_LENGTH (elt_type);
+- unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound);
++ unsigned int elt_offs = longest_to_int (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 (array_type)))
+- error (_("no such vector element"));
++ {
++ if (TYPE_NOT_ASSOCIATED (array_type))
++ error (_("no such vector element because not associated"));
++ else if (TYPE_NOT_ALLOCATED (array_type))
++ error (_("no such vector element because not allocated"));
++ else
++ error (_("no such vector element"));
++ }
+
+ if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
+ v = allocate_value_lazy (elt_type);
+diff --git a/gdb/valprint.c b/gdb/valprint.c
+index 8600b34..2f8eac1 100644
+--- a/gdb/valprint.c
++++ b/gdb/valprint.c
+@@ -307,6 +307,18 @@ valprint_check_validity (struct ui_file *stream,
+ {
+ CHECK_TYPEDEF (type);
+
++ if (TYPE_NOT_ASSOCIATED (type))
++ {
++ val_print_not_associated (stream);
++ return 0;
++ }
++
++ if (TYPE_NOT_ALLOCATED (type))
++ {
++ val_print_not_allocated (stream);
++ return 0;
++ }
++
+ if (TYPE_CODE (type) != TYPE_CODE_UNION
+ && TYPE_CODE (type) != TYPE_CODE_STRUCT
+ && TYPE_CODE (type) != TYPE_CODE_ARRAY)
+@@ -362,6 +374,18 @@ val_print_invalid_address (struct ui_file *stream)
+ fprintf_filtered (stream, _("<invalid address>"));
+ }
+
++void
++val_print_not_allocated (struct ui_file *stream)
++{
++ fprintf_filtered (stream, _("<not allocated>"));
++}
++
++void
++val_print_not_associated (struct ui_file *stream)
++{
++ fprintf_filtered (stream, _("<not associated>"));
++}
++
+ /* A generic val_print that is suitable for use by language
+ implementations of the la_val_print method. This function can
+ handle most type codes, though not all, notably exception
+@@ -803,12 +827,16 @@ static int
+ value_check_printable (struct value *val, struct ui_file *stream,
+ const struct value_print_options *options)
+ {
++ const struct type *type;
++
+ if (val == 0)
+ {
+ fprintf_filtered (stream, _("<address of value unknown>"));
+ return 0;
+ }
+
++ type = value_type (val);
++
+ if (value_entirely_optimized_out (val))
+ {
+ if (options->summary && !val_print_scalar_type_p (value_type (val)))
+@@ -834,6 +862,18 @@ value_check_printable (struct value *val, struct ui_file *stream,
+ return 0;
+ }
+
++ if (TYPE_NOT_ASSOCIATED (type))
++ {
++ val_print_not_associated (stream);
++ return 0;
++ }
++
++ if (TYPE_NOT_ALLOCATED (type))
++ {
++ val_print_not_allocated (stream);
++ return 0;
++ }
++
+ return 1;
+ }
+
+diff --git a/gdb/valprint.h b/gdb/valprint.h
+index 6698247..7a415cf 100644
+--- a/gdb/valprint.h
++++ b/gdb/valprint.h
+@@ -217,4 +217,8 @@ extern void output_command_const (const char *args, int from_tty);
+
+ extern int val_print_scalar_type_p (struct type *type);
+
++extern void val_print_not_allocated (struct ui_file *stream);
++
++extern void val_print_not_associated (struct ui_file *stream);
++
+ #endif
+diff --git a/gdb/value.c b/gdb/value.c
+index 29abe5f..5efea89 100644
+--- a/gdb/value.c
++++ b/gdb/value.c
+@@ -43,6 +43,7 @@
+ #include "tracepoint.h"
+ #include "cp-abi.h"
+ #include "user-regs.h"
++#include "dwarf2loc.h"
+
+ /* Prototypes for exported functions. */
+
+@@ -1627,6 +1628,25 @@ set_value_component_location (struct value *component,
+ if (funcs->copy_closure)
+ component->location.computed.closure = funcs->copy_closure (whole);
+ }
++
++ /* For dynamic types compute the address of the component value location in
++ sub range types based on the location of the sub range type, if not being
++ an internal GDB variable or parts of it. */
++ if (VALUE_LVAL (component) != lval_internalvar
++ && VALUE_LVAL (component) != lval_internalvar_component)
++ {
++ CORE_ADDR addr;
++ struct type *type = value_type (whole);
++
++ addr = value_raw_address (component);
++
++ if (TYPE_DATA_LOCATION (type)
++ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
++ {
++ addr = TYPE_DATA_LOCATION_ADDR (type);
++ set_value_address (component, addr);
++ }
++ }
+ }
+
+ \f
+@@ -2931,13 +2951,22 @@ value_primitive_field (struct value *arg1, int offset,
+ v = allocate_value_lazy (type);
+ else
+ {
+- v = allocate_value (type);
+- value_contents_copy_raw (v, value_embedded_offset (v),
+- arg1, value_embedded_offset (arg1) + offset,
+- TYPE_LENGTH (type));
++ if (TYPE_DATA_LOCATION (type)
++ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
++ v = value_at_lazy (type, value_address (arg1) + offset);
++ else
++ {
++ v = allocate_value (type);
++ value_contents_copy_raw (v, value_embedded_offset (v),
++ arg1, value_embedded_offset (arg1) + offset,
++ TYPE_LENGTH (type));
++ }
+ }
+- v->offset = (value_offset (arg1) + offset
+- + value_embedded_offset (arg1));
++
++ if (!TYPE_DATA_LOCATION (type)
++ || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
++ v->offset = (value_offset (arg1) + offset
++ + value_embedded_offset (arg1));
+ }
+ set_value_component_location (v, arg1);
+ VALUE_REGNUM (v) = VALUE_REGNUM (arg1);
+@@ -3520,7 +3549,8 @@ readjust_indirect_value_type (struct value *value, struct type *enc_type,
+ struct value *original_value)
+ {
+ /* Re-adjust type. */
+- deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
++ if (!is_dynamic_type (TYPE_TARGET_TYPE (original_type)))
++ deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
+
+ /* Add embedding info. */
+ set_value_enclosing_type (value, enc_type);
+@@ -3537,6 +3567,12 @@ coerce_ref (struct value *arg)
+ struct value *retval;
+ struct type *enc_type;
+
++ if (current_language->la_language != language_fortran
++ && TYPE_DATA_LOCATION (value_type_arg_tmp) != NULL
++ && TYPE_DATA_LOCATION_KIND (value_type_arg_tmp) == PROP_CONST)
++ arg = value_at_lazy (value_type_arg_tmp,
++ TYPE_DATA_LOCATION_ADDR (value_type_arg_tmp));
++
+ retval = coerce_ref_if_computed (arg);
+ if (retval)
+ return retval;
+@@ -3680,8 +3716,14 @@ value_fetch_lazy (struct value *val)
+ }
+ else if (VALUE_LVAL (val) == lval_memory)
+ {
+- CORE_ADDR addr = value_address (val);
+ struct type *type = check_typedef (value_enclosing_type (val));
++ CORE_ADDR addr;
++
++ if (TYPE_DATA_LOCATION (type) != NULL
++ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
++ addr = TYPE_DATA_LOCATION_ADDR (type);
++ else
++ addr = value_address (val);
+
+ if (TYPE_LENGTH (type))
+ read_value_memory (val, 0, value_stack (val),
projects / packages / gdb.git / commitdiff