From cec929771252d3560ec30522be36990ab1703b4f Mon Sep 17 00:00:00 2001 From: Jan Kratochvil Date: Tue, 8 Jul 2014 21:11:05 +0200 Subject: [PATCH] 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(-) create mode 100644 gdb-python-completer-1of2.patch create mode 100644 gdb-python-completer-2of2.patch delete mode 100644 gdb-vla-intel-01of23.patch delete mode 100644 gdb-vla-intel-02of23.patch delete mode 100644 gdb-vla-intel-03of23.patch delete mode 100644 gdb-vla-intel-04of23.patch delete mode 100644 gdb-vla-intel-05of23.patch delete mode 100644 gdb-vla-intel-06of23.patch delete mode 100644 gdb-vla-intel-07of23.patch delete mode 100644 gdb-vla-intel-08of23.patch delete mode 100644 gdb-vla-intel-09of23.patch delete mode 100644 gdb-vla-intel-10of23.patch delete mode 100644 gdb-vla-intel-11of23.patch delete mode 100644 gdb-vla-intel-12of23.patch delete mode 100644 gdb-vla-intel-13of23.patch delete mode 100644 gdb-vla-intel-14of23.patch delete mode 100644 gdb-vla-intel-15of23.patch delete mode 100644 gdb-vla-intel-16of23.patch delete mode 100644 gdb-vla-intel-17of23.patch delete mode 100644 gdb-vla-intel-18of23.patch delete mode 100644 gdb-vla-intel-19of23.patch delete mode 100644 gdb-vla-intel-20of23.patch delete mode 100644 gdb-vla-intel-21of23.patch delete mode 100644 gdb-vla-intel-22of23.patch delete mode 100644 gdb-vla-intel-23of23.patch create mode 100644 gdb-vla-intel.patch 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,"",@progbits -+.Ldebug_abbrev0: -+ .section .debug_info,"",@progbits -+.Ldebug_info0: -+ .section .debug_line,"",@progbits -+.Ldebug_line0: -+ .text -+.Ltext0: -+.globl foo -+ .type foo, @function -+foo: -+.LFB2: -+ .file 1 "x86_64-vla-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,"",@progbits -+.Lframe0: -+ .long .LECIE0-.LSCIE0 -+.LSCIE0: -+ .long 0xffffffff -+ .byte 0x1 -+ .string "" -+ .uleb128 0x1 -+ .sleb128 -8 -+ .byte 0x10 -+ .byte 0xc -+ .uleb128 0x7 -+ .uleb128 0x8 -+ .byte 0x90 -+ .uleb128 0x1 -+ .align 8 -+.LECIE0: -+.LSFDE0: -+ .long .LEFDE0-.LASFDE0 -+.LASFDE0: -+ .long .Lframe0 -+ .quad .LFB2 -+ .quad .LFE2-.LFB2 -+ .byte 0x4 -+ .long .LCFI0-.LFB2 -+ .byte 0xe -+ .uleb128 0x10 -+ .byte 0x86 -+ .uleb128 0x2 -+ .byte 0x4 -+ .long .LCFI1-.LCFI0 -+ .byte 0xd -+ .uleb128 0x6 -+ .align 8 -+.LEFDE0: -+ .section .eh_frame,"a",@progbits -+.Lframe1: -+ .long .LECIE1-.LSCIE1 -+.LSCIE1: -+ .long 0x0 -+ .byte 0x1 -+ .string "zR" -+ .uleb128 0x1 -+ .sleb128 -8 -+ .byte 0x10 -+ .uleb128 0x1 -+ .byte 0x3 -+ .byte 0xc -+ .uleb128 0x7 -+ .uleb128 0x8 -+ .byte 0x90 -+ .uleb128 0x1 -+ .align 8 -+.LECIE1: -+.LSFDE1: -+ .long .LEFDE1-.LASFDE1 -+.LASFDE1: -+ .long .LASFDE1-.Lframe1 -+ .long .LFB2 -+ .long .LFE2-.LFB2 -+ .uleb128 0x0 -+ .byte 0x4 -+ .long .LCFI0-.LFB2 -+ .byte 0xe -+ .uleb128 0x10 -+ .byte 0x86 -+ .uleb128 0x2 -+ .byte 0x4 -+ .long .LCFI1-.LCFI0 -+ .byte 0xd -+ .uleb128 0x6 -+ .align 8 -+.LEFDE1: -+ .text -+.Letext0: -+ .section .debug_loc,"",@progbits -+.Ldebug_loc0: -+.LLST0: -+ .quad .LFB2-.Ltext0 -+ .quad .LCFI0-.Ltext0 -+ .value 0x2 -+ .byte 0x77 -+ .sleb128 8 -+ .quad .LCFI0-.Ltext0 -+ .quad .LCFI1-.Ltext0 -+ .value 0x2 -+ .byte 0x77 -+ .sleb128 16 -+ .quad .LCFI1-.Ltext0 -+ .quad .LFE2-.Ltext0 -+ .value 0x2 -+ .byte 0x76 -+ .sleb128 16 -+ .quad 0x0 -+ .quad 0x0 -+ .section .debug_info -+.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,"",@progbits -+ .long 0x16 -+ .value 0x2 -+ .long .Ldebug_info0 -+ .long 0xa8 -+ .long 0x2d -+ .string "foo" -+ .long 0x0 -+ .section .debug_aranges,"",@progbits -+ .long 0x2c -+ .value 0x2 -+ .long .Ldebug_info0 -+ .byte 0x8 -+ .byte 0x0 -+ .value 0x0 -+ .value 0x0 -+ .quad .Ltext0 -+ .quad .Letext0-.Ltext0 -+ .quad 0x0 -+ .quad 0x0 -+ .section .debug_str,"MS",@progbits,1 -+.LASF0: -+ .string "array" -+.LASF5: -+ .string "size" -+.LASF3: -+ .string "x86_64-vla-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,"",@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 . */ -+ -+#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 . -+ -+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 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 + + 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) + : 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 + + 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 . ++ ++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 . ++ ++# 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-01of23.patch b/gdb-vla-intel-01of23.patch deleted file mode 100644 index 0b378a4..0000000 --- a/gdb-vla-intel-01of23.patch +++ /dev/null @@ -1,270 +0,0 @@ -Subject: [PATCH 01/23] dwarf: add dwarf3 DW_OP_push_object_address opcode -Message-Id: <1401861266-6240-2-git-send-email-keven.boell@intel.com> - -The opcode pushes the address of the object being evaluated. The semantic is -equivalent to the implicit push of the base address of a data member location. - -2014-05-28 Sanimir Agovic - Keven Boell - - * dwarf2expr.c (execute_stack_op) : New case. - * dwarf2expr.h (struct dwarf_expr_context_funcs) - : New function pointer get_object_addr. - * dwarf2loc.c (struct dwarf_expr_baton): Add obj_address. - (dwarf_expr_get_obj_addr): New function. - (struct dwarf_expr_context_funcs): Add - dwarf_expr_get_obj_addr to dwarf_expr_ctx_funcs. - (dwarf2_evaluate_loc_desc_full): Initialize baton.obj_address. - (dwarf2_locexpr_baton_eval): Set baton.obj_address to addr. - (needs_get_obj_addr): New function. - (struct dwarf_expr_context_funcs): Add needs_get_obj_addr to - needs_frame_ctx_funcs. - -Change-Id: Ied9e1ba632e8d35d0ec00cc832b96d432449fd82 - -Signed-off-by: Keven Boell ---- - gdb/dwarf2expr.c | 6 ++++++ - gdb/dwarf2expr.h | 4 ---- - gdb/dwarf2loc.c | 41 +++++++++++++++++++++++++++++++++++++---- - gdb/dwarf2loc.h | 1 + - gdb/gdbtypes.c | 16 ++++++++-------- - 5 files changed, 52 insertions(+), 16 deletions(-) - -Index: gdb-7.7.90.20140613/gdb/dwarf2expr.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2expr.c 2014-06-14 15:02:21.484551132 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2expr.c 2014-06-14 15:02:52.299575369 +0200 -@@ -1478,6 +1478,12 @@ execute_stack_op (struct dwarf_expr_cont - } - 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); - } -Index: gdb-7.7.90.20140613/gdb/dwarf2expr.h -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2expr.h 2014-06-14 15:02:21.485551133 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2expr.h 2014-06-14 15:02:52.299575369 +0200 -@@ -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. */ -Index: gdb-7.7.90.20140613/gdb/dwarf2loc.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2loc.c 2014-06-14 15:02:21.487551135 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2loc.c 2014-06-14 15:02:52.301575370 +0200 -@@ -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 (s - - 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, - 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.. */ -@@ -2206,7 +2224,8 @@ static const struct dwarf_expr_context_f - 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 -@@ -2235,6 +2254,7 @@ dwarf2_evaluate_loc_desc_full (struct ty - - 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); -@@ -2440,6 +2460,7 @@ dwarf2_evaluate_loc_desc (struct type *t - - static int - dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton, -+ CORE_ADDR addr, - CORE_ADDR *valp) - { - struct dwarf_expr_context *ctx; -@@ -2455,6 +2476,7 @@ dwarf2_locexpr_baton_eval (const struct - - baton.frame = get_selected_frame (NULL); - baton.per_cu = dlbaton->per_cu; -+ baton.obj_address = addr; - - objfile = dwarf2_per_cu_objfile (dlbaton->per_cu); - -@@ -2495,7 +2517,8 @@ dwarf2_locexpr_baton_eval (const struct - /* 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; -@@ -2506,7 +2529,7 @@ dwarf2_evaluate_property (const struct d - { - 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) - { -@@ -2657,6 +2680,15 @@ needs_get_addr_index (void *baton, unsig - return 1; - } - -+/* DW_OP_push_object_address has a frame already passed thru. */ -+ -+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 = -@@ -2671,7 +2703,8 @@ static const struct dwarf_expr_context_f - 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) -Index: gdb-7.7.90.20140613/gdb/dwarf2loc.h -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2loc.h 2014-06-14 15:02:21.488551135 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2loc.h 2014-06-14 15:02:52.301575370 +0200 -@@ -96,6 +96,7 @@ struct value *dwarf2_evaluate_loc_desc ( - 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, -Index: gdb-7.7.90.20140613/gdb/gdbtypes.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/gdbtypes.c 2014-06-14 15:02:21.490551137 +0200 -+++ gdb-7.7.90.20140613/gdb/gdbtypes.c 2014-06-14 15:03:37.919609955 +0200 -@@ -1657,7 +1657,7 @@ is_dynamic_type (struct type *type) - 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; -@@ -1668,7 +1668,7 @@ resolve_dynamic_range (struct type *dyn_ - 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 +1680,7 @@ resolve_dynamic_range (struct type *dyn_ - } - - prop = &TYPE_RANGE_DATA (dyn_range_type)->high; -- if (dwarf2_evaluate_property (prop, &value)) -+ if (dwarf2_evaluate_property (prop, addr, &value)) - { - high_bound.kind = PROP_CONST; - high_bound.data.const_val = value; -@@ -1707,7 +1707,7 @@ resolve_dynamic_range (struct type *dyn_ - 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; -@@ -1718,12 +1718,12 @@ resolve_dynamic_array (struct type *type - - 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); - - 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)); -+ elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type), addr); - else - elt_type = TYPE_TARGET_TYPE (type); - -@@ -1853,11 +1853,11 @@ resolve_dynamic_type (struct type *type, - } - - case TYPE_CODE_ARRAY: -- resolved_type = resolve_dynamic_array (type); -+ 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: diff --git a/gdb-vla-intel-02of23.patch b/gdb-vla-intel-02of23.patch deleted file mode 100644 index b797ece..0000000 --- a/gdb-vla-intel-02of23.patch +++ /dev/null @@ -1,192 +0,0 @@ -Subject: [PATCH 02/23] dwarf: add DW_AT_data_location support -Message-Id: <1401861266-6240-3-git-send-email-keven.boell@intel.com> - -An object might have a descriptor proceeding the actual value. -To point the debugger to the actually value of an object -DW_AT_data_location is used for. For example the compile may -emit for this entity: - - 1| int foo[N]; - -the following descriptor: - -struct array { - size_t size; - void* data; // DW_AT_data_location describes this location -} - -This allows GDB to print the actual data of an type. - -2014-05-28 Sanimir Agovic - Keven Boell - - * dwarf2read.c (set_die_type): Parse and save DW_AT_data_location - attribute. - * gdbtypes.c (is_dynamic_type): Consider a type being dynamic if - the data location has not yet been resolved. - (resolve_dynamic_type): Evaluate data location baton - if present and save its value. - * gdbtypes.h : Add data_location. - (TYPE_DATA_LOCATION): New macro. - (TYPE_DATA_LOCATION_ADDR): New macro. - (TYPE_DATA_LOCATION_IS_ADDRESS): New macro. - * value.c: Include dwarf2loc.h. - (value_fetch_lazy): Use data location addres to read value from - memory. - (coerce_ref): Construct new value from data location. - -Change-Id: Ic633fa125efdb5e438204e4f80bb3a1c97758b12 - -Signed-off-by: Keven Boell ---- - gdb/dwarf2read.c | 15 +++++++++++++++ - gdb/gdbtypes.c | 29 +++++++++++++++++++++++++++-- - gdb/gdbtypes.h | 14 ++++++++++++++ - gdb/value.c | 8 +++++++- - 4 files changed, 63 insertions(+), 3 deletions(-) - -Index: gdb-7.7.90.20140613/gdb/dwarf2read.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2read.c 2014-06-14 15:06:00.834714409 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2read.c 2014-06-14 15:06:08.326719753 +0200 -@@ -21642,6 +21642,7 @@ set_die_type (struct die_info *die, stru - { - struct dwarf2_per_cu_offset_and_type **slot, ofs; - struct objfile *objfile = cu->objfile; -+ struct attribute *attr; - - /* For Ada types, make sure that the gnat-specific data is always - initialized (if not already set). There are a few types where -@@ -21656,6 +21657,20 @@ set_die_type (struct die_info *die, stru - && !HAVE_GNAT_AUX_INFO (type)) - INIT_GNAT_SPECIFIC (type); - -+ /* Read DW_AT_data_location and set in type. */ -+ attr = dwarf2_attr (die, DW_AT_data_location, cu); -+ if (attr_form_is_block (attr)) -+ { -+ struct dynamic_prop prop; -+ -+ if (attr_to_dynamic_prop (attr, die, cu, &prop)) -+ { -+ 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 = -Index: gdb-7.7.90.20140613/gdb/gdbtypes.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/gdbtypes.c 2014-06-14 15:06:00.836714410 +0200 -+++ gdb-7.7.90.20140613/gdb/gdbtypes.c 2014-06-14 15:12:28.963986344 +0200 -@@ -1634,7 +1634,12 @@ is_dynamic_type (struct type *type) - or the elements it contains have a dynamic contents. */ - 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)); - } - - case TYPE_CODE_STRUCT: -@@ -1830,6 +1835,8 @@ resolve_dynamic_type (struct type *type, - { - 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; -@@ -1869,6 +1876,18 @@ resolve_dynamic_type (struct type *type, - break; - } - -+ type = resolved_type; -+ -+ /* Resolve data_location attribute. */ -+ prop = TYPE_DATA_LOCATION (type); -+ if (dwarf2_evaluate_property (prop, addr, &value)) -+ { -+ TYPE_DATA_LOCATION_ADDR (type) = value; -+ TYPE_DATA_LOCATION_KIND (type) = PROP_CONST; -+ } -+ else -+ TYPE_DATA_LOCATION (type) = NULL; -+ - return resolved_type; - } - -@@ -4078,6 +4097,13 @@ copy_type_recursive (struct objfile *obj - *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 pointers to other types. */ - if (TYPE_TARGET_TYPE (type)) - TYPE_TARGET_TYPE (new_type) = -Index: gdb-7.7.90.20140613/gdb/gdbtypes.h -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/gdbtypes.h 2014-06-14 15:06:00.837714411 +0200 -+++ gdb-7.7.90.20140613/gdb/gdbtypes.h 2014-06-14 15:06:08.328719754 +0200 -@@ -725,6 +725,10 @@ struct main_type - - struct func_type *func_stuff; - } type_specific; -+ -+ /* * Indirection to actual data. */ -+ -+ struct dynamic_prop *data_location; - }; - - /* * A ``struct type'' describes a particular instance of a type, with -@@ -1204,6 +1208,16 @@ extern void allocate_gnat_aux_type (stru - #define TYPE_LOW_BOUND_KIND(range_type) \ - TYPE_RANGE_DATA(range_type)->low.kind - -+/* Attribute accessors for VLA support. */ -+#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 -+ - /* Moto-specific stuff for FORTRAN arrays. */ - - #define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \ -Index: gdb-7.7.90.20140613/gdb/value.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/value.c 2014-06-14 15:06:00.838714412 +0200 -+++ gdb-7.7.90.20140613/gdb/value.c 2014-06-14 15:06:08.329719755 +0200 -@@ -3699,8 +3699,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-vla-intel-03of23.patch b/gdb-vla-intel-03of23.patch deleted file mode 100644 index fb284e9..0000000 --- a/gdb-vla-intel-03of23.patch +++ /dev/null @@ -1,115 +0,0 @@ -Subject: [PATCH 03/23] vla: introduce allocated/associated flags -Message-Id: <1401861266-6240-4-git-send-email-keven.boell@intel.com> - -Fortran 90 provide types whose values may be dynamically -allocated or associated with a variable under explicit -program control. The purpose of this commit is to read -allocated/associated DWARF tags and store them to the -main_type. - -2014-05-28 Keven Boell - Sanimir Agovic - - * dwarf2read.c (set_die_type): Add reading of - allocated/associated flags. - * gdbtypes.h (struct main_type): Add allocated/ - associated dwarf2_prop attributes. - (TYPE_ALLOCATED_PROP): New macro. - (TYPE_ASSOCIATED_PROP): New macro. - (TYPE_NOT_ALLOCATED): New macro. - (TYPE_NOT_ASSOCIATED): New macro. - -Change-Id: I44a9e21986de16de061b3ea2a7689f1bfa28ed2e - -Signed-off-by: Keven Boell ---- - gdb/dwarf2read.c | 28 ++++++++++++++++++++++++++++ - gdb/gdbtypes.h | 26 ++++++++++++++++++++++++++ - 2 files changed, 54 insertions(+) - -diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c -index 7a0f7f4..ea66602 100644 ---- a/gdb/dwarf2read.c -+++ b/gdb/dwarf2read.c -@@ -21514,6 +21514,34 @@ 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)) -+ { -+ 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)) -+ { -+ 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_form_is_block (attr)) -diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h -index c6d14d2..52e6233 100644 ---- a/gdb/gdbtypes.h -+++ b/gdb/gdbtypes.h -@@ -726,6 +726,18 @@ struct main_type - /* * Indirection to actual data. */ - - 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 -@@ -1214,6 +1226,20 @@ extern void allocate_gnat_aux_type (struct type *); - 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. */ - --- -1.7.9.5 - 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-04of23.patch b/gdb-vla-intel-04of23.patch deleted file mode 100644 index f003ab3..0000000 --- a/gdb-vla-intel-04of23.patch +++ /dev/null @@ -1,614 +0,0 @@ -Subject: [PATCH 04/23] vla: make dynamic fortran arrays functional. -Message-Id: <1401861266-6240-5-git-send-email-keven.boell@intel.com> - -This patch enables GDB to print the value of a dynamic -array (VLA) if allocated/associated in fortran. If not the -allocation status will be printed to the command line. - -(gdb) p vla_not_allocated -$1 = - -(gdb) p vla_allocated -$1 = (1, 2, 3) - -(gdb) p vla_not_associated -$1 = - -(gdb) p vla_associated -$1 = (3, 2, 1) - -The patch covers various locations where the allocation/ -association status makes sense to print. - -2014-05-28 Keven Boell - Sanimir Agovic - - * dwarf2loc.c (dwarf2_address_data_valid): New - function. - * dwarf2loc.h (dwarf2_address_data_valid): New - function. - * f-typeprint.c (f_print_type): Print allocation/ - association status. - (f_type_print_varspec_suffix): Print allocation/ - association status for &-operator usages. - * gdbtypes.c (create_array_type_with_stride): Add - query for valid data location. - (is_dynamic_type): Extend dynamic type detection - with allocated/associated. Add type detection for - fields. - (resolve_dynamic_range): Copy type before resolving - it as dynamic attributes need to be preserved. - (resolve_dynamic_array): Copy type before resolving - it as dynamic attributes need to be preserved. Add - resolving of allocated/associated attributes. - (resolve_dynamic_type): Add call to nested - type resolving. - (copy_type_recursive): Add allocated/associated - attributes to be copied. - (copy_type): Copy allocated/associated/data_location - as well as the fields structure if available. - (resolve_dynamic_compound): New function. - * valarith.c (value_subscripted_rvalue): Print allocated/ - associated status when indexing a VLA. - * valprint.c (valprint_check_validity): Print allocated/ - associated status. - (val_print_not_allocated): New function. - (val_print_not_associated): New function. - * valprint.h (val_print_not_allocated): New function. - (val_print_not_associated): New function. - * value.c (set_value_component_location): Adjust the value - address for single value prints. - -Change-Id: Idfb44c8a6b38008f8e2c84cb0fdb13729ec160f4 - -Signed-off-by: Keven Boell ---- - gdb/dwarf2loc.c | 14 +++++ - gdb/dwarf2loc.h | 6 ++ - gdb/f-typeprint.c | 62 +++++++++++++------- - gdb/gdbtypes.c | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++-- - gdb/valarith.c | 9 ++- - gdb/valprint.c | 40 +++++++++++++ - gdb/valprint.h | 4 ++ - gdb/value.c | 20 +++++++ - 8 files changed, 292 insertions(+), 28 deletions(-) - -Index: gdb-7.7.90.20140613/gdb/dwarf2loc.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2loc.c 2014-06-14 15:12:43.797996885 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2loc.c 2014-06-14 15:12:45.485998049 +0200 -@@ -2569,6 +2569,20 @@ dwarf2_evaluate_property (const struct d - 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. */ - -Index: gdb-7.7.90.20140613/gdb/dwarf2loc.h -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2loc.h 2014-06-14 15:12:43.797996885 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2loc.h 2014-06-14 15:12:45.486998064 +0200 -@@ -102,6 +102,12 @@ int dwarf2_evaluate_property (const stru - 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 -Index: gdb-7.7.90.20140613/gdb/f-typeprint.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/f-typeprint.c 2014-06-14 15:12:43.798996886 +0200 -+++ gdb-7.7.90.20140613/gdb/f-typeprint.c 2014-06-14 15:12:45.486998064 +0200 -@@ -30,6 +30,7 @@ - #include "gdbcore.h" - #include "target.h" - #include "f-lang.h" -+#include "valprint.h" - - #include - #include -@@ -56,6 +57,17 @@ f_print_type (struct type *type, const c - 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 - 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 -Index: gdb-7.7.90.20140613/gdb/gdbtypes.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/gdbtypes.c 2014-06-14 15:12:43.801996888 +0200 -+++ gdb-7.7.90.20140613/gdb/gdbtypes.c 2014-06-14 15:14:34.837102369 +0200 -@@ -1003,7 +1003,8 @@ create_array_type_with_stride (struct ty - - 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; - -@@ -1616,11 +1617,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: -@@ -1669,6 +1689,7 @@ resolve_dynamic_range (struct type *dyn_ - const struct dynamic_prop *prop; - const struct dwarf2_locexpr_baton *baton; - struct dynamic_prop low_bound, high_bound; -+ struct type *range_copy = copy_type (dyn_range_type); - - gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); - -@@ -1700,8 +1721,8 @@ resolve_dynamic_range (struct type *dyn_ - high_bound.data.const_val = 0; - } - -- static_range_type = create_range_type (copy_type (dyn_range_type), -- TYPE_TARGET_TYPE (dyn_range_type), -+ static_range_type = create_range_type (range_copy, -+ TYPE_TARGET_TYPE (range_copy), - &low_bound, &high_bound); - TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; - return static_range_type; -@@ -1718,6 +1739,8 @@ resolve_dynamic_array (struct type *type - 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); - -@@ -1725,18 +1748,93 @@ resolve_dynamic_array (struct type *type - range_type = check_typedef (TYPE_INDEX_TYPE (elt_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), addr); -+ elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr); - else - elt_type = TYPE_TARGET_TYPE (type); - -- return create_array_type (copy_type (type), -+ return create_array_type (copy, - elt_type, - range_type); - } - -+/* Resolves dynamic compound types, e.g. STRUCTS's to static ones. -+ ADDRESS is needed to resolve the compound type data location. */ -+ -+static struct type * -+resolve_dynamic_compound (struct type *type, CORE_ADDR addr) -+{ -+ struct type *cur_type, *prev_type, *copy; -+ int index, depth = 0; -+ -+ cur_type = type; -+ prev_type = cur_type; -+ while (cur_type) -+ { -+ switch (TYPE_CODE (cur_type)) -+ { -+ case TYPE_CODE_STRUCT: -+ { -+ copy = copy_type (cur_type); -+ for (index = 0; index < TYPE_NFIELDS (copy); index++) -+ { -+ struct type *index_type = TYPE_FIELD_TYPE (copy, index); -+ -+ if (index_type == NULL) -+ continue; -+ -+ if (TYPE_CODE (index_type) == TYPE_CODE_ARRAY -+ || TYPE_CODE (index_type) == TYPE_CODE_STRUCT) -+ { -+ if (TYPE_CODE (index_type) != TYPE_CODE_RANGE) -+ addr += -+ (TYPE_FIELD_BITPOS (copy, index) / 8); -+ -+ TYPE_FIELD_TYPE (copy, index) = -+ resolve_dynamic_type (TYPE_FIELD_TYPE (copy, index), -+ addr); -+ } -+ } -+ -+ /* If a struct type will be resolved as the first type, we need -+ to assign it back the resolved_type. In the other case it can -+ be that we have a struct, which is nested in another type. -+ Therefore we need to preserve the previous type, to assign the -+ new resolved type as the previous' target type. */ -+ if (depth == 0) -+ type = copy; -+ else -+ TYPE_TARGET_TYPE (prev_type) = copy; -+ } -+ break; -+ } -+ -+ /* Store the previous type, in order to assign resolved types back to -+ the right target type. */ -+ prev_type = cur_type; -+ cur_type = TYPE_TARGET_TYPE (cur_type); -+ depth++; -+ }; -+ -+ return type; -+} -+ - /* Resolve dynamic bounds of members of the union TYPE to static - bounds. */ - -@@ -1836,7 +1934,7 @@ resolve_dynamic_type (struct type *type, - struct type *real_type = check_typedef (type); - struct type *resolved_type = type; - const struct dynamic_prop *prop; -- CORE_ADDR value; -+ CORE_ADDR value, adjusted_address = addr; - - if (!is_dynamic_type (real_type)) - return type; -@@ -1882,12 +1980,15 @@ resolve_dynamic_type (struct type *type, - prop = TYPE_DATA_LOCATION (type); - if (dwarf2_evaluate_property (prop, addr, &value)) - { -+ adjusted_address = value; - TYPE_DATA_LOCATION_ADDR (type) = value; - TYPE_DATA_LOCATION_KIND (type) = PROP_CONST; - } - else - TYPE_DATA_LOCATION (type) = NULL; - -+ resolved_type = resolve_dynamic_compound (type, adjusted_address); -+ - return resolved_type; - } - -@@ -4104,6 +4205,20 @@ copy_type_recursive (struct objfile *obj - *TYPE_DATA_LOCATION (new_type) = *TYPE_DATA_LOCATION (type); - } - -+ /* Copy allocated information. */ -+ if (TYPE_ALLOCATED_PROP (type) != NULL) -+ { -+ TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop)); -+ *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type); -+ } -+ -+ /* Copy associated information. */ -+ if (TYPE_ASSOCIATED_PROP (type) != NULL) -+ { -+ TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop)); -+ *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type); -+ } -+ - /* Copy pointers to other types. */ - if (TYPE_TARGET_TYPE (type)) - TYPE_TARGET_TYPE (new_type) = -@@ -4150,6 +4265,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; - } - -Index: gdb-7.7.90.20140613/gdb/valarith.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/valarith.c 2014-06-14 15:12:43.801996888 +0200 -+++ gdb-7.7.90.20140613/gdb/valarith.c 2014-06-14 15:12:45.488998075 +0200 -@@ -200,7 +200,14 @@ value_subscripted_rvalue (struct value * - - 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); -Index: gdb-7.7.90.20140613/gdb/valprint.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/valprint.c 2014-06-14 15:12:43.802996888 +0200 -+++ gdb-7.7.90.20140613/gdb/valprint.c 2014-06-14 15:12:45.488998075 +0200 -@@ -307,6 +307,18 @@ valprint_check_validity (struct ui_file - { - 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_fil - fprintf_filtered (stream, _("")); - } - -+void -+val_print_not_allocated (struct ui_file *stream) -+{ -+ fprintf_filtered (stream, _("")); -+} -+ -+void -+val_print_not_associated (struct ui_file *stream) -+{ -+ fprintf_filtered (stream, _("")); -+} -+ - /* 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, _("
")); - 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 - 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; - } - -Index: gdb-7.7.90.20140613/gdb/valprint.h -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/valprint.h 2014-06-14 15:12:43.803996889 +0200 -+++ gdb-7.7.90.20140613/gdb/valprint.h 2014-06-14 15:12:45.489998073 +0200 -@@ -217,4 +217,8 @@ extern void output_command_const (const - - 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 -Index: gdb-7.7.90.20140613/gdb/value.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/value.c 2014-06-14 15:12:43.804996890 +0200 -+++ gdb-7.7.90.20140613/gdb/value.c 2014-06-14 15:12:45.490998069 +0200 -@@ -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 val - 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); -+ } -+ } - } - - diff --git a/gdb-vla-intel-05of23.patch b/gdb-vla-intel-05of23.patch deleted file mode 100644 index 3b09937..0000000 --- a/gdb-vla-intel-05of23.patch +++ /dev/null @@ -1,65 +0,0 @@ -Subject: [PATCH 05/23] vla: make field selection work with vla -Message-Id: <1401861266-6240-6-git-send-email-keven.boell@intel.com> - -In Fortran vla are pointers to arrays. Thus a -type only contains a pointer to such array and -we need to re-read the field to retrieve the -correct vla. - -old (wrong value): -(gdb) p type_var%vla(14) -$1 = 1 - -new (correct value): -(gdb) p type_var%vla(14) -$1 = 42 - -2014-05-28 Sanimir Agovic - Keven Boell - - * value.c (value_primitive_field): Re-evaluate - field value to get the actual value. - -Change-Id: Ic22c37324963aca520c52a80fbbd0042d1fddc05 - -Signed-off-by: Keven Boell ---- - gdb/value.c | 21 +++++++++++++++------ - 1 file changed, 15 insertions(+), 6 deletions(-) - -diff --git a/gdb/value.c b/gdb/value.c -index 08593b6..1f0d9a4 100644 ---- a/gdb/value.c -+++ b/gdb/value.c -@@ -2929,13 +2929,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); --- -1.7.9.5 - diff --git a/gdb-vla-intel-06of23.patch b/gdb-vla-intel-06of23.patch deleted file mode 100644 index 39c2d05..0000000 --- a/gdb-vla-intel-06of23.patch +++ /dev/null @@ -1,67 +0,0 @@ -Subject: [PATCH 06/23] vla: reconstruct value to compute bounds of target type -Message-Id: <1401861266-6240-7-git-send-email-keven.boell@intel.com> - -Printing a pointer to an array, gdb tries to print the -target type including its bounds. To follow this -semantic with vla, this patch re-constructs the value to -resolve the bounds of the target type. - -2014-05-28 Sanimir Agovic - Keven Boell - - * typeprint.c (whatis_exp): Re-construct value to - compute bounds of target type. - * c-valprint.c (c_value_print): Re-construct value - to compute bounds of target type. - -Change-Id: Ia8a25021c7cc206711ca6f359ae5566a367e3b3d - -Signed-off-by: Keven Boell ---- - gdb/c-valprint.c | 11 ++++++++++- - gdb/typeprint.c | 7 +++++++ - 2 files changed, 17 insertions(+), 1 deletion(-) - -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/typeprint.c b/gdb/typeprint.c -index b4ad431..b3c73a8 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) - { --- -1.7.9.5 - diff --git a/gdb-vla-intel-07of23.patch b/gdb-vla-intel-07of23.patch deleted file mode 100644 index 1eeebe2..0000000 --- a/gdb-vla-intel-07of23.patch +++ /dev/null @@ -1,211 +0,0 @@ -Subject: [PATCH 07/23] vla: use value constructor instead of raw-buffer manipulation -Message-Id: <1401861266-6240-8-git-send-email-keven.boell@intel.com> - -Instead of pre-computing indices into a fortran array re-use -the value_* interfaces to subscript a fortran array. - -2014-05-28 Sanimir Agovic - Keven Boell - - * f-valprint.c (f77_create_arrayprint_offset_tbl): Remove - function. - (F77_DIM_SIZE, F77_DIM_OFFSET): Remove macro. - (f77_print_array_1): Use value_subscript to subscript a - value array. - (f77_print_array): Remove call to f77_create_arrayprint_offset_tbl. - (f_val_print): Use value_field to construct a field value. - -Change-Id: I09e482ceb114eeb0f08b5528d40ffed8d79119ee - -Signed-off-by: Keven Boell ---- - gdb/f-valprint.c | 118 ++++++++++++++++++------------------------------------ - 1 file changed, 39 insertions(+), 79 deletions(-) - -diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c -index d8c767f..1ab5bd8 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,56 @@ 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 = TYPE_LENGTH (TYPE_TARGET_TYPE (type)); -+ size_t offs = 0; -+ -+ 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 +191,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 +335,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); - } --- -1.7.9.5 - diff --git a/gdb-vla-intel-08of23.patch b/gdb-vla-intel-08of23.patch deleted file mode 100644 index 7559d00..0000000 --- a/gdb-vla-intel-08of23.patch +++ /dev/null @@ -1,49 +0,0 @@ -Subject: [PATCH 08/23] vla: get dynamic array corner cases to work -Message-Id: <1401861266-6240-9-git-send-email-keven.boell@intel.com> - -This patch does not overwrite the value type in -case it is a dynamic type. For dynamic types GDB -resolved its dynamic values in a copy of the type. -The call to deprecated_set_value_type overwrites the -resolved type with the original type, which breaks -e.g. pointer to a Fortran type, which contains a dynamic -array. - -Old: -(gdb) print &vla1 -(PTR TO -> ( real(kind=4) (23959136:23959184))) 0x7fffffffd490 - -New: -(gdb) print &vla1 -(PTR TO -> ( real(kind=4) (5))) 0x7fffffffd490 - -2014-05-28 Keven Boell - Sanimir Agovic - - * value.c (readjust_indirect_value_type): Add - check for dynamic types. - -Change-Id: If1c6fb0bd3c1d04619e89a1b58850edb69bbfde0 - -Signed-off-by: Keven Boell ---- - gdb/value.c | 3 ++- - 1 file changed, 2 insertions(+), 1 deletion(-) - -diff --git a/gdb/value.c b/gdb/value.c -index 1f0d9a4..7abb20a 100644 ---- a/gdb/value.c -+++ b/gdb/value.c -@@ -3504,7 +3504,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); --- -1.7.9.5 - diff --git a/gdb-vla-intel-09of23.patch b/gdb-vla-intel-09of23.patch deleted file mode 100644 index b72bcc5..0000000 --- a/gdb-vla-intel-09of23.patch +++ /dev/null @@ -1,316 +0,0 @@ -Subject: [PATCH 09/23] vla: changed string length semantic. -Message-Id: <1401861266-6240-10-git-send-email-keven.boell@intel.com> - -This patch changes the semantic of the Dwarf string length -attribute to reflect the standard. This serves as pre-work -to get variable strings in Fortran to work. - -2014-05-28 Keven Boell - Sanimir Agovic - - * dwarf2read.c (read_tag_string_type): changed - semantic of DW_AT_string_length to be able to - handle Dwarf blocks as well. Support for - DW_AT_byte_length added to get correct length - if specified in combination with - DW_AT_string_length. - (attr_to_dynamic_prop): added - functionality to add Dwarf operators to baton - data attribute. Added post values to baton - as required by the string evaluation case. - (read_subrange_type): Adapt caller. - (set_die_type): Adapt caller. - (add_post_values_to_baton): New function. - * dwarf2loc.c (dwarf2_evaluate_property): Evaluate - post processing dwarf. - * dwarf2loc.h (struct dwarf2_property_baton): Add - post dwarf values attribute. - -Change-Id: I6edfa005f416cddc8e364d34891b9abf6b44f757 - -Signed-off-by: Keven Boell ---- - gdb/dwarf2loc.c | 10 +++++ - gdb/dwarf2loc.h | 3 ++ - gdb/dwarf2read.c | 129 +++++++++++++++++++++++++++++++++++++++++++++++------- - 3 files changed, 127 insertions(+), 15 deletions(-) - -diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c -index 7ab734d..2473f80 100644 ---- a/gdb/dwarf2loc.c -+++ b/gdb/dwarf2loc.c -@@ -2533,6 +2533,11 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR address, - - *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; - } - } -@@ -2555,6 +2560,11 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR address, - 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; - } - } -diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h -index fb65c5c..cf648eb 100644 ---- a/gdb/dwarf2loc.h -+++ b/gdb/dwarf2loc.h -@@ -168,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 ea66602..0b23701 100644 ---- a/gdb/dwarf2read.c -+++ b/gdb/dwarf2read.c -@@ -1842,6 +1842,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. */ - -@@ -14029,29 +14038,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); - -@@ -14368,13 +14438,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; -@@ -14387,8 +14480,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); -@@ -14409,6 +14504,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); -@@ -14420,6 +14517,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); -@@ -14509,17 +14608,17 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - - 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) -@@ -21520,7 +21619,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) - { - struct dynamic_prop prop; - -- if (attr_to_dynamic_prop (attr, die, cu, &prop)) -+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) - { - TYPE_ALLOCATED_PROP (type) - = obstack_alloc (&objfile->objfile_obstack, sizeof (prop)); -@@ -21534,7 +21633,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) - { - struct dynamic_prop prop; - -- if (attr_to_dynamic_prop (attr, die, cu, &prop)) -+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) - { - TYPE_ASSOCIATED_PROP (type) - = obstack_alloc (&objfile->objfile_obstack, sizeof (prop)); -@@ -21548,7 +21647,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) - { - struct dynamic_prop prop; - -- if (attr_to_dynamic_prop (attr, die, cu, &prop)) -+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) - { - TYPE_DATA_LOCATION (type) - = obstack_alloc (&objfile->objfile_obstack, sizeof (prop)); --- -1.7.9.5 - diff --git a/gdb-vla-intel-10of23.patch b/gdb-vla-intel-10of23.patch deleted file mode 100644 index 1455978..0000000 --- a/gdb-vla-intel-10of23.patch +++ /dev/null @@ -1,94 +0,0 @@ -Subject: [PATCH 10/23] vla: get Fortran dynamic strings working. -Message-Id: <1401861266-6240-11-git-send-email-keven.boell@intel.com> - -This patch enables the correct calculation of dynamic -string length. - -Old: -(gdb) p my_dyn_string -$1 = (PTR TO -> ( character*23959136 )) 0x605fc0 - -(gdb) p *my_dyn_string -Cannot access memory at address 0x605fc0 - -New: -(gdb) p my_dyn_string -$1 = (PTR TO -> ( character*10 )) 0x605fc0 - -(gdb) p *my_dyn_string -$2 = 'foo' - -2014-05-28 Keven Boell - Sanimir Agovic - - * gdbtypes.c (resolve_dynamic_type): Add - conditions to support string types. - (resolve_dynamic_array): Add conditions for dynamic - strings and create a new string type. - (is_dynamic_type): Follow pointer if a string type - was detected, as Fortran strings are represented - as pointers to strings internally. - -Change-Id: I7d54d762a081ce034be37ac3e368bac8111dc4e6 - -Signed-off-by: Keven Boell ---- - gdb/gdbtypes.c | 24 ++++++++++++++++++++---- - 1 file changed, 20 insertions(+), 4 deletions(-) - -Index: gdb-7.7.90.20140613/gdb/gdbtypes.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/gdbtypes.c 2014-06-14 15:14:48.623115597 +0200 -+++ gdb-7.7.90.20140613/gdb/gdbtypes.c 2014-06-14 15:15:26.876151187 +0200 -@@ -1662,6 +1662,15 @@ is_dynamic_type (struct type *type) - return is_dynamic_type (TYPE_TARGET_TYPE (type)); - } - -+ 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; -+ } - case TYPE_CODE_STRUCT: - case TYPE_CODE_UNION: - { -@@ -1742,7 +1751,8 @@ resolve_dynamic_array (struct type *type - 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)); -@@ -1769,9 +1779,14 @@ resolve_dynamic_array (struct type *type - else - elt_type = TYPE_TARGET_TYPE (type); - -- return create_array_type (copy, -- 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); - } - - /* Resolves dynamic compound types, e.g. STRUCTS's to static ones. -@@ -1958,6 +1973,7 @@ resolve_dynamic_type (struct type *type, - } - - case TYPE_CODE_ARRAY: -+ case TYPE_CODE_STRING: - resolved_type = resolve_dynamic_array (type, addr); - break; - diff --git a/gdb-vla-intel-11of23.patch b/gdb-vla-intel-11of23.patch deleted file mode 100644 index 6b18cf3..0000000 --- a/gdb-vla-intel-11of23.patch +++ /dev/null @@ -1,272 +0,0 @@ -Subject: [PATCH 11/23] vla: add stride support to fortran arrays. -Message-Id: <1401861266-6240-12-git-send-email-keven.boell@intel.com> - -2014-05-28 Sanimir Agovic - Keven Boell - - * dwarf2read.c (read_subrange_type): Read dynamic - stride attributes. - * gdbtypes.c (create_array_type_with_stride): Add - stride support - (create_range_type): Add stride parameter. - (create_static_range_type): Pass default stride - parameter. - (resolve_dynamic_range): Evaluate stride baton. - (resolve_dynamic_type): Adjust data location with - the value of byte stride. - * gdbtypes.h (TYPE_BYTE_STRIDE): New macro. - (TYPE_BYTE_STRIDE_BLOCK): New macro. - (TYPE_BYTE_STRIDE_LOCLIST): New macro. - (TYPE_BYTE_STRIDE_KIND): New macro. - * valarith.c (value_subscripted_rvalue): Use stride. - -Change-Id: I3d810c0dc37f9d9fd84dba4c764cdefc52d8501e - -Signed-off-by: Keven Boell ---- - gdb/dwarf2read.c | 13 +++++++++++-- - gdb/gdbtypes.c | 40 ++++++++++++++++++++++++++++++++++------ - gdb/gdbtypes.h | 17 +++++++++++++++++ - gdb/valarith.c | 14 +++++++++++++- - 4 files changed, 75 insertions(+), 9 deletions(-) - -Index: gdb-7.7.90.20140613/gdb/dwarf2read.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/dwarf2read.c 2014-06-16 23:24:12.741584315 +0200 -+++ gdb-7.7.90.20140613/gdb/dwarf2read.c 2014-06-16 23:25:12.702640910 +0200 -@@ -14696,7 +14696,7 @@ read_subrange_type (struct die_info *die - 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; -@@ -14716,7 +14716,9 @@ read_subrange_type (struct die_info *die - - 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. */ -@@ -14749,6 +14751,13 @@ read_subrange_type (struct die_info *die - 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, NULL, 0); -@@ -14825,7 +14834,7 @@ read_subrange_type (struct die_info *die - && !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; -Index: gdb-7.7.90.20140613/gdb/gdbtypes.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/gdbtypes.c 2014-06-16 23:24:12.741584315 +0200 -+++ gdb-7.7.90.20140613/gdb/gdbtypes.c 2014-06-16 23:25:12.704640911 +0200 -@@ -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_t - 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 *r - 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; - } -@@ -1006,16 +1012,21 @@ create_array_type_with_stride (struct ty - 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; -@@ -1697,7 +1708,7 @@ resolve_dynamic_range (struct type *dyn_ - 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); -@@ -1729,10 +1740,17 @@ resolve_dynamic_range (struct type *dyn_ - 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 (range_copy, - TYPE_TARGET_TYPE (range_copy), -- &low_bound, &high_bound); -+ &low_bound, &high_bound, &stride); - TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; - return static_range_type; - } -@@ -1996,7 +2014,17 @@ resolve_dynamic_type (struct type *type, - prop = TYPE_DATA_LOCATION (type); - if (dwarf2_evaluate_property (prop, addr, &value)) - { -+ struct type *range_type = TYPE_INDEX_TYPE (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); -+ - adjusted_address = value; -+ - TYPE_DATA_LOCATION_ADDR (type) = value; - TYPE_DATA_LOCATION_KIND (type) = PROP_CONST; - } -Index: gdb-7.7.90.20140613/gdb/gdbtypes.h -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/gdbtypes.h 2014-06-16 23:24:12.741584315 +0200 -+++ gdb-7.7.90.20140613/gdb/gdbtypes.h 2014-06-16 23:25:12.704640911 +0200 -@@ -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. */ - -@@ -1219,6 +1223,15 @@ extern void allocate_gnat_aux_type (stru - 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 VLA support. */ - #define TYPE_DATA_LOCATION(thistype) \ -@@ -1250,6 +1263,9 @@ extern void allocate_gnat_aux_type (stru - 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)))) -@@ -1718,6 +1734,7 @@ extern struct type *create_array_type_wi - - 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 *, -Index: gdb-7.7.90.20140613/gdb/valarith.c -=================================================================== ---- gdb-7.7.90.20140613.orig/gdb/valarith.c 2014-06-16 23:24:12.741584315 +0200 -+++ gdb-7.7.90.20140613/gdb/valarith.c 2014-06-16 23:26:42.541725886 +0200 -@@ -196,6 +196,7 @@ value_subscripted_rvalue (struct value * - struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); - unsigned int elt_size = TYPE_LENGTH (elt_type); - unsigned int elt_offs; -+ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type)); - struct value *v; - - if (TYPE_NOT_ASSOCIATED (array_type)) -@@ -203,7 +204,18 @@ value_subscripted_rvalue (struct value * - 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) -+ { -+ 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))) diff --git a/gdb-vla-intel-12of23.patch b/gdb-vla-intel-12of23.patch deleted file mode 100644 index b12eab0..0000000 --- a/gdb-vla-intel-12of23.patch +++ /dev/null @@ -1,243 +0,0 @@ -Subject: [PATCH 12/23] test: basic tests for dynamic array evaluations in Fortran. -Message-Id: <1401861266-6240-13-git-send-email-keven.boell@intel.com> - -Tests ensure that values of Fortran dynamic arrays -can be evaluated correctly in various ways and states. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla.f90: New file. - * vla-value.exp: New file. - -Change-Id: I0229c3b58f72ae89c2ee42d1219e4538cb6bf023 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-value.exp | 148 +++++++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla.f90 | 56 ++++++++++++ - 2 files changed, 204 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-value.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla.f90 - -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 . -+ -+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" " = " "print non-allocated vla1" -+gdb_test "print &vla1" \ -+ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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" " = " "print undefined pvla" -+gdb_test "print &pvla" \ -+ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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" " = " \ -+ "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 . -+ -+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 --- -1.7.9.5 - diff --git a/gdb-vla-intel-13of23.patch b/gdb-vla-intel-13of23.patch deleted file mode 100644 index 314fdc8..0000000 --- a/gdb-vla-intel-13of23.patch +++ /dev/null @@ -1,273 +0,0 @@ -Subject: [PATCH 13/23] test: evaluate Fortran dynamic arrays of types. -Message-Id: <1401861266-6240-14-git-send-email-keven.boell@intel.com> - -Tests ensure that dynamic arrays of various Fortran -datatypes can be evaluated correctly. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-type.exp: New file. - * vla-type.f90: New file. - -Change-Id: I7c1a381c5cb0ad48872b77993e7c7fdac85bc756 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-type.exp | 127 ++++++++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-type.f90 | 107 +++++++++++++++++++++++++++ - 2 files changed, 234 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-type.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-type.f90 - -diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp -new file mode 100644 -index 0000000..ad50d9c ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-type.exp -@@ -0,0 +1,127 @@ -+# Copyright 2014 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+standard_testfile ".f90" -+ -+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ -+ {debug f90 quiet}] } { -+ return -1 -+} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+# Check if not allocated VLA in type does not break -+# the debugger when accessing it. -+gdb_breakpoint [gdb_get_line_number "before-allocated"] -+gdb_continue_to_breakpoint "before-allocated" -+gdb_test "print twov" " = \\\( , \\\)" \ -+ "print twov before allocated" -+gdb_test "print twov%ivla1" " = " \ -+ "print twov%ivla1 before allocated" -+ -+# Check type with one VLA's inside -+gdb_breakpoint [gdb_get_line_number "onev-filled"] -+gdb_continue_to_breakpoint "onev-filled" -+gdb_test "print onev%ivla(5, 11, 23)" " = 1" "print onev%ivla(5, 11, 23)" -+gdb_test "print onev%ivla(1, 2, 3)" " = 123" "print onev%ivla(1, 2, 3)" -+gdb_test "print onev%ivla(3, 2, 1)" " = 321" "print onev%ivla(3, 2, 1)" -+gdb_test "ptype onev" \ -+ "type = Type one\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\)\r\nEnd Type one" \ -+ "ptype onev" -+ -+# Check type with two VLA's inside -+gdb_breakpoint [gdb_get_line_number "twov-filled"] -+gdb_continue_to_breakpoint "twov-filled" -+gdb_test "print twov%ivla1(5, 11, 23)" " = 1" \ -+ "print twov%ivla1(5, 11, 23)" -+gdb_test "print twov%ivla1(1, 2, 3)" " = 123" \ -+ "print twov%ivla1(1, 2, 3)" -+gdb_test "print twov%ivla1(3, 2, 1)" " = 321" \ -+ "print twov%ivla1(3, 2, 1)" -+gdb_test "ptype twov" \ -+ "type = Type two\r\n\\s+real\\\(kind=4\\\) :: ivla1\\\(5,12,99\\\)\r\n\\s+real\\\(kind=4\\\) :: ivla2\\\(9,12\\\)\r\nEnd Type two" \ -+ "ptype twov" -+ -+# Check type with attribute at beginn of type -+gdb_breakpoint [gdb_get_line_number "threev-filled"] -+gdb_continue_to_breakpoint "threev-filled" -+gdb_test "print threev%ivla(1)" " = 1" "print threev%ivla(1)" -+gdb_test "print threev%ivla(5)" " = 42" "print threev%ivla(5)" -+gdb_test "print threev%ivla(14)" " = 24" "print threev%ivla(14)" -+gdb_test "print threev%ivar" " = 3.14\\d+?" "print threev%ivar" -+gdb_test "ptype threev" \ -+ "type = Type three\r\n\\s+real\\\(kind=4\\\) :: ivar\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(20\\\)\r\nEnd Type three" \ -+ "ptype threev" -+ -+# Check type with attribute at end of type -+gdb_breakpoint [gdb_get_line_number "fourv-filled"] -+gdb_continue_to_breakpoint "fourv-filled" -+gdb_test "print fourv%ivla(1)" " = 1" "print fourv%ivla(1)" -+gdb_test "print fourv%ivla(2)" " = 2" "print fourv%ivla(2)" -+gdb_test "print fourv%ivla(7)" " = 7" "print fourv%ivla(7)" -+gdb_test "print fourv%ivla(12)" "no such vector element" "print fourv%ivla(12)" -+gdb_test "print fourv%ivar" " = 3.14\\d+?" "print fourv%ivar" -+gdb_test "ptype fourv" \ -+ "type = Type four\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(10\\\)\r\n\\s+real\\\(kind=4\\\) :: ivar\r\nEnd Type four" \ -+ "ptype fourv" -+ -+# Check VLA of types -+gdb_breakpoint [gdb_get_line_number "onevla-filled"] -+gdb_continue_to_breakpoint "onevla-filled" -+gdb_test "print onevla(2,2)%ivla(3, 6, 9)" \ -+ " = 369" "print onevla(2,2)%ivla(3, 6, 9)" -+gdb_test "print onevla(2,2)%ivla(9, 3, 6)" \ -+ " = 936" "print onevla(2,2)%ivla(9, 3, 6)" -+ -+# Check nested types containing a VLA -+gdb_breakpoint [gdb_get_line_number "fivev-filled"] -+gdb_continue_to_breakpoint "fivev-filled" -+gdb_test "print fivev%tone%ivla(5, 5, 1)" " = 1" \ -+ "print fivev%tone%ivla(5, 5, 1)" -+gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123" \ -+ "print fivev%tone%ivla(1, 2, 3)" -+gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321" \ -+ "print fivev%tone%ivla(3, 2, 1)" -+gdb_test "ptype fivev" \ -+ "type = Type five\r\n\\s+Type one\r\n\\s+real\\\(kind=4\\\) :: ivla\\\(10,10,10\\\)\r\n\\s+End Type one :: tone\r\nEnd Type five" \ -+ "ptype fivev" -+ -+# Check pointer to type, containing a VLA -+gdb_breakpoint [gdb_get_line_number "onep-associated"] -+gdb_continue_to_breakpoint "onep-associated" -+gdb_test "ptype onev" ".*real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\).*" \ -+ "ptype onev" -+gdb_test "ptype onep" ".*real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\).*" \ -+ "ptype onep" -+ -+gdb_test "print onev%ivla" " = \\( *\\( *\\( *2, *2, *2,\[()2, .\]*\\)" \ -+ "print onev%ivla" -+gdb_test "print onev" " = \\( *\\( *\\( *\\( *2, *2, *2,\[()2, .\]*\\)" \ -+ "print onev" -+gdb_test "print onep" ".*real\\\(kind=4\\\) :: ivla\\\(11,22,33\\\).*" \ -+ "print onep" -+ -+gdb_test "ptype onev%ivla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ -+ "ptype onev%ivla" -+gdb_test "ptype onep%ivla" "type = real\\\(kind=4\\\) \\\(11,22,33\\\)" \ -+ "ptype onep%ivla" -+ -+gdb_test "ptype onev%ivla(1,1,1)" "type = real\\\(kind=4\\\)" \ -+ "ptype onev%ivla(1,1,1)" -+gdb_test "ptype onep%ivla(1,1,1)" "type = real\\\(kind=4\\\)" \ -+ "ptype onep%ivla(1,1,1)" -diff --git a/gdb/testsuite/gdb.fortran/vla-type.f90 b/gdb/testsuite/gdb.fortran/vla-type.f90 -new file mode 100644 -index 0000000..06600c9 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-type.f90 -@@ -0,0 +1,107 @@ -+! 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_struct -+ type :: one -+ real, allocatable :: ivla (:, :, :) -+ end type one -+ type :: two -+ real, allocatable :: ivla1 (:, :, :) -+ real, allocatable :: ivla2 (:, :) -+ end type two -+ type :: three -+ real :: ivar -+ real, allocatable :: ivla (:) -+ end type three -+ type :: four -+ real, allocatable :: ivla (:) -+ real :: ivar -+ end type four -+ type :: five -+ type(one) :: tone -+ end type five -+ -+ type(one), target :: onev -+ type(two) :: twov -+ type(three) :: threev -+ type(four) :: fourv -+ type(five) :: fivev -+ type(one), allocatable :: onevla(:, :) -+ type(one), pointer :: onep -+ logical :: l -+ integer :: i, j -+ -+ allocate (onev%ivla (11,22,33)) ! before-allocated -+ l = allocated(onev%ivla) -+ -+ onev%ivla(:, :, :) = 1 -+ onev%ivla(1, 2, 3) = 123 -+ onev%ivla(3, 2, 1) = 321 -+ -+ allocate (twov%ivla1 (5,12,99)) ! onev-filled -+ l = allocated(twov%ivla1) -+ allocate (twov%ivla2 (9,12)) -+ l = allocated(twov%ivla2) -+ -+ twov%ivla1(:, :, :) = 1 -+ twov%ivla1(1, 2, 3) = 123 -+ twov%ivla1(3, 2, 1) = 321 -+ -+ twov%ivla2(:, :) = 1 -+ twov%ivla2(1, 2) = 12 -+ twov%ivla2(2, 1) = 21 -+ -+ threev%ivar = 3.14 ! twov-filled -+ allocate (threev%ivla (20)) -+ l = allocated(threev%ivla) -+ -+ threev%ivla(:) = 1 -+ threev%ivla(5) = 42 -+ threev%ivla(14) = 24 -+ -+ allocate (fourv%ivla (10)) ! threev-filled -+ l = allocated(fourv%ivla) -+ -+ fourv%ivar = 3.14 -+ fourv%ivla(:) = 1 -+ fourv%ivla(2) = 2 -+ fourv%ivla(7) = 7 -+ -+ -+ allocate (onevla (10, 10)) ! fourv-filled -+ do i = 1, 10 -+ do j = 1, 10 -+ allocate (onevla(i,j)%ivla(10,10,10)) -+ l = allocated(onevla(i,j)%ivla) -+ -+ onevla(i,j)%ivla(3, 6, 9) = 369 -+ onevla(i,j)%ivla(9, 3, 6) = 936 -+ end do -+ end do -+ -+ allocate (fivev%tone%ivla (10, 10, 10)) ! onevla-filled -+ l = allocated(fivev%tone%ivla) -+ fivev%tone%ivla(:, :, :) = 1 -+ fivev%tone%ivla(1, 2, 3) = 123 -+ fivev%tone%ivla(3, 2, 1) = 321 -+ -+ -+ onev%ivla(:,:,:) = 2 ! fivev-filled -+ onep => onev -+ -+ ! dummy statement for bp -+ l = allocated(fivev%tone%ivla) ! onep-associated -+end program vla_struct --- -1.7.9.5 - diff --git a/gdb-vla-intel-14of23.patch b/gdb-vla-intel-14of23.patch deleted file mode 100644 index 65dd8f4..0000000 --- a/gdb-vla-intel-14of23.patch +++ /dev/null @@ -1,172 +0,0 @@ -Subject: [PATCH 14/23] test: evaluate dynamic arrays using Fortran primitives. -Message-Id: <1401861266-6240-15-git-send-email-keven.boell@intel.com> - -Tests ensure that Fortran primitives can be evaluated -correctly when used as a dynamic array. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-datatypes.f90: New file. - * vla-datatypes.exp: New file. - -Change-Id: I8e82fa3833d77bfd7e9b4bdc40e3f96ce5e72da2 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-datatypes.exp | 82 +++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-datatypes.f90 | 51 +++++++++++++++++ - 2 files changed, 133 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-datatypes.f90 - -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 . -+ -+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 --- -1.7.9.5 - diff --git a/gdb-vla-intel-15of23.patch b/gdb-vla-intel-15of23.patch deleted file mode 100644 index d46d5ae..0000000 --- a/gdb-vla-intel-15of23.patch +++ /dev/null @@ -1,409 +0,0 @@ -Subject: [PATCH 15/23] test: dynamic arrays passed to subroutines. -Message-Id: <1401861266-6240-16-git-send-email-keven.boell@intel.com> - -Tests dynamic arrays passed to subroutines and handled -in different ways inside the routine. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-sub.f90: New file. - * vla-ptype-sub.exp: New file. - * vla-value-sub-arbitrary.exp: New file. - * vla-value-sub-finish.exp: New file. - * vla-value-sub.exp: New file. - -Change-Id: I76db950fbacbf15b1f5e887bfd164eb8f85c55d1 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-ptype-sub.exp | 87 +++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-sub.f90 | 82 ++++++++++++++++++ - .../gdb.fortran/vla-value-sub-arbitrary.exp | 35 ++++++++ - gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp | 49 +++++++++++ - gdb/testsuite/gdb.fortran/vla-value-sub.exp | 90 ++++++++++++++++++++ - 5 files changed, 343 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype-sub.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-sub.f90 - create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-arbitrary.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub-finish.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-value-sub.exp - -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 . -+ -+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-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 and -+! Jan Kratochvil . -+! Modified for the GDB testcases by Keven Boell . -+ -+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 . -+ -+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 . -+ -+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 . -+ -+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)" --- -1.7.9.5 - diff --git a/gdb-vla-intel-16of23.patch b/gdb-vla-intel-16of23.patch deleted file mode 100644 index 74fcafa..0000000 --- a/gdb-vla-intel-16of23.patch +++ /dev/null @@ -1,126 +0,0 @@ -Subject: [PATCH 16/23] test: correct ptype of dynamic arrays in Fortran. -Message-Id: <1401861266-6240-17-git-send-email-keven.boell@intel.com> - -Tests ensure that the ptype of dynamic arrays in -Fortran can be printed in GDB correctly. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-ptype.exp: New file. - -Change-Id: I508a0537be7cac5739a263788be89b18e84d8f8f - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-ptype.exp | 96 +++++++++++++++++++++++++++++++ - 1 file changed, 96 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-ptype.exp - -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 . -+ -+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 = " "ptype vla1 not initialized" -+gdb_test "ptype vla2" "type = " "ptype vla2 not initialized" -+gdb_test "ptype pvla" "type = " "ptype pvla not initialized" -+gdb_test "ptype vla1(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 = " "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 = " "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 = " "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" --- -1.7.9.5 - diff --git a/gdb-vla-intel-17of23.patch b/gdb-vla-intel-17of23.patch deleted file mode 100644 index 36a1633..0000000 --- a/gdb-vla-intel-17of23.patch +++ /dev/null @@ -1,95 +0,0 @@ -Subject: [PATCH 17/23] test: evaluating allocation/association status -Message-Id: <1401861266-6240-18-git-send-email-keven.boell@intel.com> - -Tests ensure that dynamic arrays in different states -(allocated/associated) can be evaluated. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-alloc-assoc.exp: New file. - -Change-Id: I6950473c3f1724ebf5c7b037706186b2cd6af5f0 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp | 65 +++++++++++++++++++++++++ - 1 file changed, 65 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp - -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 . -+ -+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" " = " \ -+ "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" " = " "print deallocated vla2" --- -1.7.9.5 - diff --git a/gdb-vla-intel-18of23.patch b/gdb-vla-intel-18of23.patch deleted file mode 100644 index ee5b32f..0000000 --- a/gdb-vla-intel-18of23.patch +++ /dev/null @@ -1,171 +0,0 @@ -Subject: [PATCH 18/23] test: dynamic arrays passed to functions. -Message-Id: <1401861266-6240-19-git-send-email-keven.boell@intel.com> - -Tests for dynamic arrays passed to functions -and returned from functions. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-func.f90: New file. - * vla-func.exp: New file. - -Change-Id: Ic3eb212f35f599e4c10a284c23125491653b17df - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-func.exp | 61 +++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-func.f90 | 71 ++++++++++++++++++++++++++++++++ - 2 files changed, 132 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-func.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-func.f90 - -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 . -+ -+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 --- -1.7.9.5 - diff --git a/gdb-vla-intel-19of23.patch b/gdb-vla-intel-19of23.patch deleted file mode 100644 index 61f91b8..0000000 --- a/gdb-vla-intel-19of23.patch +++ /dev/null @@ -1,92 +0,0 @@ -Subject: [PATCH 19/23] test: accessing dynamic array history values. -Message-Id: <1401861266-6240-20-git-send-email-keven.boell@intel.com> - -Tests if the history values of dynamic arrays can be -accessed and printed again with the correct values. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-history.exp: New file. - -Change-Id: Ib6d2d30272aefc24b6db5fa0633fe72274390e91 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-history.exp | 62 +++++++++++++++++++++++++++++ - 1 file changed, 62 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-history.exp - -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 . -+ -+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" " = " "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" " = " "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" --- -1.7.9.5 - diff --git a/gdb-vla-intel-20of23.patch b/gdb-vla-intel-20of23.patch deleted file mode 100644 index 1af5ac9..0000000 --- a/gdb-vla-intel-20of23.patch +++ /dev/null @@ -1,181 +0,0 @@ -Subject: [PATCH 20/23] test: dynamic string evaluations. -Message-Id: <1401861266-6240-21-git-send-email-keven.boell@intel.com> - -Tests various dynamic string evaluations. Dynamic strings -will be handled internally the same way as dynamic arrays. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-strings.f90: New file. - * vla-strings.exp: New file. - -Change-Id: Ib2f3dded2fbc5f0a9684050c5cfa22a450e18358 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-strings.exp | 104 +++++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-strings.f90 | 38 +++++++++++ - 2 files changed, 142 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-strings.f90 - -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 . -+ -+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..6679043 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-strings.f90 -@@ -0,0 +1,38 @@ -+! 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 -+ allocate(character(len=21) :: var_char) ! var_char-empty -+ 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 --- -1.7.9.5 - diff --git a/gdb-vla-intel-21of23.patch b/gdb-vla-intel-21of23.patch deleted file mode 100644 index 9494b92..0000000 --- a/gdb-vla-intel-21of23.patch +++ /dev/null @@ -1,262 +0,0 @@ -Subject: [PATCH 21/23] test: basic MI test for the dynamic array support. -Message-Id: <1401861266-6240-22-git-send-email-keven.boell@intel.com> - -Tests dynamic array evaluations using MI protocol. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.mi/: - - * mi-vla-fortran.exp: New file. - * vla.f90: New file. - -Change-Id: I37caa85b1498478f5eff0f52d3fd431388aaab6f - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 182 +++++++++++++++++++++++++++++++ - gdb/testsuite/gdb.mi/vla.f90 | 42 +++++++ - 2 files changed, 224 insertions(+) - create mode 100644 gdb/testsuite/gdb.mi/mi-vla-fortran.exp - create mode 100644 gdb/testsuite/gdb.mi/vla.f90 - -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 . -+ -+# 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=\"\"" "evaluate not allocated vla" -+ -+mi_create_varobj_checked vla1_not_allocated vla1 "" \ -+ "create local variable vla1_not_allocated" -+mi_gdb_test "501-var-info-type vla1_not_allocated" \ -+ "501\\^done,type=\"\"" \ -+ "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=\"\"" "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=\"\"" "evaluate not associated vla" -+ -+mi_create_varobj_checked pvla2_not_associated pvla2 "" \ -+ "create local variable pvla2_not_associated" -+mi_gdb_test "581-var-info-type pvla2_not_associated" \ -+ "581\\^done,type=\"\"" \ -+ "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=\"\"" "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 . -+ -+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 --- -1.7.9.5 - diff --git a/gdb-vla-intel-22of23.patch b/gdb-vla-intel-22of23.patch deleted file mode 100644 index 1a0674c..0000000 --- a/gdb-vla-intel-22of23.patch +++ /dev/null @@ -1,75 +0,0 @@ -Subject: [PATCH 22/23] test: test sizeof for dynamic fortran arrays. -Message-Id: <1401861266-6240-23-git-send-email-keven.boell@intel.com> - -Tests sizeof output of dynamic arrays in various states. - -2014-05-28 Keven Boell - Sanimir Agovic - -testsuite/gdb.fortran/: - - * vla-sizeof.exp: New file. - -Change-Id: I68d81d03ff2daa32ab87d2750873652d684e7389 - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-sizeof.exp | 46 ++++++++++++++++++++++++++++++ - 1 file changed, 46 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-sizeof.exp - -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 . -+ -+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" --- -1.7.9.5 - diff --git a/gdb-vla-intel-23of23.patch b/gdb-vla-intel-23of23.patch deleted file mode 100644 index c9657d0..0000000 --- a/gdb-vla-intel-23of23.patch +++ /dev/null @@ -1,119 +0,0 @@ -Subject: [PATCH 23/23] test: stride support for dynamic arrays. -Message-Id: <1401861266-6240-24-git-send-email-keven.boell@intel.com> - -Tests the usage of stride values in dynamic arrays. - -2014-05-28 Sanimir Agovic - Keven Boell - -testsuite/gdb.fortran/: - - * vla-stride.exp: New file. - * vla-stride.f90: New file. - -Change-Id: Ic4f68cf97046cc9f5f3664fe4c12d2b7528c22ee - -Signed-off-by: Keven Boell ---- - gdb/testsuite/gdb.fortran/vla-stride.exp | 51 ++++++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-stride.f90 | 30 ++++++++++++++++++ - 2 files changed, 81 insertions(+) - create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.exp - create mode 100644 gdb/testsuite/gdb.fortran/vla-stride.f90 - -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 . -+ -+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 --- -1.7.9.5 - 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 + #include +@@ -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 . ++ ++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" " = " \ ++ "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" " = " "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 . ++ ++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 . ++ ++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 . ++ ++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" " = " "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" " = " "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 . ++ ++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 . ++ ++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 = " "ptype vla1 not initialized" ++gdb_test "ptype vla2" "type = " "ptype vla2 not initialized" ++gdb_test "ptype pvla" "type = " "ptype pvla not initialized" ++gdb_test "ptype vla1(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 = " "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 = " "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 = " "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 . ++ ++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 . ++ ++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 . ++ ++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 and ++! Jan Kratochvil . ++! Modified for the GDB testcases by Keven Boell . ++ ++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 . ++ ++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 . ++ ++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 . ++ ++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 . ++ ++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" " = " "print non-allocated vla1" ++gdb_test "print &vla1" \ ++ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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" " = " "print undefined pvla" ++gdb_test "print &pvla" \ ++ " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(\\\)\\\)\\\) $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" " = " \ ++ "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 . ++ ++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 . ++ ++# 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=\"\"" "evaluate not allocated vla" ++ ++mi_create_varobj_checked vla1_not_allocated vla1 "" \ ++ "create local variable vla1_not_allocated" ++mi_gdb_test "501-var-info-type vla1_not_allocated" \ ++ "501\\^done,type=\"\"" \ ++ "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=\"\"" "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=\"\"" "evaluate not associated vla" ++ ++mi_create_varobj_checked pvla2_not_associated pvla2 "" \ ++ "create local variable pvla2_not_associated" ++mi_gdb_test "581-var-info-type pvla2_not_associated" \ ++ "581\\^done,type=\"\"" \ ++ "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=\"\"" "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 . ++ ++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, _("")); + } + ++void ++val_print_not_allocated (struct ui_file *stream) ++{ ++ fprintf_filtered (stream, _("")); ++} ++ ++void ++val_print_not_associated (struct ui_file *stream) ++{ ++ fprintf_filtered (stream, _("")); ++} ++ + /* 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, _("
")); + 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 - 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 - 7.7.90.20140627-8.fc21 - Do not remove %{_datadir}/gdb/syscalls/ppc*.xml as it is secondary target. - Remove: %{_datadir}/gdb/guile