From aa9640435fa6ba1a2e0df5a470ca2c208d4579e5 Mon Sep 17 00:00:00 2001 From: Kacper Kornet Date: Tue, 26 Aug 2014 16:56:49 +0100 Subject: [PATCH] - add support for Fortran dynamics arrays; copied from Fedora (263b580) --- gdb-archer-vla-tests.patch | 2795 ++++++++++++++++++++++++++ gdb-vla-intel-04of23-fix.patch | 42 + gdb-vla-intel-stringbt-fix.patch | 165 ++ gdb-vla-intel.patch | 3235 ++++++++++++++++++++++++++++++ gdb.spec | 10 +- 5 files changed, 6246 insertions(+), 1 deletion(-) create mode 100644 gdb-archer-vla-tests.patch create mode 100644 gdb-vla-intel-04of23-fix.patch create mode 100644 gdb-vla-intel-stringbt-fix.patch create mode 100644 gdb-vla-intel.patch diff --git a/gdb-archer-vla-tests.patch b/gdb-archer-vla-tests.patch new file mode 100644 index 0000000..d0fd183 --- /dev/null +++ b/gdb-archer-vla-tests.patch @@ -0,0 +1,2795 @@ +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.ada/packed_array.exp +=================================================================== +--- gdb-7.7.90.20140613.orig/gdb/testsuite/gdb.ada/packed_array.exp 2014-06-13 03:59:37.000000000 +0200 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.ada/packed_array.exp 2014-06-16 23:30:30.107940483 +0200 +@@ -56,5 +56,11 @@ gdb_test_multiple "$test" "$test" { + # are. Observed with (FSF GNU Ada 4.5.3 20110124). + xfail $test + } ++ -re "= \\(\\)\[\r\n\]+$gdb_prompt $" { ++ # archer-jankratochvil-vla resolves it as a dynamic type resolved as an ++ # empty array [0..-1]. ++ # DW_AT_upper_bound : (DW_OP_fbreg: -48; DW_OP_deref) ++ xfail $test ++ } + } + +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S 2014-06-16 23:30:30.108940484 +0200 +@@ -0,0 +1,455 @@ ++ .file "x86_64-vla-typedef.c" ++ .section .debug_abbrev,"",@progbits ++.Ldebug_abbrev0: ++ .section .debug_info,"",@progbits ++.Ldebug_info0: ++ .section .debug_line,"",@progbits ++.Ldebug_line0: ++ .text ++.Ltext0: ++.globl foo ++ .type foo, @function ++foo: ++.LFB2: ++ .file 1 "x86_64-vla-typedef.c" ++ .loc 1 22 0 ++ pushq %rbp ++.LCFI0: ++ movq %rsp, %rbp ++.LCFI1: ++ subq $64, %rsp ++.LCFI2: ++ movl %edi, -36(%rbp) ++ .loc 1 22 0 ++ movq %rsp, %rax ++ movq %rax, -48(%rbp) ++ .loc 1 23 0 ++ movl -36(%rbp), %edx ++ movslq %edx,%rax ++ subq $1, %rax ++ movq %rax, -24(%rbp) ++ .loc 1 24 0 ++ movslq %edx,%rax ++ addq $15, %rax ++ addq $15, %rax ++ shrq $4, %rax ++ salq $4, %rax ++ subq %rax, %rsp ++ movq %rsp, -56(%rbp) ++ movq -56(%rbp), %rax ++ addq $15, %rax ++ shrq $4, %rax ++ salq $4, %rax ++ movq %rax, -56(%rbp) ++ movq -56(%rbp), %rax ++ movq %rax, -16(%rbp) ++ .loc 1 27 0 ++ movl $0, -4(%rbp) ++ jmp .L2 ++.L3: ++ .loc 1 28 0 ++ movl -4(%rbp), %esi ++ movl -4(%rbp), %eax ++ movl %eax, %ecx ++ movq -16(%rbp), %rdx ++ movslq %esi,%rax ++ movb %cl, (%rdx,%rax) ++ .loc 1 27 0 ++ addl $1, -4(%rbp) ++.L2: ++ movl -4(%rbp), %eax ++ cmpl -36(%rbp), %eax ++ jl .L3 ++ .loc 1 30 0 ++ .globl break_here ++break_here: ++ movq -16(%rbp), %rax ++ movb $0, (%rax) ++ movq -48(%rbp), %rsp ++ .loc 1 31 0 ++ leave ++ ret ++.LFE2: ++ .size foo, .-foo ++ .section .debug_frame,"",@progbits ++.Lframe0: ++ .long .LECIE0-.LSCIE0 ++.LSCIE0: ++ .long 0xffffffff ++ .byte 0x1 ++ .string "" ++ .uleb128 0x1 ++ .sleb128 -8 ++ .byte 0x10 ++ .byte 0xc ++ .uleb128 0x7 ++ .uleb128 0x8 ++ .byte 0x90 ++ .uleb128 0x1 ++ .align 8 ++.LECIE0: ++.LSFDE0: ++ .long .LEFDE0-.LASFDE0 ++.LASFDE0: ++ .long .Lframe0 ++ .quad .LFB2 ++ .quad .LFE2-.LFB2 ++ .byte 0x4 ++ .long .LCFI0-.LFB2 ++ .byte 0xe ++ .uleb128 0x10 ++ .byte 0x86 ++ .uleb128 0x2 ++ .byte 0x4 ++ .long .LCFI1-.LCFI0 ++ .byte 0xd ++ .uleb128 0x6 ++ .align 8 ++.LEFDE0: ++ .section .eh_frame,"a",@progbits ++.Lframe1: ++ .long .LECIE1-.LSCIE1 ++.LSCIE1: ++ .long 0x0 ++ .byte 0x1 ++ .string "zR" ++ .uleb128 0x1 ++ .sleb128 -8 ++ .byte 0x10 ++ .uleb128 0x1 ++ .byte 0x3 ++ .byte 0xc ++ .uleb128 0x7 ++ .uleb128 0x8 ++ .byte 0x90 ++ .uleb128 0x1 ++ .align 8 ++.LECIE1: ++.LSFDE1: ++ .long .LEFDE1-.LASFDE1 ++.LASFDE1: ++ .long .LASFDE1-.Lframe1 ++ .long .LFB2 ++ .long .LFE2-.LFB2 ++ .uleb128 0x0 ++ .byte 0x4 ++ .long .LCFI0-.LFB2 ++ .byte 0xe ++ .uleb128 0x10 ++ .byte 0x86 ++ .uleb128 0x2 ++ .byte 0x4 ++ .long .LCFI1-.LCFI0 ++ .byte 0xd ++ .uleb128 0x6 ++ .align 8 ++.LEFDE1: ++ .text ++.Letext0: ++ .section .debug_loc,"",@progbits ++.Ldebug_loc0: ++.LLST0: ++ .quad .LFB2-.Ltext0 ++ .quad .LCFI0-.Ltext0 ++ .value 0x2 ++ .byte 0x77 ++ .sleb128 8 ++ .quad .LCFI0-.Ltext0 ++ .quad .LCFI1-.Ltext0 ++ .value 0x2 ++ .byte 0x77 ++ .sleb128 16 ++ .quad .LCFI1-.Ltext0 ++ .quad .LFE2-.Ltext0 ++ .value 0x2 ++ .byte 0x76 ++ .sleb128 16 ++ .quad 0x0 ++ .quad 0x0 ++ .section .debug_info ++ .long .Ldebug_end - .Ldebug_start ++.Ldebug_start: ++ .value 0x2 ++ .long .Ldebug_abbrev0 ++ .byte 0x8 ++ .uleb128 0x1 ++ .long .LASF2 ++ .byte 0x1 ++ .long .LASF3 ++ .long .LASF4 ++ .quad .Ltext0 ++ .quad .Letext0 ++ .long .Ldebug_line0 ++ .uleb128 0x2 ++ .byte 0x1 ++ .string "foo" ++ .byte 0x1 ++ .byte 0x16 ++ .byte 0x1 ++ .quad .LFB2 ++ .quad .LFE2 ++ .long .LLST0 ++ .long 0x83 ++ .uleb128 0x3 ++ .long .LASF5 ++ .byte 0x1 ++ .byte 0x15 ++ .long 0x83 ++ .byte 0x2 ++ .byte 0x91 ++ .sleb128 -52 ++.Ltag_typedef: ++ .uleb128 0x4 ++ .long .LASF6 ++ .byte 0x1 ++ .byte 0x17 ++ .long .Ltag_array_type - .debug_info ++ .uleb128 0x5 /* Abbrev Number: 5 (DW_TAG_variable) */ ++ .long .LASF0 ++ .byte 0x1 ++ .byte 0x18 ++#if 1 ++ .long .Ltag_typedef - .debug_info ++#else ++ /* Debugging only: Skip the typedef indirection. */ ++ .long .Ltag_array_type - .debug_info ++#endif ++ /* DW_AT_location: DW_FORM_block1: start */ ++ .byte 0x3 ++ .byte 0x91 ++ .sleb128 -32 ++#if 0 ++ .byte 0x6 /* DW_OP_deref */ ++#else ++ .byte 0x96 /* DW_OP_nop */ ++#endif ++ /* DW_AT_location: DW_FORM_block1: end */ ++ .uleb128 0x6 ++ .string "i" ++ .byte 0x1 ++ .byte 0x19 ++ .long 0x83 ++ .byte 0x2 ++ .byte 0x91 ++ .sleb128 -20 ++ .byte 0x0 ++ .uleb128 0x7 ++ .byte 0x4 ++ .byte 0x5 ++ .string "int" ++.Ltag_array_type: ++ .uleb128 0x8 /* Abbrev Number: 8 (DW_TAG_array_type) */ ++ .long 0xa0 + (2f - 1f) /* DW_AT_type: DW_FORM_ref4 */ ++ .long 0x9d + (2f - 1f) /* DW_AT_sibling: DW_FORM_ref4 */ ++1: /* DW_AT_data_location: DW_FORM_block1: start */ ++ .byte 2f - 3f /* length */ ++3: ++ .byte 0x97 /* DW_OP_push_object_address */ ++ .byte 0x6 /* DW_OP_deref */ ++2: /* DW_AT_data_location: DW_FORM_block1: end */ ++ .uleb128 0x9 ++ .long 0x9d + (2b - 1b) /* DW_AT_type: DW_FORM_ref4 */ ++ .byte 0x3 ++ .byte 0x91 ++ .sleb128 -40 ++ .byte 0x6 ++ .byte 0x0 ++ .uleb128 0xa ++ .byte 0x8 ++ .byte 0x7 ++ .uleb128 0xb ++ .byte 0x1 ++ .byte 0x6 ++ .long .LASF1 ++ .byte 0x0 ++.Ldebug_end: ++ .section .debug_abbrev ++ .uleb128 0x1 ++ .uleb128 0x11 ++ .byte 0x1 ++ .uleb128 0x25 ++ .uleb128 0xe ++ .uleb128 0x13 ++ .uleb128 0xb ++ .uleb128 0x3 ++ .uleb128 0xe ++ .uleb128 0x1b ++ .uleb128 0xe ++ .uleb128 0x11 ++ .uleb128 0x1 ++ .uleb128 0x12 ++ .uleb128 0x1 ++ .uleb128 0x10 ++ .uleb128 0x6 ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x2 ++ .uleb128 0x2e ++ .byte 0x1 ++ .uleb128 0x3f ++ .uleb128 0xc ++ .uleb128 0x3 ++ .uleb128 0x8 ++ .uleb128 0x3a ++ .uleb128 0xb ++ .uleb128 0x3b ++ .uleb128 0xb ++ .uleb128 0x27 ++ .uleb128 0xc ++ .uleb128 0x11 ++ .uleb128 0x1 ++ .uleb128 0x12 ++ .uleb128 0x1 ++ .uleb128 0x40 ++ .uleb128 0x6 ++ .uleb128 0x1 ++ .uleb128 0x13 ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x3 ++ .uleb128 0x5 ++ .byte 0x0 ++ .uleb128 0x3 ++ .uleb128 0xe ++ .uleb128 0x3a ++ .uleb128 0xb ++ .uleb128 0x3b ++ .uleb128 0xb ++ .uleb128 0x49 ++ .uleb128 0x13 ++ .uleb128 0x2 ++ .uleb128 0xa ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x4 ++ .uleb128 0x16 ++ .byte 0x0 ++ .uleb128 0x3 ++ .uleb128 0xe ++ .uleb128 0x3a ++ .uleb128 0xb ++ .uleb128 0x3b ++ .uleb128 0xb ++ .uleb128 0x49 ++ .uleb128 0x13 ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x5 ++ .uleb128 0x34 ++ .byte 0x0 ++ .uleb128 0x3 ++ .uleb128 0xe ++ .uleb128 0x3a ++ .uleb128 0xb ++ .uleb128 0x3b ++ .uleb128 0xb ++ .uleb128 0x49 ++ .uleb128 0x13 ++ .uleb128 0x2 ++ .uleb128 0xa ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x6 ++ .uleb128 0x34 ++ .byte 0x0 ++ .uleb128 0x3 ++ .uleb128 0x8 ++ .uleb128 0x3a ++ .uleb128 0xb ++ .uleb128 0x3b ++ .uleb128 0xb ++ .uleb128 0x49 ++ .uleb128 0x13 ++ .uleb128 0x2 ++ .uleb128 0xa ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x7 ++ .uleb128 0x24 ++ .byte 0x0 ++ .uleb128 0xb ++ .uleb128 0xb ++ .uleb128 0x3e ++ .uleb128 0xb ++ .uleb128 0x3 ++ .uleb128 0x8 ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x8 /* Abbrev Number: 8 (DW_TAG_array_type) */ ++ .uleb128 0x1 ++ .byte 0x1 ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x1 /* DW_AT_sibling */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x50 /* DW_AT_data_location */ ++ .uleb128 0xa /* DW_FORM_block1 */ ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0x9 ++ .uleb128 0x21 ++ .byte 0x0 ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x2f ++ .uleb128 0xa ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0xa ++ .uleb128 0x24 ++ .byte 0x0 ++ .uleb128 0xb ++ .uleb128 0xb ++ .uleb128 0x3e ++ .uleb128 0xb ++ .byte 0x0 ++ .byte 0x0 ++ .uleb128 0xb ++ .uleb128 0x24 ++ .byte 0x0 ++ .uleb128 0xb ++ .uleb128 0xb ++ .uleb128 0x3e ++ .uleb128 0xb ++ .uleb128 0x3 ++ .uleb128 0xe ++ .byte 0x0 ++ .byte 0x0 ++ .byte 0x0 ++ .section .debug_pubnames,"",@progbits ++ .long 0x16 ++ .value 0x2 ++ .long .Ldebug_info0 ++ .long 0xa8 ++ .long 0x2d ++ .string "foo" ++ .long 0x0 ++ .section .debug_aranges,"",@progbits ++ .long 0x2c ++ .value 0x2 ++ .long .Ldebug_info0 ++ .byte 0x8 ++ .byte 0x0 ++ .value 0x0 ++ .value 0x0 ++ .quad .Ltext0 ++ .quad .Letext0-.Ltext0 ++ .quad 0x0 ++ .quad 0x0 ++ .section .debug_str,"MS",@progbits,1 ++.LASF0: ++ .string "array" ++.LASF5: ++ .string "size" ++.LASF3: ++ .string "x86_64-vla-typedef.c" ++.LASF6: ++ .string "array_t" ++.LASF1: ++ .string "char" ++.LASF4: ++ .string "gdb.arch" ++.LASF2: ++ .string "GNU C 4.3.2 20081105 (Red Hat 4.3.2-7)" ++ .ident "GCC: (GNU) 4.3.2 20081105 (Red Hat 4.3.2-7)" ++ .section .note.GNU-stack,"",@progbits +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c 2014-06-16 23:30:30.109940484 +0200 +@@ -0,0 +1,43 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2008 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++#if 0 ++ ++void ++foo (int size) ++{ ++ typedef char array_t[size]; ++ array_t array; ++ int i; ++ ++ for (i = 0; i < size; i++) ++ array[i] = i; ++ ++ array[0] = 0; /* break-here */ ++} ++ ++#else ++ ++int ++main (void) ++{ ++ foo (26); ++ foo (78); ++ return 0; ++} ++ ++#endif +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp 2014-06-16 23:30:30.109940484 +0200 +@@ -0,0 +1,64 @@ ++# Copyright 2009 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++# Test DW_AT_data_location accessed through DW_TAG_typedef intermediate. ++ ++if ![istarget "x86_64-*-*"] then { ++ verbose "Skipping over gdb.arch/x86_64-vla-typedef.exp test made only for x86_64." ++ return ++} ++ ++set testfile x86_64-vla-typedef ++set srcasmfile ${testfile}-foo.S ++set srcfile ${testfile}.c ++set binfile ${objdir}/${subdir}/${testfile} ++set binobjfile ${objdir}/${subdir}/${testfile}-foo.o ++if { [gdb_compile "${srcdir}/${subdir}/${srcasmfile}" "${binobjfile}" object {}] != "" } { ++ untested "Couldn't compile test program" ++ return -1 ++} ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile} ${binobjfile}" "${binfile}" executable {debug}] != "" } { ++ untested "Couldn't compile test program" ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++if ![runto_main] { ++ untested x86_64-vla-typedef ++ return -1 ++} ++ ++gdb_breakpoint "break_here" ++ ++gdb_continue_to_breakpoint "break_here" ++ ++gdb_test "whatis array" "type = array_t" "first: whatis array" ++ ++gdb_test "ptype array" "type = char \\\[26\\\]" "first: ptype array" ++ ++gdb_test "p array\[1\]" "\\$\[0-9\] = 1 '\\\\001'" ++gdb_test "p array\[2\]" "\\$\[0-9\] = 2 '\\\\002'" ++gdb_test "p array\[3\]" "\\$\[0-9\] = 3 '\\\\003'" ++gdb_test "p array\[4\]" "\\$\[0-9\] = 4 '\\\\004'" ++ ++gdb_continue_to_breakpoint "break_here" ++ ++gdb_test "whatis array" "type = array_t" "second: whatis array" ++ ++gdb_test "ptype array" "type = char \\\[78\\\]" "second: ptype array" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.c +=================================================================== +--- gdb-7.7.90.20140613.orig/gdb/testsuite/gdb.base/arrayidx.c 2014-06-13 03:59:37.000000000 +0200 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.c 2014-06-16 23:30:30.109940484 +0200 +@@ -17,6 +17,13 @@ + + int array[] = {1, 2, 3, 4}; + ++#ifdef __GNUC__ ++struct ++ { ++ int a[0]; ++ } unbound; ++#endif ++ + int + main (void) + { +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.exp +=================================================================== +--- gdb-7.7.90.20140613.orig/gdb/testsuite/gdb.base/arrayidx.exp 2014-06-13 03:59:37.000000000 +0200 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/arrayidx.exp 2014-06-16 23:30:30.109940484 +0200 +@@ -49,4 +49,12 @@ gdb_test "print array" \ + "\\{\\\[0\\\] = 1, \\\[1\\\] = 2, \\\[2\\\] = 3, \\\[3\\\] = 4\\}" \ + "Print array with array-indexes on" + +- ++set test "p unbound.a == &unbound.a\[0\]" ++gdb_test_multiple $test $test { ++ -re " = 1\r\n$gdb_prompt $" { ++ pass $test ++ } ++ -re "No symbol \"unbound\" in current context.\r\n$gdb_prompt $" { ++ unsupported "$test (no GCC)" ++ } ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.c 2014-06-16 23:30:30.109940484 +0200 +@@ -0,0 +1,20 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2009 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++struct { ++ int field; ++} staticstruct = { 1 }; +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/internal-var-field-address.exp 2014-06-16 23:30:30.109940484 +0200 +@@ -0,0 +1,26 @@ ++# Copyright 2009 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++set test internal-var-field-address ++set binfile ${test}.x ++if { [gdb_compile "${srcdir}/${subdir}/${test}.c" "[standard_output_file ${binfile}]" object {debug}] != "" } { ++ untested "Couldn't compile test program" ++ return -1 ++} ++ ++clean_restart $binfile ++ ++gdb_test {set $varstruct = staticstruct} ++gdb_test {p $varstruct.field} " = 1" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.c 2014-06-16 23:30:30.110940485 +0200 +@@ -0,0 +1,31 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2011 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++#include ++ ++int ++main (int argc, char **argv) ++{ ++ char s[2 + argc]; ++ void (*f) (char *) = 0; ++ ++ memset (s, 0, sizeof (s)); ++ s[0] = 'X'; ++ ++ f (s); ++ return 0; ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-frame.exp 2014-06-16 23:30:30.110940485 +0200 +@@ -0,0 +1,38 @@ ++# Copyright 2011 Free Software Foundation, Inc. ++# ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++set testfile vla-frame ++set executable ${testfile} ++ ++if { [prepare_for_testing ${testfile}.exp ${executable}] } { ++ return -1 ++} ++ ++if ![runto_main] { ++ return -1 ++} ++ ++set test "continue" ++gdb_test_multiple $test $test { ++ -re "Continuing\\.\r\n\r\nProgram received signal SIGSEGV, Segmentation fault\\.\r\n0x0+ in \\?\\? \\(\\)\r\n$gdb_prompt $" { ++ pass $test ++ } ++ -re "\r\n$gdb_prompt $" { ++ untested ${testfile}.exp ++ return ++ } ++} ++ ++gdb_test "bt full" "\r\n +s = \"X\\\\000\"\r\n.*" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.c 2014-06-16 23:30:30.110940485 +0200 +@@ -0,0 +1,30 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2008 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++#include ++ ++int ++main (int argc, char **argv) ++{ ++ int array[argc]; ++ ++ array[0] = array[0]; ++ ++ abort (); ++ ++ return 0; ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla-overflow.exp 2014-06-16 23:30:30.110940485 +0200 +@@ -0,0 +1,109 @@ ++# Copyright 2008 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++# We could crash in: ++# #0 block_linkage_function (bl=0x0) at ../../gdb/block.c:69 ++# #1 in dwarf_block_get_frame_base (...) at ../../gdb/dwarf2block.c:97 ++# 97 framefunc = block_linkage_function (get_frame_block (frame, NULL)); ++# #2 in execute_stack_op (...) at ../../gdb/dwarf2expr.c:496 ++# #3 in dwarf_block_exec_core () at ../../gdb/dwarf2block.c:156 ++# #4 dwarf_block_exec (...) at ../../gdb/dwarf2block.c:206 ++# #5 in range_type_count_bound_internal (...) at ../../gdb/gdbtypes.c:1430 ++# #6 in create_array_type (...) at ../../gdb/gdbtypes.c:840 ++# ... ++# #21 in psymtab_to_symtab (...) at ../../gdb/symfile.c:292 ++# ... ++# #29 in backtrace_command_1 () at ../../gdb/stack.c:1273 ++ ++set testfile vla-overflow ++set shfile ${objdir}/${subdir}/${testfile}-gdb.sh ++set srcfile ${testfile}.c ++set binfile ${objdir}/${subdir}/${testfile} ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } { ++ untested "Couldn't compile test program" ++ return -1 ++} ++ ++set f [open "|getconf PAGESIZE" "r"] ++gets $f pagesize ++close $f ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++set pid_of_gdb [exp_pid -i [board_info host fileid]] ++ ++if { [runto_main] < 0 } { ++ untested vla-overflow ++ return -1 ++} ++ ++# Get the GDB memory size when we stay at main. ++ ++proc memory_v_pages_get {} { ++ global pid_of_gdb pagesize ++ set fd [open "/proc/$pid_of_gdb/statm"] ++ gets $fd line ++ close $fd ++ # number of pages of virtual memory ++ scan $line "%d" drs ++ return $drs ++} ++ ++set pages_found [memory_v_pages_get] ++ ++# s390x with glibc-debuginfo.s390x installed used approx. 16MB. ++set mb_reserve 40 ++verbose -log "pages_found = $pages_found, mb_reserve = $mb_reserve" ++set kb_found [expr $pages_found * $pagesize / 1024] ++set kb_permit [expr $kb_found + 1 * 1024 + $mb_reserve * 1024] ++verbose -log "kb_found = $kb_found, kb_permit = $kb_permit" ++ ++# Create the ulimit wrapper. ++set f [open $shfile "w"] ++puts $f "#! /bin/sh" ++puts $f "ulimit -v $kb_permit" ++puts $f "exec $GDB \"\$@\"" ++close $f ++remote_exec host "chmod +x $shfile" ++ ++gdb_exit ++set GDBold $GDB ++set GDB "$shfile" ++gdb_start ++set GDB $GDBold ++ ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++set pid_of_gdb [exp_pid -i [board_info host fileid]] ++ ++# Check the size again after the second run. ++# We must not stop in main as it would cache `array' and never crash later. ++ ++gdb_run_cmd ++ ++verbose -log "kb_found before abort() = [expr [memory_v_pages_get] * $pagesize / 1024]" ++ ++gdb_test "" "Program received signal SIGABRT, Aborted..*" "Enter abort()" ++ ++verbose -log "kb_found in abort() = [expr [memory_v_pages_get] * $pagesize / 1024]" ++ ++# `abort' can get expressed as `*__GI_abort'. ++gdb_test "bt" "in \[^ \]*abort \\(.* in main \\(.*" "Backtrace after abort()" ++ ++verbose -log "kb_found in bt after abort() = [expr [memory_v_pages_get] * $pagesize / 1024]" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla.c 2014-06-16 23:30:30.110940485 +0200 +@@ -0,0 +1,55 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2008 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++#include ++ ++void ++marker (void) ++{ ++} ++ ++void ++bar (char *a, char *b, char *c, int size) ++{ ++ memset (a, '1', size); ++ memset (b, '2', size); ++ memset (c, '3', 48); ++} ++ ++void ++foo (int size) ++{ ++ char temp1[size]; ++ char temp3[48]; ++ ++ temp1[size - 1] = '\0'; ++ { ++ char temp2[size]; ++ ++ bar (temp1, temp2, temp3, size); ++ ++ marker (); /* break-here */ ++ } ++} ++ ++int ++main (void) ++{ ++ foo (26); ++ foo (78); ++ return 0; ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.base/vla.exp 2014-06-16 23:30:30.110940485 +0200 +@@ -0,0 +1,62 @@ ++# Copyright 2008 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++set testfile vla ++set srcfile ${testfile}.c ++set binfile ${objdir}/${subdir}/${testfile} ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } { ++ untested "Couldn't compile test program" ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++if ![runto_main] { ++ untested vla ++ return -1 ++} ++ ++gdb_breakpoint [gdb_get_line_number "break-here"] ++ ++gdb_continue_to_breakpoint "break-here" ++ ++gdb_test "whatis temp1" "type = char \\\[26\\\]" "first: whatis temp1" ++gdb_test "whatis temp2" "type = char \\\[26\\\]" "first: whatis temp2" ++gdb_test "whatis temp3" "type = char \\\[48\\\]" "first: whatis temp3" ++ ++gdb_test "ptype temp1" "type = char \\\[26\\\]" "first: ptype temp1" ++gdb_test "ptype temp2" "type = char \\\[26\\\]" "first: ptype temp2" ++gdb_test "ptype temp3" "type = char \\\[48\\\]" "first: ptype temp3" ++ ++gdb_test "p temp1" " = '1' " "first: print temp1" ++gdb_test "p temp2" " = '2' " "first: print temp2" ++gdb_test "p temp3" " = '3' " "first: print temp3" ++ ++gdb_continue_to_breakpoint "break-here" ++ ++gdb_test "whatis temp1" "type = char \\\[78\\\]" "second: whatis temp1" ++gdb_test "whatis temp2" "type = char \\\[78\\\]" "second: whatis temp2" ++gdb_test "whatis temp3" "type = char \\\[48\\\]" "second: whatis temp3" ++ ++gdb_test "ptype temp1" "type = char \\\[78\\\]" "second: ptype temp1" ++gdb_test "ptype temp2" "type = char \\\[78\\\]" "second: ptype temp2" ++gdb_test "ptype temp3" "type = char \\\[48\\\]" "second: ptype temp3" ++ ++gdb_test "p temp1" " = '1' " "second: print temp1" ++gdb_test "p temp2" " = '2' " "second: print temp2" ++gdb_test "p temp3" " = '3' " "second: print temp3" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S 2014-06-16 23:30:30.111940487 +0200 +@@ -0,0 +1,246 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2010 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++/* Debug information */ ++ ++/* We will `break *main' at the very first instruction. */ ++#define main_length 1 ++ ++ .section .data ++vardata: ++ /* See DW_OP_lit3 + 1 (0-based). */ ++ .string "seennotseen" ++ ++ .section .debug_info ++.Lcu1_begin: ++ .4byte .Lcu1_end - .Lcu1_start /* Length of Compilation Unit */ ++.Lcu1_start: ++ .2byte 2 /* DWARF version number */ ++ .4byte .Ldebug_abbrev0 /* Offset Into Abbrev. Section */ ++ .byte 4 /* Pointer Size (in bytes) */ ++ ++ /* CU die */ ++ .uleb128 1 /* Abbrev: DW_TAG_compile_unit */ ++ .4byte .Lproducer /* DW_AT_producer */ ++ /* Use C++ to exploit a bug in parsing DW_AT_name "". */ ++ .byte 4 /* DW_AT_language (C++) - */ ++ .4byte main /* DW_AT_low_pc */ ++ .byte main_length /* DW_AT_high_pc */ ++ ++.Larray_type: ++ .uleb128 2 /* Abbrev: DW_TAG_array_type */ ++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */ ++ ++ .uleb128 3 /* Abbrev: DW_TAG_subrange_type */ ++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */ ++ .byte 0 /* DW_AT_lower_bound */ ++ .4byte .Llen_var-.Lcu1_begin /* DW_AT_upper_bound */ ++ .byte 0 /* End of children of die */ ++ ++ /* DW_AT_upper_bound is referencing an optimized-out variable. */ ++.Larrayb_type: ++ .uleb128 2 /* Abbrev: DW_TAG_array_type */ ++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */ ++ ++ .uleb128 3 /* Abbrev: DW_TAG_subrange_type */ ++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */ ++ .byte 0 /* DW_AT_lower_bound */ ++ .4byte .Llenb_var-.Lcu1_begin /* DW_AT_upper_bound */ ++ .byte 0 /* End of children of die */ ++ ++ /* DW_AT_upper_bound is referencing register. */ ++.Larrayreg_type: ++ .uleb128 2 /* Abbrev: DW_TAG_array_type */ ++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */ ++ ++ .uleb128 8 /* Abbrev: DW_TAG_subrange_type with block */ ++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */ ++ .byte 0 /* DW_AT_lower_bound */ ++ .byte 2f - 1f /* DW_AT_upper_bound */ ++1: .byte 0x50 /* DW_OP_reg0 */ ++2: ++ .byte 0 /* End of children of die */ ++ ++.Luint_type: ++ .uleb128 4 /* Abbrev: DW_TAG_base_type */ ++ .4byte .Luint_str /* DW_AT_name */ ++ .byte 4 /* DW_AT_byte_size */ ++ .byte 7 /* DW_AT_encoding */ ++ ++.Lchar_type: ++ .uleb128 4 /* Abbrev: DW_TAG_base_type */ ++ .4byte .Lchar_str /* DW_AT_name */ ++ .byte 1 /* DW_AT_byte_size */ ++ .byte 6 /* DW_AT_encoding */ ++ ++.Llen_var: ++ .uleb128 5 /* Abbrev: DW_TAG_variable artificial */ ++ .byte 1 /* DW_AT_artificial */ ++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */ ++ .4byte .Llen_loclist-.Lloclist /* DW_AT_location */ ++ ++ /* optimized-out variable for b_string. */ ++.Llenb_var: ++ .uleb128 7 /* Abbrev: DW_TAG_variable artificial no DW_AT_location */ ++ .byte 1 /* DW_AT_artificial */ ++ .4byte .Luint_type-.Lcu1_begin /* DW_AT_type */ ++ ++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */ ++ .string "a_string" /* DW_AT_name */ ++ .4byte .Larray_type-.Lcu1_begin /* DW_AT_type */ ++ .byte 2f - 1f /* DW_AT_location */ ++1: .byte 3 /* DW_OP_addr */ ++ .4byte vardata /* */ ++2: ++ ++ /* DW_AT_upper_bound is referencing an optimized-out variable. */ ++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */ ++ .string "b_string" /* DW_AT_name */ ++ .4byte .Larrayb_type-.Lcu1_begin /* DW_AT_type */ ++ .byte 2f - 1f /* DW_AT_location */ ++1: .byte 3 /* DW_OP_addr */ ++ .4byte vardata /* */ ++2: ++ ++ /* DW_AT_upper_bound is referencing register. */ ++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */ ++ .string "reg_string" /* DW_AT_name */ ++ .4byte .Larrayreg_type-.Lcu1_begin /* DW_AT_type */ ++ .byte 2f - 1f /* DW_AT_location */ ++1: .byte 3 /* DW_OP_addr */ ++ .4byte vardata /* */ ++2: ++ ++ .byte 0 /* End of children of CU */ ++.Lcu1_end: ++ ++ .section .debug_loc ++.Lloclist: ++.Llen_loclist: ++ .4byte 0 # Location list begin address ++ .4byte main_length # Location list end address ++ .value 2f-1f # Location expression size ++1: .byte 0x33 # DW_OP_lit3 ++ .byte 0x9f # DW_OP_stack_value ++2: ++ .quad 0x0 # Location list terminator begin (*.LLST2) ++ .quad 0x0 # Location list terminator end (*.LLST2) ++ ++ .section .debug_abbrev ++.Ldebug_abbrev0: ++ .uleb128 1 /* Abbrev code */ ++ .uleb128 0x11 /* DW_TAG_compile_unit */ ++ .byte 0x1 /* has_children */ ++ .uleb128 0x25 /* DW_AT_producer */ ++ .uleb128 0xe /* DW_FORM_strp */ ++ .uleb128 0x13 /* DW_AT_language */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .uleb128 0x11 /* DW_AT_low_pc */ ++ .uleb128 0x1 /* DW_FORM_addr */ ++ .uleb128 0x12 /* DW_AT_high_pc */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 2 /* Abbrev code */ ++ .uleb128 0x1 /* TAG: DW_TAG_array_type */ ++ .byte 0x1 /* DW_children_yes */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 3 /* Abbrev code */ ++ .uleb128 0x21 /* DW_TAG_subrange_type */ ++ .byte 0x0 /* no children */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x22 /* DW_AT_lower_bound */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .uleb128 0x2f /* DW_AT_upper_bound */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 4 /* Abbrev code */ ++ .uleb128 0x24 /* DW_TAG_base_type */ ++ .byte 0x0 /* no_children */ ++ .uleb128 0x3 /* DW_AT_name */ ++ .uleb128 0xe /* DW_FORM_strp */ ++ .uleb128 0xb /* DW_AT_byte_size */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .uleb128 0x3e /* DW_AT_encoding */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 5 /* Abbrev code */ ++ .uleb128 0x34 /* DW_TAG_variable */ ++ .byte 0x0 /* no_children */ ++ .uleb128 0x34 /* DW_AT_artificial */ ++ .uleb128 0x0c /* DW_FORM_flag */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x02 /* DW_AT_location */ ++ .uleb128 0x06 /* DW_FORM_data4 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 6 /* Abbrev code */ ++ .uleb128 0x34 /* DW_TAG_variable */ ++ .byte 0x0 /* no_children */ ++ .uleb128 0x3 /* DW_AT_name */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x2 /* DW_AT_location */ ++ .uleb128 0xa /* DW_FORM_block1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 7 /* Abbrev code */ ++ .uleb128 0x34 /* DW_TAG_variable */ ++ .byte 0x0 /* no_children */ ++ .uleb128 0x34 /* DW_AT_artificial */ ++ .uleb128 0x0c /* DW_FORM_flag */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 8 /* Abbrev code */ ++ .uleb128 0x21 /* DW_TAG_subrange_type with block */ ++ .byte 0x0 /* no children */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x22 /* DW_AT_lower_bound */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .uleb128 0x2f /* DW_AT_upper_bound */ ++ .uleb128 0xa /* DW_FORM_block1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .byte 0x0 /* Terminator */ ++ ++/* String table */ ++ .section .debug_str ++.Lproducer: ++ .string "GNU C 3.3.3" ++.Lchar_str: ++ .string "char" ++.Luint_str: ++ .string "unsigned int" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp 2014-06-16 23:30:30.111940487 +0200 +@@ -0,0 +1,63 @@ ++# Copyright 2010 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++# Test printing variable with dynamic bounds which reference a different ++# (artificial in the GCC case) variable containing loclist as its location. ++# This testcase uses value (not address) of the referenced variable: ++# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43762 ++ ++# This test can only be run on targets which support DWARF-2 and use gas. ++# For now pick a sampling of likely targets. ++if {![istarget *-*-linux*] ++ && ![istarget *-*-gnu*] ++ && ![istarget *-*-elf*] ++ && ![istarget *-*-openbsd*] ++ && ![istarget arm-*-eabi*] ++ && ![istarget powerpc-*-eabi*]} { ++ return 0 ++} ++ ++set testfile dw2-bound-loclist ++if { [prepare_for_testing ${testfile}.exp ${testfile} [list ${testfile}.S main.c] {}] } { ++ return -1 ++} ++ ++# Verify it behaves at least as an unbound array without inferior. ++ ++set test "p a_string" ++gdb_test_multiple $test $test { ++ -re " = 0x\[0-9a-f\]+ \"seennotseen\"\r\n$gdb_prompt $" { ++ pass $test ++ } ++ -re "No registers\\.\r\n$gdb_prompt $" { ++ kfail "vlaregression" $test ++ } ++} ++ ++gdb_test "ptype a_string" {type = char \[variable length\]} ++ ++# Not runto_main as dw2-bound-loclist.S handles only the first byte of main. ++if ![runto "*main"] { ++ return -1 ++} ++ ++gdb_test "p a_string" { = "seen"} ++gdb_test "ptype a_string" {type = char \[4\]} ++ ++gdb_test "p b_string" { = (0x[0-9a-f]+ )?"seennotseen"} ++gdb_test "ptype b_string" {type = char \[\]} ++ ++# The register contains unpredictable value - the array size. ++gdb_test "ptype reg_string" {type = char \[-?[0-9]+\]} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.c 2014-06-16 23:30:30.111940487 +0200 +@@ -0,0 +1,42 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2004 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 2 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program; if not, write to the Free Software ++ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ++ USA. */ ++ ++ ++/* The function `func1' traced into must have debug info on offset > 0; ++ (DW_UNSND (attr)). This is the reason of `func0' existence. */ ++ ++void ++func0(int a, int b) ++{ ++} ++ ++/* `func1' being traced into must have some arguments to dump. */ ++ ++void ++func1(int a, int b) ++{ ++ func0 (a,b); ++} ++ ++int ++main(void) ++{ ++ func1 (1, 2); ++ return 0; ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 2014-06-16 23:30:30.111940487 +0200 +@@ -0,0 +1,79 @@ ++# Copyright 2006 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++# Minimal DWARF-2 unit test ++ ++# This test can only be run on targets which support DWARF-2. ++# For now pick a sampling of likely targets. ++if {![istarget *-*-linux*] ++ && ![istarget *-*-gnu*] ++ && ![istarget *-*-elf*] ++ && ![istarget *-*-openbsd*] ++ && ![istarget arm-*-eabi*] ++ && ![istarget powerpc-*-eabi*]} { ++ return 0 ++} ++ ++set testfile "dw2-stripped" ++set srcfile ${testfile}.c ++set binfile ${objdir}/${subdir}/${testfile}.x ++ ++remote_exec build "rm -f ${binfile}" ++ ++# get the value of gcc_compiled ++if [get_compiler_info ${binfile}] { ++ return -1 ++} ++ ++# This test can only be run on gcc as we use additional_flags=FIXME ++if {$gcc_compiled == 0} { ++ return 0 ++} ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug additional_flags=-ggdb3}] != "" } { ++ return -1 ++} ++ ++remote_exec build "objcopy -R .debug_loc ${binfile}" ++set strip_output [remote_exec build "objdump -h ${binfile}"] ++ ++set test "stripping test file preservation" ++if [ regexp ".debug_info " $strip_output] { ++ pass "$test (.debug_info preserved)" ++} else { ++ fail "$test (.debug_info got also stripped)" ++} ++ ++set test "stripping test file functionality" ++if [ regexp ".debug_loc " $strip_output] { ++ fail "$test (.debug_loc still present)" ++} else { ++ pass "$test (.debug_loc stripped)" ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++# For C programs, "start" should stop in main(). ++ ++gdb_test "start" \ ++ ".*main \\(\\) at .*" \ ++ "start" ++gdb_test "step" \ ++ "func.* \\(.*\\) at .*" \ ++ "step" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S 2014-06-16 23:30:30.112940488 +0200 +@@ -0,0 +1,83 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2009 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++/* Debug information */ ++ ++ .section .debug_info ++.Lcu1_begin: ++ /* CU header */ ++ .4byte .Lcu1_end - .Lcu1_start /* Length of Compilation Unit */ ++.Lcu1_start: ++ .2byte 2 /* DWARF Version */ ++ .4byte .Labbrev1_begin /* Offset into abbrev section */ ++ .byte 4 /* Pointer size */ ++ ++ /* CU die */ ++ .uleb128 1 /* Abbrev: DW_TAG_compile_unit */ ++ .ascii "dw2-struct-member-data-location.c\0" /* DW_AT_name */ ++ .ascii "GNU C 4.3.2\0" /* DW_AT_producer */ ++ .byte 1 /* DW_AT_language (C) */ ++ ++.Ltype_uchar: ++ .uleb128 2 /* Abbrev: DW_TAG_structure_type */ ++ .ascii "some_struct\0" /* DW_AT_name */ ++ ++ .uleb128 3 /* Abbrev: DW_TAG_member */ ++ .ascii "field\0" /* DW_AT_name */ ++ .byte 0 /* DW_AT_data_member_location */ ++ ++ .byte 0 /* End of children of some_struct */ ++ ++ .byte 0 /* End of children of CU */ ++ ++.Lcu1_end: ++ ++/* Abbrev table */ ++ .section .debug_abbrev ++.Labbrev1_begin: ++ .uleb128 1 /* Abbrev code */ ++ .uleb128 0x11 /* DW_TAG_compile_unit */ ++ .byte 1 /* has_children */ ++ .uleb128 0x3 /* DW_AT_name */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .uleb128 0x25 /* DW_AT_producer */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .uleb128 0x13 /* DW_AT_language */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 2 /* Abbrev code */ ++ .uleb128 0x13 /* DW_TAG_structure_type */ ++ .byte 1 /* has_children */ ++ .uleb128 0x3 /* DW_AT_name */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 3 /* Abbrev code */ ++ .uleb128 0x0d /* DW_TAG_member */ ++ .byte 0 /* has_children */ ++ .uleb128 0x3 /* DW_AT_name */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .uleb128 0x38 /* DW_AT_data_member_location */ ++ .uleb128 0x0b /* DW_FORM_data1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp 2014-06-16 23:30:30.112940488 +0200 +@@ -0,0 +1,37 @@ ++# Copyright 2009 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++# This test can only be run on targets which support DWARF-2 and use gas. ++# For now pick a sampling of likely targets. ++if {![istarget *-*-linux*] ++ && ![istarget *-*-gnu*] ++ && ![istarget *-*-elf*] ++ && ![istarget *-*-openbsd*] ++ && ![istarget arm-*-eabi*] ++ && ![istarget powerpc-*-eabi*]} { ++ return 0 ++} ++ ++set testfile "dw2-struct-member-data-location" ++set srcfile ${testfile}.S ++set binfile ${testfile}.x ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "[standard_output_file ${binfile}]" object {nodebug}] != "" } { ++ return -1 ++} ++ ++clean_restart $binfile ++ ++gdb_test "ptype struct some_struct" "type = struct some_struct {\[\r\n \t\]*void field;\[\r\n \t\]*}" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S 2014-06-16 23:30:30.112940488 +0200 +@@ -0,0 +1,121 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2012 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++/* Debug information */ ++ ++ .section .data ++vardata: ++ .rept 129 ++ .ascii "x" ++ .endr ++ .ascii "UNSEEN\0" ++ ++ .section .debug_info ++.Lcu1_begin: ++ .4byte .Lcu1_end - .Lcu1_start /* Length of Compilation Unit */ ++.Lcu1_start: ++ .2byte 2 /* DWARF version number */ ++ .4byte .Ldebug_abbrev0 /* Offset Into Abbrev. Section */ ++ .byte 4 /* Pointer Size (in bytes) */ ++ ++ /* CU die */ ++ .uleb128 1 /* Abbrev: DW_TAG_compile_unit */ ++ .ascii "GNU C 3.3.3\0" /* DW_AT_producer */ ++ .byte 2 /* DW_AT_language (C) - */ ++ ++.Larray_type: ++ .uleb128 2 /* Abbrev: DW_TAG_array_type */ ++ .4byte .Lchar_type-.Lcu1_begin /* DW_AT_type */ ++ ++ .uleb128 8 /* Abbrev: DW_TAG_subrange_type without DW_AT_type */ ++ .byte 0 /* DW_AT_lower_bound */ ++ .byte 128 /* DW_AT_upper_bound */ ++ ++ .byte 0 /* End of children of die */ ++ ++.Lchar_type: ++ .uleb128 4 /* Abbrev: DW_TAG_base_type */ ++ .ascii "char\0" /* DW_AT_name */ ++ .byte 1 /* DW_AT_byte_size */ ++ .byte 6 /* DW_AT_encoding */ ++ ++ .uleb128 6 /* Abbrev: DW_TAG_variable DW_FORM_string */ ++ .ascii "notype_string\0" /* DW_AT_name */ ++ .4byte .Larray_type-.Lcu1_begin /* DW_AT_type */ ++ .byte 2f - 1f /* DW_AT_location */ ++1: .byte 3 /* DW_OP_addr */ ++ .4byte vardata /* */ ++2: ++ ++ .byte 0 /* End of children of CU */ ++.Lcu1_end: ++ ++ .section .debug_abbrev ++.Ldebug_abbrev0: ++ .uleb128 1 /* Abbrev code */ ++ .uleb128 0x11 /* DW_TAG_compile_unit */ ++ .byte 0x1 /* has_children */ ++ .uleb128 0x25 /* DW_AT_producer */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .uleb128 0x13 /* DW_AT_language */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 2 /* Abbrev code */ ++ .uleb128 0x1 /* TAG: DW_TAG_array_type */ ++ .byte 0x1 /* DW_children_yes */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 4 /* Abbrev code */ ++ .uleb128 0x24 /* DW_TAG_base_type */ ++ .byte 0x0 /* no_children */ ++ .uleb128 0x3 /* DW_AT_name */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .uleb128 0xb /* DW_AT_byte_size */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .uleb128 0x3e /* DW_AT_encoding */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 6 /* Abbrev code */ ++ .uleb128 0x34 /* DW_TAG_variable */ ++ .byte 0x0 /* no_children */ ++ .uleb128 0x3 /* DW_AT_name */ ++ .uleb128 0x8 /* DW_FORM_string */ ++ .uleb128 0x49 /* DW_AT_type */ ++ .uleb128 0x13 /* DW_FORM_ref4 */ ++ .uleb128 0x2 /* DW_AT_location */ ++ .uleb128 0xa /* DW_FORM_block1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .uleb128 8 /* Abbrev code */ ++ .uleb128 0x21 /* DW_TAG_subrange_type without DW_AT_type */ ++ .byte 0x0 /* no children */ ++ .uleb128 0x22 /* DW_AT_lower_bound */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .uleb128 0x2f /* DW_AT_upper_bound */ ++ .uleb128 0xb /* DW_FORM_data1 */ ++ .byte 0x0 /* Terminator */ ++ .byte 0x0 /* Terminator */ ++ ++ .byte 0x0 /* Terminator */ +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp 2014-06-16 23:30:30.112940488 +0200 +@@ -0,0 +1,39 @@ ++# Copyright 2012 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++load_lib dwarf.exp ++ ++# https://bugzilla.redhat.com/show_bug.cgi?id=806920 ++# read_subrange_type reinitialization ++# of BASE_TYPE was done too late, it affects DW_TAG_subrange_type without ++# specified DW_AT_type, present only in XLF produced code. ++ ++# This test can only be run on targets which support DWARF-2 and use gas. ++if {![dwarf2_support]} { ++ return 0 ++} ++ ++set testfile dw2-subrange-no-type ++set srcfile ${testfile}.S ++set executable ${testfile}.x ++set binfile [standard_output_file ${executable}] ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" object {}] != "" } { ++ return -1 ++} ++ ++clean_restart $executable ++ ++gdb_test "ptype notype_string" {type = char \[129\]} ++gdb_test "p notype_string" " = 'x' " +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.exp 2014-06-16 23:30:30.112940488 +0200 +@@ -0,0 +1,42 @@ ++# Copyright 2009 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++# This file was written by Jan Kratochvil . ++ ++# This file is part of the gdb testsuite. Array element stride must not be ++# specified in the number of elements but in a number of bytes instead. ++# Original problem: ++# (gdb) p c40pt(1) ++# $1 = '0-hello', ' ' ++# (gdb) p c40pt(2) ++# warning: Fortran array stride not divisible by the element size ++ ++set testfile dwarf-stride ++set srcfile ${testfile}.f90 ++ ++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug f90}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "break-here"] ++gdb_continue_to_breakpoint "break-here" ".*break-here.*" ++gdb_test "p c40pt(1)" " = '0-hello.*" ++gdb_test "p c40pt(2)" " = '1-hello.*" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.f90 +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dwarf-stride.f90 2014-06-16 23:30:30.112940488 +0200 +@@ -0,0 +1,40 @@ ++! Copyright 2009 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! File written by Alan Matsuoka. ++ ++program repro ++ ++ type small_stride ++ character*40 long_string ++ integer small_pad ++ end type small_stride ++ ++ type(small_stride), dimension (20), target :: unpleasant ++ character*40, pointer, dimension(:):: c40pt ++ ++ integer i ++ ++ do i = 0,19 ++ unpleasant(i+1)%small_pad = i+1 ++ unpleasant(i+1)%long_string = char (ichar('0') + i) // '-hello' ++ end do ++ ++ c40pt => unpleasant%long_string ++ ++ print *, c40pt ! break-here ++ ++end program repro +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.exp 2014-06-16 23:37:45.568362563 +0200 +@@ -0,0 +1,151 @@ ++# Copyright 2007 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++# This file was written by Jan Kratochvil . ++ ++# This file is part of the gdb testsuite. It contains tests for dynamically ++# allocated Fortran arrays. ++# It depends on the GCC dynamic Fortran arrays DWARF support: ++# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=22244 ++ ++set testfile "dynamic" ++set srcfile ${testfile}.f90 ++set binfile ${objdir}/${subdir}/${testfile} ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f90 quiet}] != "" } { ++ untested "Couldn't compile ${srcfile}" ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "varx-init"] ++gdb_continue_to_breakpoint "varx-init" ++gdb_test "p varx" "\\$\[0-9\]* = " "p varx unallocated" ++gdb_test "ptype varx" "type = " "ptype varx unallocated" ++gdb_test "p varx(1,5,17)" "no such vector element because not allocated" "p varx(1,5,17) unallocated" ++gdb_test "p varx(1,5,17)=1" "no such vector element because not allocated" "p varx(1,5,17)=1 unallocated" ++gdb_test "ptype varx(1,5,17)" "no such vector element because not allocated" "ptype varx(1,5,17) unallocated" ++ ++gdb_breakpoint [gdb_get_line_number "varx-allocated"] ++gdb_continue_to_breakpoint "varx-allocated" ++# $1 = (( ( 0, 0, 0, 0, 0, 0) ( 0, 0, 0, 0, 0, 0) --- , 0) ) ( ( 0, 0, ...) ...) ...) ++gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx allocated" ++# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1. ++gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varx allocated" ++ ++gdb_breakpoint [gdb_get_line_number "varx-filled"] ++gdb_continue_to_breakpoint "varx-filled" ++gdb_test "p varx(2, 5, 17)" "\\$\[0-9\]* = 6" ++gdb_test "p varx(1, 5, 17)" "\\$\[0-9\]* = 7" ++gdb_test "p varx(2, 6, 18)" "\\$\[0-9\]* = 8" ++gdb_test "p varx(6, 15, 28)" "\\$\[0-9\]* = 9" ++gdb_test "p varv" "\\$\[0-9\]* = " "p varv unassociated" ++gdb_test "ptype varv" "type = " "ptype varv unassociated" ++ ++set test "output varx" ++gdb_test_multiple $test $test { ++ -re "^output varx\r\n\[() ,6789.\]*$gdb_prompt $" { ++ pass $test ++ } ++} ++ ++gdb_breakpoint [gdb_get_line_number "varv-associated"] ++gdb_continue_to_breakpoint "varv-associated" ++gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 6" "p varx(3, 7, 19) with varv associated" ++gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 6" "p varv(3, 7, 19) associated" ++# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1. ++gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varv associated" ++gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx with varv associated" ++# Intel Fortran Compiler 10.1.008 uses the pointer type. ++gdb_test "ptype varv" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)\\)?" "ptype varv associated" ++ ++gdb_breakpoint [gdb_get_line_number "varv-filled"] ++gdb_continue_to_breakpoint "varv-filled" ++gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 10" "p varx(3, 7, 19) with varv filled" ++gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 10" "p varv(3, 7, 19) filled" ++ ++gdb_breakpoint [gdb_get_line_number "varv-deassociated"] ++gdb_continue_to_breakpoint "varv-deassociated" ++# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type. ++gdb_test "p varv" "\\$\[0-9\]* = (|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "p varv deassociated" ++gdb_test "ptype varv" "type = (|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "ptype varv deassociated" ++gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varv deassociated" ++gdb_test "p varv(1,5,17)" "no such vector element because not associated" ++gdb_test "ptype varv(1,5,17)" "no such vector element because not associated" ++ ++gdb_breakpoint [gdb_get_line_number "varx-deallocated"] ++gdb_continue_to_breakpoint "varx-deallocated" ++gdb_test "p varx" "\\$\[0-9\]* = " "p varx deallocated" ++gdb_test "ptype varx" "type = " "ptype varx deallocated" ++gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varx deallocated" ++gdb_test "p varx(1,5,17)" "no such vector element because not allocated" "p varx(1,5,17) deallocated" ++gdb_test "ptype varx(1,5,17)" "no such vector element because not allocated" "ptype varx(1,5,17) deallocated" ++ ++gdb_breakpoint [gdb_get_line_number "vary-passed"] ++gdb_continue_to_breakpoint "vary-passed" ++# $1 = (( ( 1, 1, 1, 1, 1, 1) ( 1, 1, 1, 1, 1, 1) --- , 1) ) ( ( 1, 1, ...) ...) ...) ++gdb_test "p vary" "\\$\[0-9\]* = \\(\[()1, .\]*\\)" ++ ++gdb_breakpoint [gdb_get_line_number "vary-filled"] ++gdb_continue_to_breakpoint "vary-filled" ++gdb_test "ptype vary" "type = real(\\(kind=4\\)|\\*4) \\(10,10\\)" ++gdb_test "p vary(1, 1)" "\\$\[0-9\]* = 8" ++gdb_test "p vary(2, 2)" "\\$\[0-9\]* = 9" ++gdb_test "p vary(1, 3)" "\\$\[0-9\]* = 10" ++# $1 = (( ( 3, 3, 3, 3, 3, 3) ( 3, 3, 3, 3, 3, 3) --- , 3) ) ( ( 3, 3, ...) ...) ...) ++gdb_test "p varw" "\\$\[0-9\]* = \\(\[()3, .\]*\\)" ++ ++gdb_breakpoint [gdb_get_line_number "varw-almostfilled"] ++gdb_continue_to_breakpoint "varw-almostfilled" ++gdb_test "ptype varw" "type = real(\\(kind=4\\)|\\*4) \\(5,4,3\\)" ++gdb_test "p varw(3,1,1)=1" "\\$\[0-9\]* = 1" ++# $1 = (( ( 6, 5, 1, 5, 5, 5) ( 5, 5, 5, 5, 5, 5) --- , 5) ) ( ( 5, 5, ...) ...) ...) ++gdb_test "p varw" "\\$\[0-9\]* = \\( *\\( *\\( *6, *5, *1,\[()5, .\]*\\)" "p varw filled" ++# "up" works with GCC but other Fortran compilers may copy the values into the ++# outer function only on the exit of the inner function. ++# We need both variants as depending on the arch we optionally may still be ++# executing the caller line or not after `finish'. ++gdb_test "finish" ".*(call bar \\(y, x\\)|call foo \\(x, z\\(2:6, 4:7, 6:8\\)\\))" ++gdb_test "p z(2,4,5)" "\\$\[0-9\]* = 3" ++gdb_test "p z(2,4,6)" "\\$\[0-9\]* = 6" ++gdb_test "p z(2,4,7)" "\\$\[0-9\]* = 5" ++gdb_test "p z(4,4,6)" "\\$\[0-9\]* = 1" ++ ++gdb_breakpoint [gdb_get_line_number "varz-almostfilled"] ++gdb_continue_to_breakpoint "varz-almostfilled" ++# GCC uses the pointer type here, Intel Fortran Compiler 10.1.008 does not. ++gdb_test "ptype varz" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" ++# Intel Fortran Compiler 10.1.008 has a bug here - (2:11,7:7) ++# as it produces DW_AT_lower_bound == DW_AT_upper_bound == 7. ++gdb_test "ptype vart" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(2:11,7:\\*\\)\\)?" ++gdb_test "p varz" "\\$\[0-9\]* = \\(\\)" ++gdb_test "p vart" "\\$\[0-9\]* = \\(\\)" ++gdb_test "p varz(3)" "\\$\[0-9\]* = 4" ++# maps to foo::vary(1,1) ++gdb_test "p vart(2,7)" "\\$\[0-9\]* = 8" ++# maps to foo::vary(2,2) ++gdb_test "p vart(3,8)" "\\$\[0-9\]* = 9" ++# maps to foo::vary(1,3) ++gdb_test "p vart(2,9)" "\\$\[0-9\]* = 10" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.f90 +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/dynamic.f90 2014-06-16 23:30:30.113940488 +0200 +@@ -0,0 +1,98 @@ ++! Copyright 2007 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine baz ++ real, target, allocatable :: varx (:, :, :) ++ real, pointer :: varv (:, :, :) ++ real, target :: varu (1, 2, 3) ++ logical :: l ++ allocate (varx (1:6, 5:15, 17:28)) ! varx-init ++ l = allocated (varx) ++ varx(:, :, :) = 6 ! varx-allocated ++ varx(1, 5, 17) = 7 ++ varx(2, 6, 18) = 8 ++ varx(6, 15, 28) = 9 ++ varv => varx ! varx-filled ++ l = associated (varv) ++ varv(3, 7, 19) = 10 ! varv-associated ++ varv => null () ! varv-filled ++ l = associated (varv) ++ deallocate (varx) ! varv-deassociated ++ l = allocated (varx) ++ varu(:, :, :) = 10 ! varx-deallocated ++ allocate (varv (1:6, 5:15, 17:28)) ++ l = associated (varv) ++ varv(:, :, :) = 6 ++ varv(1, 5, 17) = 7 ++ varv(2, 6, 18) = 8 ++ varv(6, 15, 28) = 9 ++ deallocate (varv) ++ l = associated (varv) ++ varv => varu ++ varv(1, 1, 1) = 6 ++ varv(1, 2, 3) = 7 ++ l = associated (varv) ++end subroutine baz ++subroutine foo (vary, varw) ++ real :: vary (:, :) ++ real :: varw (:, :, :) ++ vary(:, :) = 4 ! vary-passed ++ vary(1, 1) = 8 ++ vary(2, 2) = 9 ++ vary(1, 3) = 10 ++ varw(:, :, :) = 5 ! vary-filled ++ varw(1, 1, 1) = 6 ++ varw(2, 2, 2) = 7 ! varw-almostfilled ++end subroutine foo ++subroutine bar (varz, vart) ++ real :: varz (*) ++ real :: vart (2:11, 7:*) ++ varz(1:3) = 4 ++ varz(2) = 5 ! varz-almostfilled ++ vart(2,7) = vart(2,7) ++end subroutine bar ++program test ++ interface ++ subroutine foo (vary, varw) ++ real :: vary (:, :) ++ real :: varw (:, :, :) ++ end subroutine ++ end interface ++ interface ++ subroutine bar (varz, vart) ++ real :: varz (*) ++ real :: vart (2:11, 7:*) ++ end subroutine ++ end interface ++ real :: x (10, 10), y (5), z(8, 8, 8) ++ x(:,:) = 1 ++ y(:) = 2 ++ z(:,:,:) = 3 ++ call baz ++ call foo (x, z(2:6, 4:7, 6:8)) ++ call bar (y, x) ++ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort ++ if (x (1, 3) .ne. 10) call abort ++ if (z (2, 4, 6) .ne. 6 .or. z (3, 5, 7) .ne. 7 .or. z (2, 4, 7) .ne. 5) call abort ++ if (any (y .ne. (/4, 5, 4, 2, 2/))) call abort ++ call foo (transpose (x), z) ++ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort ++ if (x (3, 1) .ne. 10) call abort ++end +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/string.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/string.exp 2014-06-16 23:30:30.114940489 +0200 +@@ -0,0 +1,59 @@ ++# Copyright 2008 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++# This file was written by Jan Kratochvil . ++ ++# This file is part of the gdb testsuite. It contains tests for Fortran ++# strings with dynamic length. ++ ++set testfile "string" ++set srcfile ${testfile}.f90 ++set binfile ${objdir}/${subdir}/${testfile} ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f90 quiet}] != "" } { ++ untested "Couldn't compile ${srcfile}" ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "var-init"] ++gdb_continue_to_breakpoint "var-init" ++gdb_test "ptype c" "type = character(\\(kind=1\\)|\\*1)" ++gdb_test "ptype d" "type = character(\\(kind=8\\)|\\*8)" ++gdb_test "ptype e" "type = character(\\(kind=4\\)|\\*4)" ++gdb_test "ptype f" "type = character(\\(kind=4\\)|\\*4) \\(7,8:10\\)" ++gdb_test "ptype *e" "Attempt to take contents of a non-pointer value." ++gdb_test "ptype *f" "type = character(\\(kind=4\\)|\\*4) \\(7\\)" ++gdb_test "p c" "\\$\[0-9\]* = 'c'" ++gdb_test "p d" "\\$\[0-9\]* = 'd '" ++gdb_test "p e" "\\$\[0-9\]* = 'g '" ++gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\)" ++gdb_test "p *e" "Attempt to take contents of a non-pointer value." ++gdb_test "p *f" "Attempt to take contents of a non-pointer value." ++ ++gdb_breakpoint [gdb_get_line_number "var-finish"] ++gdb_continue_to_breakpoint "var-finish" ++gdb_test "p e" "\\$\[0-9\]* = 'e '" "p e re-set" ++gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f2 ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\)" "p *f re-set" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/string.f90 +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/string.f90 2014-06-16 23:30:30.114940489 +0200 +@@ -0,0 +1,37 @@ ++! Copyright 2008 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine foo (e, f) ++ character (len=1) :: c ++ character (len=8) :: d ++ character (len=*) :: e ++ character (len=*) :: f (1:7, 8:10) ++ c = 'c' ++ d = 'd' ++ e = 'e' ! var-init ++ f = 'f' ++ f(1,9) = 'f2' ++ c = 'c' ! var-finish ++end subroutine foo ++ character (len=4) :: g, h (1:7, 8:10) ++ g = 'g' ++ h = 'h' ++ call foo (g, h) ++end +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.exp 2014-06-16 23:30:30.114940489 +0200 +@@ -0,0 +1,72 @@ ++# Copyright 2011 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++if { [skip_fortran_tests] } { return -1 } ++ ++set testfile "subrange" ++set srcfile ${testfile}.f90 ++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} {debug f90}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] { ++ perror "Couldn't run to MAIN__" ++ continue ++} ++ ++# Depending on the compiler version being used, the name of the 4-byte integer ++# and real types can be printed differently. For instance, gfortran-4.1 uses ++# "int4" whereas gfortran-4.3 uses "int(kind=4)". ++set int4 "(int4|integer\\(kind=4\\))" ++ ++gdb_breakpoint [gdb_get_line_number "break-static"] ++gdb_continue_to_breakpoint "break-static" ".*break-static.*" ++ ++foreach var {a alloc ptr} { ++ global pf_prefix ++ set old_prefix $pf_prefix ++ lappend pf_prefix "$var:" ++ ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (2, 2:3)" { = \(22, 32\)} ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (2:3, 3)" { = \(32, 33\)} ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (1, 2:)" { = \(21, 31\)} ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (2, :2)" { = \(12, 22\)} ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (3, 2:2)" { = \(23\)} ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "ptype $var (3, 2:2)" " = $int4 \\(2:2\\)" ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (4, :)" { = \(14, 24, 34\)} ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (:, :)" { = \(\( *11, 12, 13, 14\) \( *21, 22, 23, 24\) \( *31, 32, 33, 34\) *\)} ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "ptype $var (:, :)" " = $int4 \\(4,3\\)" ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (:)" "Wrong number of subscripts" ++ setup_kfail "*-*-*" "vlaregression/9999" ++ gdb_test "p $var (:, :, :)" "Wrong number of subscripts" ++ ++ set pf_prefix $old_prefix ++} ++ ++gdb_test_no_output {set $a=a} ++delete_breakpoints ++gdb_unload ++setup_kfail "*-*-*" "vlaregression/9999" ++gdb_test {p $a (3, 2:2)} { = \(23\)} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.f90 +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.fortran/subrange.f90 2014-06-16 23:30:30.114940489 +0200 +@@ -0,0 +1,28 @@ ++! Copyright 2011 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 3 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program. If not, see . ++ ++program test ++ integer, target :: a (4, 3) ++ integer, allocatable :: alloc (:, :) ++ integer, pointer :: ptr (:, :) ++ do 1 i = 1, 4 ++ do 1 j = 1, 3 ++ a (i, j) = j * 10 + i ++1 continue ++ allocate (alloc (4, 3)) ++ alloc = a ++ ptr => a ++ write (*,*) a ! break-static ++end +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.c 2014-06-16 23:30:30.114940489 +0200 +@@ -0,0 +1,26 @@ ++/* Copyright 2011 Free Software Foundation, Inc. ++ ++ This file is part of GDB. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++int ++main (int argc, char **argv) ++{ ++ char vla[argc]; ++ ++ vla[0] = 0; /* break-here */ ++ ++ return 0; ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp 2014-06-16 23:30:30.114940489 +0200 +@@ -0,0 +1,57 @@ ++# Copyright 2011 Free Software Foundation, Inc. ++# ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++load_lib mi-support.exp ++set MIFLAGS "-i=mi2" ++ ++gdb_exit ++if [mi_gdb_start] { ++ continue ++} ++ ++set testfile "mi2-var-stale-type" ++set srcfile ${testfile}.c ++set binfile [standard_output_file ${testfile}] ++if {[build_executable ${testfile}.exp $testfile $srcfile] == -1} { ++ return -1 ++} ++ ++mi_delete_breakpoints ++mi_gdb_reinitialize_dir $srcdir/$subdir ++mi_gdb_load ${binfile} ++ ++mi_gdb_test {-interpreter-exec console "maintenance set internal-error quit yes"} \ ++ {\^done} \ ++ "maintenance set internal-error quit yes" ++ ++mi_gdb_test {-interpreter-exec console "maintenance set internal-error corefile yes"} \ ++ {\^done} \ ++ "maintenance set internal-error corefile yes" ++ ++set line [gdb_get_line_number "break-here"] ++set func "main" ++ ++mi_gdb_test "-break-insert -t $srcfile:$line" \ ++ "\\^done,bkpt=\{number=\"\[0-9\]+\",type=\"breakpoint\",disp=\"del\",enabled=\"y\",addr=\"$hex\",func=\"$func\(\\\(.*\\\)\)?\",file=\".*\",fullname=\".*\",line=\"$line\",\[^\r\n\]*,original-location=\".*\"\}" \ ++ "breakpoint at $func" ++ ++if { [mi_run_cmd] < 0 } { ++ return -1 ++} ++mi_expect_stop "breakpoint-hit" $func ".*" ".*" "\[0-9\]+" { "" "disp=\"del\"" } "stop after initializing vla" ++ ++mi_create_varobj "vla" "vla" "create local variable vla" ++ ++mi_gdb_test "-var-update *" "\\^done,changelist=.*" "-var-update *" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register-func.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register-func.c 2014-06-16 23:30:30.115940490 +0200 +@@ -0,0 +1,22 @@ ++/* This file is part of GDB, the GNU debugger. ++ ++ Copyright 2009 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++int ++func (int *arr) ++{ ++ return arr[0]; ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.c +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.c 2014-06-16 23:30:30.115940490 +0200 +@@ -0,0 +1,28 @@ ++/* This file is part of GDB, the GNU debugger. ++ ++ Copyright 2009 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++extern int func (int *arr); ++ ++int ++main (void) ++{ ++ int arr[] = { 42 }; ++ ++ func (arr); ++ ++ return 0; ++} +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.opt/array-from-register.exp 2014-06-16 23:30:30.115940490 +0200 +@@ -0,0 +1,33 @@ ++# Copyright 2009 Free Software Foundation, Inc. ++# ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++# ++# This file is part of the gdb testsuite. ++ ++if { [prepare_for_testing array-from-register.exp "array-from-register" \ ++ {array-from-register.c array-from-register-func.c} \ ++ {debug optimize=-O2}] } { ++ return -1 ++} ++ ++if ![runto func] then { ++ return -1 ++} ++ ++gdb_test "p arr" "\\$\[0-9\]+ = \\(int \\*\\) *0x\[0-9a-f\]+" ++ ++# Seen regression: ++# Address requested for identifier "arr" which is in register $rdi ++gdb_test "p arr\[0\]" "\\$\[0-9\]+ = 42" +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.exp +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.exp 2014-06-16 23:30:30.115940490 +0200 +@@ -0,0 +1,104 @@ ++# Copyright 2008, 2009 Free Software Foundation, Inc. ++# ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++if $tracelevel then { ++ strace $tracelevel ++} ++ ++load_lib "pascal.exp" ++ ++set testfile "arrays" ++set srcfile ${testfile}.pas ++set binfile ${objdir}/${subdir}/${testfile}$EXEEXT ++ ++# These tests only work with fpc, using the -gw3 compile-option ++pascal_init ++if { $pascal_compiler_is_fpc != 1 } { ++ return -1 ++} ++ ++# Detect if the fpc version is below 2.3.0 ++set fpc_generates_dwarf_for_dynamic_arrays 1 ++if { ($fpcversion_major < 2) || ( ($fpcversion_major == 2) && ($fpcversion_minor < 3))} { ++ set fpc_generates_dwarf_for_dynamic_arrays 0 ++} ++ ++ ++if {[gdb_compile_pascal "-gw3 ${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } { ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++set bp_location1 [gdb_get_line_number "set breakpoint 1 here"] ++set bp_location2 [gdb_get_line_number "set breakpoint 2 here"] ++ ++ ++if { [gdb_breakpoint ${srcfile}:${bp_location1}] } { ++ pass "setting breakpoint 1" ++} ++if { [gdb_breakpoint ${srcfile}:${bp_location2}] } { ++ pass "setting breakpoint 2" ++} ++ ++# Verify that "start" lands inside the right procedure. ++if { [gdb_start_cmd] < 0 } { ++ untested start ++ return -1 ++} ++ ++gdb_test "" ".* at .*${srcfile}.*" "start" ++ ++gdb_test "cont" "Breakpoint .*:${bp_location1}.*" "Going to first breakpoint" ++ ++gdb_test "print StatArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer type" ++gdb_test "print StatArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer" ++ ++gdb_test "cont" "Breakpoint .*:${bp_location2}.*" "Going to second breakpoint" ++ ++gdb_test "print StatArrChar" ".* = 'abcdefghijkl'" "Print static array of char" ++gdb_test "print Stat2dArrInt" ".* = \\{\\{0, 1, 2, 3, 4\\}, \\{1, 2, 3, 4, 5\\}, \\{2, 3, 4, 5, 6\\}, \\{3, 4, 5, 6, 7\\}, \\{4, 5, 6, 7, 8\\}, \\{5, 6, 7, 8, 9\\}, \\{6, 7, 8, 9, 10\\}, \\{7, 8, 9, 10, 11\\}, \\{8, 9, 10, 11, 12\\}, \\{9, 10, 11, 12, 13\\}, \\{10, 11, 12, 13, 14\\}, \\{11, 12, 13, 14, 15\\}\\}" "Print static 2-dimensional array of integer" ++ ++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { ++ setup_xfail "*-*-*" ++} ++gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type" ++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { ++ setup_xfail "*-*-*" ++} ++gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer" ++ ++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { ++ setup_xfail "*-*-*" ++} ++gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char" ++ ++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { ++ setup_xfail "*-*-*" ++} ++gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string" ++ ++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { ++ setup_xfail "*-*-*" ++} ++gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string" ++ ++if { $fpc_generates_dwarf_for_dynamic_arrays == 0} { ++ setup_xfail "*-*-*" ++} ++gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char" ++ +Index: gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.pas +=================================================================== +--- /dev/null 1970-01-01 00:00:00.000000000 +0000 ++++ gdb-7.7.90.20140613/gdb/testsuite/gdb.pascal/arrays.pas 2014-06-16 23:30:30.115940490 +0200 +@@ -0,0 +1,82 @@ ++{ ++ Copyright 2008, 2009 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . ++} ++ ++program arrays; ++ ++{$mode objfpc}{$h+} ++ ++uses sysutils; ++ ++type TStatArrInt= array[0..11] of integer; ++ TDynArrInt= array of integer; ++ TStatArrStr= array[0..12] of string; ++ TDynArrStr= array of string; ++ TDynArrChar = array of char; ++ TStatArrChar = array [0..11] of char; ++ ++ TStat2dArrInt = array[0..11,0..4] of integer; ++ ++var StatArrInt: TStatArrInt; ++ StatArrInt_: Array[0..11] of integer; ++ DynArrInt: TDynArrInt; ++ DynArrInt_: Array of integer; ++ StatArrStr: TStatArrStr; ++ DynArrStr: TDynArrStr; ++ StatArrChar: TStatArrChar; ++ DynArrChar: TDynArrChar; ++ ++ Stat2dArrInt: TStat2dArrInt; ++ ++ s: string; ++ ++ i,j : integer; ++ ++begin ++ for i := 0 to 11 do ++ begin ++ StatArrInt[i]:= i+50; ++ StatArrInt_[i]:= i+50; ++ StatArrChar[i]:= chr(ord('a')+i); ++ for j := 0 to 4 do ++ Stat2dArrInt[i,j]:=i+j; ++ end; ++ writeln(StatArrInt_[0]); ++ writeln(StatArrInt[0]); { set breakpoint 1 here } ++ writeln(StatArrChar[0]); ++ writeln(Stat2dArrInt[0,0]); ++ ++ setlength(DynArrInt,13); ++ setlength(DynArrInt_,13); ++ setlength(DynArrStr,13); ++ setlength(DynArrChar,13); ++ for i := 0 to 12 do ++ begin ++ DynArrInt[i]:= i+50; ++ DynArrInt_[i]:= i+50; ++ DynArrChar[i]:= chr(ord('a')+i); ++ StatArrStr[i]:='str'+inttostr(i); ++ DynArrStr[i]:='dstr'+inttostr(i); ++ end; ++ writeln(DynArrInt_[1]); ++ writeln(DynArrInt[1]); ++ writeln(DynArrStr[1]); ++ writeln(StatArrStr[1]); ++ writeln(DynArrChar[1]); ++ ++ s := 'test'#0'string'; ++ writeln(s); { set breakpoint 2 here } ++end. +Index: gdb-7.7.90.20140613/gdb/testsuite/lib/gdb.exp +=================================================================== +--- gdb-7.7.90.20140613.orig/gdb/testsuite/lib/gdb.exp 2014-06-16 23:30:29.278939700 +0200 ++++ gdb-7.7.90.20140613/gdb/testsuite/lib/gdb.exp 2014-06-16 23:30:30.117940492 +0200 +@@ -159,6 +159,11 @@ proc gdb_unload {} { + send_gdb "y\n" + exp_continue + } ++ -re "A program is being debugged already..*Are you sure you want to change the file.*y or n. $"\ ++ { send_gdb "y\n" ++ verbose "\t\tUnloading symbols for program being debugged" ++ exp_continue ++ } + -re "Discard symbol table from .*y or n.*$" { + send_gdb "y\n" + exp_continue +Index: gdb-7.7.90.20140613/gdb/testsuite/lib/pascal.exp +=================================================================== +--- gdb-7.7.90.20140613.orig/gdb/testsuite/lib/pascal.exp 2014-06-13 03:59:37.000000000 +0200 ++++ gdb-7.7.90.20140613/gdb/testsuite/lib/pascal.exp 2014-06-16 23:30:30.117940492 +0200 +@@ -37,6 +37,9 @@ proc pascal_init {} { + global pascal_compiler_is_fpc + global gpc_compiler + global fpc_compiler ++ global fpcversion_major ++ global fpcversion_minor ++ global fpcversion_release + global env + + if { $pascal_init_done == 1 } { +@@ -64,6 +67,20 @@ proc pascal_init {} { + set pascal_compiler_is_fpc 1 + verbose -log "Free Pascal compiler found" + } ++ ++ # Detect the fpc-version ++ if { $pascal_compiler_is_fpc == 1 } { ++ set fpcversion_major 1 ++ set fpcversion_minor 0 ++ set fpcversion_release 0 ++ set fpcversion [ remote_exec host $fpc_compiler "-iV" ] ++ if [regexp {.*([0-9]+)\.([0-9]+)\.([0-9]+).?} $fpcversion] { ++ regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\1} fpcversion_major ++ regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\2} fpcversion_minor ++ regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\3} fpcversion_release ++ } ++ verbose -log "Freepascal version: $fpcversion_major.$fpcversion_minor.$fpcversion_release" ++ } + } + set pascal_init_done 1 + } diff --git a/gdb-vla-intel-04of23-fix.patch b/gdb-vla-intel-04of23-fix.patch new file mode 100644 index 0000000..ad239b5 --- /dev/null +++ b/gdb-vla-intel-04of23-fix.patch @@ -0,0 +1,42 @@ +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.20140627/gdb/valarith.c +=================================================================== +--- 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 = 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)) ++ error (_("no such vector element because not associated")); ++ if (TYPE_NOT_ALLOCATED (array_type)) ++ error (_("no such vector element because not allocated")); ++ ++ 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))) +- { +- 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")); +- } ++ error (_("no such vector element")); + + if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) + v = allocate_value_lazy (elt_type); diff --git a/gdb-vla-intel-stringbt-fix.patch b/gdb-vla-intel-stringbt-fix.patch new file mode 100644 index 0000000..937f8fe --- /dev/null +++ b/gdb-vla-intel-stringbt-fix.patch @@ -0,0 +1,165 @@ +http://sourceware.org/ml/gdb-patches/2014-08/msg00025.html +Subject: [patch 1/2] Re: Crash regression(?) printing Fortran strings in bt [Re: [V2 00/23] Fortran dynamic array support] + + +--FCuugMFkClbJLl1L +Content-Type: text/plain; charset=us-ascii +Content-Disposition: inline + +On Fri, 01 Aug 2014 09:20:19 +0200, Keven Boell wrote: +> I just tried it on Fedora 20 i686. Applied the patch, you mentioned, on top of +> the Fortran VLA series and executed your dynamic-other-frame test. Everything +> is working fine here, I cannot reproduce the crash. + +I have it reproducible on Fedora 20 i686 with plain +CFLAGS=-g ./configure;make;cd gdb/testsuite;make site.exp;runtest gdb.fortran/dynamic-other-frame.exp + +Besides that I have updated the testcase with + gdb_test_no_output "set print frame-arguments all" +so that there is no longer needed the patch: + [patch] Display Fortran strings in backtraces + https://sourceware.org/ml/gdb-patches/2014-07/msg00709.html + +The fix below has no regressions for me. Unfortunately I do not see why you +cannot reproduce it. + + +Thanks, +Jan + +--FCuugMFkClbJLl1L +Content-Type: text/plain; charset=us-ascii +Content-Disposition: inline; filename="vlastringonly.patch" + +diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c +index 53cae2c..cf7ac26 100644 +--- a/gdb/gdbtypes.c ++++ b/gdb/gdbtypes.c +@@ -1659,6 +1659,7 @@ is_dynamic_type_internal (struct type *type, int top_level) + return !has_static_range (TYPE_RANGE_DATA (type)); + + case TYPE_CODE_ARRAY: ++ case TYPE_CODE_STRING: + { + gdb_assert (TYPE_NFIELDS (type) == 1); + +diff --git a/gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90 b/gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90 +new file mode 100644 +index 0000000..261ce17 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90 +@@ -0,0 +1,24 @@ ++! Copyright 2010 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine bar ++ real :: dummy ++ dummy = 1 ++end subroutine bar +diff --git a/gdb/testsuite/gdb.fortran/dynamic-other-frame.exp b/gdb/testsuite/gdb.fortran/dynamic-other-frame.exp +new file mode 100644 +index 0000000..570a28c +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/dynamic-other-frame.exp +@@ -0,0 +1,39 @@ ++# Copyright 2010 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 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. ++ ++set testfile "dynamic-other-frame" ++set srcfile1 ${testfile}.f90 ++set srcfile2 ${testfile}-stub.f90 ++set objfile2 [standard_output_file ${testfile}-stub.o] ++set executable ${testfile} ++set binfile [standard_output_file ${executable}] ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile2}" "${objfile2}" object {f90}] != "" ++ || [gdb_compile "${srcdir}/${subdir}/${srcfile1} ${objfile2}" "${binfile}" executable {debug f90}] != "" } { ++ untested "Couldn't compile ${srcfile1} or ${srcfile2}" ++ return -1 ++} ++ ++clean_restart ${executable} ++ ++gdb_test_no_output "set print frame-arguments all" ++ ++if ![runto bar_] then { ++ perror "couldn't run to bar_" ++ continue ++} ++ ++gdb_test "bt" {foo \(string='hello'.*} +diff --git a/gdb/testsuite/gdb.fortran/dynamic-other-frame.f90 b/gdb/testsuite/gdb.fortran/dynamic-other-frame.f90 +new file mode 100644 +index 0000000..2bc637d +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/dynamic-other-frame.f90 +@@ -0,0 +1,36 @@ ++! Copyright 2010 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine foo (string) ++ interface ++ subroutine bar ++ end subroutine ++ end interface ++ character string*(*) ++ call bar ! stop-here ++end subroutine foo ++program test ++ interface ++ subroutine foo (string) ++ character string*(*) ++ end subroutine ++ end interface ++ call foo ('hello') ++end + +--FCuugMFkClbJLl1L-- + diff --git a/gdb-vla-intel.patch b/gdb-vla-intel.patch new file mode 100644 index 0000000..d4f9eed --- /dev/null +++ b/gdb-vla-intel.patch @@ -0,0 +1,3235 @@ +[PATCH 00/23] Fortran dynamic array support +https://sourceware.org/ml/gdb-patches/2014-06/msg00108.html +https://github.com/intel-gdb/vla/tree/vla-fortran + +GIT snapshot: +commit 511bff520372ffc10fa2ff569c176bdf1e6e475d + + +diff --git a/gdb/NEWS b/gdb/NEWS +index d9a19ae..e6885d2 100644 +### a/gdb/NEWS +### b/gdb/NEWS +@@ -3,6 +3,9 @@ + + *** Changes since GDB 7.8 + ++* Fortran dynamic array support: It allows the user to evaluate ++ dynamic arrays like an ordinary static array. ++ + *** Changes in GDB 7.8 + + * New command line options +diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c +index f4694b0..8c45276 100644 +--- a/gdb/c-valprint.c ++++ b/gdb/c-valprint.c +@@ -538,7 +538,16 @@ c_value_print (struct value *val, struct ui_file *stream, + { + /* normal case */ + fprintf_filtered (stream, "("); +- type_print (value_type (val), "", stream, -1); ++ if (is_dynamic_type (TYPE_TARGET_TYPE (type))) ++ { ++ struct value *v; ++ ++ v = value_ind (val); ++ v = value_addr (v); ++ type_print (value_type (v), "", stream, -1); ++ } ++ else ++ type_print (value_type (val), "", stream, -1); + fprintf_filtered (stream, ") "); + } + } +diff --git a/gdb/dwarf2expr.c b/gdb/dwarf2expr.c +index 36c9f66..274ba62 100644 +--- a/gdb/dwarf2expr.c ++++ b/gdb/dwarf2expr.c +@@ -1478,6 +1478,12 @@ execute_stack_op (struct dwarf_expr_context *ctx, + } + break; + ++ case DW_OP_push_object_address: ++ /* Return the address of the object we are currently observing. */ ++ result = (ctx->funcs->get_object_address) (ctx->baton); ++ result_val = value_from_ulongest (address_type, result); ++ break; ++ + default: + error (_("Unhandled dwarf expression opcode 0x%x"), op); + } +diff --git a/gdb/dwarf2expr.h b/gdb/dwarf2expr.h +index 39dadf3..8cebbe8 100644 +--- a/gdb/dwarf2expr.h ++++ b/gdb/dwarf2expr.h +@@ -84,12 +84,8 @@ struct dwarf_expr_context_funcs + This can throw an exception if the index is out of range. */ + CORE_ADDR (*get_addr_index) (void *baton, unsigned int index); + +-#if 0 +- /* Not yet implemented. */ +- + /* Return the `object address' for DW_OP_push_object_address. */ + CORE_ADDR (*get_object_address) (void *baton); +-#endif + }; + + /* The location of a value. */ +diff --git a/gdb/dwarf2loc.c b/gdb/dwarf2loc.c +index fcab9b9..a624dac 100644 +--- a/gdb/dwarf2loc.c ++++ b/gdb/dwarf2loc.c +@@ -306,6 +306,7 @@ struct dwarf_expr_baton + { + struct frame_info *frame; + struct dwarf2_per_cu_data *per_cu; ++ CORE_ADDR obj_address; + }; + + /* Helper functions for dwarf2_evaluate_loc_desc. */ +@@ -1209,6 +1210,7 @@ dwarf_expr_push_dwarf_reg_entry_value (struct dwarf_expr_context *ctx, + + baton_local.frame = caller_frame; + baton_local.per_cu = caller_per_cu; ++ baton_local.obj_address = 0; + + saved_ctx.gdbarch = ctx->gdbarch; + saved_ctx.addr_size = ctx->addr_size; +@@ -1238,6 +1240,22 @@ dwarf_expr_get_addr_index (void *baton, unsigned int index) + return dwarf2_read_addr_index (debaton->per_cu, index); + } + ++/* Callback function for get_object_address. Return the address of the VLA ++ object. */ ++ ++static CORE_ADDR ++dwarf_expr_get_obj_addr (void *baton) ++{ ++ struct dwarf_expr_baton *debaton = baton; ++ ++ gdb_assert (debaton != NULL); ++ ++ if (debaton->obj_address == 0) ++ error (_("Location address is not set.")); ++ ++ return debaton->obj_address; ++} ++ + /* VALUE must be of type lval_computed with entry_data_value_funcs. Perform + the indirect method on it, that is use its stored target value, the sole + purpose of entry_data_value_funcs.. */ +@@ -2202,7 +2220,8 @@ static const struct dwarf_expr_context_funcs dwarf_expr_ctx_funcs = + dwarf_expr_dwarf_call, + dwarf_expr_get_base_type, + dwarf_expr_push_dwarf_reg_entry_value, +- dwarf_expr_get_addr_index ++ dwarf_expr_get_addr_index, ++ dwarf_expr_get_obj_addr + }; + + /* Evaluate a location description, starting at DATA and with length +@@ -2231,6 +2250,7 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame, + + baton.frame = frame; + baton.per_cu = per_cu; ++ baton.obj_address = 0; + + ctx = new_dwarf_expr_context (); + old_chain = make_cleanup_free_dwarf_expr_context (ctx); +@@ -2326,6 +2346,11 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame, + int in_stack_memory = dwarf_expr_fetch_in_stack_memory (ctx, 0); + + do_cleanups (value_chain); ++ ++ /* Select right frame to correctly evaluate VLA's during a backtrace. */ ++ if (is_dynamic_type (type)) ++ select_frame (frame); ++ + retval = value_at_lazy (type, address + byte_offset); + if (in_stack_memory) + set_value_stack (retval, 1); +@@ -2436,6 +2461,7 @@ dwarf2_evaluate_loc_desc (struct type *type, struct frame_info *frame, + + static int + dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton, ++ CORE_ADDR addr, + CORE_ADDR *valp) + { + struct dwarf_expr_context *ctx; +@@ -2451,6 +2477,7 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton, + + baton.frame = get_selected_frame (NULL); + baton.per_cu = dlbaton->per_cu; ++ baton.obj_address = addr; + + objfile = dwarf2_per_cu_objfile (dlbaton->per_cu); + +@@ -2491,7 +2518,8 @@ dwarf2_locexpr_baton_eval (const struct dwarf2_locexpr_baton *dlbaton, + /* See dwarf2loc.h. */ + + int +-dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value) ++dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR address, ++ CORE_ADDR *value) + { + if (prop == NULL) + return 0; +@@ -2502,7 +2530,7 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value) + { + const struct dwarf2_property_baton *baton = prop->data.baton; + +- if (dwarf2_locexpr_baton_eval (&baton->locexpr, value)) ++ if (dwarf2_locexpr_baton_eval (&baton->locexpr, address, value)) + { + if (baton->referenced_type) + { +@@ -2546,6 +2574,20 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop, CORE_ADDR *value) + return 0; + } + ++/* See dwarf2loc.h. */ ++ ++int ++dwarf2_address_data_valid (const struct type *type) ++{ ++ if (TYPE_NOT_ASSOCIATED (type)) ++ return 0; ++ ++ if (TYPE_NOT_ALLOCATED (type)) ++ return 0; ++ ++ return 1; ++} ++ + + /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */ + +@@ -2653,6 +2695,15 @@ needs_get_addr_index (void *baton, unsigned int index) + return 1; + } + ++/* DW_OP_push_object_address has a frame already passed through. */ ++ ++static CORE_ADDR ++needs_get_obj_addr (void *baton) ++{ ++ /* Nothing to do. */ ++ return 1; ++} ++ + /* Virtual method table for dwarf2_loc_desc_needs_frame below. */ + + static const struct dwarf_expr_context_funcs needs_frame_ctx_funcs = +@@ -2667,7 +2718,8 @@ static const struct dwarf_expr_context_funcs needs_frame_ctx_funcs = + needs_frame_dwarf_call, + NULL, /* get_base_type */ + needs_dwarf_reg_entry_value, +- needs_get_addr_index ++ needs_get_addr_index, ++ needs_get_obj_addr + }; + + /* Return non-zero iff the location expression at DATA (length SIZE) +@@ -3316,6 +3368,10 @@ dwarf2_compile_expr_to_ax (struct agent_expr *expr, struct axs_value *loc, + unimplemented (op); + break; + ++ case DW_OP_push_object_address: ++ unimplemented (op); ++ break; ++ + case DW_OP_skip: + offset = extract_signed_integer (op_ptr, 2, byte_order); + op_ptr += 2; +diff --git a/gdb/dwarf2loc.h b/gdb/dwarf2loc.h +index 8ad5fa9..fb65c5c 100644 +--- a/gdb/dwarf2loc.h ++++ b/gdb/dwarf2loc.h +@@ -96,11 +96,18 @@ struct value *dwarf2_evaluate_loc_desc (struct type *type, + into VALUE, otherwise returns 0. */ + + int dwarf2_evaluate_property (const struct dynamic_prop *prop, ++ CORE_ADDR address, + CORE_ADDR *value); + + CORE_ADDR dwarf2_read_addr_index (struct dwarf2_per_cu_data *per_cu, + unsigned int addr_index); + ++/* Checks if a dwarf location definition is valid. ++ Returns 1 if valid; 0 otherwise. */ ++ ++extern int dwarf2_address_data_valid (const struct type *type); ++ ++ + /* The symbol location baton types used by the DWARF-2 reader (i.e. + SYMBOL_LOCATION_BATON for a LOC_COMPUTED symbol). "struct + dwarf2_locexpr_baton" is for a symbol with a single location +diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c +index 276d2f1..fbf13ce 100644 +--- a/gdb/dwarf2read.c ++++ b/gdb/dwarf2read.c +@@ -1847,6 +1847,12 @@ static void free_dwo_file_cleanup (void *); + static void process_cu_includes (void); + + static void check_producer (struct dwarf2_cu *cu); ++ ++static int ++attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, ++ struct dwarf2_cu *cu, struct dynamic_prop *prop, ++ const gdb_byte *additional_data, int additional_data_size); ++ + + /* Various complaints about symbol reading that don't abort the process. */ + +@@ -14201,29 +14207,92 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu) + struct gdbarch *gdbarch = get_objfile_arch (objfile); + struct type *type, *range_type, *index_type, *char_type; + struct attribute *attr; +- unsigned int length; ++ unsigned int length = UINT_MAX; ++ ++ index_type = objfile_type (objfile)->builtin_int; ++ range_type = create_static_range_type (NULL, index_type, 1, length); + ++ /* If DW_AT_string_length is defined, the length is stored at some location ++ * in memory. */ + attr = dwarf2_attr (die, DW_AT_string_length, cu); + if (attr) + { +- length = DW_UNSND (attr); ++ if (attr_form_is_block (attr)) ++ { ++ struct attribute *byte_size, *bit_size; ++ struct dynamic_prop high; ++ ++ byte_size = dwarf2_attr (die, DW_AT_byte_size, cu); ++ bit_size = dwarf2_attr (die, DW_AT_bit_size, cu); ++ ++ /* DW_AT_byte_size should never occur together in combination with ++ DW_AT_string_length. */ ++ if ((byte_size == NULL && bit_size != NULL) || ++ (byte_size != NULL && bit_size == NULL)) ++ complaint (&symfile_complaints, _("DW_AT_byte_size AND " ++ "DW_AT_bit_size found together at the same time.")); ++ ++ /* If DW_AT_string_length AND DW_AT_byte_size exist together, it ++ describes the number of bytes that should be read from the length ++ memory location. */ ++ if (byte_size != NULL && bit_size == NULL) ++ { ++ /* Build new dwarf2_locexpr_baton structure with additions to the ++ data attribute, to reflect DWARF specialities to get address ++ sizes. */ ++ const gdb_byte append_ops[] = { ++ /* DW_OP_deref_size: size of an address on the target machine ++ (bytes), where the size will be specified by the next ++ operand. */ ++ DW_OP_deref_size, ++ /* Operand for DW_OP_deref_size. */ ++ DW_UNSND (byte_size) }; ++ ++ if (!attr_to_dynamic_prop (attr, die, cu, &high, ++ append_ops, ARRAY_SIZE (append_ops))) ++ complaint (&symfile_complaints, ++ _("Could not parse DW_AT_byte_size")); ++ } ++ else if (bit_size != NULL && byte_size == NULL) ++ complaint (&symfile_complaints, _("DW_AT_string_length AND " ++ "DW_AT_bit_size found but not supported yet.")); ++ /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default ++ is the address size of the target machine. */ ++ else ++ { ++ const gdb_byte append_ops[] = { DW_OP_deref }; ++ ++ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops, ++ ARRAY_SIZE (append_ops))) ++ complaint (&symfile_complaints, ++ _("Could not parse DW_AT_string_length")); ++ } ++ ++ TYPE_RANGE_DATA (range_type)->high = high; ++ } ++ else ++ { ++ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr); ++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; ++ } + } + else + { +- /* Check for the DW_AT_byte_size attribute. */ ++ /* Check for the DW_AT_byte_size attribute, which represents the length ++ in this case. */ + attr = dwarf2_attr (die, DW_AT_byte_size, cu); + if (attr) + { +- length = DW_UNSND (attr); ++ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr); ++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; + } + else + { +- length = 1; ++ TYPE_HIGH_BOUND (range_type) = 1; ++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST; + } + } + +- index_type = objfile_type (objfile)->builtin_int; +- range_type = create_static_range_type (NULL, index_type, 1, length); + char_type = language_string_char_type (cu->language_defn, gdbarch); + type = create_string_type (NULL, char_type, range_type); + +@@ -14540,13 +14609,15 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu) + return set_die_type (die, type, cu); + } + ++ + /* Parse dwarf attribute if it's a block, reference or constant and put the + resulting value of the attribute into struct bound_prop. + Returns 1 if ATTR could be resolved into PROP, 0 otherwise. */ + + static int + attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, +- struct dwarf2_cu *cu, struct dynamic_prop *prop) ++ struct dwarf2_cu *cu, struct dynamic_prop *prop, ++ const gdb_byte *additional_data, int additional_data_size) + { + struct dwarf2_property_baton *baton; + struct obstack *obstack = &cu->objfile->objfile_obstack; +@@ -14559,8 +14630,25 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, + baton = obstack_alloc (obstack, sizeof (*baton)); + baton->referenced_type = NULL; + baton->locexpr.per_cu = cu->per_cu; +- baton->locexpr.size = DW_BLOCK (attr)->size; +- baton->locexpr.data = DW_BLOCK (attr)->data; ++ ++ if (additional_data != NULL && additional_data_size > 0) ++ { ++ gdb_byte *data; ++ ++ data = obstack_alloc (&cu->objfile->objfile_obstack, ++ DW_BLOCK (attr)->size + additional_data_size); ++ memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size); ++ memcpy (data + DW_BLOCK (attr)->size, ++ additional_data, additional_data_size); ++ ++ baton->locexpr.data = data; ++ baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size; ++ } ++ else ++ { ++ baton->locexpr.data = DW_BLOCK (attr)->data; ++ baton->locexpr.size = DW_BLOCK (attr)->size; ++ } + prop->data.baton = baton; + prop->kind = PROP_LOCEXPR; + gdb_assert (prop->data.baton != NULL); +@@ -14590,8 +14678,28 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, + baton = obstack_alloc (obstack, sizeof (*baton)); + baton->referenced_type = die_type (target_die, target_cu); + baton->locexpr.per_cu = cu->per_cu; +- baton->locexpr.size = DW_BLOCK (target_attr)->size; +- baton->locexpr.data = DW_BLOCK (target_attr)->data; ++ ++ if (additional_data != NULL && additional_data_size > 0) ++ { ++ gdb_byte *data; ++ ++ data = obstack_alloc (&cu->objfile->objfile_obstack, ++ DW_BLOCK (target_attr)->size + additional_data_size); ++ memcpy (data, DW_BLOCK (target_attr)->data, ++ DW_BLOCK (target_attr)->size); ++ memcpy (data + DW_BLOCK (target_attr)->size, ++ additional_data, additional_data_size); ++ ++ baton->locexpr.data = data; ++ baton->locexpr.size = (DW_BLOCK (target_attr)->size ++ + additional_data_size); ++ } ++ else ++ { ++ baton->locexpr.data = DW_BLOCK (target_attr)->data; ++ baton->locexpr.size = DW_BLOCK (target_attr)->size; ++ } ++ + prop->data.baton = baton; + prop->kind = PROP_LOCEXPR; + gdb_assert (prop->data.baton != NULL); +@@ -14626,7 +14734,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + struct type *base_type, *orig_base_type; + struct type *range_type; + struct attribute *attr; +- struct dynamic_prop low, high; ++ struct dynamic_prop low, high, stride; + int low_default_is_valid; + int high_bound_is_count = 0; + const char *name; +@@ -14646,7 +14754,9 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + + low.kind = PROP_CONST; + high.kind = PROP_CONST; ++ stride.kind = PROP_CONST; + high.data.const_val = 0; ++ stride.data.const_val = 0; + + /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow + omitting DW_AT_lower_bound. */ +@@ -14679,19 +14789,26 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + break; + } + ++ attr = dwarf2_attr (die, DW_AT_byte_stride, cu); ++ if (attr) ++ if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0)) ++ complaint (&symfile_complaints, _("Missing DW_AT_byte_stride " ++ "- DIE at 0x%x [in module %s]"), ++ die->offset.sect_off, objfile_name (cu->objfile)); ++ + attr = dwarf2_attr (die, DW_AT_lower_bound, cu); + if (attr) +- attr_to_dynamic_prop (attr, die, cu, &low); ++ attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0); + else if (!low_default_is_valid) + complaint (&symfile_complaints, _("Missing DW_AT_lower_bound " + "- DIE at 0x%x [in module %s]"), + die->offset.sect_off, objfile_name (cu->objfile)); + + attr = dwarf2_attr (die, DW_AT_upper_bound, cu); +- if (!attr_to_dynamic_prop (attr, die, cu, &high)) ++ if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0)) + { + attr = dwarf2_attr (die, DW_AT_count, cu); +- if (attr_to_dynamic_prop (attr, die, cu, &high)) ++ if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0)) + { + /* If bounds are constant do the final calculation here. */ + if (low.kind == PROP_CONST && high.kind == PROP_CONST) +@@ -14755,7 +14872,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) + && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask)) + high.data.const_val |= negative_mask; + +- range_type = create_range_type (NULL, orig_base_type, &low, &high); ++ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride); + + if (high_bound_is_count) + TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1; +@@ -21673,6 +21790,8 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) + { + struct dwarf2_per_cu_offset_and_type **slot, ofs; + struct objfile *objfile = cu->objfile; ++ struct attribute *attr; ++ struct dynamic_prop prop; + + /* For Ada types, make sure that the gnat-specific data is always + initialized (if not already set). There are a few types where +@@ -21687,6 +21806,43 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) + && !HAVE_GNAT_AUX_INFO (type)) + INIT_GNAT_SPECIFIC (type); + ++ /* Read DW_AT_allocated and set in type. */ ++ attr = dwarf2_attr (die, DW_AT_allocated, cu); ++ if (attr_form_is_block (attr)) ++ { ++ struct dynamic_prop prop; ++ ++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) ++ { ++ TYPE_ALLOCATED_PROP (type) ++ = obstack_alloc (&objfile->objfile_obstack, sizeof (prop)); ++ *TYPE_ALLOCATED_PROP (type) = prop; ++ } ++ } ++ ++ /* Read DW_AT_associated and set in type. */ ++ attr = dwarf2_attr (die, DW_AT_associated, cu); ++ if (attr_form_is_block (attr)) ++ { ++ struct dynamic_prop prop; ++ ++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) ++ { ++ TYPE_ASSOCIATED_PROP (type) ++ = obstack_alloc (&objfile->objfile_obstack, sizeof (prop)); ++ *TYPE_ASSOCIATED_PROP (type) = prop; ++ } ++ } ++ ++ /* Read DW_AT_data_location and set in type. */ ++ attr = dwarf2_attr (die, DW_AT_data_location, cu); ++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0)) ++ { ++ TYPE_DATA_LOCATION (type) ++ = obstack_alloc (&objfile->objfile_obstack, sizeof (prop)); ++ *TYPE_DATA_LOCATION (type) = prop; ++ } ++ + if (dwarf2_per_objfile->die_type_hash == NULL) + { + dwarf2_per_objfile->die_type_hash = +diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c +index 8356aab..69e67f4 100644 +--- a/gdb/f-typeprint.c ++++ b/gdb/f-typeprint.c +@@ -30,6 +30,7 @@ + #include "gdbcore.h" + #include "target.h" + #include "f-lang.h" ++#include "valprint.h" + + #include + #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 e99a2f3..53cae2c 100644 +--- a/gdb/gdbtypes.c ++++ b/gdb/gdbtypes.c +@@ -805,7 +805,8 @@ allocate_stub_method (struct type *type) + struct type * + create_range_type (struct type *result_type, struct type *index_type, + const struct dynamic_prop *low_bound, +- const struct dynamic_prop *high_bound) ++ const struct dynamic_prop *high_bound, ++ const struct dynamic_prop *stride) + { + if (result_type == NULL) + result_type = alloc_type_copy (index_type); +@@ -820,6 +821,7 @@ create_range_type (struct type *result_type, struct type *index_type, + TYPE_ZALLOC (result_type, sizeof (struct range_bounds)); + TYPE_RANGE_DATA (result_type)->low = *low_bound; + TYPE_RANGE_DATA (result_type)->high = *high_bound; ++ TYPE_RANGE_DATA (result_type)->stride = *stride; + + if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0) + TYPE_UNSIGNED (result_type) = 1; +@@ -841,7 +843,7 @@ struct type * + create_static_range_type (struct type *result_type, struct type *index_type, + LONGEST low_bound, LONGEST high_bound) + { +- struct dynamic_prop low, high; ++ struct dynamic_prop low, high, stride; + + low.kind = PROP_CONST; + low.data.const_val = low_bound; +@@ -849,7 +851,11 @@ create_static_range_type (struct type *result_type, struct type *index_type, + high.kind = PROP_CONST; + high.data.const_val = high_bound; + +- result_type = create_range_type (result_type, index_type, &low, &high); ++ stride.kind = PROP_CONST; ++ stride.data.const_val = 0; ++ ++ result_type = create_range_type (result_type, index_type, ++ &low, &high, &stride); + + return result_type; + } +@@ -1003,18 +1009,24 @@ create_array_type_with_stride (struct type *result_type, + + TYPE_CODE (result_type) = TYPE_CODE_ARRAY; + TYPE_TARGET_TYPE (result_type) = element_type; +- if (has_static_range (TYPE_RANGE_DATA (range_type))) ++ if (has_static_range (TYPE_RANGE_DATA (range_type)) ++ && dwarf2_address_data_valid (result_type)) + { +- LONGEST low_bound, high_bound; ++ LONGEST low_bound, high_bound, byte_stride; + + if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) + low_bound = high_bound = 0; + CHECK_TYPEDEF (element_type); ++ ++ byte_stride = abs (TYPE_BYTE_STRIDE (range_type)); ++ + /* Be careful when setting the array length. Ada arrays can be + empty arrays with the high_bound being smaller than the low_bound. + In such cases, the array length should be zero. */ + if (high_bound < low_bound) + TYPE_LENGTH (result_type) = 0; ++ else if (byte_stride > 0) ++ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1); + else if (bit_stride > 0) + TYPE_LENGTH (result_type) = + (bit_stride * (high_bound - low_bound + 1) + 7) / 8; +@@ -1616,12 +1628,31 @@ stub_noname_complaint (void) + static int + is_dynamic_type_internal (struct type *type, int top_level) + { ++ int index; ++ ++ if (!type) ++ return 0; ++ + type = check_typedef (type); + + /* We only want to recognize references at the outermost level. */ + if (top_level && TYPE_CODE (type) == TYPE_CODE_REF) + type = check_typedef (TYPE_TARGET_TYPE (type)); + ++ if (TYPE_ASSOCIATED_PROP (type)) ++ return 1; ++ ++ if (TYPE_ALLOCATED_PROP (type)) ++ return 1; ++ ++ /* Scan field types in the Fortran case for nested dynamic types. ++ This will be done only for Fortran as in the C++ case an endless recursion ++ can occur in the area of classes. */ ++ if (current_language->la_language == language_fortran) ++ for (index = 0; index < TYPE_NFIELDS (type); index++) ++ if (is_dynamic_type (TYPE_FIELD_TYPE (type, index))) ++ return 1; ++ + switch (TYPE_CODE (type)) + { + case TYPE_CODE_RANGE: +@@ -1631,11 +1662,19 @@ is_dynamic_type_internal (struct type *type, int top_level) + { + gdb_assert (TYPE_NFIELDS (type) == 1); + +- /* The array is dynamic if either the bounds are dynamic, +- or the elements it contains have a dynamic contents. */ ++ /* The array is dynamic if either ++ - the bounds are dynamic, ++ - the elements it contains have a dynamic contents ++ - a data_locaton attribute was found. */ + if (is_dynamic_type_internal (TYPE_INDEX_TYPE (type), 0)) + return 1; +- return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0); ++ else if (TYPE_DATA_LOCATION (type) != NULL ++ && (TYPE_DATA_LOCATION_KIND (type) == PROP_LOCEXPR ++ || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST)) ++ return 1; ++ else ++ return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0); ++ break; + } + + case TYPE_CODE_STRUCT: +@@ -1648,6 +1687,17 @@ is_dynamic_type_internal (struct type *type, int top_level) + && is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0)) + return 1; + } ++ case TYPE_CODE_PTR: ++ { ++ if (TYPE_TARGET_TYPE (type) ++ && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING) ++ return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type))); ++ ++ return 0; ++ break; ++ } ++ default: ++ return 0; + break; + } + +@@ -1666,22 +1716,23 @@ static struct type *resolve_dynamic_type_internal (struct type *type, + CORE_ADDR addr, + int top_level); + +-/* Given a dynamic range type (dyn_range_type), return a static version +- of that type. */ ++/* Given a dynamic range type (dyn_range_type) and address, ++ return a static version of that type. */ + + static struct type * +-resolve_dynamic_range (struct type *dyn_range_type) ++resolve_dynamic_range (struct type *dyn_range_type, CORE_ADDR addr) + { + CORE_ADDR value; + struct type *static_range_type; + const struct dynamic_prop *prop; + const struct dwarf2_locexpr_baton *baton; +- struct dynamic_prop low_bound, high_bound; ++ struct dynamic_prop low_bound, high_bound, stride; ++ struct type *range_copy = copy_type (dyn_range_type); + + gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE); + + prop = &TYPE_RANGE_DATA (dyn_range_type)->low; +- if (dwarf2_evaluate_property (prop, &value)) ++ if (dwarf2_evaluate_property (prop, addr, &value)) + { + low_bound.kind = PROP_CONST; + low_bound.data.const_val = value; +@@ -1693,7 +1744,7 @@ resolve_dynamic_range (struct type *dyn_range_type) + } + + prop = &TYPE_RANGE_DATA (dyn_range_type)->high; +- if (dwarf2_evaluate_property (prop, &value)) ++ if (dwarf2_evaluate_property (prop, addr, &value)) + { + high_bound.kind = PROP_CONST; + high_bound.data.const_val = value; +@@ -1707,10 +1758,17 @@ resolve_dynamic_range (struct type *dyn_range_type) + high_bound.kind = PROP_UNDEFINED; + high_bound.data.const_val = 0; + } ++ ++ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride; ++ if (dwarf2_evaluate_property (prop, addr, &value)) ++ { ++ stride.kind = PROP_CONST; ++ stride.data.const_val = value; ++ } + +- static_range_type = create_range_type (copy_type (dyn_range_type), +- TYPE_TARGET_TYPE (dyn_range_type), +- &low_bound, &high_bound); ++ static_range_type = create_range_type (range_copy, ++ TYPE_TARGET_TYPE (range_copy), ++ &low_bound, &high_bound, &stride); + TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1; + return static_range_type; + } +@@ -1720,29 +1778,52 @@ resolve_dynamic_range (struct type *dyn_range_type) + of the associated array. */ + + static struct type * +-resolve_dynamic_array (struct type *type) ++resolve_dynamic_array (struct type *type, CORE_ADDR addr) + { + CORE_ADDR value; + struct type *elt_type; + struct type *range_type; + struct type *ary_dim; ++ struct dynamic_prop *prop; ++ struct type *copy = copy_type (type); + +- gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY); ++ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY ++ || TYPE_CODE (type) == TYPE_CODE_STRING); + + elt_type = type; + range_type = check_typedef (TYPE_INDEX_TYPE (elt_type)); +- range_type = resolve_dynamic_range (range_type); ++ range_type = resolve_dynamic_range (range_type, addr); ++ ++ prop = TYPE_ALLOCATED_PROP (type); ++ if (dwarf2_evaluate_property (prop, addr, &value)) ++ { ++ TYPE_ALLOCATED_PROP (copy)->kind = PROP_CONST; ++ TYPE_ALLOCATED_PROP (copy)->data.const_val = value; ++ } ++ ++ prop = TYPE_ASSOCIATED_PROP (type); ++ if (dwarf2_evaluate_property (prop, addr, &value)) ++ { ++ TYPE_ASSOCIATED_PROP (copy)->kind = PROP_CONST; ++ TYPE_ASSOCIATED_PROP (copy)->data.const_val = value; ++ } + + ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); + +- if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY) +- elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (type)); ++ if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY ++ || TYPE_CODE (ary_dim) == TYPE_CODE_STRING)) ++ elt_type = resolve_dynamic_array (TYPE_TARGET_TYPE (copy), addr); + else + elt_type = TYPE_TARGET_TYPE (type); + +- return create_array_type (copy_type (type), +- elt_type, +- range_type); ++ if (TYPE_CODE (type) == TYPE_CODE_STRING) ++ return create_string_type (copy, ++ elt_type, ++ range_type); ++ else ++ return create_array_type (copy, ++ elt_type, ++ range_type); + } + + /* Resolve dynamic bounds of members of the union TYPE to static +@@ -1846,6 +1927,8 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr, + { + struct type *real_type = check_typedef (type); + struct type *resolved_type = type; ++ const struct dynamic_prop *prop; ++ CORE_ADDR value; + + if (!is_dynamic_type_internal (real_type, top_level)) + return type; +@@ -1871,11 +1954,12 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr, + } + + case TYPE_CODE_ARRAY: +- resolved_type = resolve_dynamic_array (type); ++ case TYPE_CODE_STRING: ++ resolved_type = resolve_dynamic_array (type, addr); + break; + + case TYPE_CODE_RANGE: +- resolved_type = resolve_dynamic_range (type); ++ resolved_type = resolve_dynamic_range (type, addr); + break; + + case TYPE_CODE_UNION: +@@ -1887,6 +1971,25 @@ resolve_dynamic_type_internal (struct type *type, CORE_ADDR addr, + break; + } + ++ /* Resolve data_location attribute. */ ++ prop = TYPE_DATA_LOCATION (resolved_type); ++ if (dwarf2_evaluate_property (prop, addr, &value)) ++ { ++ struct type *range_type = TYPE_INDEX_TYPE (resolved_type); ++ ++ /* Adjust the data location with the value of byte stride if set, which ++ can describe the separation between successive elements along the ++ dimension. */ ++ if (TYPE_BYTE_STRIDE (range_type) < 0) ++ value += (TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type)) ++ * TYPE_BYTE_STRIDE (range_type); ++ ++ TYPE_DATA_LOCATION_ADDR (resolved_type) = value; ++ TYPE_DATA_LOCATION_KIND (resolved_type) = PROP_CONST; ++ } ++ else ++ TYPE_DATA_LOCATION (resolved_type) = NULL; ++ + return resolved_type; + } + +@@ -4104,6 +4207,27 @@ copy_type_recursive (struct objfile *objfile, + *TYPE_RANGE_DATA (new_type) = *TYPE_RANGE_DATA (type); + } + ++ /* Copy the data location information. */ ++ if (TYPE_DATA_LOCATION (type) != NULL) ++ { ++ TYPE_DATA_LOCATION (new_type) = xmalloc (sizeof (struct dynamic_prop)); ++ *TYPE_DATA_LOCATION (new_type) = *TYPE_DATA_LOCATION (type); ++ } ++ ++ /* Copy allocated information. */ ++ if (TYPE_ALLOCATED_PROP (type) != NULL) ++ { ++ TYPE_ALLOCATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop)); ++ *TYPE_ALLOCATED_PROP (new_type) = *TYPE_ALLOCATED_PROP (type); ++ } ++ ++ /* Copy associated information. */ ++ if (TYPE_ASSOCIATED_PROP (type) != NULL) ++ { ++ TYPE_ASSOCIATED_PROP (new_type) = xmalloc (sizeof (struct dynamic_prop)); ++ *TYPE_ASSOCIATED_PROP (new_type) = *TYPE_ASSOCIATED_PROP (type); ++ } ++ + /* Copy pointers to other types. */ + if (TYPE_TARGET_TYPE (type)) + TYPE_TARGET_TYPE (new_type) = +@@ -4150,6 +4274,44 @@ copy_type (const struct type *type) + memcpy (TYPE_MAIN_TYPE (new_type), TYPE_MAIN_TYPE (type), + sizeof (struct main_type)); + ++ if (TYPE_ALLOCATED_PROP (type)) ++ { ++ TYPE_ALLOCATED_PROP (new_type) ++ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack, ++ struct dynamic_prop); ++ memcpy (TYPE_ALLOCATED_PROP (new_type), TYPE_ALLOCATED_PROP (type), ++ sizeof (struct dynamic_prop)); ++ } ++ ++ if (TYPE_ASSOCIATED_PROP (type)) ++ { ++ TYPE_ASSOCIATED_PROP (new_type) ++ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack, ++ struct dynamic_prop); ++ memcpy (TYPE_ASSOCIATED_PROP (new_type), TYPE_ASSOCIATED_PROP (type), ++ sizeof (struct dynamic_prop)); ++ } ++ ++ if (TYPE_DATA_LOCATION (type)) ++ { ++ TYPE_DATA_LOCATION (new_type) ++ = OBSTACK_ZALLOC (&TYPE_OWNER (type).objfile->objfile_obstack, ++ struct dynamic_prop); ++ memcpy (TYPE_DATA_LOCATION (new_type), TYPE_DATA_LOCATION (type), ++ sizeof (struct dynamic_prop)); ++ } ++ ++ if (TYPE_NFIELDS (type)) ++ { ++ int nfields = TYPE_NFIELDS (type); ++ ++ TYPE_FIELDS (new_type) ++ = OBSTACK_CALLOC (&TYPE_OWNER (type).objfile->objfile_obstack, ++ nfields, struct field); ++ memcpy (TYPE_FIELDS (new_type), TYPE_FIELDS (type), ++ nfields * sizeof (struct field)); ++ } ++ + return new_type; + } + +diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h +index 5008ef4..436edf8 100644 +--- a/gdb/gdbtypes.h ++++ b/gdb/gdbtypes.h +@@ -669,6 +669,10 @@ struct main_type + + struct dynamic_prop high; + ++ /* * Stride of range. */ ++ ++ struct dynamic_prop stride; ++ + /* True if HIGH range bound contains the number of elements in the + subrange. This affects how the final hight bound is computed. */ + +@@ -724,6 +728,23 @@ struct main_type + + struct func_type *func_stuff; + } type_specific; ++ ++ /* * Contains a location description value for the current type. Evaluating ++ this field yields to the location of the data for an object. */ ++ ++ struct dynamic_prop *data_location; ++ ++ /* Structure for DW_AT_allocated. ++ The presence of this attribute indicates that the object of the type ++ can be allocated/deallocated. The value can be a dwarf expression, ++ reference, or a constant. */ ++ struct dynamic_prop *allocated; ++ ++ /* Structure for DW_AT_associated. ++ The presence of this attribute indicated that the object of the type ++ can be associated. The value can be a dwarf expression, ++ reference, or a constant. */ ++ struct dynamic_prop *associated; + }; + + /* * A ``struct type'' describes a particular instance of a type, with +@@ -1202,6 +1223,39 @@ extern void allocate_gnat_aux_type (struct type *); + TYPE_RANGE_DATA(range_type)->high.kind + #define TYPE_LOW_BOUND_KIND(range_type) \ + TYPE_RANGE_DATA(range_type)->low.kind ++#define TYPE_BYTE_STRIDE(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.const_val ++#define TYPE_BYTE_STRIDE_BLOCK(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.locexpr ++#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.data.loclist ++#define TYPE_BYTE_STRIDE_KIND(range_type) \ ++ TYPE_RANGE_DATA(range_type)->stride.kind ++ ++ ++/* Attribute accessors for the type data location. */ ++#define TYPE_DATA_LOCATION(thistype) \ ++ TYPE_MAIN_TYPE(thistype)->data_location ++#define TYPE_DATA_LOCATION_BATON(thistype) \ ++ TYPE_DATA_LOCATION (thistype)->data.baton ++#define TYPE_DATA_LOCATION_ADDR(thistype) \ ++ TYPE_DATA_LOCATION (thistype)->data.const_val ++#define TYPE_DATA_LOCATION_KIND(thistype) \ ++ TYPE_DATA_LOCATION (thistype)->kind ++#define TYPE_ALLOCATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->allocated ++#define TYPE_ASSOCIATED_PROP(thistype) TYPE_MAIN_TYPE(thistype)->associated ++ ++/* Allocated status of type object. If set to non-zero it means the object ++ is allocated. A zero value means it is not allocated. */ ++#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \ ++ && TYPE_ALLOCATED_PROP (t)->kind == PROP_CONST \ ++ && !TYPE_ALLOCATED_PROP (t)->data.const_val) ++ ++/* Associated status of type object. If set to non-zero it means the object ++ is associated. A zero value means it is not associated. */ ++#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \ ++ && TYPE_ASSOCIATED_PROP (t)->kind == PROP_CONST \ ++ && !TYPE_ASSOCIATED_PROP (t)->data.const_val) + + /* Moto-specific stuff for FORTRAN arrays. */ + +@@ -1209,6 +1263,9 @@ extern void allocate_gnat_aux_type (struct type *); + TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) + #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ + TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype)) ++#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \ ++ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0) ++ + + #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ + (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype)))) +@@ -1677,6 +1734,7 @@ extern struct type *create_array_type_with_stride + + extern struct type *create_range_type (struct type *, struct type *, + const struct dynamic_prop *, ++ const struct dynamic_prop *, + const struct dynamic_prop *); + + extern struct type *create_array_type (struct type *, struct type *, +diff --git a/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp +new file mode 100644 +index 0000000..20607c3 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-alloc-assoc.exp +@@ -0,0 +1,65 @@ ++# Copyright 2014 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++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..35f585d +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-stride.exp +@@ -0,0 +1,44 @@ ++# Copyright 2014 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++standard_testfile ".f90" ++ ++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ ++ {debug f90 quiet}] } { ++ return -1 ++} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "re-reverse-elements"] ++gdb_continue_to_breakpoint "re-reverse-elements" ++gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \ ++ "print re-reverse-elements" ++gdb_test "print pvla(1)" " = 1" "print first re-reverse-element" ++gdb_test "print pvla(10)" " = 10" "print last re-reverse-element" ++ ++gdb_breakpoint [gdb_get_line_number "odd-elements"] ++gdb_continue_to_breakpoint "odd-elements" ++gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements" ++gdb_test "print pvla(1)" " = 1" "print first odd-element" ++gdb_test "print pvla(5)" " = 9" "print last odd-element" ++ ++gdb_breakpoint [gdb_get_line_number "single-element"] ++gdb_continue_to_breakpoint "single-element" ++gdb_test "print pvla" " = \\\(5\\\)" "print single-element" ++gdb_test "print pvla(1)" " = 5" "print one single-element" +diff --git a/gdb/testsuite/gdb.fortran/vla-stride.f90 b/gdb/testsuite/gdb.fortran/vla-stride.f90 +new file mode 100644 +index 0000000..6aa4f2b +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-stride.f90 +@@ -0,0 +1,30 @@ ++! Copyright 2014 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++program vla_stride ++ integer, target, allocatable :: vla (:) ++ integer, pointer :: pvla (:) ++ ++ allocate(vla(10)) ++ vla = (/ (I, I = 1,10) /) ++ ++ pvla => vla(10:1:-1) ++ pvla => pvla(10:1:-1) ++ pvla => vla(1:10:2) ! re-reverse-elements ++ pvla => vla(5:4:-2) ! odd-elements ++ ++ pvla => null() ! single-element ++end program vla_stride +diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp +new file mode 100644 +index 0000000..7fc1734 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/vla-strings.exp +@@ -0,0 +1,104 @@ ++# Copyright 2014 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++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 29abe5f..5efea89 100644 +--- a/gdb/value.c ++++ b/gdb/value.c +@@ -43,6 +43,7 @@ + #include "tracepoint.h" + #include "cp-abi.h" + #include "user-regs.h" ++#include "dwarf2loc.h" + + /* Prototypes for exported functions. */ + +@@ -1627,6 +1628,25 @@ set_value_component_location (struct value *component, + if (funcs->copy_closure) + component->location.computed.closure = funcs->copy_closure (whole); + } ++ ++ /* For dynamic types compute the address of the component value location in ++ sub range types based on the location of the sub range type, if not being ++ an internal GDB variable or parts of it. */ ++ if (VALUE_LVAL (component) != lval_internalvar ++ && VALUE_LVAL (component) != lval_internalvar_component) ++ { ++ CORE_ADDR addr; ++ struct type *type = value_type (whole); ++ ++ addr = value_raw_address (component); ++ ++ if (TYPE_DATA_LOCATION (type) ++ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) ++ { ++ addr = TYPE_DATA_LOCATION_ADDR (type); ++ set_value_address (component, addr); ++ } ++ } + } + + +@@ -2931,13 +2951,22 @@ value_primitive_field (struct value *arg1, int offset, + v = allocate_value_lazy (type); + else + { +- v = allocate_value (type); +- value_contents_copy_raw (v, value_embedded_offset (v), +- arg1, value_embedded_offset (arg1) + offset, +- TYPE_LENGTH (type)); ++ if (TYPE_DATA_LOCATION (type) ++ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) ++ v = value_at_lazy (type, value_address (arg1) + offset); ++ else ++ { ++ v = allocate_value (type); ++ value_contents_copy_raw (v, value_embedded_offset (v), ++ arg1, value_embedded_offset (arg1) + offset, ++ TYPE_LENGTH (type)); ++ } + } +- v->offset = (value_offset (arg1) + offset +- + value_embedded_offset (arg1)); ++ ++ if (!TYPE_DATA_LOCATION (type) ++ || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) ++ v->offset = (value_offset (arg1) + offset ++ + value_embedded_offset (arg1)); + } + set_value_component_location (v, arg1); + VALUE_REGNUM (v) = VALUE_REGNUM (arg1); +@@ -3520,7 +3549,8 @@ readjust_indirect_value_type (struct value *value, struct type *enc_type, + struct value *original_value) + { + /* Re-adjust type. */ +- deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type)); ++ if (!is_dynamic_type (TYPE_TARGET_TYPE (original_type))) ++ deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type)); + + /* Add embedding info. */ + set_value_enclosing_type (value, enc_type); +@@ -3537,6 +3567,12 @@ coerce_ref (struct value *arg) + struct value *retval; + struct type *enc_type; + ++ if (current_language->la_language != language_fortran ++ && TYPE_DATA_LOCATION (value_type_arg_tmp) != NULL ++ && TYPE_DATA_LOCATION_KIND (value_type_arg_tmp) == PROP_CONST) ++ arg = value_at_lazy (value_type_arg_tmp, ++ TYPE_DATA_LOCATION_ADDR (value_type_arg_tmp)); ++ + retval = coerce_ref_if_computed (arg); + if (retval) + return retval; +@@ -3680,8 +3716,14 @@ value_fetch_lazy (struct value *val) + } + else if (VALUE_LVAL (val) == lval_memory) + { +- CORE_ADDR addr = value_address (val); + struct type *type = check_typedef (value_enclosing_type (val)); ++ CORE_ADDR addr; ++ ++ if (TYPE_DATA_LOCATION (type) != NULL ++ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST) ++ addr = TYPE_DATA_LOCATION_ADDR (type); ++ else ++ addr = value_address (val); + + if (TYPE_LENGTH (type)) + read_value_memory (val, 0, value_stack (val), diff --git a/gdb.spec b/gdb.spec index ca12ca5..130ce50 100644 --- a/gdb.spec +++ b/gdb.spec @@ -20,7 +20,7 @@ Summary(zh_TW.UTF-8): [.-A開發]C和.$)B其.-A他語.$)B言的調試器 %define snap 20120926 Name: gdb Version: 7.8 -Release: 0.1 +Release: 1 License: GPL v3+ Group: Development/Debuggers Source0: http://ftp.gnu.org/gnu/gdb/%{name}-%{version}.tar.xz @@ -36,6 +36,10 @@ Patch104: gdb-6.6-buildid-locate-rpm-librpm-workaround.patch Patch105: gdb-6.6-buildid-locate-misleading-warning-missing-debuginfo-rhbz981154.patch Patch110: gdb-6.3-gstack-20050411.patch Patch111: gdb-gdb-add-index-script.patch +Patch112: gdb-archer-vla-tests.patch +Patch113: gdb-vla-intel.patch +Patch114: gdb-vla-intel-04of23-fix.patch +Patch115: gdb-vla-intel-stringbt-fix.patch Patch1000: %{name}-readline.patch Patch1001: %{name}-info.patch Patch1002: %{name}-passflags.patch @@ -177,6 +181,10 @@ rm -f gdb/jv-exp.c gdb/m2-exp.c gdb/objc-exp.c gdb/p-exp.c %patch105 -p1 %patch110 -p1 %patch111 -p1 +%patch112 -p1 +%patch113 -p1 +%patch114 -p1 +%patch115 -p1 %patch1000 -p1 %patch1001 -p1 -- 2.44.0