[gdb] Rebase the Intel VLA patchset.
Jan Kratochvil
jankratochvil at fedoraproject.org
Tue Jul 8 19:10:59 UTC 2014
commit cec929771252d3560ec30522be36990ab1703b4f
Author: Jan Kratochvil <jan.kratochvil at redhat.com>
Date: Tue Jul 8 21:11:05 2014 +0200
Rebase the Intel VLA patchset.
- Python completion w/overriden completer (Sergio Durigan Junior, BZ 1075199).
- Remove %{_bindir}/mono-gdb.py workaround of mono BZ 815501.
gdb-archer-vla-tests.patch | 581 -------
gdb-python-completer-1of2.patch | 747 +++++++++
gdb-python-completer-2of2.patch | 72 +
gdb-vla-intel-01of23.patch | 270 ----
gdb-vla-intel-02of23.patch | 192 ---
gdb-vla-intel-03of23.patch | 115 --
gdb-vla-intel-04of23-fix.patch | 18 +-
gdb-vla-intel-04of23.patch | 614 --------
gdb-vla-intel-05of23.patch | 65 -
gdb-vla-intel-06of23.patch | 67 -
gdb-vla-intel-07of23.patch | 211 ---
gdb-vla-intel-08of23.patch | 49 -
gdb-vla-intel-09of23.patch | 316 ----
gdb-vla-intel-10of23.patch | 94 --
gdb-vla-intel-11of23.patch | 272 ----
gdb-vla-intel-12of23.patch | 243 ---
gdb-vla-intel-13of23.patch | 273 ----
gdb-vla-intel-14of23.patch | 172 --
gdb-vla-intel-15of23.patch | 409 -----
gdb-vla-intel-16of23.patch | 126 --
gdb-vla-intel-17of23.patch | 95 --
gdb-vla-intel-18of23.patch | 171 --
gdb-vla-intel-19of23.patch | 92 --
gdb-vla-intel-20of23.patch | 181 ---
gdb-vla-intel-21of23.patch | 262 ----
gdb-vla-intel-22of23.patch | 75 -
gdb-vla-intel-23of23.patch | 119 --
gdb-vla-intel.patch | 3264 +++++++++++++++++++++++++++++++++++++++
gdb.spec | 64 +-
29 files changed, 4110 insertions(+), 5119 deletions(-)
---
diff --git a/gdb-archer-vla-tests.patch b/gdb-archer-vla-tests.patch
index 1f8886d..b8c4edc 100644
--- a/gdb-archer-vla-tests.patch
+++ b/gdb-archer-vla-tests.patch
@@ -14,587 +14,6 @@ Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.ada/packed_array.exp
+ }
}
-Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-pointer-foo.S
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-pointer-foo.S 2014-06-16 23:30:30.108940484 +0200
-@@ -0,0 +1,457 @@
-+ .file "x86_64-vla-pointer.c"
-+ .section .debug_abbrev,"", at progbits
-+.Ldebug_abbrev0:
-+ .section .debug_info,"", at progbits
-+.Ldebug_info0:
-+ .section .debug_line,"", at progbits
-+.Ldebug_line0:
-+ .text
-+.Ltext0:
-+.globl foo
-+ .type foo, @function
-+foo:
-+.LFB2:
-+ .file 1 "x86_64-vla-pointer.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,"", at 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", at 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,"", at 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
-+.Ldebug_relative:
-+ .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 .Ltype_int - .Ldebug_relative
-+ .uleb128 0x3
-+ .long .LASF5
-+ .byte 0x1
-+ .byte 0x15
-+ .long .Ltype_int - .Ldebug_relative
-+ .byte 0x2
-+ .byte 0x91
-+ .sleb128 -52
-+.Ltag_pointer:
-+ .uleb128 0x4
-+ .byte 0x8 /* DW_AT_byte_size */
-+ .long .Ltag_array_type - .debug_info /* DW_AT_type */
-+ .uleb128 0x5 /* Abbrev Number: 5 (DW_TAG_variable) */
-+ .long .LASF0
-+ .byte 0x1
-+ .byte 0x18
-+#if 1
-+ .long .Ltag_pointer - .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 .Ltype_int - .Ldebug_relative
-+ .byte 0x2
-+ .byte 0x91
-+ .sleb128 -20
-+ .byte 0x0
-+.Ltype_int:
-+ .uleb128 0x7
-+ .byte 0x4
-+ .byte 0x5
-+ .string "int"
-+.Ltag_array_type:
-+ .uleb128 0x8 /* Abbrev Number: 8 (DW_TAG_array_type) */
-+ .long .Ltype_char - .Ldebug_relative
-+ .long .Ltype_ulong - .Ldebug_relative /* 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 */
-+#if 1
-+ .byte 0x6 /* DW_OP_deref */
-+#else
-+ .byte 0x96 /* DW_OP_nop */
-+#endif
-+2: /* DW_AT_data_location: DW_FORM_block1: end */
-+ .uleb128 0x9
-+ .long .Ltype_char - .Ldebug_relative /* DW_AT_type: DW_FORM_ref4 */
-+ .byte 0x3
-+ .byte 0x91
-+ .sleb128 -40
-+ .byte 0x6
-+ .byte 0x0
-+.Ltype_ulong:
-+ .uleb128 0xa
-+ .byte 0x8
-+ .byte 0x7
-+.Ltype_char:
-+ .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 /* .Ltag_pointer abbrev */
-+ .uleb128 0x0f /* DW_TAG_pointer_type */
-+ .byte 0x0
-+ .uleb128 0x0b
-+ .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,"", at progbits
-+ .long 0x16
-+ .value 0x2
-+ .long .Ldebug_info0
-+ .long 0xa8
-+ .long 0x2d
-+ .string "foo"
-+ .long 0x0
-+ .section .debug_aranges,"", at 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", at progbits,1
-+.LASF0:
-+ .string "array"
-+.LASF5:
-+ .string "size"
-+.LASF3:
-+ .string "x86_64-vla-pointer.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,"", at progbits
-Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-pointer.c
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-pointer.c 2014-06-16 23:30:30.108940484 +0200
-@@ -0,0 +1,43 @@
-+/* 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/>. */
-+
-+#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-pointer.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-pointer.exp 2014-06-16 23:30:30.108940484 +0200
-@@ -0,0 +1,66 @@
-+# 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/>.
-+
-+if ![istarget "x86_64-*-*"] then {
-+ verbose "Skipping over gdb.arch/x86_64-vla-pointer.exp test made only for x86_64."
-+ return
-+}
-+
-+set testfile x86_64-vla-pointer
-+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-pointer
-+ return -1
-+}
-+
-+gdb_breakpoint "break_here"
-+
-+gdb_continue_to_breakpoint "break_here"
-+
-+gdb_test "whatis array" "type = char \\(\\*\\)\\\[26\\\]" "first: whatis array"
-+gdb_test "ptype array" "type = char \\(\\*\\)\\\[26\\\]" "first: ptype array"
-+
-+gdb_test "whatis *array" "type = char \\\[variable length\\\]" "first: whatis *array"
-+gdb_test "ptype *array" "type = char \\\[variable length\\\]" "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 = char \\(\\*\\)\\\[78\\\]" "second: whatis array"
-+gdb_test "ptype array" "type = char \\(\\*\\)\\\[78\\\]" "second: ptype array"
-+
-+gdb_test "whatis *array" "type = char \\\[variable length\\\]" "second: whatis *array"
-+gdb_test "ptype *array" "type = char \\\[variable length\\\]" "second: ptype *array"
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
diff --git a/gdb-python-completer-1of2.patch b/gdb-python-completer-1of2.patch
new file mode 100644
index 0000000..c078822
--- /dev/null
+++ b/gdb-python-completer-1of2.patch
@@ -0,0 +1,747 @@
+http://sourceware.org/ml/gdb-patches/2014-07/msg00002.html
+Subject: Re: [PATCH] PR python/16699: GDB Python command completion with overriden complete vs. completer class
+https://bugzilla.redhat.com/show_bug.cgi?id=1075199
+
+On Wednesday, May 21 2014, Doug Evans wrote:
+
+> Sergio Durigan Junior <sergiodj at redhat.com> writes:
+>> [...]
+>> Thanks. WDYT of the following patch?
+>
+> Hi.
+>
+> fwiw it's too bad the ability to plug in different completers isn't more,
+> I dunno, parameterized (couldn't pick a better term, apologies -
+> I thought of "object oriented" but that carries its own baggage).
+> Performing completion obviously involves specifying more than a just
+> single function (witness the comparison of the completer with specific
+> functions).
+
+Thanks for the reply, and sorry for the long delay in answering.
+
+> Plus it's more than specifying brkchars.
+> Witness code like this:
+>
+> /* Many commands which want to complete on
+> file names accept several file names, as
+> in "run foo bar >>baz". So we don't want
+> to complete the entire text after the
+> command, just the last word. To this
+> end, we need to find the beginning of the
+> file name by starting at `word' and going
+> backwards. */
+> for (p = word;
+> p > tmp_command
+> && strchr (gdb_completer_file_name_break_characters, p[-1]) == NULL;
+> p--)
+> ;
+>
+> IWBN if a "completer" object described how to do all these three things.
+> Then the special case code for filename_completer (and location_completer)
+> in completer.c could disappear. But maybe that's a patch for another day.
+
+While I agree with you that the completion mechanism could be better (I
+myself had a lot of trouble with it), I unfortunately don't have enough
+time to tackle this problem now. So yeah, I think it will be a patch
+for another day...
+
+> Regarding the hack of using a static local to pass data from
+> handle_brkchars to handle_completion, I know it's a hacky pragmatic
+> choice. To get the reference counting right the code assumes that
+> if the handle_brkchars phase is done then the handle_completion
+> phase will be done too, right?
+
+Yeah. This is true for the current code (well, except maybe for the
+case you describe below...).
+
+> I wonder if a SIGINT could sneak in
+> there between the two passes (either today or tomorrow).
+> Maybe the code in cmdpy_completer_helper for handle_brkchars_p could
+> first check whether resultobj is already non-NULL, and decrement its
+> reference count before setting it to NULL?
+
+Yes, done (I think). Thanks for raising this issue.
+
+> And cmdpy_completer_helper
+> could be defined to return a borrowed reference to resultobj?
+> Dunno, just thinking out loud.
+
+Done, I guess.
+
+> Something puzzles me though: If it's ok to cache the completion result from the
+> handle_brkchars pass to the handle_completion pass, why have two passes?
+> It feels like there must be a case where this caching of the result
+> in a static local from one pass to the next won't work.
+
+I'm not sure I follow.
+
+It's OK to cache the result because handle_brkchars and
+handle_completion work on the same set of data. In fact, we wouldn't
+need to have two passes here; my previous patch didn't have two passes,
+and worked fine. I just implemented it this way because Tom (correctly)
+raised the point that the completion itself might be time-consuming, and
+thus we could reuse its result in the two phases.
+
+> Another question:
+> I noticed complete_command doesn't do this two-phase dance
+> of handle_brkchars followed by handle_completions. Should it?
+> It just goes straight to handle_completions.
+
+I don't think it should, because for complete_command (and
+complete_filename et al) the handle_brkchars is already defined
+internally by GDB. See:
+
+ ...
+ /* Choose the default set of word break characters to break
+ completions. If we later find out that we are doing completions
+ on command strings (as opposed to strings supplied by the
+ individual command completer functions, which can be any string)
+ then we will switch to the special word break set for command
+ strings, which leaves out the '-' character used in some
+ commands. */
+ rl_completer_word_break_characters =
+ current_language->la_word_break_characters();
+ ...
+
+ /* It is a normal command; what comes after it is
+ completed by the command's completer function. */
+ if (c->completer == filename_completer)
+ {
+ /* Many commands which want to complete on
+ file names accept several file names, as
+ in "run foo bar >>baz". So we don't want
+ to complete the entire text after the
+ command, just the last word. To this
+ end, we need to find the beginning of the
+ file name by starting at `word' and going
+ backwards. */
+ for (p = word;
+ p > tmp_command
+ && strchr (gdb_completer_file_name_break_characters, p[-1]) == NULL;
+ p--)
+ ;
+ rl_completer_word_break_characters =
+ gdb_completer_file_name_break_characters;
+ }
+ else if (c->completer == location_completer)
+ {
+ /* Commands which complete on locations want to
+ see the entire argument. */
+ for (p = word;
+ p > tmp_command
+ && p[-1] != ' ' && p[-1] != '\t';
+ p--)
+ ;
+ }
+ if (reason == handle_brkchars
+ && c->completer_handle_brkchars != NULL)
+ (*c->completer_handle_brkchars) (c, p, word);
+ if (reason != handle_brkchars && c->completer != NULL)
+ list = (*c->completer) (c, p, word);
+
+
+The complete_command function will only be called by the last "if"
+clause, when reason != handle_brkchars. Otherwise,
+complete_line_internal will just deal with handle_brkchars. And for
+complete_command, the right value for rl_completer_word_break_characters
+is what is attributed at the beginning of the function.
+
+My patch implements this "two-phase" dance for Python because in this
+specific case (i.e., a completion method defined in the Python script)
+there is no way to know the value of handle_brkchars before we actually
+do the completion itself.
+
+In fact, my patch could probably be "simplified" and be made to call
+cmdpy_completer directly (without any cmdpy_completer_handle_brkchars),
+assuming that this function took care of filling handle_brkchars
+correctly. What I mean is: when dealing with the handle_brkchars case,
+the completer command can do anything it wants.
+
+> [Maybe that explains the difference from using TAB. Dunno off hand.]
+> It seems like complete_command is trying to hand-code its own
+> handle_brkchars handling:
+>
+> static void
+> complete_command (char *arg, int from_tty)
+> {
+> int argpoint;
+> char *point, *arg_prefix;
+> VEC (char_ptr) *completions;
+>
+> dont_repeat ();
+>
+> if (arg == NULL)
+> arg = "";
+> argpoint = strlen (arg);
+>
+> /* complete_line assumes that its first argument is somewhere
+> within, and except for filenames at the beginning of, the word to
+> be completed. The following crude imitation of readline's
+> word-breaking tries to accomodate this. */
+> point = arg + argpoint;
+> while (point > arg)
+> {
+> if (strchr (rl_completer_word_break_characters, point[-1]) != 0)
+> break;
+> point--;
+> }
+>
+> arg_prefix = alloca (point - arg + 1);
+> memcpy (arg_prefix, arg, point - arg);
+> arg_prefix[point - arg] = 0;
+>
+> completions = complete_line (point, arg, argpoint);
+>
+> ...
+> }
+
+Yes, it seems so, but I did not check further.
+
+> TAB and the complete command should work identically of course,
+> but for your testcase, maybe you should test both just to verify
+> both work reasonably well (even if not identically).
+> Given that complete_command doesn't do the two phase dance,
+> does it work with your patch?
+> Maybe it does, but IWBN to confirm that.
+
+The 'complete' command does not work as it should with my patch:
+
+ (gdb) complete completefileinit /hom
+ completefileinit /home
+ (gdb) complete completefilemethod /hom
+ completefilemethod /home
+
+But then, it also does not work without my patch either:
+
+ (gdb) complete file /hom
+ file /home
+
+So I am not extending the testcase for now, because this bug needs to be
+fixed first (and it is unrelated to the patch I am proposing).
+
+WDYT of this version?
+
+Thanks,
+
+--
+Sergio
+GPG key ID: 65FC5E36
+Please send encrypted e-mail if possible
+http://blog.sergiodj.net/
+
+gdb/
+2014-06-30 Sergio Durigan Junior <sergiodj at redhat.com>
+
+ PR python/16699
+ * cli/cli-decode.c (set_cmd_completer_handle_brkchars): New
+ function.
+ (add_cmd): Set "completer_handle_brkchars" to NULL.
+ * cli/cli-decode.h (struct cmd_list_element)
+ <completer_handle_brkchars>: New field.
+ * command.h (completer_ftype_void): New typedef.
+ (set_cmd_completer_handle_brkchars): New prototype.
+ * completer.c (set_gdb_completion_word_break_characters): New
+ function.
+ (complete_line_internal): Call "completer_handle_brkchars"
+ callback from command.
+ * completer.h: Include "command.h".
+ (set_gdb_completion_word_break_characters): New prototype.
+ * python/py-cmd.c (cmdpy_completer_helper): New function.
+ (cmdpy_completer_handle_brkchars): New function.
+ (cmdpy_completer): Adjust to use cmdpy_completer_helper.
+ (cmdpy_init): Set completer_handle_brkchars to
+ cmdpy_completer_handle_brkchars.
+
+gdb/testsuite/
+2014-06-30 Sergio Durigan Junior <sergiodj at redhat.com>
+
+ PR python/16699
+ * gdb.python/py-completion.exp: New file.
+ * gdb.python/py-completion.py: Likewise.
+
+
+Index: gdb-7.7.90.20140627/gdb/cli/cli-decode.c
+===================================================================
+--- gdb-7.7.90.20140627.orig/gdb/cli/cli-decode.c 2014-07-07 20:53:52.635106914 +0200
++++ gdb-7.7.90.20140627/gdb/cli/cli-decode.c 2014-07-07 20:53:55.429110207 +0200
+@@ -164,6 +164,15 @@ set_cmd_completer (struct cmd_list_eleme
+ cmd->completer = completer; /* Ok. */
+ }
+
++/* See definition in commands.h. */
++
++void
++set_cmd_completer_handle_brkchars (struct cmd_list_element *cmd,
++ completer_ftype_void *completer_handle_brkchars)
++{
++ cmd->completer_handle_brkchars = completer_handle_brkchars;
++}
++
+ /* Add element named NAME.
+ Space for NAME and DOC must be allocated by the caller.
+ CLASS is the top level category into which commands are broken down
+@@ -239,6 +248,7 @@ add_cmd (const char *name, enum command_
+ c->prefix = NULL;
+ c->abbrev_flag = 0;
+ set_cmd_completer (c, make_symbol_completion_list_fn);
++ c->completer_handle_brkchars = NULL;
+ c->destroyer = NULL;
+ c->type = not_set_cmd;
+ c->var = NULL;
+Index: gdb-7.7.90.20140627/gdb/cli/cli-decode.h
+===================================================================
+--- gdb-7.7.90.20140627.orig/gdb/cli/cli-decode.h 2014-07-07 20:53:52.636106915 +0200
++++ gdb-7.7.90.20140627/gdb/cli/cli-decode.h 2014-07-07 20:53:55.429110207 +0200
+@@ -176,6 +176,15 @@ struct cmd_list_element
+ "baz/foo", return "baz/foobar". */
+ completer_ftype *completer;
+
++ /* Handle the word break characters for this completer. Usually
++ this function need not be defined, but for some types of
++ completers (e.g., Python completers declared as methods inside
++ a class) the word break chars may need to be redefined
++ depending on the completer type (e.g., for filename
++ completers). */
++
++ completer_ftype_void *completer_handle_brkchars;
++
+ /* Destruction routine for this command. If non-NULL, this is
+ called when this command instance is destroyed. This may be
+ used to finalize the CONTEXT field, if needed. */
+Index: gdb-7.7.90.20140627/gdb/command.h
+===================================================================
+--- gdb-7.7.90.20140627.orig/gdb/command.h 2014-07-07 20:53:52.636106915 +0200
++++ gdb-7.7.90.20140627/gdb/command.h 2014-07-07 20:53:55.430110208 +0200
+@@ -158,8 +158,16 @@ extern void set_cmd_sfunc (struct cmd_li
+ typedef VEC (char_ptr) *completer_ftype (struct cmd_list_element *,
+ const char *, const char *);
+
++typedef void completer_ftype_void (struct cmd_list_element *,
++ const char *, const char *);
++
+ extern void set_cmd_completer (struct cmd_list_element *, completer_ftype *);
+
++/* Set the completer_handle_brkchars callback. */
++
++extern void set_cmd_completer_handle_brkchars (struct cmd_list_element *,
++ completer_ftype_void *);
++
+ /* HACK: cagney/2002-02-23: Code, mostly in tracepoints.c, grubs
+ around in cmd objects to test the value of the commands sfunc(). */
+ extern int cmd_cfunc_eq (struct cmd_list_element *cmd,
+Index: gdb-7.7.90.20140627/gdb/completer.c
+===================================================================
+--- gdb-7.7.90.20140627.orig/gdb/completer.c 2014-07-07 20:53:52.637106916 +0200
++++ gdb-7.7.90.20140627/gdb/completer.c 2014-07-07 20:53:55.430110208 +0200
+@@ -450,6 +450,21 @@ expression_completer (struct cmd_list_el
+ return location_completer (ignore, p, word);
+ }
+
++/* See definition in completer.h. */
++
++void
++set_gdb_completion_word_break_characters (completer_ftype *fn)
++{
++ /* So far we are only interested in differentiating filename
++ completers from everything else. */
++ if (fn == filename_completer)
++ rl_completer_word_break_characters
++ = gdb_completer_file_name_break_characters;
++ else
++ rl_completer_word_break_characters
++ = gdb_completer_command_word_break_characters;
++}
++
+ /* Here are some useful test cases for completion. FIXME: These
+ should be put in the test suite. They should be tested with both
+ M-? and TAB.
+@@ -678,6 +693,9 @@ complete_line_internal (const char *text
+ p--)
+ ;
+ }
++ if (reason == handle_brkchars
++ && c->completer_handle_brkchars != NULL)
++ (*c->completer_handle_brkchars) (c, p, word);
+ if (reason != handle_brkchars && c->completer != NULL)
+ list = (*c->completer) (c, p, word);
+ }
+@@ -751,6 +769,9 @@ complete_line_internal (const char *text
+ p--)
+ ;
+ }
++ if (reason == handle_brkchars
++ && c->completer_handle_brkchars != NULL)
++ (*c->completer_handle_brkchars) (c, p, word);
+ if (reason != handle_brkchars && c->completer != NULL)
+ list = (*c->completer) (c, p, word);
+ }
+Index: gdb-7.7.90.20140627/gdb/completer.h
+===================================================================
+--- gdb-7.7.90.20140627.orig/gdb/completer.h 2014-07-07 20:53:52.637106916 +0200
++++ gdb-7.7.90.20140627/gdb/completer.h 2014-07-07 20:54:13.297131831 +0200
+@@ -18,6 +18,7 @@
+ #define COMPLETER_H 1
+
+ #include "gdb_vecs.h"
++#include "command.h"
+
+ extern VEC (char_ptr) *complete_line (const char *text,
+ char *line_buffer,
+@@ -48,6 +49,13 @@ extern char *get_gdb_completer_quote_cha
+
+ extern char *gdb_completion_word_break_characters (void);
+
++/* Set the word break characters array to the corresponding set of
++ chars, based on FN. This function is useful for cases when the
++ completer doesn't know the type of the completion until some
++ calculation is done (e.g., for Python functions). */
++
++extern void set_gdb_completion_word_break_characters (completer_ftype *fn);
++
+ /* Exported to linespec.c */
+
+ extern const char *skip_quoted_chars (const char *, const char *,
+Index: gdb-7.7.90.20140627/gdb/python/py-cmd.c
+===================================================================
+--- gdb-7.7.90.20140627.orig/gdb/python/py-cmd.c 2014-07-07 20:53:52.637106916 +0200
++++ gdb-7.7.90.20140627/gdb/python/py-cmd.c 2014-07-07 20:53:55.431110209 +0200
+@@ -208,45 +208,155 @@ cmdpy_function (struct cmd_list_element
+ do_cleanups (cleanup);
+ }
+
++/* Helper function for the Python command completers (both "pure"
++ completer and brkchar handler). This function takes COMMAND, TEXT
++ and WORD and tries to call the Python method for completion with
++ these arguments. It also takes HANDLE_BRKCHARS_P, an argument to
++ identify whether it is being called from the brkchar handler or
++ from the "pure" completer. In the first case, it effectively calls
++ the Python method for completion, and records the PyObject in a
++ static variable (used as a "cache"). In the second case, it just
++ returns that variable, without actually calling the Python method
++ again. This saves us one Python method call.
++
++ It is important to mention that this function is built on the
++ assumption that the calls to cmdpy_completer_handle_brkchars and
++ cmdpy_completer will be subsequent with nothing intervening. This
++ is true for our completer mechanism.
++
++ This function returns the PyObject representing the Python method
++ call. */
++
++static PyObject *
++cmdpy_completer_helper (struct cmd_list_element *command,
++ const char *text, const char *word,
++ int handle_brkchars_p)
++{
++ cmdpy_object *obj = (cmdpy_object *) get_cmd_context (command);
++ PyObject *textobj, *wordobj;
++ /* This static variable will server as a "cache" for us, in order to
++ store the PyObject that results from calling the Python
++ function. */
++ static PyObject *resultobj = NULL;
++
++ if (handle_brkchars_p)
++ {
++ /* If we were called to handle brkchars, it means this is the
++ first function call of two that will happen in a row.
++ Therefore, we need to call the completer ourselves, and cache
++ the return value in the static variable RESULTOBJ. Then, in
++ the second call, we can just use the value of RESULTOBJ to do
++ our job. */
++ if (resultobj != NULL)
++ Py_DECREF (resultobj);
++
++ resultobj = NULL;
++ if (!obj)
++ error (_("Invalid invocation of Python command object."));
++ if (!PyObject_HasAttr ((PyObject *) obj, complete_cst))
++ {
++ /* If there is no complete method, don't error. */
++ return NULL;
++ }
++
++ textobj = PyUnicode_Decode (text, strlen (text), host_charset (), NULL);
++ if (!textobj)
++ error (_("Could not convert argument to Python string."));
++ wordobj = PyUnicode_Decode (word, sizeof (word), host_charset (), NULL);
++ if (!wordobj)
++ {
++ Py_DECREF (textobj);
++ error (_("Could not convert argument to Python string."));
++ }
++
++ resultobj = PyObject_CallMethodObjArgs ((PyObject *) obj, complete_cst,
++ textobj, wordobj, NULL);
++ Py_DECREF (textobj);
++ Py_DECREF (wordobj);
++ if (!resultobj)
++ {
++ /* Just swallow errors here. */
++ PyErr_Clear ();
++ }
++
++ Py_XINCREF (resultobj);
++ }
++
++ return resultobj;
++}
++
++/* Python function called to determine the break characters of a
++ certain completer. We are only interested in knowing if the
++ completer registered by the user will return one of the integer
++ codes (see COMPLETER_* symbols). */
++
++static void
++cmdpy_completer_handle_brkchars (struct cmd_list_element *command,
++ const char *text, const char *word)
++{
++ PyObject *resultobj = NULL;
++ struct cleanup *cleanup;
++
++ cleanup = ensure_python_env (get_current_arch (), current_language);
++
++ /* Calling our helper to obtain the PyObject of the Python
++ function. */
++ resultobj = cmdpy_completer_helper (command, text, word, 1);
++
++ /* Check if there was an error. */
++ if (resultobj == NULL)
++ goto done;
++
++ if (PyInt_Check (resultobj))
++ {
++ /* User code may also return one of the completion constants,
++ thus requesting that sort of completion. We are only
++ interested in this kind of return. */
++ long value;
++
++ if (!gdb_py_int_as_long (resultobj, &value))
++ {
++ /* Ignore. */
++ PyErr_Clear ();
++ }
++ else if (value >= 0 && value < (long) N_COMPLETERS)
++ {
++ /* This is the core of this function. Depending on which
++ completer type the Python function returns, we have to
++ adjust the break characters accordingly. */
++ set_gdb_completion_word_break_characters
++ (completers[value].completer);
++ }
++ }
++
++ done:
++
++ /* We do not call Py_XDECREF here because RESULTOBJ will be used in
++ the subsequent call to cmdpy_completer function. */
++ do_cleanups (cleanup);
++}
++
+ /* Called by gdb for command completion. */
+
+ static VEC (char_ptr) *
+ cmdpy_completer (struct cmd_list_element *command,
+ const char *text, const char *word)
+ {
+- cmdpy_object *obj = (cmdpy_object *) get_cmd_context (command);
+- PyObject *textobj, *wordobj, *resultobj = NULL;
++ PyObject *resultobj = NULL;
+ VEC (char_ptr) *result = NULL;
+ struct cleanup *cleanup;
+
+ cleanup = ensure_python_env (get_current_arch (), current_language);
+
+- if (! obj)
+- error (_("Invalid invocation of Python command object."));
+- if (! PyObject_HasAttr ((PyObject *) obj, complete_cst))
+- {
+- /* If there is no complete method, don't error -- instead, just
+- say that there are no completions. */
+- goto done;
+- }
+-
+- textobj = PyUnicode_Decode (text, strlen (text), host_charset (), NULL);
+- if (! textobj)
+- error (_("Could not convert argument to Python string."));
+- wordobj = PyUnicode_Decode (word, strlen (word), host_charset (), NULL);
+- if (! wordobj)
+- error (_("Could not convert argument to Python string."));
+-
+- resultobj = PyObject_CallMethodObjArgs ((PyObject *) obj, complete_cst,
+- textobj, wordobj, NULL);
+- Py_DECREF (textobj);
+- Py_DECREF (wordobj);
+- if (! resultobj)
+- {
+- /* Just swallow errors here. */
+- PyErr_Clear ();
+- goto done;
+- }
++ /* Calling our helper to obtain the PyObject of the Python
++ function. */
++ resultobj = cmdpy_completer_helper (command, text, word, 0);
++
++ /* If the result object of calling the Python function is NULL, it
++ means that there was an error. In this case, just give up and
++ return NULL. */
++ if (resultobj == NULL)
++ goto done;
+
+ result = NULL;
+ if (PyInt_Check (resultobj))
+@@ -302,7 +412,6 @@ cmdpy_completer (struct cmd_list_element
+
+ done:
+
+- Py_XDECREF (resultobj);
+ do_cleanups (cleanup);
+
+ return result;
+@@ -548,6 +657,9 @@ cmdpy_init (PyObject *self, PyObject *ar
+ set_cmd_context (cmd, self);
+ set_cmd_completer (cmd, ((completetype == -1) ? cmdpy_completer
+ : completers[completetype].completer));
++ if (completetype == -1)
++ set_cmd_completer_handle_brkchars (cmd,
++ cmdpy_completer_handle_brkchars);
+ }
+ if (except.reason < 0)
+ {
+Index: gdb-7.7.90.20140627/gdb/testsuite/gdb.python/py-completion.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140627/gdb/testsuite/gdb.python/py-completion.exp 2014-07-07 20:53:55.431110209 +0200
+@@ -0,0 +1,70 @@
++# Copyright (C) 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/>.
++
++set testfile "py-completion"
++
++load_lib gdb-python.exp
++
++gdb_exit
++gdb_start
++
++# Skip all tests if Python scripting is not enabled.
++if { [skip_python_tests] } { continue }
++
++gdb_test_no_output "source ${srcdir}/${subdir}/${testfile}.py"
++
++# Create a temporary directory
++set testdir "${objdir}/${subdir}/py-completion-testdir/"
++set testdir_regex [string_to_regexp $testdir]
++set testdir_complete "${objdir}/${subdir}/py-completion-test"
++file mkdir $testdir
++
++# This one should always pass.
++send_gdb "completefileinit ${testdir_complete}\t"
++gdb_test_multiple "" "completefileinit completion" {
++ -re "^completefileinit ${testdir_regex}$" {
++ pass "completefileinit completion"
++ }
++}
++
++# Just discarding whatever we typed.
++send_gdb "\n"
++gdb_test "print" ".*"
++
++# This is the problematic one.
++send_gdb "completefilemethod ${testdir_complete}\t"
++gdb_test_multiple "" "completefilemethod completion" {
++ -re "^completefilemethod ${testdir_regex} $" {
++ fail "completefilemethod completion (completed filename as wrong command arg)"
++ }
++ -re "^completefilemethod ${testdir_regex}$" {
++ pass "completefilemethod completion"
++ }
++}
++
++# Discarding again
++send_gdb "\n"
++gdb_test "print" ".*"
++
++# Another problematic
++send_gdb "completefilecommandcond ${objdir}/${subdir}/py-completion-t\t"
++gdb_test_multiple "" "completefilecommandcond completion" {
++ -re "^completefilecommandcond ${testdir}$" {
++ fail "completefilecommandcond completion (completed filename instead of command)"
++ }
++ -re "^completefilecommandcond ${objdir}/${subdir}/py-completion-t$" {
++ pass "completefilecommandcond completion"
++ }
++}
+Index: gdb-7.7.90.20140627/gdb/testsuite/gdb.python/py-completion.py
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.7.90.20140627/gdb/testsuite/gdb.python/py-completion.py 2014-07-07 20:53:55.431110209 +0200
+@@ -0,0 +1,58 @@
++# Copyright (C) 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/>.
++
++# This testcase tests PR python/16699
++
++import gdb
++
++class CompleteFileInit(gdb.Command):
++ def __init__(self):
++ gdb.Command.__init__(self,'completefileinit',gdb.COMMAND_USER,gdb.COMPLETE_FILENAME)
++
++ def invoke(self,argument,from_tty):
++ raise gdb.GdbError('not implemented')
++
++class CompleteFileMethod(gdb.Command):
++ def __init__(self):
++ gdb.Command.__init__(self,'completefilemethod',gdb.COMMAND_USER)
++
++ def invoke(self,argument,from_tty):
++ raise gdb.GdbError('not implemented')
++
++ def complete(self,text,word):
++ return gdb.COMPLETE_FILENAME
++
++class CompleteFileCommandCond(gdb.Command):
++ def __init__(self):
++ gdb.Command.__init__(self,'completefilecommandcond',gdb.COMMAND_USER)
++
++ def invoke(self,argument,from_tty):
++ raise gdb.GdbError('not implemented')
++
++ def complete(self,text,word):
++ # This is a test made to know if the command
++ # completion still works fine. When the user asks to
++ # complete something like "completefilecommandcond
++ # /path/to/py-completion-t", it should not complete to
++ # "/path/to/py-completion-test/", but instead just
++ # wait for input.
++ if "py-completion-t" in text:
++ return gdb.COMPLETE_COMMAND
++ else:
++ return gdb.COMPLETE_FILENAME
++
++CompleteFileInit()
++CompleteFileMethod()
++CompleteFileCommandCond()
diff --git a/gdb-python-completer-2of2.patch b/gdb-python-completer-2of2.patch
new file mode 100644
index 0000000..ec3c62f
--- /dev/null
+++ b/gdb-python-completer-2of2.patch
@@ -0,0 +1,72 @@
+http://sourceware.org/ml/gdb-patches/2014-07/msg00154.html
+Subject: Re: [PATCH] PR python/16699: GDB Python command completion with overriden complete vs. completer class
+
+
+--pWyiEgJYm5f9v55/
+Content-Type: text/plain; charset=us-ascii
+Content-Disposition: inline
+
+On Tue, 08 Jul 2014 17:32:21 +0200, Jan Kratochvil wrote:
+> - -re "^completefilecommandcond ${objdir}/${subdir}/py-completion-t$" {
+> + -re "^completefilecommandcond ${completion_regex}$" {
+
+There was a racy bug here - and even in the former test - here should be:
+ + -re "^completefilecommandcond ${completion_regex}\007$" {
+
+Updated fix attached.
+
+
+Jan
+
+--pWyiEgJYm5f9v55/
+Content-Type: text/plain; charset=us-ascii
+Content-Disposition: inline; filename="py-completion-race2.patch"
+
+--- ./gdb/testsuite/gdb.python/py-completion.exp-orig 2014-07-07 21:32:17.891045058 +0200
++++ ./gdb/testsuite/gdb.python/py-completion.exp 2014-07-08 20:14:57.189791928 +0200
+@@ -26,9 +26,9 @@ if { [skip_python_tests] } { continue }
+ gdb_test_no_output "source ${srcdir}/${subdir}/${testfile}.py"
+
+ # Create a temporary directory
+-set testdir "${objdir}/${subdir}/py-completion-testdir/"
++set testdir "[standard_output_file "py-completion-testdir"]/"
+ set testdir_regex [string_to_regexp $testdir]
+-set testdir_complete "${objdir}/${subdir}/py-completion-test"
++set testdir_complete [standard_output_file "py-completion-test"]
+ file mkdir $testdir
+
+ # This one should always pass.
+@@ -40,8 +40,7 @@ gdb_test_multiple "" "completefileinit c
+ }
+
+ # Just discarding whatever we typed.
+-send_gdb "\n"
+-gdb_test "print" ".*"
++gdb_test " " ".*" "discard #1"
+
+ # This is the problematic one.
+ send_gdb "completefilemethod ${testdir_complete}\t"
+@@ -55,16 +54,16 @@ gdb_test_multiple "" "completefilemethod
+ }
+
+ # Discarding again
+-send_gdb "\n"
+-gdb_test "print" ".*"
++gdb_test " " ".*" "discard #2"
+
+ # Another problematic
+-send_gdb "completefilecommandcond ${objdir}/${subdir}/py-completion-t\t"
++set completion_regex "[string_to_regexp [standard_output_file "py-completion-t"]]"
++send_gdb "completefilecommandcond [standard_output_file "py-completion-t\t"]"
+ gdb_test_multiple "" "completefilecommandcond completion" {
+ -re "^completefilecommandcond ${testdir}$" {
+ fail "completefilecommandcond completion (completed filename instead of command)"
+ }
+- -re "^completefilecommandcond ${objdir}/${subdir}/py-completion-t$" {
++ -re "^completefilecommandcond ${completion_regex}\007$" {
+ pass "completefilecommandcond completion"
+ }
+ }
+
+--pWyiEgJYm5f9v55/--
+
diff --git a/gdb-vla-intel-04of23-fix.patch b/gdb-vla-intel-04of23-fix.patch
index 305c541..ad239b5 100644
--- a/gdb-vla-intel-04of23-fix.patch
+++ b/gdb-vla-intel-04of23-fix.patch
@@ -1,16 +1,17 @@
Re: [PATCH 04/23] vla: make dynamic fortran arrays functional.
https://sourceware.org/ml/gdb-patches/2014-06/msg00570.html
-Index: gdb-7.7.90.20140613/gdb/valarith.c
+Index: gdb-7.7.90.20140627/gdb/valarith.c
===================================================================
---- gdb-7.7.90.20140613.orig/gdb/valarith.c 2014-06-16 23:16:48.129164644 +0200
-+++ gdb-7.7.90.20140613/gdb/valarith.c 2014-06-16 23:17:52.544225452 +0200
-@@ -195,19 +195,19 @@ value_subscripted_rvalue (struct value *
+--- gdb-7.7.90.20140627.orig/gdb/valarith.c 2014-07-07 20:44:03.136394525 +0200
++++ gdb-7.7.90.20140627/gdb/valarith.c 2014-07-07 20:45:41.588536459 +0200
+@@ -195,10 +195,17 @@ value_subscripted_rvalue (struct value *
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);
+ unsigned int elt_offs;
+ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
struct value *v;
+ if (TYPE_NOT_ASSOCIATED (array_type))
@@ -18,8 +19,13 @@ Index: gdb-7.7.90.20140613/gdb/valarith.c
+ if (TYPE_NOT_ALLOCATED (array_type))
+ error (_("no such vector element because not allocated"));
+
-+ elt_offs = elt_size * longest_to_int (index - lowerbound);
++ elt_offs = longest_to_int (index - lowerbound);
+
+ if (elt_stride > 0)
+ elt_offs *= elt_stride;
+ else if (elt_stride < 0)
+@@ -212,14 +219,7 @@ value_subscripted_rvalue (struct value *
+
if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
&& elt_offs >= TYPE_LENGTH (array_type)))
- {
diff --git a/gdb-vla-intel.patch b/gdb-vla-intel.patch
new file mode 100644
index 0000000..0a646ab
--- /dev/null
+++ b/gdb-vla-intel.patch
@@ -0,0 +1,3264 @@
+[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 c622a047d23bcbc4dc68398fc70b531cebd8f5ee
+
+
+diff --git a/gdb/NEWS b/gdb/NEWS
+index d9a19ae..1f22fea 100644
+### a/gdb/NEWS
+### b/gdb/NEWS
+@@ -3,6 +3,10 @@
+
+ *** Changes since GDB 7.8
+
++* Fortran dynamic array support: GDB has now support for
++ dynamic arrays in Fortran. 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..4aac278 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);
+@@ -2436,6 +2456,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 +2472,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 +2513,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 +2525,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)
+ {
+@@ -2510,6 +2533,11 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
+
+ *value = value_as_address (val);
+ }
++ if (baton->post_values.data && baton->post_values.size > 0)
++ {
++ CORE_ADDR new_addr = *value;
++ dwarf2_locexpr_baton_eval (&baton->post_values, new_addr, value);
++ }
+ return 1;
+ }
+ }
+@@ -2532,6 +2560,11 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value)
+ if (!value_optimized_out (val))
+ {
+ *value = value_as_address (val);
++ if (baton->post_values.data && baton->post_values.size > 0)
++ {
++ CORE_ADDR new_addr = *value;
++ dwarf2_locexpr_baton_eval (&baton->post_values, new_addr, value);
++ }
+ return 1;
+ }
+ }
+@@ -2546,6 +2579,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;
++}
++
+
+ /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */
+
+@@ -2653,6 +2700,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 +2723,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 +3373,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..cf648eb 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
+@@ -161,6 +168,9 @@ struct dwarf2_property_baton
+ /* Location list to be evaluated in the context of REFERENCED_TYPE. */
+ struct dwarf2_loclist_baton loclist;
+ };
++
++ /* Attributes, which will be pushed after evaluating locexpr or loclist. */
++ struct dwarf2_locexpr_baton post_values;
+ };
+
+ extern const struct symbol_computed_ops dwarf2_locexpr_funcs;
+diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
+index 276d2f1..f5b35d7 100644
+--- a/gdb/dwarf2read.c
++++ b/gdb/dwarf2read.c
+@@ -1847,6 +1847,15 @@ 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);
++
++static void add_post_values_to_baton (struct dwarf2_property_baton *baton,
++ const gdb_byte *data, int size, struct dwarf2_cu *cu);
++
+
+ /* Various complaints about symbol reading that don't abort the process. */
+
+@@ -14201,29 +14210,90 @@ 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_push_object_address,
++ /* 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
++ {
++ if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
++ 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 +14610,36 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
+ return set_die_type (die, type, cu);
+ }
+
++/* Add post processing op-codes to a dwarf2_property_baton. */
++
++static void add_post_values_to_baton (struct dwarf2_property_baton *baton,
++ const gdb_byte *data, int size, struct dwarf2_cu *cu)
++{
++ if (data != NULL && size > 0)
++ {
++ struct obstack *obstack = &cu->objfile->objfile_obstack;
++ gdb_byte *post_data;
++
++ post_data = obstack_alloc (obstack, size);
++ memcpy(post_data, data, size);
++ baton->post_values.data = post_data;
++ baton->post_values.size = size;
++ baton->post_values.per_cu = cu->per_cu;
++ } else {
++ baton->post_values.data = NULL;
++ baton->post_values.size = 0;
++ baton->post_values.per_cu = NULL;
++ }
++}
++
+ /* 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 +14652,10 @@ 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;
++ baton->locexpr.size = DW_BLOCK (attr)->size;
++ add_post_values_to_baton (baton, additional_data,
++ additional_data_size, cu);
+ prop->data.baton = baton;
+ prop->kind = PROP_LOCEXPR;
+ gdb_assert (prop->data.baton != NULL);
+@@ -14581,6 +14676,8 @@ 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);
+ fill_in_loclist_baton (cu, &baton->loclist, target_attr);
++ add_post_values_to_baton (baton, additional_data,
++ additional_data_size, cu);
+ prop->data.baton = baton;
+ prop->kind = PROP_LOCLIST;
+ gdb_assert (prop->data.baton != NULL);
+@@ -14592,6 +14689,8 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
+ baton->locexpr.per_cu = cu->per_cu;
+ baton->locexpr.size = DW_BLOCK (target_attr)->size;
+ baton->locexpr.data = DW_BLOCK (target_attr)->data;
++ add_post_values_to_baton (baton, additional_data,
++ additional_data_size, cu);
+ prop->data.baton = baton;
+ prop->kind = PROP_LOCEXPR;
+ gdb_assert (prop->data.baton != NULL);
+@@ -14626,7 +14725,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 +14745,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 +14780,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 +14863,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 +21781,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 +21797,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 d0c002f..3f52d61 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,11 +1628,30 @@ stub_noname_complaint (void)
+ int
+ is_dynamic_type (struct type *type)
+ {
++ int index;
++
++ if (!type)
++ return 0;
++
+ type = check_typedef (type);
+
+ if (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:
+@@ -1630,11 +1661,19 @@ is_dynamic_type (struct type *type)
+ {
+ 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 (TYPE_INDEX_TYPE (type)))
+ return 1;
+- return is_dynamic_type (TYPE_TARGET_TYPE (type));
++ 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 (TYPE_TARGET_TYPE (type));
++ break;
+ }
+
+ case TYPE_CODE_STRUCT:
+@@ -1647,28 +1686,40 @@ is_dynamic_type (struct type *type)
+ && is_dynamic_type (TYPE_FIELD_TYPE (type, i)))
+ 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;
+ }
+
+ return 0;
+ }
+
+-/* 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;
+@@ -1680,7 +1731,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;
+@@ -1694,10 +1745,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;
+ }
+@@ -1707,29 +1765,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
+@@ -1823,6 +1904,7 @@ resolve_dynamic_struct (struct type *type, CORE_ADDR addr)
+ return resolved_type;
+ }
+
++
+ /* See gdbtypes.h */
+
+ struct type *
+@@ -1830,6 +1912,8 @@ resolve_dynamic_type (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 (real_type))
+ return type;
+@@ -1853,11 +1937,12 @@ resolve_dynamic_type (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:
+@@ -1869,6 +1954,25 @@ resolve_dynamic_type (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;
+ }
+
+@@ -4078,6 +4182,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) =
+@@ -4124,6 +4249,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;
+ }
+
+diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
+index bb6352d..5818f79 100644
+--- a/gdb/gdbtypes.h
++++ b/gdb/gdbtypes.h
+@@ -670,6 +670,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. */
+
+@@ -725,6 +729,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
+@@ -1203,6 +1224,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. */
+
+@@ -1210,6 +1264,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))))
+@@ -1678,6 +1735,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..e791115
+--- /dev/null
++++ b/gdb/testsuite/gdb.fortran/vla-stride.exp
+@@ -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 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 "reverse-elements"]
++gdb_continue_to_breakpoint "reverse-elements"
++gdb_test "print pvla" " = \\\(10, 9, 8, 7, 6, 5, 4, 3, 2, 1\\\)" \
++ "print reverse-elements"
++gdb_test "print pvla(1)" " = 10" "print first reverse-element"
++gdb_test "print pvla(10)" " = 1" "print last reverse-element"
++
++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..1f8cc55
+--- /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) ! reverse-elements
++ 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 at redhat.com> and
++! Jan Kratochvil <jan.kratochvil at redhat.com>.
++! Modified for the GDB testcases by Keven Boell <keven.boell at 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 557056f..4e91a43 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. */
+
+@@ -1646,6 +1647,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);
++ }
++ }
+ }
+
+
+@@ -2950,13 +2970,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);
+@@ -3539,7 +3568,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);
+@@ -3556,6 +3586,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;
+@@ -3699,8 +3735,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),
diff --git a/gdb.spec b/gdb.spec
index ba22a4e..d64443c 100644
--- a/gdb.spec
+++ b/gdb.spec
@@ -25,7 +25,7 @@ Version: 7.7.90.%{snapsrc}
# The release always contains a leading reserved number, start it at 1.
# `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing.
-Release: 8%{?dist}
+Release: 9%{?dist}
License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and BSD and Public Domain and GFDL
Group: Development/Debuggers
@@ -506,30 +506,8 @@ Patch852: gdb-gnat-dwarf-crash-3of3.patch
# VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests.
Patch887: gdb-archer-vla-tests.patch
-Patch888: gdb-vla-intel-01of23.patch
-Patch889: gdb-vla-intel-02of23.patch
-Patch890: gdb-vla-intel-03of23.patch
-Patch891: gdb-vla-intel-04of23.patch
+Patch888: gdb-vla-intel.patch
Patch912: gdb-vla-intel-04of23-fix.patch
-Patch892: gdb-vla-intel-05of23.patch
-Patch893: gdb-vla-intel-06of23.patch
-Patch894: gdb-vla-intel-07of23.patch
-Patch895: gdb-vla-intel-08of23.patch
-Patch896: gdb-vla-intel-09of23.patch
-Patch897: gdb-vla-intel-10of23.patch
-Patch898: gdb-vla-intel-11of23.patch
-Patch899: gdb-vla-intel-12of23.patch
-Patch900: gdb-vla-intel-13of23.patch
-Patch901: gdb-vla-intel-14of23.patch
-Patch902: gdb-vla-intel-15of23.patch
-Patch903: gdb-vla-intel-16of23.patch
-Patch904: gdb-vla-intel-17of23.patch
-Patch905: gdb-vla-intel-18of23.patch
-Patch906: gdb-vla-intel-19of23.patch
-Patch907: gdb-vla-intel-20of23.patch
-Patch908: gdb-vla-intel-21of23.patch
-Patch909: gdb-vla-intel-22of23.patch
-Patch910: gdb-vla-intel-23of23.patch
# Fix --with-system-readline with readline-6.3 patch 5.
Patch914: gdb-readline-6.3.5.patch
@@ -540,6 +518,10 @@ Patch918: gdb-btrobust.patch
# Fix crash on optimized-out entry data values (BZ 1111910).
Patch919: gdb-entrydataoptimizedout.patch
+# Python completion w/overriden completer (Sergio Durigan Junior, BZ 1075199).
+Patch920: gdb-python-completer-1of2.patch
+Patch921: gdb-python-completer-2of2.patch
+
%if 0%{!?rhel:1} || 0%{?rhel} > 6
# RL_STATE_FEDORA_GDB would not be found for:
# Patch642: gdb-readline62-ask-more-rh.patch
@@ -715,29 +697,7 @@ find -name "*.info*"|xargs rm -f
%patch349 -p1
#patch232 -p1
%patch888 -p1
-%patch889 -p1
-%patch890 -p1
-%patch891 -p1
%patch912 -p1
-%patch892 -p1
-%patch893 -p1
-%patch894 -p1
-%patch895 -p1
-%patch896 -p1
-%patch897 -p1
-%patch898 -p1
-%patch899 -p1
-%patch900 -p1
-%patch901 -p1
-%patch902 -p1
-%patch903 -p1
-%patch904 -p1
-%patch905 -p1
-%patch906 -p1
-%patch907 -p1
-%patch908 -p1
-%patch909 -p1
-%patch910 -p1
%patch1 -p1
%patch105 -p1
@@ -839,6 +799,8 @@ find -name "*.info*"|xargs rm -f
%patch914 -p1
%patch918 -p1
%patch919 -p1
+%patch920 -p1
+%patch921 -p1
%patch848 -p1
%if 0%{!?el6:1}
@@ -960,9 +922,8 @@ $(: ppc64 host build crashes on ppc variant of libexpat.so ) \
%else
--disable-inprocess-agent \
%endif
-$(: %{_bindir}/mono-gdb.py is workaround for mono BZ 815501. ) \
- --with-auto-load-dir='$debugdir:$datadir/auto-load%{?scl::%{_root_datadir}/gdb/auto-load}' \
- --with-auto-load-safe-path='$debugdir:$datadir/auto-load%{?scl::%{_root_datadir}/gdb/auto-load}:%{_root_bindir}/mono-gdb.py' \
+ --with-auto-load-dir='$debugdir:$datadir/auto-load%{?scl::%{_root_datadir}/gdb/auto-load}' \
+ --with-auto-load-safe-path='$debugdir:$datadir/auto-load%{?scl::%{_root_datadir}/gdb/auto-load}' \
%ifarch sparc sparcv9
sparc-%{_vendor}-%{_target_os}%{?_gnu}
%else
@@ -1330,6 +1291,11 @@ then
fi
%changelog
+* Tue Jul 8 2014 Jan Kratochvil <jan.kratochvil at redhat.com> - 7.7.90.20140627-9.fc21
+- Rebase the Intel VLA patchset.
+- Python completion w/overriden completer (Sergio Durigan Junior, BZ 1075199).
+- Remove %{_bindir}/mono-gdb.py workaround of mono BZ 815501.
+
* Tue Jul 1 2014 Jan Kratochvil <jan.kratochvil at redhat.com> - 7.7.90.20140627-8.fc21
- Do not remove %{_datadir}/gdb/syscalls/ppc*.xml as it is secondary target.
- Remove: %{_datadir}/gdb/guile
More information about the scm-commits
mailing list