From 362037ef220b1f20987f30bc58cb32e6f6dc5b67 Mon Sep 17 00:00:00 2001 From: Kevin Buettner Date: Thu, 24 Jun 2021 15:46:14 -0700 Subject: [PATCH 1/7] Rebase to FSF GDB 10.2. Drop gdb-6.3-test-pie-20050107.patch. Drop gdb-6.3-test-self-20050110.patch. Drop gdb-6.5-bz218379-ppc-solib-trampoline-test.patch. Drop gdb-6.6-buildid-locate-core-as-arg.patch. Drop gdb-6.8-quit-never-aborts.patch. Drop gdb-archer-pie-addons-keep-disabled.patch. Drop gdb-archer-pie-addons.patch. Drop gdb-archer-vla-tests.patch. Drop gdb-archer.patch. Drop gdb-attach-fail-reasons-5of5.patch. Drop gdb-btrobust.patch. Drop gdb-bz1219747-attach-kills.patch. Drop gdb-bz533176-fortran-omp-step.patch. Drop gdb-dts-rhel6-python-compat.patch. Drop gdb-gnat-dwarf-crash-3of3.patch. Drop gdb-jit-reader-multilib.patch. Drop gdb-moribund-utrace-workaround.patch. Drop gdb-rhbz1930528-fix-gnulib-build-error.patch. Drop gdb-rhbz1932645-aarch64-ptrace-header-order.patch. Drop gdb-vla-intel-fix-print-char-array.patch. Drop gdb-vla-intel-fortran-strides.patch. Drop gdb-vla-intel-stringbt-fix.patch. Drop gdb-vla-intel-tests.patch. Drop process_psymtab_comp_unit-type-unit.patch. Drop gdb-testsuite-readline63-sigint-revert.patch. Drop gdb-config.patch. Add following upstream patches for Fortran stride / slice support: gdb-rhbz1964167-convert-enum-range_type.patch gdb-rhbz1964167-fortran-array-slices-at-prompt.patch gdb-rhbz1964167-fortran-array-strides-in-expressions.patch gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch gdb-rhbz1964167-fortran-range_type-to-range_flag.patch gdb-rhbz1964167-fortran-whitespace_array.patch gdb-rhbz1964167-move-fortran-expr-handling.patch Backport "Exclude debuginfo files from 'outside ELF segments' warning". (Keith Seitz, RH BZ 1898252) Backport "Fix crash when expanding partial symtab..." (Tom Tromey. gdb/27743) Backport "[gdb/server] Don't overwrite fs/gs_base with -m32" (Tom de Vries) --- .gitignore | 4 +- _gdb.spec.Patch.include | 276 +- _gdb.spec.patch.include | 11 - _git_upstream_commit | 2 +- _patch_order | 33 +- gdb-6.3-test-pie-20050107.patch | 2027 --------- gdb-6.3-test-self-20050110.patch | 42 - ...379-solib-trampoline-lookup-lock-fix.patch | 27 - gdb-6.6-buildid-locate-core-as-arg.patch | 196 - gdb-6.6-buildid-locate-rpm-scl.patch | 4 +- gdb-6.6-buildid-locate.patch | 6 +- gdb-6.8-quit-never-aborts.patch | 78 - gdb-archer-pie-addons-keep-disabled.patch | 89 - gdb-archer-pie-addons.patch | 39 - gdb-archer-vla-tests.patch | 3737 ----------------- gdb-archer.patch | 187 - gdb-attach-fail-reasons-5of5.patch | 356 -- gdb-btrobust.patch | 45 - gdb-bz1219747-attach-kills.patch | 178 - gdb-bz533176-fortran-omp-step.patch | 130 - gdb-dont-overwrite-fsgsbase-m32.patch | 139 + gdb-dts-rhel6-python-compat.patch | 315 -- gdb-gdb27743-psymtab-imported-unit.patch | 281 ++ gdb-gnat-dwarf-crash-3of3.patch | 219 - gdb-jit-reader-multilib.patch | 46 - gdb-moribund-utrace-workaround.patch | 25 - ...oadable-section-outside-ELF-segments.patch | 67 + gdb-rhbz1909902-frame_id_p-assert-1.patch | 6 +- gdb-rhbz1964167-convert-enum-range_type.patch | 375 ++ ...64167-fortran-array-slices-at-prompt.patch | 2660 ++++++++++++ ...fortran-array-strides-in-expressions.patch | 193 + ...clean-up-array-expression-evaluation.patch | 209 + ...fix-type-format-mismatch-in-f-lang.c.patch | 128 + ...167-fortran-range_type-to-range_flag.patch | 224 + ...rhbz1964167-fortran-whitespace_array.patch | 137 + ...bz1964167-move-fortran-expr-handling.patch | 787 ++++ gdb-vla-intel-fix-print-char-array.patch | 59 - gdb-vla-intel-fortran-strides.patch | 1778 -------- gdb-vla-intel-fortran-vla-strings.patch | 1086 ----- gdb-vla-intel-stringbt-fix.patch | 167 - gdb-vla-intel-tests.patch | 350 -- gdb.spec | 83 +- sources | 2 +- 43 files changed, 5387 insertions(+), 11416 deletions(-) delete mode 100644 gdb-6.3-test-pie-20050107.patch delete mode 100644 gdb-6.3-test-self-20050110.patch delete mode 100644 gdb-6.5-bz218379-solib-trampoline-lookup-lock-fix.patch delete mode 100644 gdb-6.6-buildid-locate-core-as-arg.patch delete mode 100644 gdb-6.8-quit-never-aborts.patch delete mode 100644 gdb-archer-pie-addons-keep-disabled.patch delete mode 100644 gdb-archer-pie-addons.patch delete mode 100644 gdb-archer-vla-tests.patch delete mode 100644 gdb-archer.patch delete mode 100644 gdb-attach-fail-reasons-5of5.patch delete mode 100644 gdb-btrobust.patch delete mode 100644 gdb-bz1219747-attach-kills.patch delete mode 100644 gdb-bz533176-fortran-omp-step.patch create mode 100644 gdb-dont-overwrite-fsgsbase-m32.patch delete mode 100644 gdb-dts-rhel6-python-compat.patch create mode 100644 gdb-gdb27743-psymtab-imported-unit.patch delete mode 100644 gdb-gnat-dwarf-crash-3of3.patch delete mode 100644 gdb-jit-reader-multilib.patch delete mode 100644 gdb-moribund-utrace-workaround.patch create mode 100644 gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch create mode 100644 gdb-rhbz1964167-convert-enum-range_type.patch create mode 100644 gdb-rhbz1964167-fortran-array-slices-at-prompt.patch create mode 100644 gdb-rhbz1964167-fortran-array-strides-in-expressions.patch create mode 100644 gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch create mode 100644 gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch create mode 100644 gdb-rhbz1964167-fortran-range_type-to-range_flag.patch create mode 100644 gdb-rhbz1964167-fortran-whitespace_array.patch create mode 100644 gdb-rhbz1964167-move-fortran-expr-handling.patch delete mode 100644 gdb-vla-intel-fix-print-char-array.patch delete mode 100644 gdb-vla-intel-fortran-strides.patch delete mode 100644 gdb-vla-intel-fortran-vla-strings.patch delete mode 100644 gdb-vla-intel-stringbt-fix.patch delete mode 100644 gdb-vla-intel-tests.patch diff --git a/.gitignore b/.gitignore index 7f9170e..cd1a984 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,3 @@ -/binutils-gdb /gdb-libstdc++-v3-python-8.1.1-20180626.tar.xz -/gdb-9.2.tar.xz -/gdb-10.1.tar.xz /v2.0.4.tar.gz +/gdb-10.2.tar.xz diff --git a/_gdb.spec.Patch.include b/_gdb.spec.Patch.include index eca6b2b..6374bfc 100644 --- a/_gdb.spec.Patch.include +++ b/_gdb.spec.Patch.include @@ -2,373 +2,300 @@ #=fedora Patch001: gdb-6.3-rh-testversion-20041202.patch -# VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests. -#=push -Patch002: gdb-vla-intel-fortran-strides.patch - -#=push -Patch003: gdb-vla-intel-fortran-vla-strings.patch - -#=push+jan -Patch004: gdb-vla-intel-stringbt-fix.patch - # Add a wrapper script to GDB that implements pstack using the # --readnever option. #=push -Patch005: gdb-6.3-gstack-20050411.patch - -# VSYSCALL and PIE -#=fedoratest -Patch006: gdb-6.3-test-pie-20050107.patch - -# Get selftest working with sep-debug-info -#=fedoratest -Patch007: gdb-6.3-test-self-20050110.patch +Patch002: gdb-6.3-gstack-20050411.patch # Test support of multiple destructors just like multiple constructors #=fedoratest -Patch008: gdb-6.3-test-dtorfix-20050121.patch +Patch003: gdb-6.3-test-dtorfix-20050121.patch # Fix to support executable moving #=fedoratest -Patch009: gdb-6.3-test-movedir-20050125.patch +Patch004: gdb-6.3-test-movedir-20050125.patch # Test sibling threads to set threaded watchpoints for x86 and x86-64 #=fedoratest -Patch010: gdb-6.3-threaded-watchpoints2-20050225.patch +Patch005: gdb-6.3-threaded-watchpoints2-20050225.patch # Notify observers that the inferior has been created #=fedoratest -Patch011: gdb-6.3-inferior-notification-20050721.patch +Patch006: gdb-6.3-inferior-notification-20050721.patch # Verify printing of inherited members test #=fedoratest -Patch012: gdb-6.3-inheritancetest-20050726.patch +Patch007: gdb-6.3-inheritancetest-20050726.patch # Support TLS symbols (+`errno' suggestion if no pthread is found) (BZ 185337). #=push+jan: It should be replaced by Infinity project. -Patch013: gdb-6.5-bz185337-resolve-tls-without-debuginfo-v2.patch +Patch008: gdb-6.5-bz185337-resolve-tls-without-debuginfo-v2.patch # Fix TLS symbols resolving for shared libraries with a relative pathname. # The testsuite needs `gdb-6.5-tls-of-separate-debuginfo.patch'. #=fedoratest: One should recheck if it is really fixed upstream. -Patch014: gdb-6.5-sharedlibrary-path.patch +Patch009: gdb-6.5-sharedlibrary-path.patch # Improved testsuite results by the testsuite provided by the courtesy of BEA. #=fedoratest: For upstream it should be rewritten as a dejagnu test, the test of no "??" was useful. -Patch015: gdb-6.5-BEA-testsuite.patch +Patch010: gdb-6.5-BEA-testsuite.patch # Testcase for deadlocking on last address space byte; for corrupted backtraces. #=fedoratest -Patch016: gdb-6.5-last-address-space-byte-test.patch +Patch011: gdb-6.5-last-address-space-byte-test.patch # Fix readline segfault on excessively long hand-typed lines. #=fedoratest -Patch017: gdb-6.5-readline-long-line-crash-test.patch +Patch012: gdb-6.5-readline-long-line-crash-test.patch # Test sideeffects of skipping ppc .so libs trampolines (BZ 218379). #=fedoratest -Patch018: gdb-6.5-bz218379-ppc-solib-trampoline-test.patch - -# Fix lockup on trampoline vs. its function lookup; unreproducible (BZ 218379). -#=fedora -Patch019: gdb-6.5-bz218379-solib-trampoline-lookup-lock-fix.patch +Patch013: gdb-6.5-bz218379-ppc-solib-trampoline-test.patch # Find symbols properly at their original (included) file (BZ 109921). #=fedoratest -Patch020: gdb-6.5-bz109921-DW_AT_decl_file-test.patch +Patch014: gdb-6.5-bz109921-DW_AT_decl_file-test.patch # Update PPC unwinding patches to their upstream variants (BZ 140532). #=fedoratest -Patch021: gdb-6.3-bz140532-ppc-unwinding-test.patch +Patch015: gdb-6.3-bz140532-ppc-unwinding-test.patch # Testcase for exec() from threaded program (BZ 202689). #=fedoratest -Patch022: gdb-6.3-bz202689-exec-from-pthread-test.patch +Patch016: gdb-6.3-bz202689-exec-from-pthread-test.patch # Testcase for PPC Power6/DFP instructions disassembly (BZ 230000). #=fedoratest -Patch023: gdb-6.6-bz230000-power6-disassembly-test.patch +Patch017: gdb-6.6-bz230000-power6-disassembly-test.patch # Allow running `/usr/bin/gcore' with provided but inaccessible tty (BZ 229517). #=fedoratest -Patch024: gdb-6.6-bz229517-gcore-without-terminal.patch +Patch018: gdb-6.6-bz229517-gcore-without-terminal.patch # Avoid too long timeouts on failing cases of "annota1.exp annota3.exp". #=fedoratest -Patch025: gdb-6.6-testsuite-timeouts.patch +Patch019: gdb-6.6-testsuite-timeouts.patch # Support for stepping over PPC atomic instruction sequences (BZ 237572). #=fedoratest -Patch026: gdb-6.6-bz237572-ppc-atomic-sequence-test.patch +Patch020: gdb-6.6-bz237572-ppc-atomic-sequence-test.patch # Test kernel VDSO decoding while attaching to an i386 process. #=fedoratest -Patch027: gdb-6.3-attach-see-vdso-test.patch +Patch021: gdb-6.3-attach-see-vdso-test.patch # Test leftover zombie process (BZ 243845). #=fedoratest -Patch028: gdb-6.5-bz243845-stale-testing-zombie-test.patch +Patch022: gdb-6.5-bz243845-stale-testing-zombie-test.patch # New locating of the matching binaries from the pure core file (build-id). #=push+jan -Patch029: gdb-6.6-buildid-locate.patch +Patch023: gdb-6.6-buildid-locate.patch # Fix loading of core files without build-ids but with build-ids in executables. # Load strictly build-id-checked core files only if no executable is specified # (Jan Kratochvil, RH BZ 1339862). #=push+jan -Patch030: gdb-6.6-buildid-locate-solib-missing-ids.patch +Patch024: gdb-6.6-buildid-locate-solib-missing-ids.patch #=push+jan -Patch031: gdb-6.6-buildid-locate-rpm.patch +Patch025: gdb-6.6-buildid-locate-rpm.patch # Fix displaying of numeric char arrays as strings (BZ 224128). #=fedoratest: But it is failing anyway, one should check the behavior more. -Patch032: gdb-6.7-charsign-test.patch +Patch026: gdb-6.7-charsign-test.patch # Test PPC hiding of call-volatile parameter register. #=fedoratest -Patch033: gdb-6.7-ppc-clobbered-registers-O2-test.patch +Patch027: gdb-6.7-ppc-clobbered-registers-O2-test.patch # Testsuite fixes for more stable/comparable results. #=fedoratest -Patch034: gdb-6.7-testsuite-stable-results.patch +Patch028: gdb-6.7-testsuite-stable-results.patch # Test ia64 memory leaks of the code using libunwind. #=fedoratest -Patch035: gdb-6.5-ia64-libunwind-leak-test.patch +Patch029: gdb-6.5-ia64-libunwind-leak-test.patch # Test hiding unexpected breakpoints on intentional step commands. #=fedoratest -Patch036: gdb-6.5-missed-trap-on-step-test.patch +Patch030: gdb-6.5-missed-trap-on-step-test.patch # Test gcore memory and time requirements for large inferiors. #=fedoratest -Patch037: gdb-6.5-gcore-buffer-limit-test.patch +Patch031: gdb-6.5-gcore-buffer-limit-test.patch # Test GCORE for shmid 0 shared memory mappings. #=fedoratest: But it is broken anyway, sometimes the case being tested is not reproducible. -Patch038: gdb-6.3-mapping-zero-inode-test.patch +Patch032: gdb-6.3-mapping-zero-inode-test.patch # Test a crash on `focus cmd', `focus prev' commands. #=fedoratest -Patch039: gdb-6.3-focus-cmd-prev-test.patch +Patch033: gdb-6.3-focus-cmd-prev-test.patch # Test various forms of threads tracking across exec() (BZ 442765). #=fedoratest -Patch040: gdb-6.8-bz442765-threaded-exec-test.patch +Patch034: gdb-6.8-bz442765-threaded-exec-test.patch # Test a crash on libraries missing the .text section. #=fedoratest -Patch041: gdb-6.5-section-num-fixup-test.patch +Patch035: gdb-6.5-section-num-fixup-test.patch # Fix resolving of variables at locations lists in prelinked libs (BZ 466901). #=fedoratest -Patch042: gdb-6.8-bz466901-backtrace-full-prelinked.patch +Patch036: gdb-6.8-bz466901-backtrace-full-prelinked.patch # New test for step-resume breakpoint placed in multiple threads at once. #=fedoratest -Patch043: gdb-simultaneous-step-resume-breakpoint-test.patch +Patch037: gdb-simultaneous-step-resume-breakpoint-test.patch # Fix GNU/Linux core open: Can't read pathname for load map: Input/output error. # Fix regression of undisplayed missing shared libraries caused by a fix for. #=fedoratest: It should be in glibc: libc-alpha: <20091004161706.GA27450@.*> -Patch044: gdb-core-open-vdso-warning.patch - -# Fix stepping with OMP parallel Fortran sections (BZ 533176). -#=push+jan: It requires some better DWARF annotations. -Patch045: gdb-bz533176-fortran-omp-step.patch +Patch038: gdb-core-open-vdso-warning.patch # Workaround ccache making lineno non-zero for command-line definitions. #=fedoratest: ccache is rarely used and it is even fixed now. -Patch046: gdb-ccache-workaround.patch - -#=push+jan: May get obsoleted by Tom's unrelocated objfiles patch. -Patch047: gdb-archer-pie-addons.patch - -#=push+jan: Breakpoints disabling matching should not be based on address. -Patch048: gdb-archer-pie-addons-keep-disabled.patch +Patch039: gdb-ccache-workaround.patch # Testcase for "Do not make up line information" fix by Daniel Jacobowitz. #=fedoratest -Patch049: gdb-lineno-makeup-test.patch +Patch040: gdb-lineno-makeup-test.patch # Test power7 ppc disassembly. #=fedoratest -Patch050: gdb-ppc-power7-test.patch - -# Workaround non-stop moribund locations exploited by kernel utrace (BZ 590623). -#=push+jan: Currently it is still not fully safe. -Patch051: gdb-moribund-utrace-workaround.patch +Patch041: gdb-ppc-power7-test.patch # Fix follow-exec for C++ programs (bugreported by Martin Stransky). #=fedoratest -Patch052: gdb-archer-next-over-throw-cxx-exec.patch +Patch042: gdb-archer-next-over-throw-cxx-exec.patch # Backport DWARF-4 support (BZ 601887, Tom Tromey). #=fedoratest -Patch053: gdb-bz601887-dwarf4-rh-test.patch - -#=push+jan -Patch054: gdb-6.6-buildid-locate-core-as-arg.patch +Patch043: gdb-bz601887-dwarf4-rh-test.patch # Workaround librpm BZ 643031 due to its unexpected exit() calls (BZ 642879). #=push+jan -Patch055: gdb-6.6-buildid-locate-rpm-librpm-workaround.patch +Patch044: gdb-6.6-buildid-locate-rpm-librpm-workaround.patch # [delayed-symfile] Test a backtrace regression on CFIs without DIE (BZ 614604). #=fedoratest -Patch056: gdb-test-bt-cfi-without-die.patch +Patch045: gdb-test-bt-cfi-without-die.patch # Verify GDB Python built-in function gdb.solib_address exists (BZ # 634108). #=fedoratest -Patch057: gdb-bz634108-solib_address.patch +Patch046: gdb-bz634108-solib_address.patch # New test gdb.arch/x86_64-pid0-core.exp for kernel PID 0 cores (BZ 611435). #=fedoratest -Patch058: gdb-test-pid0-core.patch +Patch047: gdb-test-pid0-core.patch # [archer-tromey-delayed-symfile] New test gdb.dwarf2/dw2-aranges.exp. #=fedoratest -Patch059: gdb-test-dw2-aranges.patch +Patch048: gdb-test-dw2-aranges.patch # [archer-keiths-expr-cumulative+upstream] Import C++ testcases. #=fedoratest -Patch060: gdb-test-expr-cumulative-archer.patch +Patch049: gdb-test-expr-cumulative-archer.patch # Fix regressions on C++ names resolving (PR 11734, PR 12273, Keith Seitz). #=fedoratest -Patch061: gdb-physname-pr11734-test.patch +Patch050: gdb-physname-pr11734-test.patch # Fix regressions on C++ names resolving (PR 11734, PR 12273, Keith Seitz). #=fedoratest -Patch062: gdb-physname-pr12273-test.patch +Patch051: gdb-physname-pr12273-test.patch # Test GDB opcodes/ disassembly of Intel Ivy Bridge instructions (BZ 696890). #=fedoratest -Patch063: gdb-test-ivy-bridge.patch +Patch052: gdb-test-ivy-bridge.patch # Hack for proper PIE run of the testsuite. #=fedoratest -Patch064: gdb-runtest-pie-override.patch - -# Print reasons for failed attach/spawn incl. SELinux deny_ptrace (BZ 786878). -#=push+jan -Patch065: gdb-attach-fail-reasons-5of5.patch +Patch053: gdb-runtest-pie-override.patch # Workaround PR libc/14166 for inferior calls of strstr. #=fedoratest: Compatibility with RHELs (unchecked which ones). -Patch066: gdb-glibc-strstr-workaround.patch +Patch054: gdb-glibc-strstr-workaround.patch # Include testcase for `Unable to see a variable inside a module (XLF)' (BZ 823789). #=fedoratest -Patch067: gdb-rhel5.9-testcase-xlf-var-inside-mod.patch +Patch055: gdb-rhel5.9-testcase-xlf-var-inside-mod.patch # Testcase for `Setting solib-absolute-prefix breaks vDSO' (BZ 818343). #=fedoratest -Patch068: gdb-rhbz-818343-set-solib-absolute-prefix-testcase.patch +Patch056: gdb-rhbz-818343-set-solib-absolute-prefix-testcase.patch # Import regression test for `gdb/findvar.c:417: internal-error: # read_var_value: Assertion `frame' failed.' (RH BZ 947564) from RHEL 6.5. #=fedoratest -Patch069: gdb-rhbz947564-findvar-assertion-frame-failed-testcase.patch - -# Fix crash of -readnow /usr/lib/debug/usr/bin/gnatbind.debug (BZ 1069211). -#=push+jan -Patch070: gdb-gnat-dwarf-crash-3of3.patch +Patch057: gdb-rhbz947564-findvar-assertion-frame-failed-testcase.patch # Fix 'memory leak in infpy_read_memory()' (RH BZ 1007614) #=fedoratest -Patch071: gdb-rhbz1007614-memleak-infpy_read_memory-test.patch +Patch058: gdb-rhbz1007614-memleak-infpy_read_memory-test.patch # Fix 'gdb gives highly misleading error when debuginfo pkg is present, # but not corresponding binary pkg' (RH BZ 981154). #=push+jan -Patch072: gdb-6.6-buildid-locate-misleading-warning-missing-debuginfo-rhbz981154.patch - -#=fedoratest -Patch073: gdb-archer-vla-tests.patch - -#=fedoratest -Patch074: gdb-vla-intel-tests.patch - -# Continue backtrace even if a frame filter throws an exception (Phil Muldoon). -#=push -Patch075: gdb-btrobust.patch +Patch059: gdb-6.6-buildid-locate-misleading-warning-missing-debuginfo-rhbz981154.patch # Display Fortran strings in backtraces. #=fedoratest -Patch076: gdb-fortran-frame-string.patch +Patch060: gdb-fortran-frame-string.patch # Testcase for '[SAP] Recursive dlopen causes SAP HANA installer to # crash.' (RH BZ 1156192). #=fedoratest -Patch077: gdb-rhbz1156192-recursive-dlopen-test.patch - -# Fix jit-reader.h for multi-lib. -#=push+jan -Patch078: gdb-jit-reader-multilib.patch +Patch061: gdb-rhbz1156192-recursive-dlopen-test.patch # Fix '`catch syscall' doesn't work for parent after `fork' is called' # (Philippe Waroquiers, RH BZ 1149205). #=fedoratest -Patch079: gdb-rhbz1149205-catch-syscall-after-fork-test.patch +Patch062: gdb-rhbz1149205-catch-syscall-after-fork-test.patch # Fix 'backport GDB 7.4 fix to RHEL 6.6 GDB' [Original Sourceware bug # description: 'C++ (and objc): Internal error on unqualified name # re-set', PR 11657] (RH BZ 1186476). #=fedoratest -Patch080: gdb-rhbz1186476-internal-error-unqualified-name-re-set-test.patch +Patch063: gdb-rhbz1186476-internal-error-unqualified-name-re-set-test.patch # Test 'info type-printers' Python error (RH BZ 1350436). #=fedoratest -Patch081: gdb-rhbz1350436-type-printers-error.patch +Patch064: gdb-rhbz1350436-type-printers-error.patch # Fix '[ppc64] and [s390x] wrong prologue skip on -O2 -g code' (Jan # Kratochvil, RH BZ 1084404). #=fedoratest -Patch082: gdb-rhbz1084404-ppc64-s390x-wrong-prologue-skip-O2-g-3of3.patch - -# Never kill PID on: gdb exec PID (Jan Kratochvil, RH BZ 1219747). -#=push+jan -Patch083: gdb-bz1219747-attach-kills.patch +Patch065: gdb-rhbz1084404-ppc64-s390x-wrong-prologue-skip-O2-g-3of3.patch # Force libncursesw over libncurses to match the includes (RH BZ 1270534). #=push+jan -Patch084: gdb-fedora-libncursesw.patch +Patch066: gdb-fedora-libncursesw.patch # Test clflushopt instruction decode (for RH BZ 1262471). #=fedoratest -Patch085: gdb-opcodes-clflushopt-test.patch - -# [rhel6] DTS backward Python compatibility API (BZ 1020004, Phil Muldoon). -#=fedora -Patch086: gdb-dts-rhel6-python-compat.patch +Patch067: gdb-opcodes-clflushopt-test.patch # [SCL] Skip deprecated .gdb_index warning for Red Hat built files (BZ 953585). #=push+jan -Patch087: gdb-6.6-buildid-locate-rpm-scl.patch - -# Make the GDB quit processing non-abortable to cleanup everything properly. -#=fedora: It was useful only after gdb-6.8-attach-signalled-detach-stopped.patch . -Patch088: gdb-6.8-quit-never-aborts.patch +Patch068: gdb-6.6-buildid-locate-rpm-scl.patch # [aarch64] Fix hardware watchpoints (RH BZ 1261564). #=fedoratest -Patch089: gdb-rhbz1261564-aarch64-hw-watchpoint-test.patch +Patch069: gdb-rhbz1261564-aarch64-hw-watchpoint-test.patch # Add messages suggesting more recent RHEL gdbserver (RH BZ 1321114). #=fedora -Patch090: gdb-container-rh-pkg.patch +Patch070: gdb-container-rh-pkg.patch # New test for Python "Cannot locate object file for block" (for RH BZ 1325795). #=fedoratest -Patch091: gdb-rhbz1325795-framefilters-test.patch +Patch071: gdb-rhbz1325795-framefilters-test.patch # [dts+el7] [x86*] Bundle linux_perf.h for libipt (RH BZ 1256513). #=fedora -Patch092: gdb-linux_perf-bundle.patch +Patch072: gdb-linux_perf-bundle.patch # Fix gdb-headless /usr/bin/ executables (BZ 1390251). # @@ -377,26 +304,63 @@ Patch092: gdb-linux_perf-bundle.patch # # https://fedoraproject.org/wiki/Changes/Minimal_GDB_in_buildroot #=fedora -Patch093: gdb-libexec-add-index.patch +Patch073: gdb-libexec-add-index.patch # New testcase for: Fix -completion crash (Gary Benson, RH BZ 1398387). #=fedoratest -Patch094: gdb-rhbz1398387-tab-crash-test.patch - -# Python patches of: http://sourceware.org/gdb/wiki/ProjectArcher -#=push -Patch095: gdb-archer.patch - -# Revert upstream commit 469412dd9ccc4de5874fd3299b105833f36b34cd -Patch096: gdb-vla-intel-fix-print-char-array.patch +Patch074: gdb-rhbz1398387-tab-crash-test.patch # [s390x] Backport arch12 instructions decoding (RH BZ 1553104). # =fedoratest -Patch097: gdb-rhbz1553104-s390x-arch12-test.patch +Patch075: gdb-rhbz1553104-s390x-arch12-test.patch # Backport fix for frame_id_p assertion failure (RH BZ 1909902). -Patch098: gdb-rhbz1909902-frame_id_p-assert-1.patch +Patch076: gdb-rhbz1909902-frame_id_p-assert-1.patch # Backport patch #2 which fixes a frame_id_p assertion failure (RH BZ 1909902). -Patch099: gdb-rhbz1909902-frame_id_p-assert-2.patch +Patch077: gdb-rhbz1909902-frame_id_p-assert-2.patch + +# [fortran] Backport Andrew Burgess's commit which cleans up +# array/string expression evaluation. +Patch078: gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch + +# [fortran] Backport Andrew Burgess's commit which moves Fortran +# expression handling to f-lang.c. +Patch079: gdb-rhbz1964167-move-fortran-expr-handling.patch + +# [fortran] Backport Andrew Burgess's commit which eliminates undesirable +# whitespace when printing arrays. +Patch080: gdb-rhbz1964167-fortran-whitespace_array.patch + +# [fortran] Backport Andrew Burgess's commit which changes enum +# range_type into a bit field enum. +Patch081: gdb-rhbz1964167-convert-enum-range_type.patch + +# [fortran] Backport Andrew Burgess's commit which renames enum +# range_type to enum range_flag. +Patch082: gdb-rhbz1964167-fortran-range_type-to-range_flag.patch + +# [fortran] Backport Andrew Burgess's commit which adds support +# for array strides in expressions. +Patch083: gdb-rhbz1964167-fortran-array-strides-in-expressions.patch + +# [fortran] Backport Andrew Burgess's commit for Fortran array +# slice support +Patch084: gdb-rhbz1964167-fortran-array-slices-at-prompt.patch + +# [fortran] Backport Simon Marchi's commit which fixes a 32-bit build +# problem in gdb/f-lang.c. +Patch085: gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch + +# Backport of "Exclude debuginfo files from 'outside of ELF segments' +# warning" (Keith Seitz) +Patch086: gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch + +# Backport "Fix crash when expanding partial symtabs with DW_TAG_imported_unit" +# (Tom Tromey, gdb/27743) +Patch087: gdb-gdb27743-psymtab-imported-unit.patch + +# Backport "[gdb/server] Don't overwrite fs/gs_base with -m32" +# (Tom de Vries) +Patch088: gdb-dont-overwrite-fsgsbase-m32.patch diff --git a/_gdb.spec.patch.include b/_gdb.spec.patch.include index dddd45a..b6c1352 100644 --- a/_gdb.spec.patch.include +++ b/_gdb.spec.patch.include @@ -86,14 +86,3 @@ %patch086 -p1 %patch087 -p1 %patch088 -p1 -%patch089 -p1 -%patch090 -p1 -%patch091 -p1 -%patch092 -p1 -%patch093 -p1 -%patch094 -p1 -%patch095 -p1 -%patch096 -p1 -%patch097 -p1 -%patch098 -p1 -%patch099 -p1 diff --git a/_git_upstream_commit b/_git_upstream_commit index 8f2b797..02c1a0f 100644 --- a/_git_upstream_commit +++ b/_git_upstream_commit @@ -1 +1 @@ -606e3fd147ed9a00df165e46f30fe5c46dcda345 +ce35d7163e779b1321058b22f005c70ce1524b25 diff --git a/_patch_order b/_patch_order index bcdfd76..1293fad 100644 --- a/_patch_order +++ b/_patch_order @@ -1,10 +1,5 @@ gdb-6.3-rh-testversion-20041202.patch -gdb-vla-intel-fortran-strides.patch -gdb-vla-intel-fortran-vla-strings.patch -gdb-vla-intel-stringbt-fix.patch gdb-6.3-gstack-20050411.patch -gdb-6.3-test-pie-20050107.patch -gdb-6.3-test-self-20050110.patch gdb-6.3-test-dtorfix-20050121.patch gdb-6.3-test-movedir-20050125.patch gdb-6.3-threaded-watchpoints2-20050225.patch @@ -16,7 +11,6 @@ gdb-6.5-BEA-testsuite.patch gdb-6.5-last-address-space-byte-test.patch gdb-6.5-readline-long-line-crash-test.patch gdb-6.5-bz218379-ppc-solib-trampoline-test.patch -gdb-6.5-bz218379-solib-trampoline-lookup-lock-fix.patch gdb-6.5-bz109921-DW_AT_decl_file-test.patch gdb-6.3-bz140532-ppc-unwinding-test.patch gdb-6.3-bz202689-exec-from-pthread-test.patch @@ -42,16 +36,11 @@ gdb-6.5-section-num-fixup-test.patch gdb-6.8-bz466901-backtrace-full-prelinked.patch gdb-simultaneous-step-resume-breakpoint-test.patch gdb-core-open-vdso-warning.patch -gdb-bz533176-fortran-omp-step.patch gdb-ccache-workaround.patch -gdb-archer-pie-addons.patch -gdb-archer-pie-addons-keep-disabled.patch gdb-lineno-makeup-test.patch gdb-ppc-power7-test.patch -gdb-moribund-utrace-workaround.patch gdb-archer-next-over-throw-cxx-exec.patch gdb-bz601887-dwarf4-rh-test.patch -gdb-6.6-buildid-locate-core-as-arg.patch gdb-6.6-buildid-locate-rpm-librpm-workaround.patch gdb-test-bt-cfi-without-die.patch gdb-bz634108-solib_address.patch @@ -62,38 +51,38 @@ gdb-physname-pr11734-test.patch gdb-physname-pr12273-test.patch gdb-test-ivy-bridge.patch gdb-runtest-pie-override.patch -gdb-attach-fail-reasons-5of5.patch gdb-glibc-strstr-workaround.patch gdb-rhel5.9-testcase-xlf-var-inside-mod.patch gdb-rhbz-818343-set-solib-absolute-prefix-testcase.patch gdb-rhbz947564-findvar-assertion-frame-failed-testcase.patch -gdb-gnat-dwarf-crash-3of3.patch gdb-rhbz1007614-memleak-infpy_read_memory-test.patch gdb-6.6-buildid-locate-misleading-warning-missing-debuginfo-rhbz981154.patch -gdb-archer-vla-tests.patch -gdb-vla-intel-tests.patch -gdb-btrobust.patch gdb-fortran-frame-string.patch gdb-rhbz1156192-recursive-dlopen-test.patch -gdb-jit-reader-multilib.patch gdb-rhbz1149205-catch-syscall-after-fork-test.patch gdb-rhbz1186476-internal-error-unqualified-name-re-set-test.patch gdb-rhbz1350436-type-printers-error.patch gdb-rhbz1084404-ppc64-s390x-wrong-prologue-skip-O2-g-3of3.patch -gdb-bz1219747-attach-kills.patch gdb-fedora-libncursesw.patch gdb-opcodes-clflushopt-test.patch -gdb-dts-rhel6-python-compat.patch gdb-6.6-buildid-locate-rpm-scl.patch -gdb-6.8-quit-never-aborts.patch gdb-rhbz1261564-aarch64-hw-watchpoint-test.patch gdb-container-rh-pkg.patch gdb-rhbz1325795-framefilters-test.patch gdb-linux_perf-bundle.patch gdb-libexec-add-index.patch gdb-rhbz1398387-tab-crash-test.patch -gdb-archer.patch -gdb-vla-intel-fix-print-char-array.patch gdb-rhbz1553104-s390x-arch12-test.patch gdb-rhbz1909902-frame_id_p-assert-1.patch gdb-rhbz1909902-frame_id_p-assert-2.patch +gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch +gdb-rhbz1964167-move-fortran-expr-handling.patch +gdb-rhbz1964167-fortran-whitespace_array.patch +gdb-rhbz1964167-convert-enum-range_type.patch +gdb-rhbz1964167-fortran-range_type-to-range_flag.patch +gdb-rhbz1964167-fortran-array-strides-in-expressions.patch +gdb-rhbz1964167-fortran-array-slices-at-prompt.patch +gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch +gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch +gdb-gdb27743-psymtab-imported-unit.patch +gdb-dont-overwrite-fsgsbase-m32.patch diff --git a/gdb-6.3-test-pie-20050107.patch b/gdb-6.3-test-pie-20050107.patch deleted file mode 100644 index 85f133b..0000000 --- a/gdb-6.3-test-pie-20050107.patch +++ /dev/null @@ -1,2027 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-6.3-test-pie-20050107.patch - -;; VSYSCALL and PIE -;;=fedoratest - -diff --git a/gdb/testsuite/gdb.pie/attach.c b/gdb/testsuite/gdb.pie/attach.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/attach.c -@@ -0,0 +1,20 @@ -+/* This program is intended to be started outside of gdb, and then -+ attached to by gdb. Thus, it simply spins in a loop. The loop -+ is exited when & if the variable 'should_exit' is non-zero. (It -+ is initialized to zero in this program, so the loop will never -+ exit unless/until gdb sets the variable to non-zero.) -+ */ -+#include -+ -+int should_exit = 0; -+ -+int main () -+{ -+ int local_i = 0; -+ -+ while (! should_exit) -+ { -+ local_i++; -+ } -+ return 0; -+} -diff --git a/gdb/testsuite/gdb.pie/attach.exp b/gdb/testsuite/gdb.pie/attach.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/attach.exp -@@ -0,0 +1,416 @@ -+# Copyright 1997, 1999, 2002 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. */ -+ -+# On HP-UX 11.0, this test is causing a process running the program -+# "attach" to be left around spinning. Until we figure out why, I am -+# commenting out the test to avoid polluting tiamat (our 11.0 nightly -+# test machine) with these processes. RT -+# -+# Setting the magic bit in the target app should work. I added a -+# "kill", and also a test for the R3 register warning. JB -+if { [istarget "hppa*-*-hpux*"] } { -+ return 0 -+} -+ -+# are we on a target board -+if [is_remote target] then { -+ return 0 -+} -+ -+set testfile "attach" -+set srcfile ${testfile}.c -+set srcfile2 ${testfile}2.c -+set binfile [standard_output_file ${testfile}] -+set binfile2 [standard_output_file ${testfile}2] -+set escapedbinfile [string_to_regexp [standard_output_file ${testfile}]] -+set cleanupfile [standard_output_file ${testfile}.awk] -+ -+#execute_anywhere "rm -f ${binfile} ${binfile2}" -+remote_exec build "rm -f ${binfile} ${binfile2}" -+# For debugging this test -+# -+#log_user 1 -+ -+# Clean out any old files from past runs. -+# -+remote_exec build "${cleanupfile}" -+ -+# build the first test case -+# -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug "additional_flags= -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+# Build the in-system-call test -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile2}" "${binfile2}" executable {debug "additional_flags= -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+if [get_compiler_info ${binfile}] { -+ return -1 -+} -+ -+proc do_attach_tests {} { -+ global gdb_prompt -+ global binfile -+ global escapedbinfile -+ global srcfile -+ global testfile -+ global subdir -+ global timeout -+ -+ # Start the program running and then wait for a bit, to be sure -+ # that it can be attached to. -+ # -+ set testpid [eval exec $binfile &] -+ exec sleep 2 -+ -+ # Verify that we cannot attach to nonsense. -+ # -+ send_gdb "attach abc\n" -+ gdb_expect { -+ -re ".*Illegal process-id: abc.*$gdb_prompt $"\ -+ {pass "attach to nonsense is prohibited"} -+ -re "Attaching to.*, process .*couldn't open /proc file.*$gdb_prompt $"\ -+ { -+ # Response expected from /proc-based systems. -+ pass "attach to nonsense is prohibited" -+ } -+ -re "Attaching to.*$gdb_prompt $"\ -+ {fail "attach to nonsense is prohibited (bogus pid allowed)"} -+ -re "$gdb_prompt $" {fail "attach to nonsense is prohibited"} -+ timeout {fail "(timeout) attach to nonsense is prohibited"} -+ } -+ -+ # Verify that we cannot attach to what appears to be a valid -+ # process ID, but is a process that doesn't exist. Traditionally, -+ # most systems didn't have a process with ID 0, so we take that as -+ # the default. However, there are a few exceptions. -+ # -+ set boguspid 0 -+ if { [istarget "*-*-*bsd*"] } { -+ # In FreeBSD 5.0, PID 0 is used for "swapper". Use -1 instead -+ # (which should have the desired effect on any version of -+ # FreeBSD, and probably other *BSD's too). -+ set boguspid -1 -+ } -+ send_gdb "attach $boguspid\n" -+ gdb_expect { -+ -re "Attaching to.*, process $boguspid.*No such process.*$gdb_prompt $"\ -+ { -+ # Response expected on ptrace-based systems (i.e. HP-UX 10.20). -+ pass "attach to nonexistent process is prohibited" -+ } -+ -re "Attaching to.*, process $boguspid failed.*Hint.*$gdb_prompt $"\ -+ { -+ # Response expected on ttrace-based systems (i.e. HP-UX 11.0). -+ pass "attach to nonexistent process is prohibited" -+ } -+ -re "Attaching to.*, process $boguspid.*denied.*$gdb_prompt $"\ -+ {pass "attach to nonexistent process is prohibited"} -+ -re "Attaching to.*, process $boguspid.*not permitted.*$gdb_prompt $"\ -+ {pass "attach to nonexistent process is prohibited"} -+ -re "Attaching to.*, process .*couldn't open /proc file.*$gdb_prompt $"\ -+ { -+ # Response expected from /proc-based systems. -+ pass "attach to nonexistent process is prohibited" -+ } -+ -re "$gdb_prompt $" {fail "attach to nonexistent process is prohibited"} -+ timeout { -+ fail "(timeout) attach to nonexistent process is prohibited" -+ } -+ } -+ -+ # Verify that we can attach to the process by first giving its -+ # executable name via the file command, and using attach with -+ # the process ID. -+ # -+ # (Actually, the test system appears to do this automatically -+ # for us. So, we must also be prepared to be asked if we want -+ # to discard an existing set of symbols.) -+ # -+ send_gdb "file $binfile\n" -+ gdb_expect { -+ -re "Load new symbol table from.*y or n.*$" { -+ send_gdb "y\n" -+ gdb_expect { -+ -re "Reading symbols from $escapedbinfile\.\.\.*done.*$gdb_prompt $"\ -+ {pass "(re)set file, before attach1"} -+ -re "$gdb_prompt $" {fail "(re)set file, before attach1"} -+ timeout {fail "(timeout) (re)set file, before attach1"} -+ } -+ } -+ -re "Reading symbols from $escapedbinfile\.\.\.*done.*$gdb_prompt $"\ -+ {pass "set file, before attach1"} -+ -re "$gdb_prompt $" {fail "set file, before attach1"} -+ timeout {fail "(timeout) set file, before attach1"} -+ } -+ -+ send_gdb "attach $testpid\n" -+ gdb_expect { -+ -re "Attaching to program.*`?$escapedbinfile'?, process $testpid.*main.*at .*$srcfile:.*$gdb_prompt $"\ -+ {pass "attach1, after setting file"} -+ -re "$gdb_prompt $" {fail "attach1, after setting file"} -+ timeout {fail "(timeout) attach1, after setting file"} -+ } -+ -+ # Verify that we can "see" the variable "should_exit" in the -+ # program, and that it is zero. -+ # -+ send_gdb "print should_exit\n" -+ gdb_expect { -+ -re ".* = 0.*$gdb_prompt $"\ -+ {pass "after attach1, print should_exit"} -+ -re "$gdb_prompt $" {fail "after attach1, print should_exit"} -+ timeout {fail "(timeout) after attach1, print should_exit"} -+ } -+ -+ # Detach the process. -+ # -+ send_gdb "detach\n" -+ gdb_expect { -+ -re "Detaching from program: .*$escapedbinfile.*$gdb_prompt $"\ -+ {pass "attach1 detach"} -+ -re "$gdb_prompt $" {fail "attach1 detach"} -+ timeout {fail "(timeout) attach1 detach"} -+ } -+ -+ # Wait a bit for gdb to finish detaching -+ # -+ exec sleep 5 -+ -+ # Purge the symbols from gdb's brain. (We want to be certain -+ # the next attach, which won't be preceded by a "file" command, -+ # is really getting the executable file without our help.) -+ # -+ set old_timeout $timeout -+ set timeout 15 -+ send_gdb "file\n" -+ gdb_expect { -+ -re ".*gdb internal error.*$" { -+ fail "Internal error, prob. Memory corruption" -+ } -+ -re "No executable file now.*Discard symbol table.*y or n.*$" { -+ send_gdb "y\n" -+ gdb_expect { -+ -re "No symbol file now.*$gdb_prompt $"\ -+ {pass "attach1, purging symbols after detach"} -+ -re "$gdb_prompt $" {fail "attach1, purging symbols after detach"} -+ timeout {fail "(timeout) attach1, purging symbols after detach"} -+ } -+ } -+ -re "$gdb_prompt $" {fail "attach1, purging file after detach"} -+ timeout { -+ fail "(timeout) attach1, purging file after detach" -+ } -+ } -+ set timeout $old_timeout -+ -+ # Verify that we can attach to the process just by giving the -+ # process ID. -+ # -+ send_gdb "attach $testpid\n" -+ gdb_expect { -+ -re "Attaching to process $testpid.*Reading symbols from $escapedbinfile.*main.*at .*$gdb_prompt $"\ -+ {pass "attach2"} -+ -re "$gdb_prompt $" {fail "attach2"} -+ timeout {fail "(timeout) attach2"} -+ } -+ -+ # Verify that we can modify the variable "should_exit" in the -+ # program. -+ # -+ send_gdb "set should_exit=1\n" -+ gdb_expect { -+ -re "$gdb_prompt $" {pass "after attach2, set should_exit"} -+ timeout {fail "(timeout) after attach2, set should_exit"} -+ } -+ -+ # Verify that the modification really happened. -+ # -+ send_gdb "tbreak 19\n" -+ gdb_expect { -+ -re "reakpoint .*at.*$srcfile, line 19.*$gdb_prompt $"\ -+ {pass "after attach2, set tbreak postloop"} -+ -re "$gdb_prompt $" {fail "after attach2, set tbreak postloop"} -+ timeout {fail "(timeout) after attach2, set tbreak postloop"} -+ } -+ send_gdb "continue\n" -+ gdb_expect { -+ -re "main.*at.*$srcfile:19.*$gdb_prompt $"\ -+ {pass "after attach2, reach tbreak postloop"} -+ -re "$gdb_prompt $" {fail "after attach2, reach tbreak postloop"} -+ timeout {fail "(timeout) after attach2, reach tbreak postloop"} -+ } -+ -+ # Allow the test process to exit, to cleanup after ourselves. -+ # -+ gdb_test "continue" {\[Inferior .* exited normally\]} "after attach2, exit" -+ -+ # Make sure we don't leave a process around to confuse -+ # the next test run (and prevent the compile by keeping -+ # the text file busy), in case the "set should_exit" didn't -+ # work. -+ # -+ remote_exec build "kill -9 ${testpid}" -+ # Start the program running and then wait for a bit, to be sure -+ # that it can be attached to. -+ # -+ set testpid [eval exec $binfile &] -+ exec sleep 2 -+ -+ # Verify that we can attach to the process, and find its a.out -+ # when we're cd'd to some directory that doesn't contain the -+ # a.out. (We use the source path set by the "dir" command.) -+ # -+ send_gdb "dir [file dirname [standard_output_file ${testfile}]]\n" -+ gdb_expect { -+ -re ".*Source directories searched: .*$gdb_prompt $"\ -+ {pass "set source path"} -+ -re "$gdb_prompt $" {fail "set source path"} -+ timeout {fail "(timeout) set source path"} -+ } -+ -+ send_gdb "cd /tmp\n" -+ gdb_expect { -+ -re ".*Working directory /tmp.*$gdb_prompt $"\ -+ {pass "cd away from process' a.out"} -+ -re "$gdb_prompt $" {fail "cd away from process' a.out"} -+ timeout {fail "(timeout) cd away from process' a.out"} -+ } -+ -+ # Explicitly flush out any knowledge of the previous attachment. -+ send_gdb "symbol\n" -+ gdb_expect { -+ -re ".*Discard symbol table from.*y or n. $"\ -+ {send_gdb "y\n" -+ gdb_expect { -+ -re ".*No symbol file now.*$gdb_prompt $"\ -+ {pass "before attach3, flush symbols"} -+ -re "$gdb_prompt $" {fail "before attach3, flush symbols"} -+ timeout {fail "(timeout) before attach3, flush symbols"} -+ } -+ } -+ -re ".*No symbol file now.*$gdb_prompt $"\ -+ {pass "before attach3, flush symbols"} -+ -re "$gdb_prompt $" {fail "before attach3, flush symbols"} -+ timeout {fail "(timeout) before attach3, flush symbols"} -+ } -+ send_gdb "exec\n" -+ gdb_expect { -+ -re ".*No executable file now.*$gdb_prompt $"\ -+ {pass "before attach3, flush exec"} -+ -re "$gdb_prompt $" {fail "before attach3, flush exec"} -+ timeout {fail "(timeout) before attach3, flush exec"} -+ } -+ -+ send_gdb "attach $testpid\n" -+ gdb_expect { -+ -re "Attaching to process $testpid.*Reading symbols from $escapedbinfile.*main.*at .*$gdb_prompt $"\ -+ {pass "attach when process' a.out not in cwd"} -+ -re "$gdb_prompt $" {fail "attach when process' a.out not in cwd"} -+ timeout {fail "(timeout) attach when process' a.out not in cwd"} -+ } -+ -+ send_gdb "kill\n" -+ gdb_expect { -+ -re ".*Kill the program being debugged.*y or n. $"\ -+ {send_gdb "y\n" -+ gdb_expect { -+ -re "$gdb_prompt $" {pass "after attach3, exit"} -+ timeout {fail "(timeout) after attach3, exit"} -+ } -+ } -+ -re "$gdb_prompt $" {fail "after attach3, exit"} -+ timeout {fail "(timeout) after attach3, exit"} -+ } -+ -+ # Another "don't leave a process around" -+ remote_exec build "kill -9 ${testpid}" -+} -+ -+proc do_call_attach_tests {} { -+ global gdb_prompt -+ global binfile2 -+ -+ # Start the program running and then wait for a bit, to be sure -+ # that it can be attached to. -+ # -+ set testpid [eval exec $binfile2 &] -+ exec sleep 2 -+ -+ # Attach -+ # -+ gdb_test "file $binfile2" ".*" "force switch to gdb64, if necessary" -+ send_gdb "attach $testpid\n" -+ gdb_expect { -+ -re ".*warning: reading register.*I.*O error.*$gdb_prompt $" { -+ fail "attach call, read register 3 error" -+ } -+ -re "Attaching to.*process $testpid.*$gdb_prompt $" { -+ # libc is relocated, not relocated, therefore not printed. -+ pass "attach call" -+ } -+ -re "$gdb_prompt $" {fail "attach call"} -+ timeout {fail "(timeout) attach call"} -+ } -+ -+ # See if other registers are problems -+ # -+ send_gdb "i r r3\n" -+ gdb_expect { -+ -re ".*warning: reading register.*$gdb_prompt $" { -+ pass "CHFts23490: known bug" -+ } -+ -re ".*r3.*$gdb_prompt $" { -+ pass "Bug fixed, Yayyy!" -+ } -+ timeout { fail "timeout on info reg" } -+ } -+ -+ # Get rid of the process -+ # -+ gdb_test "p should_exit = 1" ".*" -+ gdb_test "c" {\[Inferior .* exited normally\]} -+ -+ # Be paranoid -+ # -+ remote_exec build "kill -9 ${testpid}" -+ -+} -+ -+ -+# Start with a fresh gdb -+# -+gdb_exit -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfile} -+ -+# This is a test of gdb's ability to attach to a running process. -+# -+do_attach_tests -+ -+# Test attaching when the target is inside a system call -+# -+gdb_exit -+gdb_start -+ -+gdb_reinitialize_dir $srcdir/$subdir -+do_call_attach_tests -+ -+return 0 -diff --git a/gdb/testsuite/gdb.pie/attach2.c b/gdb/testsuite/gdb.pie/attach2.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/attach2.c -@@ -0,0 +1,24 @@ -+/* This program is intended to be started outside of gdb, and then -+ attached to by gdb. Thus, it simply spins in a loop. The loop -+ is exited when & if the variable 'should_exit' is non-zero. (It -+ is initialized to zero in this program, so the loop will never -+ exit unless/until gdb sets the variable to non-zero.) -+ */ -+#include -+#include -+#include -+ -+int should_exit = 0; -+ -+int main () -+{ -+ int local_i = 0; -+ -+ sleep( 10 ); /* System call causes register fetch to fail */ -+ /* This is a known HPUX "feature" */ -+ while (! should_exit) -+ { -+ local_i++; -+ } -+ return (0); -+} -diff --git a/gdb/testsuite/gdb.pie/break.c b/gdb/testsuite/gdb.pie/break.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/break.c -@@ -0,0 +1,146 @@ -+/* This testcase is part of GDB, the GNU debugger. -+ -+ Copyright 1992, 1993, 1994, 1995, 1999, 2002, 2003 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. -+ -+ Please email any bugs, comments, and/or additions to this file to: -+ bug-gdb@prep.ai.mit.edu */ -+ -+#ifdef vxworks -+ -+# include -+ -+/* VxWorks does not supply atoi. */ -+static int -+atoi (z) -+ char *z; -+{ -+ int i = 0; -+ -+ while (*z >= '0' && *z <= '9') -+ i = i * 10 + (*z++ - '0'); -+ return i; -+} -+ -+/* I don't know of any way to pass an array to VxWorks. This function -+ can be called directly from gdb. */ -+ -+vxmain (arg) -+char *arg; -+{ -+ char *argv[2]; -+ -+ argv[0] = ""; -+ argv[1] = arg; -+ main (2, argv, (char **) 0); -+} -+ -+#else /* ! vxworks */ -+# include -+# include -+#endif /* ! vxworks */ -+ -+#ifdef PROTOTYPES -+extern int marker1 (void); -+extern int marker2 (int a); -+extern void marker3 (char *a, char *b); -+extern void marker4 (long d); -+#else -+extern int marker1 (); -+extern int marker2 (); -+extern void marker3 (); -+extern void marker4 (); -+#endif -+ -+/* -+ * This simple classical example of recursion is useful for -+ * testing stack backtraces and such. -+ */ -+ -+#ifdef PROTOTYPES -+int factorial(int); -+ -+int -+main (int argc, char **argv, char **envp) -+#else -+int -+main (argc, argv, envp) -+int argc; -+char *argv[], **envp; -+#endif -+{ -+#ifdef usestubs -+ set_debug_traps(); /* set breakpoint 5 here */ -+ breakpoint(); -+#endif -+ if (argc == 12345) { /* an unlikely value < 2^16, in case uninited */ /* set breakpoint 6 here */ -+ fprintf (stderr, "usage: factorial \n"); -+ return 1; -+ } -+ printf ("%d\n", factorial (atoi ("6"))); /* set breakpoint 1 here */ -+ /* set breakpoint 12 here */ -+ marker1 (); /* set breakpoint 11 here */ -+ marker2 (43); /* set breakpoint 20 here */ -+ marker3 ("stack", "trace"); /* set breakpoint 21 here */ -+ marker4 (177601976L); -+ argc = (argc == 12345); /* This is silly, but we can step off of it */ /* set breakpoint 2 here */ -+ return argc; /* set breakpoint 10 here */ -+} -+ -+#ifdef PROTOTYPES -+int factorial (int value) -+#else -+int factorial (value) -+int value; -+#endif -+{ -+ if (value > 1) { /* set breakpoint 7 here */ -+ value *= factorial (value - 1); -+ } -+ return (value); /* set breakpoint 19 here */ -+} -+ -+#ifdef PROTOTYPES -+int multi_line_if_conditional (int a, int b, int c) -+#else -+int multi_line_if_conditional (a, b, c) -+ int a, b, c; -+#endif -+{ -+ if (a /* set breakpoint 3 here */ -+ && b -+ && c) -+ return 0; -+ else -+ return 1; -+} -+ -+#ifdef PROTOTYPES -+int multi_line_while_conditional (int a, int b, int c) -+#else -+int multi_line_while_conditional (a, b, c) -+ int a, b, c; -+#endif -+{ -+ while (a /* set breakpoint 4 here */ -+ && b -+ && c) -+ { -+ a--, b--, c--; -+ } -+ return 0; -+} -diff --git a/gdb/testsuite/gdb.pie/break.exp b/gdb/testsuite/gdb.pie/break.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/break.exp -@@ -0,0 +1,954 @@ -+# Copyright 1988, 1990, 1991, 1992, 1994, 1995, 1996, 1997, 1998, 1999, -+# 2000, 2002, 2003, 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. -+ -+# Please email any bugs, comments, and/or additions to this file to: -+# bug-gdb@prep.ai.mit.edu -+ -+# This file was written by Rob Savoye. (rob@cygnus.com) -+ -+# Test the same stuff but with PIE executables -+ -+set testfile "break" -+set srcfile ${testfile}.c -+set srcfile1 ${testfile}1.c -+set binfile [standard_output_file ${testfile}] -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}0.o" object {debug "additional_flags=-w -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile1}" "${binfile}1.o" object {debug "additional_flags=-w -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+if { [gdb_compile "${binfile}0.o ${binfile}1.o" "${binfile}" executable {debug "additional_flags=-w -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+if [get_compiler_info ${binfile}] { -+ return -1 -+} -+ -+gdb_exit -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfile} -+ -+if [target_info exists gdb_stub] { -+ gdb_step_for_stub; -+} -+# -+# test simple breakpoint setting commands -+# -+ -+# Test deleting all breakpoints when there are none installed, -+# GDB should not prompt for confirmation. -+# Note that gdb-init.exp provides a "delete_breakpoints" proc -+# for general use elsewhere. -+ -+send_gdb "delete breakpoints\n" -+gdb_expect { -+ -re "Delete all breakpoints.*$" { -+ send_gdb "y\n" -+ gdb_expect { -+ -re "$gdb_prompt $" { -+ fail "Delete all breakpoints when none (unexpected prompt)" -+ } -+ timeout { fail "Delete all breakpoints when none (timeout after unexpected prompt)" } -+ } -+ } -+ -re ".*$gdb_prompt $" { pass "Delete all breakpoints when none" } -+ timeout { fail "Delete all breakpoints when none (timeout)" } -+} -+ -+# -+# test break at function -+# -+gdb_test "break main" \ -+ "Breakpoint.*at.* file .*$srcfile, line.*" \ -+ "breakpoint function" -+ -+# -+# test break at quoted function -+# -+gdb_test "break \"marker2\"" \ -+ "Breakpoint.*at.* file .*$srcfile1, line.*" \ -+ "breakpoint quoted function" -+ -+# -+# test break at function in file -+# -+gdb_test "break $srcfile:factorial" \ -+ "Breakpoint.*at.* file .*$srcfile, line.*" \ -+ "breakpoint function in file" -+ -+set bp_location1 [gdb_get_line_number "set breakpoint 1 here"] -+ -+# -+# test break at line number -+# -+# Note that the default source file is the last one whose source text -+# was printed. For native debugging, before we've executed the -+# program, this is the file containing main, but for remote debugging, -+# it's wherever the processor was stopped when we connected to the -+# board. So, to be sure, we do a list command. -+# -+gdb_test "list main" \ -+ ".*main \\(argc, argv, envp\\).*" \ -+ "use `list' to establish default source file" -+gdb_test "break $bp_location1" \ -+ "Breakpoint.*at.* file .*$srcfile, line $bp_location1\\." \ -+ "breakpoint line number" -+ -+# -+# test duplicate breakpoint -+# -+gdb_test "break $bp_location1" \ -+ "Note: breakpoint \[0-9\]+ also set at pc.*Breakpoint \[0-9\]+ at.* file .*$srcfile, line $bp_location1\\." \ -+ "breakpoint duplicate" -+ -+set bp_location2 [gdb_get_line_number "set breakpoint 2 here"] -+ -+# -+# test break at line number in file -+# -+gdb_test "break $srcfile:$bp_location2" \ -+ "Breakpoint.*at.* file .*$srcfile, line $bp_location2\\." \ -+ "breakpoint line number in file" -+ -+set bp_location3 [gdb_get_line_number "set breakpoint 3 here"] -+set bp_location4 [gdb_get_line_number "set breakpoint 4 here"] -+ -+# -+# Test putting a break at the start of a multi-line if conditional. -+# Verify the breakpoint was put at the start of the conditional. -+# -+gdb_test "break multi_line_if_conditional" \ -+ "Breakpoint.*at.* file .*$srcfile, line $bp_location3\\." \ -+ "breakpoint at start of multi line if conditional" -+ -+gdb_test "break multi_line_while_conditional" \ -+ "Breakpoint.*at.* file .*$srcfile, line $bp_location4\\." \ -+ "breakpoint at start of multi line while conditional" -+ -+set bp_location5 [gdb_get_line_number "set breakpoint 5 here"] -+set bp_location6 [gdb_get_line_number "set breakpoint 6 here"] -+ -+# -+# check to see what breakpoints are set -+# -+if [target_info exists gdb_stub] { -+ set main_line $bp_location5 -+} else { -+ set main_line $bp_location6 -+} -+ -+set proto "" -+ -+set bp_location7 [gdb_get_line_number "set breakpoint 7 here"] -+set bp_location8 [gdb_get_line_number "set breakpoint 8 here" $srcfile1] -+set bp_location9 [gdb_get_line_number "set breakpoint 9 here" $srcfile1] -+ -+# Test a pending breakpoint in PIE executable does not crash later GDB. -+gdb_breakpoint "non_existent_function" allow-pending -+ -+gdb_test "info break" \ -+ "Num\[ \]+Type\[ \]+Disp Enb Address\[ \]+What.* -+\[0-9\]+\[\t \]+breakpoint keep y.* in main at .*$srcfile:$main_line.* -+\[0-9\]+\[\t \]+breakpoint keep y.* in marker2 at .*$srcfile1:($bp_location8|$bp_location9).* -+\[0-9\]+\[\t \]+breakpoint keep y.* in factorial$proto at .*$srcfile:$bp_location7.* -+\[0-9\]+\[\t \]+breakpoint keep y.* in main at .*$srcfile:$bp_location1.* -+\[0-9\]+\[\t \]+breakpoint keep y.* in main at .*$srcfile:$bp_location1.* -+\[0-9\]+\[\t \]+breakpoint keep y.* in main at .*$srcfile:$bp_location2.* -+\[0-9\]+\[\t \]+breakpoint keep y.* in multi_line_if_conditional at .*$srcfile:$bp_location3.* -+\[0-9\]+\[\t \]+breakpoint keep y.* in multi_line_while_conditional at .*$srcfile:$bp_location4.* -+\[0-9\]+\[\t \]+breakpoint keep y.* *non_existent_function" \ -+ "breakpoint info" -+ -+# FIXME: The rest of this test doesn't work with anything that can't -+# handle arguments. -+# Huh? There doesn't *appear* to be anything that passes arguments -+# below. -+if [istarget "mips-idt-*"] then { -+ return -+} -+ -+# -+# run until the breakpoint at main is hit. For non-stubs-using targets. -+# -+if ![target_info exists use_gdb_stub] { -+ if [istarget "*-*-vxworks*"] then { -+ send_gdb "run vxmain \"2\"\n" -+ set timeout 120 -+ verbose "Timeout is now $timeout seconds" 2 -+ } else { -+ send_gdb "run\n" -+ } -+ gdb_expect { -+ -re "The program .* has been started already.*y or n. $" { -+ send_gdb "y\n" -+ exp_continue -+ } -+ -re "Starting program.*Breakpoint \[0-9\]+,.*main .*argc.*argv.* at .*$srcfile:$bp_location6.*$bp_location6\[\t \]+if .argc.* \{.*$gdb_prompt $"\ -+ { pass "run until function breakpoint" } -+ -re ".*$gdb_prompt $" { fail "run until function breakpoint" } -+ timeout { fail "run until function breakpoint (timeout)" } -+ } -+} else { -+ if ![target_info exists gdb_stub] { -+ gdb_test continue ".*Continuing\\..*Breakpoint \[0-9\]+, main \\(argc=.*, argv=.*, envp=.*\\) at .*$srcfile:$bp_location6.*$bp_location6\[\t \]+if .argc.*\{.*" "stub continue" -+ } -+} -+ -+# -+# run until the breakpoint at a line number -+# -+gdb_test continue "Continuing\\..*Breakpoint \[0-9\]+, main \\(argc=.*, argv=.*, envp=.*\\) at .*$srcfile:$bp_location1.*$bp_location1\[\t \]+printf.*factorial.*" \ -+ "run until breakpoint set at a line number" -+ -+# -+# Run until the breakpoint set in a function in a file -+# -+for {set i 6} {$i >= 1} {incr i -1} { -+ gdb_test continue "Continuing\\..*Breakpoint \[0-9\]+, factorial \\(value=$i\\) at .*$srcfile:$bp_location7.*$bp_location7\[\t \]+.*if .value > 1. \{.*" \ -+ "run until file:function($i) breakpoint" -+} -+ -+# -+# Run until the breakpoint set at a quoted function -+# -+gdb_test continue "Continuing\\..*Breakpoint \[0-9\]+, (0x\[0-9a-f\]+ in )?marker2 \\(a=43\\) at .*$srcfile1:($bp_location8|$bp_location9).*" \ -+ "run until quoted breakpoint" -+# -+# run until the file:function breakpoint at a line number in a file -+# -+gdb_test continue "Continuing\\..*Breakpoint \[0-9\]+, main \\(argc=.*, argv=.*, envp=.*\\) at .*$srcfile:$bp_location2.*$bp_location2\[\t \]+argc = \\(argc == 12345\\);.*" \ -+ "run until file:linenum breakpoint" -+ -+# Test break at offset +1 -+set bp_location10 [gdb_get_line_number "set breakpoint 10 here"] -+ -+gdb_test "break +1" \ -+ "Breakpoint.*at.* file .*$srcfile, line $bp_location10\\." \ -+ "breakpoint offset +1" -+ -+# Check to see if breakpoint is hit when stepped onto -+ -+gdb_test "step" \ -+ ".*Breakpoint \[0-9\]+, main \\(argc=.*, argv=.*, envp=.*\\) at .*$srcfile:$bp_location10.*$bp_location10\[\t \]+return argc;.*breakpoint 10 here.*" \ -+ "step onto breakpoint" -+ -+# -+# delete all breakpoints so we can start over, course this can be a test too -+# -+delete_breakpoints -+ -+# -+# test temporary breakpoint at function -+# -+ -+gdb_test "tbreak main" "reakpoint.*at.* file .*$srcfile, line.*" "Temporary breakpoint function" -+ -+# -+# test break at function in file -+# -+ -+gdb_test "tbreak $srcfile:factorial" "reakpoint.*at.* file .*$srcfile, line.*" \ -+ "Temporary breakpoint function in file" -+ -+# -+# test break at line number -+# -+send_gdb "tbreak $bp_location1\n" -+gdb_expect { -+ -re "reakpoint.*at.* file .*$srcfile, line $bp_location1.*$gdb_prompt $" { pass "Temporary breakpoint line number #1" } -+ -re ".*$gdb_prompt $" { pass "Temporary breakpoint line number #1" } -+ timeout { fail "breakpoint line number #1 (timeout)" } -+} -+ -+gdb_test "tbreak $bp_location6" "reakpoint.*at.* file .*$srcfile, line $bp_location6.*" "Temporary breakpoint line number #2" -+ -+# -+# test break at line number in file -+# -+send_gdb "tbreak $srcfile:$bp_location2\n" -+gdb_expect { -+ -re "reakpoint.*at.* file .*$srcfile, line $bp_location2.*$gdb_prompt $" { pass "Temporary breakpoint line number in file #1" } -+ -re ".*$gdb_prompt $" { pass "Temporary breakpoint line number in file #1" } -+ timeout { fail "Temporary breakpoint line number in file #1 (timeout)" } -+} -+ -+set bp_location11 [gdb_get_line_number "set breakpoint 11 here"] -+gdb_test "tbreak $srcfile:$bp_location11" "reakpoint.*at.* file .*$srcfile, line $bp_location11.*" "Temporary breakpoint line number in file #2" -+ -+# -+# check to see what breakpoints are set (temporary this time) -+# -+gdb_test "info break" "Num.*Type.*Disp Enb Address.*What.*\[\r\n\] -+\[0-9\]+\[\t \]+breakpoint del.*y.*in main at .*$srcfile:$main_line.*\[\r\n\] -+\[0-9\]+\[\t \]+breakpoint del.*y.*in factorial$proto at .*$srcfile:$bp_location7.*\[\r\n\] -+\[0-9\]+\[\t \]+breakpoint del.*y.*in main at .*$srcfile:$bp_location1.*\[\r\n\] -+\[0-9\]+\[\t \]+breakpoint del.*y.*in main at .*$srcfile:$bp_location6.*\[\r\n\] -+\[0-9\]+\[\t \]+breakpoint del.*y.*in main at .*$srcfile:$bp_location2.*\[\r\n\] -+\[0-9\]+\[\t \]+breakpoint del.*y.*in main at .*$srcfile:$bp_location11.*" \ -+ "Temporary breakpoint info" -+ -+ -+#*********** -+ -+# Verify that catchpoints for fork, vfork and exec don't trigger -+# inappropriately. (There are no calls to those system functions -+# in this test program.) -+# -+if ![runto_main] then { fail "break tests suppressed" } -+ -+send_gdb "catch\n" -+gdb_expect { -+ -re "Catch requires an event name.*$gdb_prompt $"\ -+ {pass "catch requires an event name"} -+ -re "$gdb_prompt $"\ -+ {fail "catch requires an event name"} -+ timeout {fail "(timeout) catch requires an event name"} -+} -+ -+ -+set name "set catch fork, never expected to trigger" -+send_gdb "catch fork\n" -+gdb_expect { -+ -re "Catchpoint \[0-9\]* .fork..*$gdb_prompt $" -+ {pass $name} -+ -re "Catch of fork not yet implemented.*$gdb_prompt $" -+ {pass $name} -+ -re "$gdb_prompt $" -+ {fail $name} -+ timeout {fail "(timeout) $name"} -+} -+ -+ -+set name "set catch vfork, never expected to trigger" -+send_gdb "catch vfork\n" -+ -+# If we are on HP-UX 10.20, we expect an error message to be -+# printed if we type "catch vfork" at the gdb gdb_prompt. This is -+# because on HP-UX 10.20, we cannot catch vfork events. -+ -+if [istarget "hppa*-hp-hpux10.20"] then { -+ gdb_expect { -+ -re "Catch of vfork events not supported on HP-UX 10.20..*$gdb_prompt $" -+ {pass $name} -+ -re "$gdb_prompt $" -+ {fail $name} -+ timeout {fail "(timeout) $name"} -+ } -+} else { -+ gdb_expect { -+ -re "Catchpoint \[0-9\]* .vfork..*$gdb_prompt $" -+ {pass $name} -+ -re "Catch of vfork not yet implemented.*$gdb_prompt $" -+ {pass $name} -+ -re "$gdb_prompt $" -+ {fail $name} -+ timeout {fail "(timeout) $name"} -+ } -+} -+ -+set name "set catch exec, never expected to trigger" -+send_gdb "catch exec\n" -+gdb_expect { -+ -re "Catchpoint \[0-9\]* .exec..*$gdb_prompt $" -+ {pass $name} -+ -re "Catch of exec not yet implemented.*$gdb_prompt $" -+ {pass $name} -+ -re "$gdb_prompt $" {fail $name} -+ timeout {fail "(timeout) $name"} -+} -+ -+# Verify that GDB responds gracefully when asked to set a breakpoint -+# on a nonexistent source line. -+# -+gdb_test_no_output "set breakpoint pending off" -+gdb_test "break 999" \ -+ "No line 999 in the current file." \ -+ "break on non-existent source line" -+ -+# Run to the desired default location. If not positioned here, the -+# tests below don't work. -+# -+gdb_test "until $bp_location1" "main .* at .*:$bp_location1.*" "until bp_location1" -+ -+ -+# Verify that GDB allows one to just say "break", which is treated -+# as the "default" breakpoint. Note that GDB gets cute when printing -+# the informational message about other breakpoints at the same -+# location. We'll hit that bird with this stone too. -+# -+send_gdb "break\n" -+gdb_expect { -+ -re "Breakpoint \[0-9\]*.*$gdb_prompt $"\ -+ {pass "break on default location, 1st time"} -+ -re "$gdb_prompt $"\ -+ {fail "break on default location, 1st time"} -+ timeout {fail "(timeout) break on default location, 1st time"} -+} -+ -+send_gdb "break\n" -+gdb_expect { -+ -re "Note: breakpoint \[0-9\]* also set at .*Breakpoint \[0-9\]*.*$gdb_prompt $"\ -+ {pass "break on default location, 2nd time"} -+ -re "$gdb_prompt $"\ -+ {fail "break on default location, 2nd time"} -+ timeout {fail "(timeout) break on default location, 2nd time"} -+} -+ -+send_gdb "break\n" -+gdb_expect { -+ -re "Note: breakpoints \[0-9\]* and \[0-9\]* also set at .*Breakpoint \[0-9\]*.*$gdb_prompt $"\ -+ {pass "break on default location, 3rd time"} -+ -re "$gdb_prompt $"\ -+ {fail "break on default location, 3rd time"} -+ timeout {fail "(timeout) break on default location, 3rd time"} -+} -+ -+send_gdb "break\n" -+gdb_expect { -+ -re "Note: breakpoints \[0-9\]*, \[0-9\]* and \[0-9\]* also set at .*Breakpoint \[0-9\]*.*$gdb_prompt $"\ -+ {pass "break on default location, 4th time"} -+ -re "$gdb_prompt $"\ -+ {fail "break on default location, 4th time"} -+ timeout {fail "(timeout) break on default location, 4th time"} -+} -+ -+# Verify that a "silent" breakpoint can be set, and that GDB is indeed -+# "silent" about its triggering. -+# -+if ![runto_main] then { fail "break tests suppressed" } -+ -+send_gdb "break $bp_location1\n" -+gdb_expect { -+ -re "Breakpoint (\[0-9\]*) at .*, line $bp_location1.*$gdb_prompt $"\ -+ {pass "set to-be-silent break bp_location1"} -+ -re "$gdb_prompt $"\ -+ {fail "set to-be-silent break bp_location1"} -+ timeout {fail "(timeout) set to-be-silent break bp_location1"} -+} -+ -+send_gdb "commands $expect_out(1,string)\n" -+send_gdb "silent\n" -+send_gdb "end\n" -+gdb_expect { -+ -re ".*$gdb_prompt $"\ -+ {pass "set silent break bp_location1"} -+ timeout {fail "(timeout) set silent break bp_location1"} -+} -+ -+send_gdb "info break $expect_out(1,string)\n" -+gdb_expect { -+ -re "\[0-9\]*\[ \t\]*breakpoint.*:$bp_location1\r\n\[ \t\]*silent.*$gdb_prompt $"\ -+ {pass "info silent break bp_location1"} -+ -re "$gdb_prompt $"\ -+ {fail "info silent break bp_location1"} -+ timeout {fail "(timeout) info silent break bp_location1"} -+} -+send_gdb "continue\n" -+gdb_expect { -+ -re "Continuing.\r\n$gdb_prompt $"\ -+ {pass "hit silent break bp_location1"} -+ -re "$gdb_prompt $"\ -+ {fail "hit silent break bp_location1"} -+ timeout {fail "(timeout) hit silent break bp_location1"} -+} -+send_gdb "bt\n" -+gdb_expect { -+ -re "#0 main .* at .*:$bp_location1.*$gdb_prompt $"\ -+ {pass "stopped for silent break bp_location1"} -+ -re "$gdb_prompt $"\ -+ {fail "stopped for silent break bp_location1"} -+ timeout {fail "(timeout) stopped for silent break bp_location1"} -+} -+ -+# Verify that GDB can at least parse a breakpoint with the -+# "thread" keyword. (We won't attempt to test here that a -+# thread-specific breakpoint really triggers appropriately. -+# The gdb.threads subdirectory contains tests for that.) -+# -+set bp_location12 [gdb_get_line_number "set breakpoint 12 here"] -+send_gdb "break $bp_location12 thread 999\n" -+gdb_expect { -+ -re "Unknown thread 999.*$gdb_prompt $"\ -+ {pass "thread-specific breakpoint on non-existent thread disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "thread-specific breakpoint on non-existent thread disallowed"} -+ timeout {fail "(timeout) thread-specific breakpoint on non-existent thread disallowed"} -+} -+ -+gdb_test "break $bp_location12 thread foo" \ -+ "Invalid thread ID: foo" \ -+ "thread-specific breakpoint on bogus thread ID disallowed" -+ -+# Verify that GDB responds gracefully to a breakpoint command with -+# trailing garbage. -+# -+send_gdb "break $bp_location12 foo\n" -+gdb_expect { -+ -re "malformed linespec error: unexpected string, \"foo\"\r\n$gdb_prompt $"\ -+ {pass "breakpoint with trailing garbage disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "breakpoint with trailing garbage disallowed"} -+ timeout {fail "(timeout) breakpoint with trailing garbage disallowed"} -+} -+ -+# Verify that GDB responds gracefully to a "clear" command that has -+# no matching breakpoint. (First, get us off the current source line, -+# which we know has a breakpoint.) -+# -+send_gdb "next\n" -+gdb_expect { -+ -re ".*$gdb_prompt $"\ -+ {pass "step over breakpoint"} -+ timeout {fail "(timeout) step over breakpoint"} -+} -+send_gdb "clear 81\n" -+gdb_expect { -+ -re "No breakpoint at 81..*$gdb_prompt $"\ -+ {pass "clear line has no breakpoint disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "clear line has no breakpoint disallowed"} -+ timeout {fail "(timeout) clear line has no breakpoint disallowed"} -+} -+send_gdb "clear\n" -+gdb_expect { -+ -re "No breakpoint at this line..*$gdb_prompt $"\ -+ {pass "clear current line has no breakpoint disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "clear current line has no breakpoint disallowed"} -+ timeout {fail "(timeout) clear current line has no breakpoint disallowed"} -+} -+ -+# Verify that we can set and clear multiple breakpoints. -+# -+# We don't test that it deletes the correct breakpoints. We do at -+# least test that it deletes more than one breakpoint. -+# -+gdb_test "break marker3" "Breakpoint.*at.*" "break marker3 #1" -+gdb_test "break marker3" "Breakpoint.*at.*" "break marker3 #2" -+gdb_test "clear marker3" {Deleted breakpoints [0-9]+ [0-9]+.*} -+ -+# Verify that a breakpoint can be set via a convenience variable. -+# -+send_gdb "set \$foo=$bp_location11\n" -+gdb_expect { -+ -re "$gdb_prompt $"\ -+ {pass "set convenience variable \$foo to bp_location11"} -+ timeout {fail "(timeout) set convenience variable \$foo to bp_location11"} -+} -+send_gdb "break \$foo\n" -+gdb_expect { -+ -re "Breakpoint (\[0-9\]*) at .*, line $bp_location11.*$gdb_prompt $"\ -+ {pass "set breakpoint via convenience variable"} -+ -re "$gdb_prompt $"\ -+ {fail "set breakpoint via convenience variable"} -+ timeout {fail "(timeout) set breakpoint via convenience variable"} -+} -+ -+# Verify that GDB responds gracefully to an attempt to set a -+# breakpoint via a convenience variable whose type is not integer. -+# -+send_gdb "set \$foo=81.5\n" -+gdb_expect { -+ -re "$gdb_prompt $"\ -+ {pass "set convenience variable \$foo to 81.5"} -+ timeout {fail "(timeout) set convenience variable \$foo to 81.5"} -+} -+send_gdb "break \$foo\n" -+gdb_expect { -+ -re "Convenience variables used in line specs must have integer values..*$gdb_prompt $"\ -+ {pass "set breakpoint via non-integer convenience variable disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "set breakpoint via non-integer convenience variable disallowed"} -+ timeout {fail "(timeout) set breakpoint via non-integer convenience variable disallowed"} -+} -+ -+# Verify that we can set and trigger a breakpoint in a user-called function. -+# -+send_gdb "break marker2\n" -+gdb_expect { -+ -re "Breakpoint (\[0-9\]*) at .*, line ($bp_location8|$bp_location9).*$gdb_prompt $"\ -+ {pass "set breakpoint on to-be-called function"} -+ -re "$gdb_prompt $"\ -+ {fail "set breakpoint on to-be-called function"} -+ timeout {fail "(timeout) set breakpoint on to-be-called function"} -+} -+send_gdb "print marker2(99)\n" -+gdb_expect { -+ -re "The program being debugged stopped while in a function called from GDB.\r\nEvaluation of the expression containing the function\r\n.marker2$proto. will be abandoned.\r\nWhen the function is done executing, GDB will silently stop.\r\n$gdb_prompt $"\ -+ {pass "hit breakpoint on called function"} -+ -re "$gdb_prompt $"\ -+ {fail "hit breakpoint on called function"} -+ timeout {fail "(timeout) hit breakpoint on called function"} -+} -+ -+# As long as we're stopped (breakpointed) in a called function, -+# verify that we can successfully backtrace & such from here. -+# -+# In this and the following test, the _sr4export check apparently is needed -+# for hppa*-*-hpux. -+# -+send_gdb "bt\n" -+gdb_expect { -+ -re "#0\[ \t\]*($hex in )?marker2.*:($bp_location8|$bp_location9)\r\n#1.*_sr4export.*$gdb_prompt $"\ -+ {pass "backtrace while in called function"} -+ -re "#0\[ \t\]*($hex in )?marker2.*:($bp_location8|$bp_location9)\r\n#1.*function called from gdb.*$gdb_prompt $"\ -+ {pass "backtrace while in called function"} -+ -re "$gdb_prompt $"\ -+ {fail "backtrace while in called function"} -+ timeout {fail "(timeout) backtrace while in called function"} -+} -+ -+# Return from the called function. For remote targets, it's important to do -+# this before runto_main, which otherwise may silently stop on the dummy -+# breakpoint inserted by GDB at the program's entry point. -+# -+send_gdb "finish\n" -+gdb_expect { -+ -re "Run till exit from .*marker2.* at .*($bp_location8|$bp_location9)\r\n.* in _sr4export.*$gdb_prompt $"\ -+ {pass "finish from called function"} -+ -re "Run till exit from .*marker2.* at .*($bp_location8|$bp_location9)\r\n.*function called from gdb.*$gdb_prompt $"\ -+ {pass "finish from called function"} -+ -re "Run till exit from .*marker2.* at .*($bp_location8|$bp_location9)\r\n.*Value returned.*$gdb_prompt $"\ -+ {pass "finish from called function"} -+ -re "$gdb_prompt $"\ -+ {fail "finish from called function"} -+ timeout {fail "(timeout) finish from called function"} -+} -+ -+# Verify that GDB responds gracefully to a "finish" command with -+# arguments. -+# -+if ![runto_main] then { fail "break tests suppressed" } -+ -+send_gdb "finish 123\n" -+gdb_expect { -+ -re "The \"finish\" command does not take any arguments.\r\n$gdb_prompt $"\ -+ {pass "finish with arguments disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "finish with arguments disallowed"} -+ timeout {fail "(timeout) finish with arguments disallowed"} -+} -+ -+# Verify that GDB responds gracefully to a request to "finish" from -+# the outermost frame. On a stub that never exits, this will just -+# run to the stubs routine, so we don't get this error... Thus the -+# second condition. -+# -+ -+send_gdb "finish\n" -+gdb_expect { -+ -re "\"finish\" not meaningful in the outermost frame.\r\n$gdb_prompt $"\ -+ {pass "finish from outermost frame disallowed"} -+ -re "Run till exit from.*\r\n$gdb_prompt $" { -+ pass "finish from outermost frame disallowed" -+ } -+ -re "$gdb_prompt $"\ -+ {fail "finish from outermost frame disallowed"} -+ timeout {fail "(timeout) finish from outermost frame disallowed"} -+} -+ -+# Verify that we can explicitly ask GDB to stop on all shared library -+# events, and that it does so. -+# -+if [istarget "hppa*-*-hpux*"] then { -+ if ![runto_main] then { fail "break tests suppressed" } -+ -+ send_gdb "set stop-on-solib-events 1\n" -+ gdb_expect { -+ -re "$gdb_prompt $"\ -+ {pass "set stop-on-solib-events"} -+ timeout {fail "(timeout) set stop-on-solib-events"} -+ } -+ -+ send_gdb "run\n" -+ gdb_expect { -+ -re ".*Start it from the beginning.*y or n. $"\ -+ {send_gdb "y\n" -+ gdb_expect { -+ -re ".*Stopped due to shared library event.*$gdb_prompt $"\ -+ {pass "triggered stop-on-solib-events"} -+ -re "$gdb_prompt $"\ -+ {fail "triggered stop-on-solib-events"} -+ timeout {fail "(timeout) triggered stop-on-solib-events"} -+ } -+ } -+ -re "$gdb_prompt $"\ -+ {fail "rerun for stop-on-solib-events"} -+ timeout {fail "(timeout) rerun for stop-on-solib-events"} -+ } -+ -+ send_gdb "set stop-on-solib-events 0\n" -+ gdb_expect { -+ -re "$gdb_prompt $"\ -+ {pass "reset stop-on-solib-events"} -+ timeout {fail "(timeout) reset stop-on-solib-events"} -+ } -+} -+ -+# Hardware breakpoints are unsupported on HP-UX. Verify that GDB -+# gracefully responds to requests to create them. -+# -+if [istarget "hppa*-*-hpux*"] then { -+ if ![runto_main] then { fail "break tests suppressed" } -+ -+ send_gdb "hbreak\n" -+ gdb_expect { -+ -re "No hardware breakpoint support in the target.*$gdb_prompt $"\ -+ {pass "hw breaks disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "hw breaks disallowed"} -+ timeout {fail "(timeout) hw breaks disallowed"} -+ } -+ -+ send_gdb "thbreak\n" -+ gdb_expect { -+ -re "No hardware breakpoint support in the target.*$gdb_prompt $"\ -+ {pass "temporary hw breaks disallowed"} -+ -re "$gdb_prompt $"\ -+ {fail "temporary hw breaks disallowed"} -+ timeout {fail "(timeout) temporary hw breaks disallowed"} -+ } -+} -+ -+#******** -+ -+ -+# -+# Test "next" over recursive function call. -+# -+ -+proc test_next_with_recursion {} { -+ global gdb_prompt -+ global decimal -+ global binfile -+ -+ if [target_info exists use_gdb_stub] { -+ # Reload the program. -+ delete_breakpoints -+ gdb_load ${binfile}; -+ } else { -+ # FIXME: should be using runto -+ gdb_test "kill" "" "kill program" "Kill the program being debugged.*y or n. $" "y" -+ -+ delete_breakpoints -+ } -+ -+ gdb_test "break factorial" "Breakpoint $decimal at .*" "break at factorial" -+ -+ # Run until we call factorial with 6 -+ -+ if [istarget "*-*-vxworks*"] then { -+ send_gdb "run vxmain \"6\"\n" -+ } else { -+ gdb_run_cmd -+ } -+ gdb_expect { -+ -re "Break.* factorial .value=6. .*$gdb_prompt $" {} -+ -re ".*$gdb_prompt $" { -+ fail "run to factorial(6)"; -+ gdb_suppress_tests; -+ } -+ timeout { fail "run to factorial(6) (timeout)" ; gdb_suppress_tests } -+ } -+ -+ # Continue until we call factorial recursively with 5. -+ -+ if [gdb_test "continue" \ -+ "Continuing.*Break.* factorial .value=5. .*" \ -+ "continue to factorial(5)"] then { gdb_suppress_tests } -+ -+ # Do a backtrace just to confirm how many levels deep we are. -+ -+ if [gdb_test "backtrace" \ -+ "#0\[ \t\]+ factorial .value=5..*" \ -+ "backtrace from factorial(5)"] then { gdb_suppress_tests } -+ -+ # Now a "next" should position us at the recursive call, which -+ # we will be performing with 4. -+ -+ if [gdb_test "next" \ -+ ".* factorial .value - 1.;.*" \ -+ "next to recursive call"] then { gdb_suppress_tests } -+ -+ # Disable the breakpoint at the entry to factorial by deleting them all. -+ # The "next" should run until we return to the next line from this -+ # recursive call to factorial with 4. -+ # Buggy versions of gdb will stop instead at the innermost frame on -+ # the line where we are trying to "next" to. -+ -+ delete_breakpoints -+ -+ if [istarget "mips*tx39-*"] { -+ set timeout 60 -+ } -+ # We used to set timeout here for all other targets as well. This -+ # is almost certainly wrong. The proper timeout depends on the -+ # target system in use, and how we communicate with it, so there -+ # is no single value appropriate for all targets. The timeout -+ # should be established by the Dejagnu config file(s) for the -+ # board, and respected by the test suite. -+ # -+ # For example, if I'm running GDB over an SSH tunnel talking to a -+ # portmaster in California talking to an ancient 68k board running -+ # a crummy ROM monitor (a situation I can only wish were -+ # hypothetical), then I need a large timeout. But that's not the -+ # kind of knowledge that belongs in this file. -+ -+ gdb_test next "\[0-9\]*\[\t \]+return \\(value\\);.*" \ -+ "next over recursive call" -+ -+ # OK, we should be back in the same stack frame we started from. -+ # Do a backtrace just to confirm. -+ -+ set result [gdb_test "backtrace" \ -+ "#0\[ \t\]+ factorial .value=120.*\r\n#1\[ \t\]+ \[0-9a-fx\]+ in factorial .value=6..*" \ -+ "backtrace from factorial(5.1)"] -+ if { $result != 0 } { gdb_suppress_tests } -+ -+ if [target_info exists gdb,noresults] { gdb_suppress_tests } -+ gdb_continue_to_end "recursive next test" -+ gdb_stop_suppressing_tests; -+} -+ -+test_next_with_recursion -+ -+ -+#******** -+ -+# build a new file with optimization enabled so that we can try breakpoints -+# on targets with optimized prologues -+ -+set binfileo2 [standard_output_file ${testfile}o2] -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}O0.o" object {debug "additional_flags=-w -O2 -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile1}" "${binfile}O1.o" object {debug "additional_flags=-w -O2 -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+if { [gdb_compile "${binfile}O0.o ${binfile}O1.o" "${binfileo2}" executable {debug "additional_flags=-w -fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+if [get_compiler_info ${binfileo2}] { -+ return -1 -+} -+ -+gdb_exit -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfileo2} -+ -+if [target_info exists gdb_stub] { -+ gdb_step_for_stub; -+} -+ -+# -+# test break at function -+# -+gdb_test "break main" \ -+ "Breakpoint.*at.* file .*$srcfile, line.*" \ -+ "breakpoint function, optimized file" -+ -+# -+# test break at function -+# -+gdb_test "break marker4" \ -+ "Breakpoint.*at.* file .*$srcfile1, line.*" \ -+ "breakpoint small function, optimized file" -+ -+# -+# run until the breakpoint at main is hit. For non-stubs-using targets. -+# -+if ![target_info exists use_gdb_stub] { -+ if [istarget "*-*-vxworks*"] then { -+ send_gdb "run vxmain \"2\"\n" -+ set timeout 120 -+ verbose "Timeout is now $timeout seconds" 2 -+ } else { -+ send_gdb "run\n" -+ } -+ gdb_expect { -+ -re "The program .* has been started already.*y or n. $" { -+ send_gdb "y\n" -+ exp_continue -+ } -+ -re "Starting program.*Breakpoint \[0-9\]+,.*main .*argc.*argv.* at .*$srcfile:$bp_location6.*$bp_location6\[\t \]+if .argc.* \{.*$gdb_prompt $"\ -+ { pass "run until function breakpoint, optimized file" } -+ -re "Starting program.*Breakpoint \[0-9\]+,.*main .*argc.*argv.* at .*$gdb_prompt $"\ -+ { pass "run until function breakpoint, optimized file (code motion)" } -+ -re ".*$gdb_prompt $" { fail "run until function breakpoint, optimized file" } -+ timeout { fail "run until function breakpoint, optimized file (timeout)" } -+ } -+} else { -+ if ![target_info exists gdb_stub] { -+ gdb_test continue ".*Continuing\\..*Breakpoint \[0-9\]+, main \\(argc=.*, argv=.*, envp=.*\\) at .*$srcfile:$bp_location6.*$bp_location6\[\t \]+if .argc.*\{.*" "stub continue, optimized file" -+ } -+} -+ -+# -+# run until the breakpoint at a small function -+# -+ -+# -+# Add a second pass pattern. The behavior differs here between stabs -+# and dwarf for one-line functions. Stabs preserves two line symbols -+# (one before the prologue and one after) with the same line number, -+# but dwarf regards these as duplicates and discards one of them. -+# Therefore the address after the prologue (where the breakpoint is) -+# has no exactly matching line symbol, and GDB reports the breakpoint -+# as if it were in the middle of a line rather than at the beginning. -+ -+set bp_location13 [gdb_get_line_number "set breakpoint 13 here" $srcfile1] -+set bp_location14 [gdb_get_line_number "set breakpoint 14 here" $srcfile1] -+send_gdb "continue\n" -+gdb_expect { -+ -re "Breakpoint $decimal, marker4 \\(d=177601976\\) at .*$srcfile1:$bp_location13\[\r\n\]+$bp_location13\[\t \]+void marker4.*" { -+ pass "run until breakpoint set at small function, optimized file" -+ } -+ -re "Breakpoint $decimal, $hex in marker4 \\(d=177601976\\) at .*$srcfile1:$bp_location13\[\r\n\]+$bp_location13\[\t \]+void marker4.*" { -+ pass "run until breakpoint set at small function, optimized file" -+ } -+ -re "Breakpoint $decimal, marker4 \\(d=177601976\\) at .*$srcfile1:$bp_location14\[\r\n\]+$bp_location14\[\t \]+void marker4.*" { -+ # marker4() is defined at line 46 when compiled with -DPROTOTYPES -+ pass "run until breakpoint set at small function, optimized file (line bp_location14)" -+ } -+ -re ".*$gdb_prompt " { -+ fail "run until breakpoint set at small function, optimized file" -+ } -+ timeout { -+ fail "run until breakpoint set at small function, optimized file (timeout)" -+ } -+} -+ -+ -+# Reset the default arguments for VxWorks -+if [istarget "*-*-vxworks*"] { -+ set timeout 10 -+ verbose "Timeout is now $timeout seconds" 2 -+ send_gdb "set args main\n" -+ gdb_expect -re ".*$gdb_prompt $" {} -+} -diff --git a/gdb/testsuite/gdb.pie/break1.c b/gdb/testsuite/gdb.pie/break1.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/break1.c -@@ -0,0 +1,44 @@ -+/* This testcase is part of GDB, the GNU debugger. -+ -+ Copyright 1992, 1993, 1994, 1995, 1999, 2002, 2003 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. -+ -+ Please email any bugs, comments, and/or additions to this file to: -+ bug-gdb@prep.ai.mit.edu */ -+ -+/* The code for this file was extracted from the gdb testsuite -+ testcase "break.c". */ -+ -+/* The following functions do nothing useful. They are included -+ simply as places to try setting breakpoints at. They are -+ explicitly "one-line functions" to verify that this case works -+ (some versions of gcc have or have had problems with this). -+ -+ These functions are in a separate source file to prevent an -+ optimizing compiler from inlining them and optimizing them away. */ -+ -+#ifdef PROTOTYPES -+int marker1 (void) { return (0); } /* set breakpoint 15 here */ -+int marker2 (int a) { return (1); } /* set breakpoint 8 here */ -+void marker3 (char *a, char *b) {} /* set breakpoint 17 here */ -+void marker4 (long d) {} /* set breakpoint 14 here */ -+#else -+int marker1 () { return (0); } /* set breakpoint 16 here */ -+int marker2 (a) int a; { return (1); } /* set breakpoint 9 here */ -+void marker3 (a, b) char *a, *b; {} /* set breakpoint 18 here */ -+void marker4 (d) long d; {} /* set breakpoint 13 here */ -+#endif -diff --git a/gdb/testsuite/gdb.pie/corefile.exp b/gdb/testsuite/gdb.pie/corefile.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/corefile.exp -@@ -0,0 +1,233 @@ -+# Copyright 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 -+# 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 Fred Fish. (fnf@cygnus.com) -+ -+# are we on a target board -+if ![isnative] then { -+ return -+} -+ -+set testfile "coremaker" -+set srcfile ${testfile}.c -+set binfile [standard_output_file ${testfile}] -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug "additional_flags=-fpie -pie"}] != "" } { -+ gdb_suppress_entire_file "Testcase compile failed, so all tests in this file will automatically fail." -+} -+ -+# Create and source the file that provides information about the compiler -+# used to compile the test case. -+if [get_compiler_info ${binfile}] { -+ return -1; -+} -+ -+# Create a core file named "corefile" rather than just "core", to -+# avoid problems with sys admin types that like to regularly prune all -+# files named "core" from the system. -+# -+# Arbitrarily try setting the core size limit to "unlimited" since -+# this does not hurt on systems where the command does not work and -+# allows us to generate a core on systems where it does. -+# -+# Some systems append "core" to the name of the program; others append -+# the name of the program to "core"; still others (like Linux, as of -+# May 2003) create cores named "core.PID". In the latter case, we -+# could have many core files lying around, and it may be difficult to -+# tell which one is ours, so let's run the program in a subdirectory. -+set found 0 -+set coredir [standard_output_file coredir.[getpid]] -+file mkdir $coredir -+catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile}; true) >/dev/null 2>&1\"" -+# remote_exec host "${binfile}" -+foreach i "${coredir}/core ${coredir}/core.coremaker.c ${binfile}.core" { -+ if [remote_file build exists $i] { -+ remote_exec build "mv $i [standard_output_file corefile]" -+ set found 1 -+ } -+} -+# Check for "core.PID". -+if { $found == 0 } { -+ set names [glob -nocomplain -directory $coredir core.*] -+ if {[llength $names] == 1} { -+ set corefile [file join $coredir [lindex $names 0]] -+ remote_exec build "mv $corefile [standard_output_file corefile]" -+ set found 1 -+ } -+} -+if { $found == 0 } { -+ # The braindamaged HPUX shell quits after the ulimit -c above -+ # without executing ${binfile}. So we try again without the -+ # ulimit here if we didn't find a core file above. -+ # Oh, I should mention that any "braindamaged" non-Unix system has -+ # the same problem. I like the cd bit too, it's really neat'n stuff. -+ catch "system \"(cd [file dirname [standard_output_file ${binfile}]]; ${binfile}; true) >/dev/null 2>&1\"" -+ foreach i "[standard_output_file core] [standard_output_file core.coremaker.c] ${binfile}.core" { -+ if [remote_file build exists $i] { -+ remote_exec build "mv $i [standard_output_file corefile]" -+ set found 1 -+ } -+ } -+} -+ -+# Try to clean up after ourselves. -+remote_file build delete [file join $coredir coremmap.data] -+remote_exec build "rmdir $coredir" -+ -+if { $found == 0 } { -+ warning "can't generate a core file - core tests suppressed - check ulimit -c" -+ return 0 -+} -+ -+# -+# Test that we can simply startup with a "-core=corefile" command line arg -+# and recognize that the core file is a valid, usable core file. -+# To do this, we must shutdown the currently running gdb and restart -+# with the -core args. We can't use gdb_start because it looks for -+# the first gdb prompt, and the message we are looking for occurs -+# before the first prompt. Also, we can't include GDBFLAGS because -+# if it is empty, this confuses gdb with an empty argument that it -+# grumbles about (said grumbling currently being ignored in gdb_start). -+# **FIXME** -+# -+# Another problem is that on some systems (solaris for example), there -+# is apparently a limit on the length of a fully specified path to -+# the coremaker executable, at about 80 chars. For this case, consider -+# it a pass, but note that the program name is bad. -+ -+gdb_exit -+if $verbose>1 then { -+ send_user "Spawning $GDB -nw $GDBFLAGS -core=[standard_output_file corefile]\n" -+} -+ -+set oldtimeout $timeout -+set timeout [expr "$timeout + 60"] -+verbose "Timeout is now $timeout seconds" 2 -+eval "spawn $GDB -nw $GDBFLAGS -core=[standard_output_file corefile]" -+expect { -+ -re "Couldn't find .* registers in core file.*$gdb_prompt $" { -+ fail "args: -core=corefile (couldn't find regs)" -+ } -+ -re "Core was generated by .*coremaker.*\r\n\#0 .*\(\).*\r\n$gdb_prompt $" { -+ pass "args: -core=corefile" -+ } -+ -re "Core was generated by .*\r\n\#0 .*\(\).*\r\n$gdb_prompt $" { -+ pass "args: -core=corefile (with bad program name)" -+ } -+ -re ".*registers from core file: File in wrong format.* $" { -+ fail "args: -core=corefile (could not read registers from core file)" -+ } -+ -re ".*$gdb_prompt $" { fail "args: -core=corefile" } -+ timeout { fail "(timeout) starting with -core" } -+} -+ -+ -+# -+# Test that startup with both an executable file and -core argument. -+# See previous comments above, they are still applicable. -+# -+ -+close; -+ -+if $verbose>1 then { -+ send_user "Spawning $GDB -nw $GDBFLAGS $binfile -core=[standard_output_file corefile]\n" -+} -+ -+ -+eval "spawn $GDB -nw $GDBFLAGS $binfile -core=[standard_output_file corefile]"; -+expect { -+ -re "Core was generated by .*coremaker.*\r\n\#0 .*\(\).*\r\n$gdb_prompt $" { -+ pass "args: execfile -core=corefile" -+ } -+ -re "Core was generated by .*\r\n\#0 .*\(\).*\r\n$gdb_prompt $" { -+ pass "args: execfile -core=corefile (with bad program name)" -+ } -+ -re ".*registers from core file: File in wrong format.* $" { -+ fail "args: execfile -core=corefile (could not read registers from core file)" -+ } -+ -re ".*$gdb_prompt $" { fail "args: execfile -core=corefile" } -+ timeout { fail "(timeout) starting with -core" } -+} -+set timeout $oldtimeout -+verbose "Timeout is now $timeout seconds" 2 -+ -+close; -+ -+# Now restart normally. -+ -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfile} -+ -+# Test basic corefile recognition via core-file command. -+ -+send_gdb "core-file [standard_output_file corefile]\n" -+gdb_expect { -+ -re ".* program is being debugged already.*y or n. $" { -+ # gdb_load may connect us to a gdbserver. -+ send_gdb "y\n" -+ exp_continue; -+ } -+ -re "Core was generated by .*coremaker.*\r\n\#0 .*\(\).*\r\n$gdb_prompt $" { -+ pass "core-file command" -+ } -+ -re "Core was generated by .*\r\n\#0 .*\(\).*\r\n$gdb_prompt $" { -+ pass "core-file command (with bad program name)" -+ } -+ -re ".*registers from core file: File in wrong format.* $" { -+ fail "core-file command (could not read registers from core file)" -+ } -+ -re ".*$gdb_prompt $" { fail "core-file command" } -+ timeout { fail "(timeout) core-file command" } -+} -+ -+# Test correct mapping of corefile sections by printing some variables. -+ -+gdb_test "print coremaker_data" "\\\$$decimal = 202" -+gdb_test "print coremaker_bss" "\\\$$decimal = 10" -+gdb_test "print coremaker_ro" "\\\$$decimal = 201" -+ -+gdb_test "print func2::coremaker_local" "\\\$$decimal = \\{0, 1, 2, 3, 4\\}" -+ -+# Somehow we better test the ability to read the registers out of the core -+# file correctly. I don't think the other tests do this. -+ -+gdb_test "bt" "abort.*func2.*func1.*main.*" "backtrace in corefile.exp" -+gdb_test "up" "#\[0-9\]* *\[0-9xa-fH'\]* in .* \\(.*\\).*" "up in corefile.exp" -+ -+# Test ability to read mmap'd data -+ -+gdb_test "x/8bd buf1" ".*:.*0.*1.*2.*3.*4.*5.*6.*7" "accessing original mmap data in core file" -+setup_xfail "*-*-sunos*" "*-*-ultrix*" "*-*-aix*" -+set test "accessing mmapped data in core file" -+gdb_test_multiple "x/8bd buf2" "$test" { -+ -re ".*:.*0.*1.*2.*3.*4.*5.*6.*7.*$gdb_prompt $" { -+ pass "$test" -+ } -+ -re "0x\[f\]*:.*Cannot access memory at address 0x\[f\]*.*$gdb_prompt $" { -+ fail "$test (mapping failed at runtime)" -+ } -+ -re "0x.*:.*Cannot access memory at address 0x.*$gdb_prompt $" { -+ fail "$test (mapping address not found in core file)" -+ } -+} -+ -+# test reinit_frame_cache -+ -+gdb_load ${binfile} -+gdb_test "up" "#\[0-9\]* *\[0-9xa-fH'\]* in .* \\(.*\\).*" "up in corefile.exp (reinit)" -+ -+gdb_test "core" "No core file now." -diff --git a/gdb/testsuite/gdb.pie/coremaker.c b/gdb/testsuite/gdb.pie/coremaker.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pie/coremaker.c -@@ -0,0 +1,142 @@ -+/* Copyright 1992, 1993, 1994, 1995, 1996, 1999 -+ 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 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. */ -+ -+/* Simple little program that just generates a core dump from inside some -+ nested function calls. */ -+ -+#include -+#include -+#include -+#include -+#include -+#include -+#include -+ -+#ifndef __STDC__ -+#define const /**/ -+#endif -+ -+#define MAPSIZE (8 * 1024) -+ -+/* Don't make these automatic vars or we will have to walk back up the -+ stack to access them. */ -+ -+char *buf1; -+char *buf2; -+ -+int coremaker_data = 1; /* In Data section */ -+int coremaker_bss; /* In BSS section */ -+ -+const int coremaker_ro = 201; /* In Read-Only Data section */ -+ -+/* Note that if the mapping fails for any reason, we set buf2 -+ to -1 and the testsuite notices this and reports it as -+ a failure due to a mapping error. This way we don't have -+ to test for specific errors when running the core maker. */ -+ -+void -+mmapdata () -+{ -+ int j, fd; -+ -+ /* Allocate and initialize a buffer that will be used to write -+ the file that is later mapped in. */ -+ -+ buf1 = (char *) malloc (MAPSIZE); -+ for (j = 0; j < MAPSIZE; ++j) -+ { -+ buf1[j] = j; -+ } -+ -+ /* Write the file to map in */ -+ -+ fd = open ("coremmap.data", O_CREAT | O_RDWR, 0666); -+ if (fd == -1) -+ { -+ perror ("coremmap.data open failed"); -+ buf2 = (char *) -1; -+ return; -+ } -+ write (fd, buf1, MAPSIZE); -+ -+ /* Now map the file into our address space as buf2 */ -+ -+ buf2 = (char *) mmap (0, MAPSIZE, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0); -+ if (buf2 == (char *) -1) -+ { -+ perror ("mmap failed"); -+ return; -+ } -+ -+ /* Verify that the original data and the mapped data are identical. -+ If not, we'd rather fail now than when trying to access the mapped -+ data from the core file. */ -+ -+ for (j = 0; j < MAPSIZE; ++j) -+ { -+ if (buf1[j] != buf2[j]) -+ { -+ fprintf (stderr, "mapped data is incorrect"); -+ buf2 = (char *) -1; -+ return; -+ } -+ } -+} -+ -+void -+func2 () -+{ -+ int coremaker_local[5]; -+ int i; -+ -+#ifdef SA_FULLDUMP -+ /* Force a corefile that includes the data section for AIX. */ -+ { -+ struct sigaction sa; -+ -+ sigaction (SIGABRT, (struct sigaction *)0, &sa); -+ sa.sa_flags |= SA_FULLDUMP; -+ sigaction (SIGABRT, &sa, (struct sigaction *)0); -+ } -+#endif -+ -+ /* Make sure that coremaker_local doesn't get optimized away. */ -+ for (i = 0; i < 5; i++) -+ coremaker_local[i] = i; -+ coremaker_bss = 0; -+ for (i = 0; i < 5; i++) -+ coremaker_bss += coremaker_local[i]; -+ coremaker_data = coremaker_ro + 1; -+ abort (); -+} -+ -+void -+func1 () -+{ -+ func2 (); -+} -+ -+int main () -+{ -+ mmapdata (); -+ func1 (); -+ return 0; -+} -+ diff --git a/gdb-6.3-test-self-20050110.patch b/gdb-6.3-test-self-20050110.patch deleted file mode 100644 index 2709093..0000000 --- a/gdb-6.3-test-self-20050110.patch +++ /dev/null @@ -1,42 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Elena Zannoni -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-6.3-test-self-20050110.patch - -;; Get selftest working with sep-debug-info -;;=fedoratest - -2004-02-23 Elena Zannoni - - * gdb.gdb/selftest.exp: Make sure that the debug directory is - set up properly. - * gdb.gdb/complaints.exp: Ditto. - * gdb.gdb/xfullpath.exp: Ditto. - * gdb.gdb/observer.exp: Ditto. - -diff --git a/gdb/testsuite/lib/selftest-support.exp b/gdb/testsuite/lib/selftest-support.exp ---- a/gdb/testsuite/lib/selftest-support.exp -+++ b/gdb/testsuite/lib/selftest-support.exp -@@ -152,18 +152,18 @@ proc do_self_tests {function body} { - } - - # Remove any old copy lying around. -- remote_file host delete $xgdb -+ #remote_file host delete $xgdb - - gdb_start -- set file [remote_download host $GDB_FULLPATH $xgdb] -+ #set file [remote_download host $GDB_FULLPATH $xgdb] - -- set result [selftest_setup $file $function] -+ set result [selftest_setup $GDB_FULLPATH $function] - if {$result == 0} then { - set result [uplevel $body] - } - - gdb_exit -- catch "remote_file host delete $file" -+ #catch "remote_file host delete $file" - - if {$result < 0} then { - warning "Couldn't test self" diff --git a/gdb-6.5-bz218379-solib-trampoline-lookup-lock-fix.patch b/gdb-6.5-bz218379-solib-trampoline-lookup-lock-fix.patch deleted file mode 100644 index 54c1a1e..0000000 --- a/gdb-6.5-bz218379-solib-trampoline-lookup-lock-fix.patch +++ /dev/null @@ -1,27 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-6.5-bz218379-solib-trampoline-lookup-lock-fix.patch - -;; Fix lockup on trampoline vs. its function lookup; unreproducible (BZ 218379). -;;=fedora - -https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=218379 - -diff --git a/gdb/symtab.c b/gdb/symtab.c ---- a/gdb/symtab.c -+++ b/gdb/symtab.c -@@ -3169,6 +3169,13 @@ find_pc_sect_line (CORE_ADDR pc, struct obj_section *section, int notcurrent) - msymbol->linkage_name ()); */ - ; - /* fall through */ -+ /* `msymbol' trampoline may be located before its .text symbol -+ but this text symbol may be the address we were looking for. -+ Avoid `find_pc_sect_line'<->`find_pc_line' infinite loop. -+ Red Hat Bug 218379. */ -+ else if (BMSYMBOL_VALUE_ADDRESS (mfunsym) == pc) -+ warning ("In stub for %s (0x%s); interlocked, please submit the binary to http://bugzilla.redhat.com", msymbol.minsym->linkage_name (), paddress (target_gdbarch (), pc)); -+ /* fall through */ - else - { - /* Detect an obvious case of infinite recursion. If this diff --git a/gdb-6.6-buildid-locate-core-as-arg.patch b/gdb-6.6-buildid-locate-core-as-arg.patch deleted file mode 100644 index 45b915d..0000000 --- a/gdb-6.6-buildid-locate-core-as-arg.patch +++ /dev/null @@ -1,196 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-6.6-buildid-locate-core-as-arg.patch - -;;=push+jan - -http://sourceware.org/ml/gdb-patches/2010-01/msg00558.html - -[ Fixed up since the mail. ] - -On Thu, 21 Jan 2010 18:17:15 +0100, Doug Evans wrote: -> Not an exhaustive list, but if we go down the path of converting "gdb -> corefile" to "gdb -c corefile", then we also need to think about "file -> corefile" being converted to "core corefile" [or "target core -> corefile", "core" is apparently deprecated in favor of "target core"] -> and "target exec corefile" -> "target core corefile". Presumably -> "file corefile" (and "target exec corefile") would discard the -> currently selected executable. But maybe not. Will that be confusing -> for users? I don't know. - -While thinking about it overriding some GDB _commands_ was not my intention. - -There is a general assumption if I have a shell COMMAND and some FILE I can do -$ COMMAND FILE -and COMMAND will appropriately load the FILE. - -FSF GDB currently needs to specify also the executable file for core files -which already inhibits this intuitive expectation. OTOH with the build-id -locating patch which could allow such intuitive start notneeding the -executable file. Still it currently did not work due to the required "-c": -$ COMMAND -c COREFILE - -Entering "file", "core-file" or "attach" commands is already explicit enough -so that it IMO should do what the command name says without any -autodetections. The second command line argument -(captured_main->pid_or_core_arg) is also autodetected (for PID or CORE) but -neither "attach" accepts a core file nor "core-file" accepts a PID. - -The patch makes sense only with the build-id patchset so this is not submit -for FSF GDB inclusion yet. I am fine with your patch (+/- Hui Zhu's pending -bfd_check_format_matches) as the patch below is its natural extension. - -Sorry for the delay, -Jan - -2010-01-25 Jan Kratochvil - - * exceptions.h (enum errors ): New. - * exec.c: Include exceptions.h. - (exec_file_attach ): Call throw_error (IS_CORE_ERROR, ...). - * main.c (exec_or_core_file_attach): New. - (captured_main ): Set also corearg. - (captured_main ): New variable func. - Call exec_or_core_file_attach if COREARG matches EXECARG. Call - symbol_file_add_main only if CORE_BFD remained NULL. - -Http://sourceware.org/ml/gdb-patches/2010-01/msg00517.html -2010-01-20 Doug Evans - - * exec.c (exec_file_attach): Print a more useful error message if the - user did "gdb core". - -diff --git a/gdb/exec.c b/gdb/exec.c ---- a/gdb/exec.c -+++ b/gdb/exec.c -@@ -18,6 +18,8 @@ - along with this program. If not, see . */ - - #include "defs.h" -+#include "arch-utils.h" -+#include "exceptions.h" - #include "frame.h" - #include "inferior.h" - #include "target.h" -@@ -495,12 +497,27 @@ exec_file_attach (const char *filename, int from_tty) - - if (!bfd_check_format_matches (exec_bfd, bfd_object, &matching)) - { -+ int is_core; -+ -+ /* If the user accidentally did "gdb core", print a useful -+ error message. Check it only after bfd_object has been checked as -+ a valid executable may get recognized for example also as -+ "trad-core". */ -+ is_core = bfd_check_format (exec_bfd, bfd_core); -+ - /* Make sure to close exec_bfd, or else "run" might try to use - it. */ - exec_close (); -- error (_("\"%ps\": not in executable format: %s"), -- styled_string (file_name_style.style (), scratch_pathname), -- gdb_bfd_errmsg (bfd_get_error (), matching).c_str ()); -+ -+ if (is_core != 0) -+ throw_error (IS_CORE_ERROR, -+ _("\"%s\" is a core file.\n" -+ "Please specify an executable to debug."), -+ scratch_pathname); -+ else -+ error (_("\"%ps\": not in executable format: %s"), -+ styled_string (file_name_style.style (), scratch_pathname), -+ gdb_bfd_errmsg (bfd_get_error (), matching).c_str ()); - } - - if (build_section_table (exec_bfd, §ions, §ions_end)) -diff --git a/gdb/main.c b/gdb/main.c ---- a/gdb/main.c -+++ b/gdb/main.c -@@ -524,6 +524,34 @@ struct cmdarg - char *string; - }; - -+/* Call exec_file_attach. If it detected FILENAME is a core file call -+ core_file_command. Print the original exec_file_attach error only if -+ core_file_command failed to find a matching executable. */ -+ -+static void -+exec_or_core_file_attach (const char *filename, int from_tty) -+{ -+ gdb_assert (exec_bfd == NULL); -+ -+ try -+ { -+ exec_file_attach (filename, from_tty); -+ } -+ catch (gdb_exception_error &e) -+ { -+ if (e.error == IS_CORE_ERROR) -+ { -+ core_file_command ((char *) filename, from_tty); -+ -+ /* Iff the core file found its executable suppress the error message -+ from exec_file_attach. */ -+ if (exec_bfd != NULL) -+ return; -+ } -+ throw_exception (std::move (e)); -+ } -+} -+ - static void - captured_main_1 (struct captured_main_args *context) - { -@@ -959,6 +987,8 @@ captured_main_1 (struct captured_main_args *context) - { - symarg = argv[optind]; - execarg = argv[optind]; -+ if (optind + 1 == argc && corearg == NULL) -+ corearg = argv[optind]; - optind++; - } - -@@ -1114,12 +1144,25 @@ captured_main_1 (struct captured_main_args *context) - && symarg != NULL - && strcmp (execarg, symarg) == 0) - { -+ catch_command_errors_const_ftype *func; -+ -+ /* Call exec_or_core_file_attach only if the file was specified as -+ a command line argument (and not an a command line option). */ -+ if (corearg != NULL && strcmp (corearg, execarg) == 0) -+ { -+ func = exec_or_core_file_attach; -+ corearg = NULL; -+ } -+ else -+ func = exec_file_attach; -+ - /* The exec file and the symbol-file are the same. If we can't - open it, better only print one error message. -- catch_command_errors returns non-zero on success! */ -- ret = catch_command_errors (exec_file_attach, execarg, -- !batch_flag); -- if (ret != 0) -+ catch_command_errors returns non-zero on success! -+ Do not load EXECARG as a symbol file if it has been already processed -+ as a core file. */ -+ ret = catch_command_errors (func, execarg, !batch_flag); -+ if (ret != 0 && core_bfd == NULL) - ret = catch_command_errors (symbol_file_add_main_adapter, - symarg, !batch_flag); - } -diff --git a/gdbsupport/common-exceptions.h b/gdbsupport/common-exceptions.h ---- a/gdbsupport/common-exceptions.h -+++ b/gdbsupport/common-exceptions.h -@@ -106,6 +106,9 @@ enum errors { - "_ERROR" is appended to the name. */ - MAX_COMPLETIONS_REACHED_ERROR, - -+ /* Attempt to load a core file as executable. */ -+ IS_CORE_ERROR, -+ - /* Add more errors here. */ - NR_ERRORS - }; diff --git a/gdb-6.6-buildid-locate-rpm-scl.patch b/gdb-6.6-buildid-locate-rpm-scl.patch index 09f930f..81056cc 100644 --- a/gdb-6.6-buildid-locate-rpm-scl.patch +++ b/gdb-6.6-buildid-locate-rpm-scl.patch @@ -98,7 +98,7 @@ diff --git a/gdb/build-id.c b/gdb/build-id.c diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c --- a/gdb/dwarf2/read.c +++ b/gdb/dwarf2/read.c -@@ -3025,6 +3025,16 @@ read_gdb_index_from_buffer (const char *filename, +@@ -3034,6 +3034,16 @@ read_gdb_index_from_buffer (const char *filename, "set use-deprecated-index-sections on". */ if (version < 6 && !deprecated_ok) { @@ -115,7 +115,7 @@ diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c static int warning_printed = 0; if (!warning_printed) { -@@ -3036,6 +3046,10 @@ to use the section anyway."), +@@ -3045,6 +3055,10 @@ to use the section anyway."), warning_printed = 1; } return 0; diff --git a/gdb-6.6-buildid-locate.patch b/gdb-6.6-buildid-locate.patch index 6c9fb81..17d51f4 100644 --- a/gdb-6.6-buildid-locate.patch +++ b/gdb-6.6-buildid-locate.patch @@ -1107,7 +1107,7 @@ diff --git a/gdb/dwarf2/index-cache.c b/gdb/dwarf2/index-cache.c diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c --- a/gdb/dwarf2/read.c +++ b/gdb/dwarf2/read.c -@@ -2218,7 +2218,7 @@ dwarf2_get_dwz_file (dwarf2_per_bfd *per_bfd) +@@ -2225,7 +2225,7 @@ dwarf2_get_dwz_file (dwarf2_per_bfd *per_bfd) } if (dwz_bfd == NULL) @@ -1116,7 +1116,7 @@ diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c if (dwz_bfd == nullptr) { -@@ -5980,7 +5980,7 @@ get_gdb_index_contents_from_section (objfile *obj, T *section_owner) +@@ -5989,7 +5989,7 @@ get_gdb_index_contents_from_section (objfile *obj, T *section_owner) static gdb::array_view get_gdb_index_contents_from_cache (objfile *obj, dwarf2_per_bfd *dwarf2_per_bfd) { @@ -1125,7 +1125,7 @@ diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c if (build_id == nullptr) return {}; -@@ -5993,7 +5993,7 @@ get_gdb_index_contents_from_cache (objfile *obj, dwarf2_per_bfd *dwarf2_per_bfd) +@@ -6002,7 +6002,7 @@ get_gdb_index_contents_from_cache (objfile *obj, dwarf2_per_bfd *dwarf2_per_bfd) static gdb::array_view get_gdb_index_contents_from_cache_dwz (objfile *obj, dwz_file *dwz) { diff --git a/gdb-6.8-quit-never-aborts.patch b/gdb-6.8-quit-never-aborts.patch deleted file mode 100644 index a682469..0000000 --- a/gdb-6.8-quit-never-aborts.patch +++ /dev/null @@ -1,78 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-6.8-quit-never-aborts.patch - -;; Make the GDB quit processing non-abortable to cleanup everything properly. -;;=fedora: It was useful only after gdb-6.8-attach-signalled-detach-stopped.patch . - -We may abort the process of detaching threads with multiple SIGINTs - which are -being sent during a testcase terminating its child GDB. - -Some of the threads may not be properly PTRACE_DETACHed which hurts if they -should have been detached with SIGSTOP (as they are accidentally left running -on the debugger termination). - -diff --git a/gdb/defs.h b/gdb/defs.h ---- a/gdb/defs.h -+++ b/gdb/defs.h -@@ -177,6 +177,10 @@ extern void default_quit_handler (void); - /* Flag that function quit should call quit_force. */ - extern volatile int sync_quit_force_run; - -+#ifdef NEED_DETACH_SIGSTOP -+extern int quit_flag_cleanup; -+#endif -+ - extern void quit (void); - - /* Helper for the QUIT macro. */ -diff --git a/gdb/extension.c b/gdb/extension.c ---- a/gdb/extension.c -+++ b/gdb/extension.c -@@ -769,6 +769,11 @@ check_quit_flag (void) - { - int result = 0; - -+#ifdef NEED_DETACH_SIGSTOP -+ if (quit_flag_cleanup) -+ return 0; -+#endif -+ - for (const struct extension_language_defn *extlang : extension_languages) - { - if (extlang->ops != nullptr -diff --git a/gdb/top.c b/gdb/top.c ---- a/gdb/top.c -+++ b/gdb/top.c -@@ -1770,7 +1770,13 @@ quit_force (int *exit_arg, int from_tty) - else if (return_child_result) - exit_code = return_child_result_value; - -+#ifndef NEED_DETACH_SIGSTOP - /* We want to handle any quit errors and exit regardless. */ -+#else -+ /* We want to handle any quit errors and exit regardless but we should never -+ get user-interrupted to properly detach the inferior. */ -+ quit_flag_cleanup = 1; -+#endif - - /* Get out of tfind mode, and kill or detach all inferiors. */ - try -diff --git a/gdb/utils.c b/gdb/utils.c ---- a/gdb/utils.c -+++ b/gdb/utils.c -@@ -103,6 +103,13 @@ static std::chrono::steady_clock::duration prompt_for_continue_wait_time; - - static bool debug_timestamp = false; - -+#ifdef NEED_DETACH_SIGSTOP -+/* Nonzero means we are already processing the quitting cleanups and we should -+ no longer get aborted. */ -+ -+int quit_flag_cleanup; -+#endif -+ - /* True means that strings with character values >0x7F should be printed - as octal escapes. False means just print the value (e.g. it's an - international character, and the terminal or window can cope.) */ diff --git a/gdb-archer-pie-addons-keep-disabled.patch b/gdb-archer-pie-addons-keep-disabled.patch deleted file mode 100644 index ed02f2c..0000000 --- a/gdb-archer-pie-addons-keep-disabled.patch +++ /dev/null @@ -1,89 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-archer-pie-addons-keep-disabled.patch - -;;=push+jan: Breakpoints disabling matching should not be based on address. - -diff --git a/gdb/breakpoint.c b/gdb/breakpoint.c ---- a/gdb/breakpoint.c -+++ b/gdb/breakpoint.c -@@ -15431,6 +15431,50 @@ static struct cmd_list_element *enablebreaklist = NULL; - - cmd_list_element *commands_cmd_element = nullptr; - -+void -+breakpoints_relocate (struct objfile *objfile, section_offsets &delta) -+{ -+ struct bp_location *bl, **blp_tmp; -+ int changed = 0; -+ -+ gdb_assert (objfile->separate_debug_objfile_backlink == NULL); -+ -+ ALL_BP_LOCATIONS (bl, blp_tmp) -+ { -+ struct obj_section *osect; -+ -+ /* BL->SECTION can be correctly NULL for breakpoints with multiple -+ locations expanded through symtab. */ -+ -+ ALL_OBJFILE_OSECTIONS (objfile, osect) -+ { -+ CORE_ADDR relocated_address; -+ CORE_ADDR delta_offset; -+ -+ delta_offset = delta[osect->the_bfd_section->index]; -+ if (delta_offset == 0) -+ continue; -+ relocated_address = bl->address + delta_offset; -+ -+ if (obj_section_addr (osect) <= relocated_address -+ && relocated_address < obj_section_endaddr (osect)) -+ { -+ if (bl->inserted) -+ remove_breakpoint (bl); -+ -+ bl->address += delta_offset; -+ bl->requested_address += delta_offset; -+ -+ changed = 1; -+ } -+ } -+ } -+ -+ if (changed) -+ std::sort (bp_locations, bp_locations + bp_locations_count, -+ bp_location_is_less_than); -+} -+ - void _initialize_breakpoint (); - void - _initialize_breakpoint () -diff --git a/gdb/breakpoint.h b/gdb/breakpoint.h ---- a/gdb/breakpoint.h -+++ b/gdb/breakpoint.h -@@ -1691,6 +1691,9 @@ extern const char *ep_parse_optional_if_clause (const char **arg); - UIOUT iff debugging multiple threads. */ - extern void maybe_print_thread_hit_breakpoint (struct ui_out *uiout); - -+extern void breakpoints_relocate (struct objfile *objfile, -+ section_offsets &delta); -+ - /* Print the specified breakpoint. */ - extern void print_breakpoint (breakpoint *bp); - -diff --git a/gdb/objfiles.c b/gdb/objfiles.c ---- a/gdb/objfiles.c -+++ b/gdb/objfiles.c -@@ -742,6 +742,11 @@ objfile_relocate1 (struct objfile *objfile, - obj_section_addr (s)); - } - -+ /* Final call of breakpoint_re_set can keep breakpoint locations disabled if -+ their addresses match. */ -+ if (objfile->separate_debug_objfile_backlink == NULL) -+ breakpoints_relocate (objfile, delta); -+ - /* Data changed. */ - return 1; - } diff --git a/gdb-archer-pie-addons.patch b/gdb-archer-pie-addons.patch deleted file mode 100644 index f0c68db..0000000 --- a/gdb-archer-pie-addons.patch +++ /dev/null @@ -1,39 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-archer-pie-addons.patch - -;;=push+jan: May get obsoleted by Tom's unrelocated objfiles patch. - -diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h ---- a/gdb/gdbtypes.h -+++ b/gdb/gdbtypes.h -@@ -649,6 +649,7 @@ enum field_loc_kind - { - FIELD_LOC_KIND_BITPOS, /**< bitpos */ - FIELD_LOC_KIND_ENUMVAL, /**< enumval */ -+ /* This address is unrelocated by the objfile's ANOFFSET. */ - FIELD_LOC_KIND_PHYSADDR, /**< physaddr */ - FIELD_LOC_KIND_PHYSNAME, /**< physname */ - FIELD_LOC_KIND_DWARF_BLOCK /**< dwarf_block */ -@@ -699,6 +700,7 @@ union field_location - field. Otherwise, physname is the mangled label of the - static field. */ - -+ /* This address is unrelocated by the objfile's ANOFFSET. */ - CORE_ADDR physaddr; - const char *physname; - -diff --git a/gdb/value.c b/gdb/value.c ---- a/gdb/value.c -+++ b/gdb/value.c -@@ -2850,7 +2850,8 @@ value_static_field (struct type *type, int fieldno) - { - case FIELD_LOC_KIND_PHYSADDR: - retval = value_at_lazy (type->field (fieldno).type (), -- TYPE_FIELD_STATIC_PHYSADDR (type, fieldno)); -+ TYPE_FIELD_STATIC_PHYSADDR (type, fieldno) -+ + (TYPE_OBJFILE (type) == NULL ? 0 : TYPE_OBJFILE (type)->section_offsets[SECT_OFF_TEXT (TYPE_OBJFILE (type))])); - break; - case FIELD_LOC_KIND_PHYSNAME: - { diff --git a/gdb-archer-vla-tests.patch b/gdb-archer-vla-tests.patch deleted file mode 100644 index 47c98d3..0000000 --- a/gdb-archer-vla-tests.patch +++ /dev/null @@ -1,3737 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-archer-vla-tests.patch - -;;=fedoratest - -diff --git a/gdb/testsuite/gdb.ada/packed_array.exp b/gdb/testsuite/gdb.ada/packed_array.exp ---- a/gdb/testsuite/gdb.ada/packed_array.exp -+++ b/gdb/testsuite/gdb.ada/packed_array.exp -@@ -53,5 +53,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 -+ } - } - -diff --git a/gdb/testsuite/gdb.arch/x86_64-vla-pointer-foo.S b/gdb/testsuite/gdb.arch/x86_64-vla-pointer-foo.S -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.arch/x86_64-vla-pointer-foo.S -@@ -0,0 +1,358 @@ -+ .file "x86_64-vla-pointer.c" -+ .text -+.Ltext0: -+ .globl foo -+ .type foo, @function -+foo: -+.LFB0: -+ .file 1 "gdb.arch/x86_64-vla-pointer.c" -+ # gdb.arch/x86_64-vla-pointer.c:22 -+ .loc 1 22 0 -+ .cfi_startproc -+# BLOCK 2 seq:0 -+# PRED: ENTRY (FALLTHRU) -+ pushq %rbp -+ .cfi_def_cfa_offset 16 -+ .cfi_offset 6, -16 -+ movq %rsp, %rbp -+ .cfi_def_cfa_register 6 -+ pushq %rbx -+ subq $56, %rsp -+ .cfi_offset 3, -24 -+ movl %edi, -52(%rbp) -+ # gdb.arch/x86_64-vla-pointer.c:22 -+ .loc 1 22 0 -+ movq %rsp, %rax -+ movq %rax, %rsi -+ # gdb.arch/x86_64-vla-pointer.c:23 -+ .loc 1 23 0 -+ movl -52(%rbp), %eax -+ movslq %eax, %rdx -+ subq $1, %rdx -+ movq %rdx, -32(%rbp) -+ movslq %eax, %rdx -+ movq %rdx, %r8 -+ movl $0, %r9d -+ # gdb.arch/x86_64-vla-pointer.c:24 -+ .loc 1 24 0 -+ movslq %eax, %rdx -+ movq %rdx, %rcx -+ movl $0, %ebx -+ cltq -+ movl $16, %edx -+ subq $1, %rdx -+ addq %rdx, %rax -+ movl $16, %ebx -+ movl $0, %edx -+ divq %rbx -+ imulq $16, %rax, %rax -+ subq %rax, %rsp -+ movq %rsp, %rax -+ addq $0, %rax -+ movq %rax, -40(%rbp) -+ # gdb.arch/x86_64-vla-pointer.c:27 -+ .loc 1 27 0 -+ movl $0, -20(%rbp) -+# SUCC: 4 [100.0%] -+ jmp .L2 -+# BLOCK 3 seq:1 -+# PRED: 4 -+.L3: -+ # gdb.arch/x86_64-vla-pointer.c:28 -+ .loc 1 28 0 discriminator 3 -+ movl -20(%rbp), %eax -+ movl %eax, %ecx -+ movq -40(%rbp), %rdx -+ movl -20(%rbp), %eax -+ cltq -+ movb %cl, (%rdx,%rax) -+# SUCC: 4 (FALLTHRU,DFS_BACK) -+ # gdb.arch/x86_64-vla-pointer.c:27 -+ .loc 1 27 0 discriminator 3 -+ addl $1, -20(%rbp) -+# BLOCK 4 seq:2 -+# PRED: 3 (FALLTHRU,DFS_BACK) 2 [100.0%] -+.L2: -+ # gdb.arch/x86_64-vla-pointer.c:27 -+ .loc 1 27 0 is_stmt 0 discriminator 1 -+ movl -20(%rbp), %eax -+ cmpl -52(%rbp), %eax -+# SUCC: 3 5 (FALLTHRU) -+ jl .L3 -+# BLOCK 5 seq:3 -+# PRED: 4 (FALLTHRU) -+ # gdb.arch/x86_64-vla-pointer.c:30 -+ .loc 1 30 0 is_stmt 1 -+ movq -40(%rbp), %rax -+ movb $0, (%rax) -+ movq %rsi, %rsp -+ # gdb.arch/x86_64-vla-pointer.c:31 -+ .loc 1 31 0 -+ nop -+ movq -8(%rbp), %rbx -+ leave -+ .cfi_def_cfa 7, 8 -+# SUCC: EXIT [100.0%] -+ ret -+ .cfi_endproc -+.LFE0: -+ .size foo, .-foo -+.Letext0: -+ .section .debug_info,"",@progbits -+.Ldebug_info0: -+ .long 0xa5 # Length of Compilation Unit Info -+ .value 0x4 # DWARF version number -+ .long .Ldebug_abbrev0 # Offset Into Abbrev. Section -+ .byte 0x8 # Pointer Size (in bytes) -+ .uleb128 0x1 # (DIE (0xb) DW_TAG_compile_unit) -+ .long .LASF3 # DW_AT_producer: "GNU C11 6.2.1 20160916 (Red Hat 6.2.1-2) -mtune=generic -march=x86-64 -g" -+ .byte 0xc # DW_AT_language -+ .long .LASF4 # DW_AT_name: "gdb.arch/x86_64-vla-pointer.c" -+ .long .LASF5 # DW_AT_comp_dir: "/home/jkratoch/redhat/fedora/gdb/master/gdb-7.12/gdb/testsuite" -+ .quad .Ltext0 # DW_AT_low_pc -+ .quad .Letext0-.Ltext0 # DW_AT_high_pc -+ .long .Ldebug_line0 # DW_AT_stmt_list -+ .uleb128 0x2 # (DIE (0x2d) DW_TAG_subprogram) -+ # DW_AT_external -+ .ascii "foo\0" # DW_AT_name -+ .byte 0x1 # DW_AT_decl_file (gdb.arch/x86_64-vla-pointer.c) -+ .byte 0x15 # DW_AT_decl_line -+ # DW_AT_prototyped -+ .quad .LFB0 # DW_AT_low_pc -+ .quad .LFE0-.LFB0 # DW_AT_high_pc -+ .uleb128 0x1 # DW_AT_frame_base -+ .byte 0x9c # DW_OP_call_frame_cfa -+ # DW_AT_GNU_all_call_sites -+ .long 0x80 # DW_AT_sibling -+ .uleb128 0x3 # (DIE (0x4a) DW_TAG_formal_parameter) -+ .long .LASF6 # DW_AT_name: "size" -+ .byte 0x1 # DW_AT_decl_file (gdb.arch/x86_64-vla-pointer.c) -+ .byte 0x15 # DW_AT_decl_line -+ .long 0x80 # DW_AT_type -+ .uleb128 0x3 # DW_AT_location -+ .byte 0x91 # DW_OP_fbreg -+ .sleb128 -68 -+ .uleb128 0x4 # (DIE (0x59) DW_TAG_typedef) -+ .long .LASF7 # DW_AT_name: "array_t" -+ .byte 0x1 # DW_AT_decl_file (gdb.arch/x86_64-vla-pointer.c) -+ .byte 0x17 # DW_AT_decl_line -+ .long 0x87 # DW_AT_type -+ .uleb128 0x5 # (DIE (0x64) DW_TAG_variable) -+ .long .LASF0 # DW_AT_name: "array" -+ .byte 0x1 # DW_AT_decl_file (gdb.arch/x86_64-vla-pointer.c) -+ .byte 0x18 # DW_AT_decl_line -+ .long 0x59 # DW_AT_type -+ .uleb128 0x3 # DW_AT_location -+ .byte 0x91 # DW_OP_fbreg -+ .sleb128 -56 -+ .byte 0x6 # DW_OP_deref -+ .uleb128 0x6 # (DIE (0x73) DW_TAG_variable) -+ .ascii "i\0" # DW_AT_name -+ .byte 0x1 # DW_AT_decl_file (gdb.arch/x86_64-vla-pointer.c) -+ .byte 0x19 # DW_AT_decl_line -+ .long 0x80 # DW_AT_type -+ .uleb128 0x2 # DW_AT_location -+ .byte 0x91 # DW_OP_fbreg -+ .sleb128 -36 -+ .byte 0 # end of children of DIE 0x2d -+ .uleb128 0x7 # (DIE (0x80) DW_TAG_base_type) -+ .byte 0x4 # DW_AT_byte_size -+ .byte 0x5 # DW_AT_encoding -+ .ascii "int\0" # DW_AT_name -+ .uleb128 0x8 # (DIE (0x87) DW_TAG_array_type) -+ .long 0xa1 # DW_AT_type -+ .long 0x9a # DW_AT_sibling -+ .uleb128 0x9 # (DIE (0x90) DW_TAG_subrange_type) -+ .long 0x9a # DW_AT_type -+ .uleb128 0x3 # DW_AT_upper_bound -+ .byte 0x91 # DW_OP_fbreg -+ .sleb128 -48 -+ .byte 0x6 # DW_OP_deref -+ .byte 0 # end of children of DIE 0x87 -+ .uleb128 0xa # (DIE (0x9a) DW_TAG_base_type) -+ .byte 0x8 # DW_AT_byte_size -+ .byte 0x7 # DW_AT_encoding -+ .long .LASF1 # DW_AT_name: "sizetype" -+ .uleb128 0xa # (DIE (0xa1) DW_TAG_base_type) -+ .byte 0x1 # DW_AT_byte_size -+ .byte 0x6 # DW_AT_encoding -+ .long .LASF2 # DW_AT_name: "char" -+ .byte 0 # end of children of DIE 0xb -+ .section .debug_abbrev,"",@progbits -+.Ldebug_abbrev0: -+ .uleb128 0x1 # (abbrev code) -+ .uleb128 0x11 # (TAG: DW_TAG_compile_unit) -+ .byte 0x1 # DW_children_yes -+ .uleb128 0x25 # (DW_AT_producer) -+ .uleb128 0xe # (DW_FORM_strp) -+ .uleb128 0x13 # (DW_AT_language) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0xe # (DW_FORM_strp) -+ .uleb128 0x1b # (DW_AT_comp_dir) -+ .uleb128 0xe # (DW_FORM_strp) -+ .uleb128 0x11 # (DW_AT_low_pc) -+ .uleb128 0x1 # (DW_FORM_addr) -+ .uleb128 0x12 # (DW_AT_high_pc) -+ .uleb128 0x7 # (DW_FORM_data8) -+ .uleb128 0x10 # (DW_AT_stmt_list) -+ .uleb128 0x17 # (DW_FORM_sec_offset) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x2 # (abbrev code) -+ .uleb128 0x2e # (TAG: DW_TAG_subprogram) -+ .byte 0x1 # DW_children_yes -+ .uleb128 0x3f # (DW_AT_external) -+ .uleb128 0x19 # (DW_FORM_flag_present) -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0x8 # (DW_FORM_string) -+ .uleb128 0x3a # (DW_AT_decl_file) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3b # (DW_AT_decl_line) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x27 # (DW_AT_prototyped) -+ .uleb128 0x19 # (DW_FORM_flag_present) -+ .uleb128 0x11 # (DW_AT_low_pc) -+ .uleb128 0x1 # (DW_FORM_addr) -+ .uleb128 0x12 # (DW_AT_high_pc) -+ .uleb128 0x7 # (DW_FORM_data8) -+ .uleb128 0x40 # (DW_AT_frame_base) -+ .uleb128 0x18 # (DW_FORM_exprloc) -+ .uleb128 0x2117 # (DW_AT_GNU_all_call_sites) -+ .uleb128 0x19 # (DW_FORM_flag_present) -+ .uleb128 0x1 # (DW_AT_sibling) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x3 # (abbrev code) -+ .uleb128 0x5 # (TAG: DW_TAG_formal_parameter) -+ .byte 0 # DW_children_no -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0xe # (DW_FORM_strp) -+ .uleb128 0x3a # (DW_AT_decl_file) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3b # (DW_AT_decl_line) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x49 # (DW_AT_type) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .uleb128 0x2 # (DW_AT_location) -+ .uleb128 0x18 # (DW_FORM_exprloc) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x4 # (abbrev code) -+ .uleb128 0x16 # (TAG: DW_TAG_typedef) -+ .byte 0 # DW_children_no -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0xe # (DW_FORM_strp) -+ .uleb128 0x3a # (DW_AT_decl_file) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3b # (DW_AT_decl_line) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x49 # (DW_AT_type) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x5 # (abbrev code) -+ .uleb128 0x34 # (TAG: DW_TAG_variable) -+ .byte 0 # DW_children_no -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0xe # (DW_FORM_strp) -+ .uleb128 0x3a # (DW_AT_decl_file) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3b # (DW_AT_decl_line) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x49 # (DW_AT_type) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .uleb128 0x2 # (DW_AT_location) -+ .uleb128 0x18 # (DW_FORM_exprloc) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x6 # (abbrev code) -+ .uleb128 0x34 # (TAG: DW_TAG_variable) -+ .byte 0 # DW_children_no -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0x8 # (DW_FORM_string) -+ .uleb128 0x3a # (DW_AT_decl_file) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3b # (DW_AT_decl_line) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x49 # (DW_AT_type) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .uleb128 0x2 # (DW_AT_location) -+ .uleb128 0x18 # (DW_FORM_exprloc) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x7 # (abbrev code) -+ .uleb128 0x24 # (TAG: DW_TAG_base_type) -+ .byte 0 # DW_children_no -+ .uleb128 0xb # (DW_AT_byte_size) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3e # (DW_AT_encoding) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0x8 # (DW_FORM_string) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x8 # (abbrev code) -+ .uleb128 0x1 # (TAG: DW_TAG_array_type) -+ .byte 0x1 # DW_children_yes -+ .uleb128 0x49 # (DW_AT_type) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .uleb128 0x1 # (DW_AT_sibling) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .byte 0 -+ .byte 0 -+ .uleb128 0x9 # (abbrev code) -+ .uleb128 0x21 # (TAG: DW_TAG_subrange_type) -+ .byte 0 # DW_children_no -+ .uleb128 0x49 # (DW_AT_type) -+ .uleb128 0x13 # (DW_FORM_ref4) -+ .uleb128 0x2f # (DW_AT_upper_bound) -+ .uleb128 0x18 # (DW_FORM_exprloc) -+ .byte 0 -+ .byte 0 -+ .uleb128 0xa # (abbrev code) -+ .uleb128 0x24 # (TAG: DW_TAG_base_type) -+ .byte 0 # DW_children_no -+ .uleb128 0xb # (DW_AT_byte_size) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3e # (DW_AT_encoding) -+ .uleb128 0xb # (DW_FORM_data1) -+ .uleb128 0x3 # (DW_AT_name) -+ .uleb128 0xe # (DW_FORM_strp) -+ .byte 0 -+ .byte 0 -+ .byte 0 -+ .section .debug_aranges,"",@progbits -+ .long 0x2c # Length of Address Ranges Info -+ .value 0x2 # DWARF Version -+ .long .Ldebug_info0 # Offset of Compilation Unit Info -+ .byte 0x8 # Size of Address -+ .byte 0 # Size of Segment Descriptor -+ .value 0 # Pad to 16 byte boundary -+ .value 0 -+ .quad .Ltext0 # Address -+ .quad .Letext0-.Ltext0 # Length -+ .quad 0 -+ .quad 0 -+ .section .debug_line,"",@progbits -+.Ldebug_line0: -+ .section .debug_str,"MS",@progbits,1 -+.LASF4: -+ .string "gdb.arch/x86_64-vla-pointer.c" -+.LASF7: -+ .string "array_t" -+.LASF3: -+ .string "GNU C11 6.2.1 20160916 (Red Hat 6.2.1-2) -mtune=generic -march=x86-64 -g" -+.LASF2: -+ .string "char" -+.LASF1: -+ .string "sizetype" -+.LASF5: -+ .string "/home/jkratoch/redhat/fedora/gdb/master/gdb-7.12/gdb/testsuite" -+.LASF6: -+ .string "size" -+.LASF0: -+ .string "array" -+ .ident "GCC: (GNU) 6.2.1 20160916 (Red Hat 6.2.1-2)" -+ .section .note.GNU-stack,"",@progbits -diff --git a/gdb/testsuite/gdb.arch/x86_64-vla-pointer.c b/gdb/testsuite/gdb.arch/x86_64-vla-pointer.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.arch/x86_64-vla-pointer.c -@@ -0,0 +1,45 @@ -+/* This testcase is part of GDB, the GNU debugger. -+ -+ Copyright 2009 Free Software Foundation, Inc. -+ -+ This program is free software; you can redistribute it and/or modify -+ it under the terms of the GNU General Public License as published by -+ the Free Software Foundation; either version 3 of the License, or -+ (at your option) any later version. -+ -+ This program is distributed in the hope that it will be useful, -+ but WITHOUT ANY WARRANTY; without even the implied warranty of -+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+ GNU General Public License for more details. -+ -+ You should have received a copy of the GNU General Public License -+ along with this program. If not, see . */ -+ -+#if 0 -+ -+void -+foo (int size) -+{ -+ typedef char array_t[size]; -+ array_t array; -+ int i; -+ -+ for (i = 0; i < size; i++) -+ array[i] = i; -+ -+ array[0] = 0; /* break-here */ -+} -+ -+#else -+ -+void foo (int size); -+ -+int -+main (void) -+{ -+ foo (26); -+ foo (78); -+ return 0; -+} -+ -+#endif -diff --git a/gdb/testsuite/gdb.arch/x86_64-vla-pointer.exp b/gdb/testsuite/gdb.arch/x86_64-vla-pointer.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.arch/x86_64-vla-pointer.exp -@@ -0,0 +1,65 @@ -+# Copyright 2009 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+if ![istarget "x86_64-*-*"] then { -+ verbose "Skipping over gdb.arch/x86_64-vla-pointer.exp test made only for x86_64." -+ return -+} -+ -+set testfile x86_64-vla-pointer -+set srcasmfile ${testfile}-foo.S -+set srcfile ${testfile}.c -+set binfile [standard_output_file ${testfile}] -+set binobjfile [standard_output_file ${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 {}] != "" } { -+ untested "Couldn't compile test program" -+ return -1 -+} -+ -+gdb_exit -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfile} -+ -+if ![runto_main] { -+ untested x86_64-vla-pointer -+ return -1 -+} -+ -+gdb_breakpoint $srcfile:[gdb_get_line_number "break-here"] -+ -+gdb_continue_to_breakpoint "break-here" -+ -+gdb_test "whatis array" "type = array_t" "first: whatis array" -+gdb_test "whatis array_t" "type = char \\\[variable length\\\]" "first: whatis array_t" -+gdb_test "ptype array" "type = char \\\[26\\\]" "first: ptype array" -+ -+gdb_test "whatis *array" "type = char" "first: whatis *array" -+gdb_test "ptype *array" "type = char" "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 "whatis array_t" "type = char \\\[variable length\\\]" "second: whatis array_t" -+gdb_test "ptype array" "type = char \\\[78\\\]" "second: ptype array" -diff --git a/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S b/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S -@@ -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 -diff --git a/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c b/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c -@@ -0,0 +1,45 @@ -+/* 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 -+ -+void foo (int size); -+ -+int -+main (void) -+{ -+ foo (26); -+ foo (78); -+ return 0; -+} -+ -+#endif -diff --git a/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp b/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp -@@ -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 [standard_output_file ${testfile}] -+set binobjfile [standard_output_file ${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" -diff --git a/gdb/testsuite/gdb.base/arrayidx.c b/gdb/testsuite/gdb.base/arrayidx.c ---- a/gdb/testsuite/gdb.base/arrayidx.c -+++ b/gdb/testsuite/gdb.base/arrayidx.c -@@ -17,6 +17,13 @@ - - int array[] = {1, 2, 3, 4}; - -+#ifdef __GNUC__ -+struct -+ { -+ int a[0]; -+ } unbound; -+#endif -+ - int - main (void) - { -diff --git a/gdb/testsuite/gdb.base/arrayidx.exp b/gdb/testsuite/gdb.base/arrayidx.exp ---- a/gdb/testsuite/gdb.base/arrayidx.exp -+++ b/gdb/testsuite/gdb.base/arrayidx.exp -@@ -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)" -+ } -+} -diff --git a/gdb/testsuite/gdb.base/internal-var-field-address.c b/gdb/testsuite/gdb.base/internal-var-field-address.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/internal-var-field-address.c -@@ -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 }; -diff --git a/gdb/testsuite/gdb.base/internal-var-field-address.exp b/gdb/testsuite/gdb.base/internal-var-field-address.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/internal-var-field-address.exp -@@ -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" -diff --git a/gdb/testsuite/gdb.base/vla-frame.c b/gdb/testsuite/gdb.base/vla-frame.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/vla-frame.c -@@ -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; -+} -diff --git a/gdb/testsuite/gdb.base/vla-frame.exp b/gdb/testsuite/gdb.base/vla-frame.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/vla-frame.exp -@@ -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.*" -diff --git a/gdb/testsuite/gdb.base/vla-overflow.c b/gdb/testsuite/gdb.base/vla-overflow.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/vla-overflow.c -@@ -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; -+} -diff --git a/gdb/testsuite/gdb.base/vla-overflow.exp b/gdb/testsuite/gdb.base/vla-overflow.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/vla-overflow.exp -@@ -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 [standard_output_file ${testfile}-gdb.sh] -+set srcfile ${testfile}.c -+set binfile [standard_output_file ${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]" -diff --git a/gdb/testsuite/gdb.base/vla.c b/gdb/testsuite/gdb.base/vla.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/vla.c -@@ -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; -+} -diff --git a/gdb/testsuite/gdb.base/vla.exp b/gdb/testsuite/gdb.base/vla.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/vla.exp -@@ -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 [standard_output_file ${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" -diff --git a/gdb/testsuite/gdb.cp/gdb9593.cc b/gdb/testsuite/gdb.cp/gdb9593.cc -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.cp/gdb9593.cc -@@ -0,0 +1,180 @@ -+/* This testcase is part of GDB, the GNU debugger. -+ -+ 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 . -+ */ -+#include -+ -+using namespace std; -+ -+class NextOverThrowDerivates -+{ -+ -+public: -+ -+ -+ // Single throw an exception in this function. -+ void function1() -+ { -+ throw 20; -+ } -+ -+ // Throw an exception in another function. -+ void function2() -+ { -+ function1(); -+ } -+ -+ // Throw an exception in another function, but handle it -+ // locally. -+ void function3 () -+ { -+ { -+ try -+ { -+ function1 (); -+ } -+ catch (...) -+ { -+ cout << "Caught and handled function1 exception" << endl; -+ } -+ } -+ } -+ -+ void rethrow () -+ { -+ try -+ { -+ function1 (); -+ } -+ catch (...) -+ { -+ throw; -+ } -+ } -+ -+ void finish () -+ { -+ // We use this to test that a "finish" here does not end up in -+ // this frame, but in the one above. -+ try -+ { -+ function1 (); -+ } -+ catch (int x) -+ { -+ } -+ function1 (); // marker for until -+ } -+ -+ void until () -+ { -+ function1 (); -+ function1 (); // until here -+ } -+ -+}; -+NextOverThrowDerivates next_cases; -+ -+ -+int main () -+{ -+ try -+ { -+ next_cases.function1 (); -+ } -+ catch (...) -+ { -+ // Discard -+ } -+ -+ try -+ { -+ next_cases.function2 (); -+ } -+ catch (...) -+ { -+ // Discard -+ } -+ -+ try -+ { -+ // This is duplicated so we can next over one but step into -+ // another. -+ next_cases.function2 (); -+ } -+ catch (...) -+ { -+ // Discard -+ } -+ -+ next_cases.function3 (); -+ -+ try -+ { -+ next_cases.rethrow (); -+ } -+ catch (...) -+ { -+ // Discard -+ } -+ -+ try -+ { -+ // Another duplicate so we can test "finish". -+ next_cases.function2 (); -+ } -+ catch (...) -+ { -+ // Discard -+ } -+ -+ // Another test for "finish". -+ try -+ { -+ next_cases.finish (); -+ } -+ catch (...) -+ { -+ } -+ -+ // Test of "until". -+ try -+ { -+ next_cases.finish (); -+ } -+ catch (...) -+ { -+ } -+ -+ // Test of "until" with an argument. -+ try -+ { -+ next_cases.until (); -+ } -+ catch (...) -+ { -+ } -+ -+ // Test of "advance". -+ try -+ { -+ next_cases.until (); -+ } -+ catch (...) -+ { -+ } -+} -+ -diff --git a/gdb/testsuite/gdb.cp/gdb9593.exp b/gdb/testsuite/gdb.cp/gdb9593.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.cp/gdb9593.exp -@@ -0,0 +1,182 @@ -+# 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 -+} -+ -+if { [skip_cplus_tests] } { continue } -+ -+set testfile "gdb9593" -+set srcfile ${testfile}.cc -+set binfile [standard_output_file $testfile] -+ -+# Create and source the file that provides information about the compiler -+# used to compile the test case. -+if [get_compiler_info "c++"] { -+ untested gdb9593.exp -+ return -1 -+} -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug c++}] != "" } { -+ untested gdb9593.exp -+ return -1 -+} -+ -+# Some targets can't do function calls, so don't even bother with this -+# test. -+if [target_info exists gdb,cannot_call_functions] { -+ setup_xfail "*-*-*" 9593 -+ fail "This target can not call functions" -+ continue -+} -+ -+gdb_exit -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfile} -+ -+if ![runto_main] then { -+ perror "couldn't run to main" -+ continue -+} -+ -+# See whether we have the needed unwinder hooks. -+set ok 1 -+gdb_test_multiple "print _Unwind_DebugHook" "check for unwinder hook" { -+ -re "= .*_Unwind_DebugHook.*\r\n$gdb_prompt $" { -+ pass "check for unwinder hook" -+ } -+ -re "No symbol .* in current context.\r\n$gdb_prompt $" { -+ # Pass the test so we don't get bogus fails in the results. -+ pass "check for unwinder hook" -+ set ok 0 -+ } -+} -+if {!$ok} { -+ untested gdb9593.exp -+ return -1 -+} -+ -+# See http://sourceware.org/bugzilla/show_bug.cgi?id=9593 -+ -+gdb_test "next" \ -+ ".*catch (...).*" \ -+ "next over a throw 1" -+ -+gdb_test "next" \ -+ ".*next_cases.function2.*" \ -+ "next past catch 1" -+ -+gdb_test "next" \ -+ ".*catch (...).*" \ -+ "next over a throw 2" -+ -+gdb_test "next" \ -+ ".*next_cases.function2.*" \ -+ "next past catch 2" -+ -+gdb_test "step" \ -+ ".*function1().*" \ -+ "step into function2 1" -+ -+gdb_test "next" \ -+ ".*catch (...).*" \ -+ "next over a throw 3" -+ -+gdb_test "next" \ -+ ".*next_cases.function3.*" \ -+ "next past catch 3" -+ -+gdb_test "next" \ -+ ".*next_cases.rethrow.*" \ -+ "next over a throw 4" -+ -+gdb_test "next" \ -+ ".*catch (...).*" \ -+ "next over a rethrow" -+ -+gdb_test "next" \ -+ ".*next_cases.function2.*" \ -+ "next after a rethrow" -+ -+gdb_test "step" \ -+ ".*function1().*" \ -+ "step into function2 2" -+ -+gdb_test "finish" \ -+ ".*catch (...).*" \ -+ "finish 1" -+ -+gdb_test "next" \ -+ ".*next_cases.finish ().*" \ -+ "next past catch 4" -+ -+gdb_test "step" \ -+ ".*function1 ().*" \ -+ "step into finish method" -+ -+gdb_test "finish" \ -+ ".*catch (...).*" \ -+ "finish 2" -+ -+gdb_test "next" \ -+ ".*next_cases.finish ().*" \ -+ "next past catch 5" -+ -+gdb_test "step" \ -+ ".*function1 ().*" \ -+ "step into finish, for until" -+ -+gdb_test "until" \ -+ ".*function1 ().*" \ -+ "until with no argument 1" -+ -+set line [gdb_get_line_number "marker for until" $testfile.cc] -+ -+gdb_test "until $line" \ -+ ".*function1 ().*" \ -+ "next past catch 6" -+ -+gdb_test "until" \ -+ ".*catch (...).*" \ -+ "until with no argument 2" -+ -+set line [gdb_get_line_number "until here" $testfile.cc] -+ -+gdb_test "next" \ -+ ".*next_cases.until ().*" \ -+ "next past catch 6" -+ -+gdb_test "step" \ -+ ".*function1 ().*" \ -+ "step into until" -+ -+gdb_test "until $line" \ -+ ".*catch (...).*" \ -+ "until-over-throw" -+ -+gdb_test "next" \ -+ ".*next_cases.until ().*" \ -+ "next past catch 7" -+ -+gdb_test "step" \ -+ ".*function1 ().*" \ -+ "step into until, for advance" -+ -+gdb_test "advance $line" \ -+ ".*catch (...).*" \ -+ "advance-over-throw" -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S b/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S -@@ -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" -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp b/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp -@@ -0,0 +1,66 @@ -+# 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. -+ -+# FIXME: FSF GDB crashes due to !has_stack_frames (). -+# But in practice that should not happen. -+# https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43762 -+#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]+\]} -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-stripped.c b/gdb/testsuite/gdb.dwarf2/dw2-stripped.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-stripped.c -@@ -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; -+} -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp b/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp -@@ -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 [standard_output_file ${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" -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S b/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S -@@ -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 */ -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp b/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp -@@ -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\]*}" -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S b/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S -@@ -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 */ -diff --git a/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp b/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp -@@ -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' " -diff --git a/gdb/testsuite/gdb.fortran/dwarf-stride.exp b/gdb/testsuite/gdb.fortran/dwarf-stride.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/dwarf-stride.exp -@@ -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.*" -diff --git a/gdb/testsuite/gdb.fortran/dwarf-stride.f90 b/gdb/testsuite/gdb.fortran/dwarf-stride.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/dwarf-stride.f90 -@@ -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 -diff --git a/gdb/testsuite/gdb.fortran/dynamic.exp b/gdb/testsuite/gdb.fortran/dynamic.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/dynamic.exp -@@ -0,0 +1,154 @@ -+# 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 [standard_output_file ${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" -+ -+# http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#5 -+# Do not: gdb_test "p varx" "\\$\[0-9\]* = " "p varx unallocated" -+# Do not: gdb_test "ptype varx" {type = real\(kind=4\) \(:,:,:\)} "ptype varx unallocated" -+# Do not: gdb_test "p varx(1,5,17)" {no such vector element \(vector not allocated\)} "p varx(1,5,17) unallocated" -+# Do not: gdb_test "p varx(1,5,17)=1" {no such vector element \(vector not allocated\)} "p varx(1,5,17)=1 unallocated" -+# Do not: gdb_test "ptype varx(1,5,17)" {no such vector element \(vector not allocated\)} "ptype varx(1,5,17) unallocated" -+ -+gdb_breakpoint [gdb_get_line_number "varx-allocated"] -+gdb_continue_to_breakpoint "varx-allocated" -+# $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), allocatable \\(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" -+# http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#5 -+# Do not: gdb_test "p varv" "\\$\[0-9\]* = " "p varv unassociated" -+# Do not: gdb_test "ptype varv" {type = real\(kind=4\) \(:,:,:\)} "ptype varv unassociated" -+ -+set test "output varx" -+gdb_test_multiple $test $test { -+ -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), allocatable \\(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 = real\(kind=4\) \(:,:,:\)} "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 \(vector not associated\)} -+gdb_test "ptype varv(1,5,17)" {no such vector element \(vector 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 = real\(kind=4\), allocatable \(:,:,:\)} "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 \(vector not allocated\)} "p varx(1,5,17) deallocated" -+gdb_test "ptype varx(1,5,17)" {no such vector element \(vector 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" -diff --git a/gdb/testsuite/gdb.fortran/dynamic.f90 b/gdb/testsuite/gdb.fortran/dynamic.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/dynamic.f90 -@@ -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 -diff --git a/gdb/testsuite/gdb.fortran/string.exp b/gdb/testsuite/gdb.fortran/string.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/string.exp -@@ -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 [standard_output_file ${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" -diff --git a/gdb/testsuite/gdb.fortran/string.f90 b/gdb/testsuite/gdb.fortran/string.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/string.f90 -@@ -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 -diff --git a/gdb/testsuite/gdb.fortran/subrange.exp b/gdb/testsuite/gdb.fortran/subrange.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/subrange.exp -@@ -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\)} -diff --git a/gdb/testsuite/gdb.fortran/subrange.f90 b/gdb/testsuite/gdb.fortran/subrange.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/subrange.f90 -@@ -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 -diff --git a/gdb/testsuite/gdb.mi/mi2-var-stale-type.c b/gdb/testsuite/gdb.mi/mi2-var-stale-type.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.mi/mi2-var-stale-type.c -@@ -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; -+} -diff --git a/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp b/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp -@@ -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 *" -diff --git a/gdb/testsuite/gdb.opt/array-from-register-func.c b/gdb/testsuite/gdb.opt/array-from-register-func.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.opt/array-from-register-func.c -@@ -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]; -+} -diff --git a/gdb/testsuite/gdb.opt/array-from-register.c b/gdb/testsuite/gdb.opt/array-from-register.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.opt/array-from-register.c -@@ -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; -+} -diff --git a/gdb/testsuite/gdb.opt/array-from-register.exp b/gdb/testsuite/gdb.opt/array-from-register.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.opt/array-from-register.exp -@@ -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" -diff --git a/gdb/testsuite/gdb.opt/fortran-string.exp b/gdb/testsuite/gdb.opt/fortran-string.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.opt/fortran-string.exp -@@ -0,0 +1,39 @@ -+# 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 . -+ -+# Test GDB can cope with Fortran strings having their length present in a CPU -+# register. With -O0 the string length is passed on the stack. To make this -+# test meaningful the follow assertion should pass. It is not being checked -+# here as the "_s" symbol is compiler dependent: -+# (gdb) info address _s -+# Symbol "_s" is a variable in register XX. -+ -+set test fortran-string -+set srcfile ${test}.f90 -+if { [prepare_for_testing ${test}.exp ${test} ${srcfile} {debug f90 additional_flags=-O2}] } { -+ return -1 -+} -+ -+if ![runto $srcfile:[gdb_get_line_number "s = s"]] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_test "frame" ".*s='foo'.*" -+gdb_test "ptype s" "type = character\\*3" -+gdb_test "p s" "\\$\[0-9\]* = 'foo'" -diff --git a/gdb/testsuite/gdb.opt/fortran-string.f90 b/gdb/testsuite/gdb.opt/fortran-string.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.opt/fortran-string.f90 -@@ -0,0 +1,28 @@ -+! 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. -+! -+! 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 f(s) -+ character*(*) s -+ s = s -+ end -+ -+ program main -+ call f ('foo') -+ end -diff --git a/gdb/testsuite/gdb.pascal/arrays.exp b/gdb/testsuite/gdb.pascal/arrays.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pascal/arrays.exp -@@ -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 [standard_output_file ${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" -+ -diff --git a/gdb/testsuite/gdb.pascal/arrays.pas b/gdb/testsuite/gdb.pascal/arrays.pas -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.pascal/arrays.pas -@@ -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. -diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp ---- a/gdb/testsuite/lib/gdb.exp -+++ b/gdb/testsuite/lib/gdb.exp -@@ -224,6 +224,11 @@ proc gdb_unload {} { - send_gdb "y\n" answer - 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" answer - exp_continue -diff --git a/gdb/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp ---- a/gdb/testsuite/lib/pascal.exp -+++ b/gdb/testsuite/lib/pascal.exp -@@ -37,6 +37,9 @@ proc pascal_init {} { - gdb_persistent_global pascal_compiler_is_fpc - gdb_persistent_global gpc_compiler - gdb_persistent_global fpc_compiler -+ gdb_persistent_global fpcversion_major -+ gdb_persistent_global fpcversion_minor -+ gdb_persistent_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-archer.patch b/gdb-archer.patch deleted file mode 100644 index 3d59f4f..0000000 --- a/gdb-archer.patch +++ /dev/null @@ -1,187 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-archer.patch - -;; Python patches of: http://sourceware.org/gdb/wiki/ProjectArcher -;;=push - -http://sourceware.org/gdb/wiki/ProjectArcher -http://sourceware.org/gdb/wiki/ArcherBranchManagement - -GIT snapshot: -commit 718a1618b2f691a7f407213bb50f100ac59f91c3 - -tromey/python - -diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in ---- a/gdb/data-directory/Makefile.in -+++ b/gdb/data-directory/Makefile.in -@@ -80,6 +80,7 @@ PYTHON_FILE_LIST = \ - gdb/unwinder.py \ - gdb/xmethod.py \ - gdb/command/__init__.py \ -+ gdb/command/ignore_errors.py \ - gdb/command/explore.py \ - gdb/command/backtrace.py \ - gdb/command/frame_filters.py \ -@@ -92,6 +93,7 @@ PYTHON_FILE_LIST = \ - gdb/function/as_string.py \ - gdb/function/caller_is.py \ - gdb/function/strfns.py \ -+ gdb/function/in_scope.py \ - gdb/printer/__init__.py \ - gdb/printer/bound_registers.py - -diff --git a/gdb/gdb-gdb.gdb.in b/gdb/gdb-gdb.gdb.in ---- a/gdb/gdb-gdb.gdb.in -+++ b/gdb/gdb-gdb.gdb.in -@@ -1,5 +1,15 @@ - echo Setting up the environment for debugging gdb.\n - -+# Set up the Python library and "require" command. -+python -+from os.path import abspath -+gdb.datadir = abspath ('@srcdir@/python/lib') -+gdb.pythonlibdir = gdb.datadir -+gdb.__path__ = [gdb.datadir + '/gdb'] -+sys.path.insert(0, gdb.datadir) -+end -+source @srcdir@/python/lib/gdb/__init__.py -+ - if !$gdb_init_done - set variable $gdb_init_done = 1 - -diff --git a/gdb/python/lib/gdb/command/ignore_errors.py b/gdb/python/lib/gdb/command/ignore_errors.py -new file mode 100644 ---- /dev/null -+++ b/gdb/python/lib/gdb/command/ignore_errors.py -@@ -0,0 +1,37 @@ -+# Ignore errors in user commands. -+ -+# Copyright (C) 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 . -+ -+import gdb -+ -+class IgnoreErrorsCommand (gdb.Command): -+ """Execute a single command, ignoring all errors. -+Only one-line commands are supported. -+This is primarily useful in scripts.""" -+ -+ def __init__ (self): -+ super (IgnoreErrorsCommand, self).__init__ ("ignore-errors", -+ gdb.COMMAND_OBSCURE, -+ # FIXME... -+ gdb.COMPLETE_COMMAND) -+ -+ def invoke (self, arg, from_tty): -+ try: -+ gdb.execute (arg, from_tty) -+ except: -+ pass -+ -+IgnoreErrorsCommand () -diff --git a/gdb/python/lib/gdb/function/in_scope.py b/gdb/python/lib/gdb/function/in_scope.py -new file mode 100644 ---- /dev/null -+++ b/gdb/python/lib/gdb/function/in_scope.py -@@ -0,0 +1,47 @@ -+# In-scope function. -+ -+# Copyright (C) 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 . -+ -+import gdb -+ -+class InScope (gdb.Function): -+ """Return True if all the given variables or macros are in scope. -+Takes one argument for each variable name to be checked.""" -+ -+ def __init__ (self): -+ super (InScope, self).__init__ ("in_scope") -+ -+ def invoke (self, *vars): -+ if len (vars) == 0: -+ raise (TypeError, "in_scope takes at least one argument") -+ -+ # gdb.Value isn't hashable so it can't be put in a map. -+ # Convert to string first. -+ wanted = set (map (lambda x: x.string (), vars)) -+ found = set () -+ block = gdb.selected_frame ().block () -+ while block: -+ for sym in block: -+ if (sym.is_argument or sym.is_constant -+ or sym.is_function or sym.is_variable): -+ if sym.name in wanted: -+ found.add (sym.name) -+ -+ block = block.superblock -+ -+ return wanted == found -+ -+InScope () -diff --git a/gdb/testsuite/gdb.python/py-frame.exp b/gdb/testsuite/gdb.python/py-frame.exp ---- a/gdb/testsuite/gdb.python/py-frame.exp -+++ b/gdb/testsuite/gdb.python/py-frame.exp -@@ -95,6 +95,8 @@ gdb_test "python print ('result = %s' % f0.read_var ('a'))" " = 1" "test Frame.r - - gdb_test "python print ('result = %s' % (gdb.selected_frame () == f1))" " = True" "test gdb.selected_frame" - -+gdb_test "python print ('result = %s' % (f0.block ()))" "" "test Frame.block" -+ - # Can read SP register. - gdb_test "python print ('result = %s' % (gdb.selected_frame ().read_register ('sp') == gdb.parse_and_eval ('\$sp')))" \ - " = True" \ -diff --git a/gdb/testsuite/gdb.python/py-value.exp b/gdb/testsuite/gdb.python/py-value.exp ---- a/gdb/testsuite/gdb.python/py-value.exp -+++ b/gdb/testsuite/gdb.python/py-value.exp -@@ -419,6 +419,15 @@ proc test_value_after_death {} { - "print value's type" - } - -+# Regression test for a cast failure. The bug was that if we cast a -+# value to its own type, gdb could crash. This happened because we -+# could end up double-freeing a struct value. -+proc test_cast_regression {} { -+ gdb_test "python v = gdb.Value(5)" "" "create value for cast test" -+ gdb_test "python v = v.cast(v.type)" "" "cast value for cast test" -+ gdb_test "python print(v)" "5" "print value for cast test" -+} -+ - # Regression test for invalid subscript operations. The bug was that - # the type of the value was not being checked before allowing a - # subscript operation to proceed. -@@ -606,6 +615,7 @@ test_value_in_inferior - test_value_from_buffer - test_inferior_function_call - test_value_after_death -+test_cast_regression - - # Test either C or C++ values. - diff --git a/gdb-attach-fail-reasons-5of5.patch b/gdb-attach-fail-reasons-5of5.patch deleted file mode 100644 index 8830be3..0000000 --- a/gdb-attach-fail-reasons-5of5.patch +++ /dev/null @@ -1,356 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-attach-fail-reasons-5of5.patch - -;; Print reasons for failed attach/spawn incl. SELinux deny_ptrace (BZ 786878). -;;=push+jan - -http://sourceware.org/ml/gdb-patches/2012-03/msg00171.html - -Hi, - -and here is the last bit for new SELinux 'deny_ptrace': - https://bugzilla.redhat.com/show_bug.cgi?id=786878 - -As even PTRACE_TRACEME fails in such case it needs to install hook for even -that event. - -Thanks, -Jan - -gdb/ -2012-03-06 Jan Kratochvil - - * common/linux-ptrace.c [HAVE_SELINUX_SELINUX_H]: include - selinux/selinux.h. - (linux_ptrace_attach_warnings): Call linux_ptrace_create_warnings. - (linux_ptrace_create_warnings): New. - * common/linux-ptrace.h (linux_ptrace_create_warnings): New declaration. - * config.in: Regenerate. - * configure: Regenerate. - * configure.ac: Check selinux/selinux.h and the selinux library. - * inf-ptrace.c (inf_ptrace_me): Check the ptrace result. - * linux-nat.c (linux_nat_create_inferior): New variable ex. Wrap - to_create_inferior into TRY_CATCH, call linux_ptrace_create_warnings. - -gdb/gdbserver/ - * config.in: Regenerate. - * configure: Regenerate. - * configure.ac: Check selinux/selinux.h and the selinux library. - * linux-low.c (linux_traceme): New function. - (linux_create_inferior, linux_tracefork_child): Call it instead of - direct ptrace. - -diff --git a/gdb/config.in b/gdb/config.in ---- a/gdb/config.in -+++ b/gdb/config.in -@@ -253,6 +253,9 @@ - /* Define if librpm library is being used. */ - #undef HAVE_LIBRPM - -+/* Define to 1 if you have the `selinux' library (-lselinux). */ -+#undef HAVE_LIBSELINUX -+ - /* Define to 1 if you have the header file. */ - #undef HAVE_LIBUNWIND_IA64_H - -@@ -388,6 +391,9 @@ - /* Define to 1 if you have the `scm_new_smob' function. */ - #undef HAVE_SCM_NEW_SMOB - -+/* Define to 1 if you have the header file. */ -+#undef HAVE_SELINUX_SELINUX_H -+ - /* Define to 1 if you have the `setlocale' function. */ - #undef HAVE_SETLOCALE - -diff --git a/gdb/configure b/gdb/configure ---- a/gdb/configure -+++ b/gdb/configure -@@ -16861,6 +16861,64 @@ cat >>confdefs.h <<_ACEOF - _ACEOF - - -+for ac_header in selinux/selinux.h -+do : -+ ac_fn_c_check_header_mongrel "$LINENO" "selinux/selinux.h" "ac_cv_header_selinux_selinux_h" "$ac_includes_default" -+if test "x$ac_cv_header_selinux_selinux_h" = x""yes; then : -+ cat >>confdefs.h <<_ACEOF -+#define HAVE_SELINUX_SELINUX_H 1 -+_ACEOF -+ -+fi -+ -+done -+ -+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for security_get_boolean_active in -lselinux" >&5 -+$as_echo_n "checking for security_get_boolean_active in -lselinux... " >&6; } -+if test "${ac_cv_lib_selinux_security_get_boolean_active+set}" = set; then : -+ $as_echo_n "(cached) " >&6 -+else -+ ac_check_lib_save_LIBS=$LIBS -+LIBS="-lselinux $LIBS" -+cat confdefs.h - <<_ACEOF >conftest.$ac_ext -+/* end confdefs.h. */ -+ -+/* Override any GCC internal prototype to avoid an error. -+ Use char because int might match the return type of a GCC -+ builtin and then its argument prototype would still apply. */ -+#ifdef __cplusplus -+extern "C" -+#endif -+char security_get_boolean_active (); -+int -+main () -+{ -+return security_get_boolean_active (); -+ ; -+ return 0; -+} -+_ACEOF -+if ac_fn_c_try_link "$LINENO"; then : -+ ac_cv_lib_selinux_security_get_boolean_active=yes -+else -+ ac_cv_lib_selinux_security_get_boolean_active=no -+fi -+rm -f core conftest.err conftest.$ac_objext \ -+ conftest$ac_exeext conftest.$ac_ext -+LIBS=$ac_check_lib_save_LIBS -+fi -+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_selinux_security_get_boolean_active" >&5 -+$as_echo "$ac_cv_lib_selinux_security_get_boolean_active" >&6; } -+if test "x$ac_cv_lib_selinux_security_get_boolean_active" = x""yes; then : -+ cat >>confdefs.h <<_ACEOF -+#define HAVE_LIBSELINUX 1 -+_ACEOF -+ -+ LIBS="-lselinux $LIBS" -+ -+fi -+ -+ - - # Support for --with-sysroot is a copy of GDB_AC_WITH_DIR, - # except that the argument to --with-sysroot is optional. -diff --git a/gdb/configure.ac b/gdb/configure.ac ---- a/gdb/configure.ac -+++ b/gdb/configure.ac -@@ -1900,6 +1900,10 @@ case $host_os in - esac - AC_DEFINE_UNQUOTED(GDBINIT,"$gdbinit",[The .gdbinit filename.]) - -+dnl Check security_get_boolean_active availability. -+AC_CHECK_HEADERS(selinux/selinux.h) -+AC_CHECK_LIB(selinux, security_get_boolean_active) -+ - dnl Handle optional features that can be enabled. - - # Support for --with-sysroot is a copy of GDB_AC_WITH_DIR, -diff --git a/gdb/linux-nat.c b/gdb/linux-nat.c ---- a/gdb/linux-nat.c -+++ b/gdb/linux-nat.c -@@ -1103,7 +1103,16 @@ linux_nat_target::create_inferior (const char *exec_file, - /* Make sure we report all signals during startup. */ - pass_signals ({}); - -- inf_ptrace_target::create_inferior (exec_file, allargs, env, from_tty); -+ try -+ { -+ inf_ptrace_target::create_inferior (exec_file, allargs, env, from_tty); -+ } -+ catch (const gdb_exception_error &ex) -+ { -+ std::string result = linux_ptrace_create_warnings (); -+ -+ throw_error (ex.error, "%s%s", result.c_str (), ex.message->c_str ()); -+ } - } - - /* Callback for linux_proc_attach_tgid_threads. Attach to PTID if not -diff --git a/gdb/nat/linux-ptrace.c b/gdb/nat/linux-ptrace.c ---- a/gdb/nat/linux-ptrace.c -+++ b/gdb/nat/linux-ptrace.c -@@ -25,6 +25,10 @@ - #include - #endif - -+#ifdef HAVE_SELINUX_SELINUX_H -+# include -+#endif /* HAVE_SELINUX_SELINUX_H */ -+ - /* Stores the ptrace options supported by the running kernel. - A value of -1 means we did not check for features yet. A value - of 0 means there are no supported features. */ -@@ -50,6 +54,8 @@ linux_ptrace_attach_fail_reason (pid_t pid) - "terminated"), - (int) pid); - -+ result += linux_ptrace_create_warnings (); -+ - return result; - } - -@@ -586,6 +592,25 @@ linux_ptrace_init_warnings (void) - linux_ptrace_test_ret_to_nx (); - } - -+/* Print all possible reasons we could fail to create a traced process. */ -+ -+std::string -+linux_ptrace_create_warnings () -+{ -+ std::string result; -+ -+#ifdef HAVE_LIBSELINUX -+ /* -1 is returned for errors, 0 if it has no effect, 1 if PTRACE_ATTACH is -+ forbidden. */ -+ if (security_get_boolean_active ("deny_ptrace") == 1) -+ string_appendf (result, -+ _("the SELinux boolean 'deny_ptrace' is enabled, " -+ "you can disable this process attach protection by: " -+ "(gdb) shell sudo setsebool deny_ptrace=0\n")); -+#endif /* HAVE_LIBSELINUX */ -+ return result; -+} -+ - /* Extract extended ptrace event from wait status. */ - - int -diff --git a/gdb/nat/linux-ptrace.h b/gdb/nat/linux-ptrace.h ---- a/gdb/nat/linux-ptrace.h -+++ b/gdb/nat/linux-ptrace.h -@@ -184,6 +184,7 @@ extern std::string linux_ptrace_attach_fail_reason (pid_t pid); - extern std::string linux_ptrace_attach_fail_reason_string (ptid_t ptid, int err); - - extern void linux_ptrace_init_warnings (void); -+extern std::string linux_ptrace_create_warnings (); - extern void linux_check_ptrace_features (void); - extern void linux_enable_event_reporting (pid_t pid, int attached); - extern void linux_disable_event_reporting (pid_t pid); -diff --git a/gdbserver/config.in b/gdbserver/config.in ---- a/gdbserver/config.in -+++ b/gdbserver/config.in -@@ -143,6 +143,9 @@ - /* Define if you have the ipt library. */ - #undef HAVE_LIBIPT - -+/* Define to 1 if you have the `selinux' library (-lselinux). */ -+#undef HAVE_LIBSELINUX -+ - /* Define if the target supports branch tracing. */ - #undef HAVE_LINUX_BTRACE - -@@ -249,6 +252,9 @@ - /* Define to 1 if you have the `sbrk' function. */ - #undef HAVE_SBRK - -+/* Define to 1 if you have the header file. */ -+#undef HAVE_SELINUX_SELINUX_H -+ - /* Define to 1 if you have the `setns' function. */ - #undef HAVE_SETNS - -diff --git a/gdbserver/configure b/gdbserver/configure ---- a/gdbserver/configure -+++ b/gdbserver/configure -@@ -10683,6 +10683,64 @@ if $want_ipa ; then - fi - fi - -+for ac_header in selinux/selinux.h -+do : -+ ac_fn_c_check_header_mongrel "$LINENO" "selinux/selinux.h" "ac_cv_header_selinux_selinux_h" "$ac_includes_default" -+if test "x$ac_cv_header_selinux_selinux_h" = x""yes; then : -+ cat >>confdefs.h <<_ACEOF -+#define HAVE_SELINUX_SELINUX_H 1 -+_ACEOF -+ -+fi -+ -+done -+ -+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for security_get_boolean_active in -lselinux" >&5 -+$as_echo_n "checking for security_get_boolean_active in -lselinux... " >&6; } -+if test "${ac_cv_lib_selinux_security_get_boolean_active+set}" = set; then : -+ $as_echo_n "(cached) " >&6 -+else -+ ac_check_lib_save_LIBS=$LIBS -+LIBS="-lselinux $LIBS" -+cat confdefs.h - <<_ACEOF >conftest.$ac_ext -+/* end confdefs.h. */ -+ -+/* Override any GCC internal prototype to avoid an error. -+ Use char because int might match the return type of a GCC -+ builtin and then its argument prototype would still apply. */ -+#ifdef __cplusplus -+extern "C" -+#endif -+char security_get_boolean_active (); -+int -+main () -+{ -+return security_get_boolean_active (); -+ ; -+ return 0; -+} -+_ACEOF -+if ac_fn_c_try_link "$LINENO"; then : -+ ac_cv_lib_selinux_security_get_boolean_active=yes -+else -+ ac_cv_lib_selinux_security_get_boolean_active=no -+fi -+rm -f core conftest.err conftest.$ac_objext \ -+ conftest$ac_exeext conftest.$ac_ext -+LIBS=$ac_check_lib_save_LIBS -+fi -+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_selinux_security_get_boolean_active" >&5 -+$as_echo "$ac_cv_lib_selinux_security_get_boolean_active" >&6; } -+if test "x$ac_cv_lib_selinux_security_get_boolean_active" = x""yes; then : -+ cat >>confdefs.h <<_ACEOF -+#define HAVE_LIBSELINUX 1 -+_ACEOF -+ -+ LIBS="-lselinux $LIBS" -+ -+fi -+ -+ - - - -diff --git a/gdbserver/configure.ac b/gdbserver/configure.ac ---- a/gdbserver/configure.ac -+++ b/gdbserver/configure.ac -@@ -401,6 +401,10 @@ if $want_ipa ; then - fi - fi - -+dnl Check security_get_boolean_active availability. -+AC_CHECK_HEADERS(selinux/selinux.h) -+AC_CHECK_LIB(selinux, security_get_boolean_active) -+ - AC_SUBST(GDBSERVER_DEPFILES) - AC_SUBST(GDBSERVER_LIBS) - AC_SUBST(srv_xmlbuiltin) -diff --git a/gdbserver/linux-low.cc b/gdbserver/linux-low.cc ---- a/gdbserver/linux-low.cc -+++ b/gdbserver/linux-low.cc -@@ -932,7 +932,16 @@ linux_ptrace_fun () - { - if (ptrace (PTRACE_TRACEME, 0, (PTRACE_TYPE_ARG3) 0, - (PTRACE_TYPE_ARG4) 0) < 0) -- trace_start_error_with_name ("ptrace"); -+ { -+ int save_errno = errno; -+ -+ std::string msg (linux_ptrace_create_warnings ()); -+ -+ msg += _("Cannot trace created process"); -+ -+ errno = save_errno; -+ trace_start_error_with_name (msg.c_str ()); -+ } - - if (setpgid (0, 0) < 0) - trace_start_error_with_name ("setpgid"); diff --git a/gdb-btrobust.patch b/gdb-btrobust.patch deleted file mode 100644 index 2c7e2d3..0000000 --- a/gdb-btrobust.patch +++ /dev/null @@ -1,45 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-btrobust.patch - -;; Continue backtrace even if a frame filter throws an exception (Phil Muldoon). -;;=push - -This should fix the error with glib. An error message will still be -printed, but a default backtrace will occur in this case. - --- - -diff --git a/gdb/python/py-framefilter.c b/gdb/python/py-framefilter.c ---- a/gdb/python/py-framefilter.c -+++ b/gdb/python/py-framefilter.c -@@ -1204,6 +1204,7 @@ gdbpy_apply_frame_filter (const struct extension_language_defn *extlang, - htab_eq_pointer, - NULL)); - -+ int count_printed = 0; - while (true) - { - gdbpy_ref<> item (PyIter_Next (iterable.get ())); -@@ -1212,8 +1213,8 @@ gdbpy_apply_frame_filter (const struct extension_language_defn *extlang, - { - if (PyErr_Occurred ()) - { -- gdbpy_print_stack_or_quit (); -- return EXT_LANG_BT_ERROR; -+ gdbpy_print_stack (); -+ return count_printed > 0 ? EXT_LANG_BT_ERROR : EXT_LANG_BT_NO_FILTERS; - } - break; - } -@@ -1245,7 +1246,8 @@ gdbpy_apply_frame_filter (const struct extension_language_defn *extlang, - /* Do not exit on error printing a single frame. Print the - error and continue with other frames. */ - if (success == EXT_LANG_BT_ERROR) -- gdbpy_print_stack_or_quit (); -+ gdbpy_print_stack (); -+ count_printed++; - } - - return success; diff --git a/gdb-bz1219747-attach-kills.patch b/gdb-bz1219747-attach-kills.patch deleted file mode 100644 index fb3a349..0000000 --- a/gdb-bz1219747-attach-kills.patch +++ /dev/null @@ -1,178 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-bz1219747-attach-kills.patch - -;; Never kill PID on: gdb exec PID (Jan Kratochvil, RH BZ 1219747). -;;=push+jan - -http://sourceware.org/ml/gdb-patches/2015-10/msg00301.html - -Hi, - -in some cases with deleted main executable GDB will want to kill the inferior. - -$ cp /bin/sleep /tmp/sleep;/tmp/sleep 1h&p=$! -$ rm /tmp/sleep -$ gdb /tmp/sleep $p -GNU gdb (GDB) 7.10.50.20151016-cvs -/tmp/sleep: No such file or directory. -Attaching to process 9694 -/tmp/sleep (deleted): No such file or directory. -A program is being debugged already. Kill it? (y or n) _ - -The first attachment of "/tmp/sleep" commandline argument errors at: - -267 if (scratch_chan < 0) -268 perror_with_name (filename); -1051 if (catch_command_errors_const (exec_file_attach, execarg, -1052 !batch_flag)) - -Then GDB tries to attach to the process $p: - -1082 if (catch_command_errors (attach_command, pid_or_core_arg, -1083 !batch_flag) == 0) - -This succeeds and since this moment GDB has a valid inferior. But despite that -the lines -1082 if (catch_command_errors (attach_command, pid_or_core_arg, -1083 !batch_flag) == 0) -still fail because consequently attach_command() fails to find the associated -executable file: - -267 if (scratch_chan < 0) -268 perror_with_name (filename); -1082 if (catch_command_errors (attach_command, pid_or_core_arg, -1083 !batch_flag) == 0) - -and therefore GDB executes the following: - -(gdb) bt -2179 if (have_inferiors ()) -2180 { -2181 if (!from_tty -2182 || !have_live_inferiors () -2183 || query (_("A program is being debugged already. Kill it? "))) -2184 iterate_over_inferiors (dispose_inferior, NULL); -2185 else -2186 error (_("Program not killed.")); -2187 } -1084 catch_command_errors (core_file_command, pid_or_core_arg, -1085 !batch_flag); - -No regressions on {x86_64,x86_64-m32,i686}-fedora24pre-linux-gnu. - -Thanks, -Jan - -gdb/ChangeLog -2015-10-16 Jan Kratochvil - - * main.c (captured_main): Run core_file_command for pid_or_core_arg - only if not have_inferiors (). - -gdb/testsuite/ChangeLog -2015-10-16 Jan Kratochvil - - * gdb.base/attach-kills.c: New. - * gdb.base/attach-kills.exp: New. - -diff --git a/gdb/main.c b/gdb/main.c ---- a/gdb/main.c -+++ b/gdb/main.c -@@ -1199,7 +1199,10 @@ captured_main_1 (struct captured_main_args *context) - { - ret = catch_command_errors (attach_command, pid_or_core_arg, - !batch_flag); -- if (ret == 0) -+ if (ret == 0 -+ /* attach_command could succeed partially and core_file_command -+ would try to kill it. */ -+ && !have_inferiors ()) - ret = catch_command_errors (core_file_command, - pid_or_core_arg, - !batch_flag); -diff --git a/gdb/testsuite/gdb.base/attach-kills.c b/gdb/testsuite/gdb.base/attach-kills.c -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/attach-kills.c -@@ -0,0 +1,25 @@ -+/* This testcase is part of GDB, the GNU debugger. -+ -+ Copyright 2015 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 (void) -+{ -+ sleep (600); -+ return 0; -+} -diff --git a/gdb/testsuite/gdb.base/attach-kills.exp b/gdb/testsuite/gdb.base/attach-kills.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.base/attach-kills.exp -@@ -0,0 +1,49 @@ -+# Copyright (C) 2015 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 { ![can_spawn_for_attach] } { -+ return 0 -+} -+ -+standard_testfile -+ -+if { [build_executable ${testfile}.exp $testfile] == -1 } { -+ return -1 -+} -+ -+# Start the program running and then wait for a bit, to be sure -+# that it can be attached to. -+ -+set test_spawn_id [spawn_wait_for_attach $binfile] -+set testpid [spawn_id_get_pid $test_spawn_id] -+ -+remote_exec target "cp -pf -- $binfile $binfile-copy" -+remote_exec target "rm -f -- $binfile" -+ -+set test "start gdb" -+set res [gdb_spawn_with_cmdline_opts \ -+ "-iex \"set height 0\" -iex \"set width 0\" /DoEsNoTeXySt $testpid"] -+if { $res != 0} { -+ fail "$test (spawn)" -+ kill_wait_spawned_process $test_spawn_id -+ return -1 -+} -+gdb_test_multiple "" $test { -+ -re "\r\nAttaching to .*\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+ -+kill_wait_spawned_process $test_spawn_id diff --git a/gdb-bz533176-fortran-omp-step.patch b/gdb-bz533176-fortran-omp-step.patch deleted file mode 100644 index 5264115..0000000 --- a/gdb-bz533176-fortran-omp-step.patch +++ /dev/null @@ -1,130 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-bz533176-fortran-omp-step.patch - -;; Fix stepping with OMP parallel Fortran sections (BZ 533176). -;;=push+jan: It requires some better DWARF annotations. - -https://bugzilla.redhat.com/show_bug.cgi?id=533176#c4 - -I find it a bug in DWARF and gdb behaves correctly according to it. From the -current DWARF's point of view the is a function call which you skip by "next". - -If you hide any /usr/lib/debug such as using: -gdb -nx -ex 'set debug-file-directory /qwe' -ex 'file ./tpcommon_gfortran44' -and use "step" command instead of "next" there it will work. -(You need to hide debuginfo from libgomp as you would step into libgomp sources -to maintain the threads for execution.) - -There should be some DWARF extension for it, currently tried to detect -substring ".omp_fn." as this function is called "MAIN__.omp_fn.0" and do not -consider such sub-function as a skippable by "next". - -Another problem is that with "set scheduler-locking" being "off" (default -upstream) or "step" (default in F/RHEL) the simultaneous execution of the -threads is inconvenient. Setting it to "on" will lockup the debugging as the -threads need to get synchronized at some point. This is a more general -debugging problem of GOMP outside of the scope of this Bug. - -diff --git a/gdb/infrun.c b/gdb/infrun.c ---- a/gdb/infrun.c -+++ b/gdb/infrun.c -@@ -6788,6 +6788,16 @@ process_event_stop_test (struct execution_control_state *ecs) - - if (ecs->event_thread->control.step_over_calls == STEP_OVER_ALL) - { -+ struct symbol *stop_fn = find_pc_function (stop_pc); -+ struct minimal_symbol *stopf = lookup_minimal_symbol_by_pc (stop_pc).minsym; -+ -+ if ((stop_fn == NULL -+ || strstr (stop_fn->linkage_name (), ".omp_fn.") == NULL) -+ /* gcc-4.7.2-9.fc19.x86_64 uses a new format. */ -+ && (stopf == NULL -+ || strstr (stopf->linkage_name (), "._omp_fn.") == NULL)) -+{ /* ".omp_fn." */ -+ - /* We're doing a "next". - - Normal (forward) execution: set a breakpoint at the -@@ -6821,6 +6831,7 @@ process_event_stop_test (struct execution_control_state *ecs) - - keep_going (ecs); - return; -+} /* ".omp_fn." */ - } - - /* If we are in a function call trampoline (a stub between the -diff --git a/gdb/testsuite/gdb.fortran/omp-step.exp b/gdb/testsuite/gdb.fortran/omp-step.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/omp-step.exp -@@ -0,0 +1,31 @@ -+# 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 testfile "omp-step" -+set srcfile ${testfile}.f90 -+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90 additional_flags=-fopenmp}] } { -+ return -1 -+} -+ -+if ![runto [gdb_get_line_number "start-here"]] { -+ perror "Couldn't run to start-here" -+ return 0 -+} -+ -+gdb_test "next" {!\$omp parallel} "step closer" -+gdb_test "next" {a\(omp_get_thread_num\(\) \+ 1\) = 1} "step into omp" -+ -+gdb_breakpoint [gdb_get_line_number "success"] -+gdb_continue_to_breakpoint "success" ".*success.*" -diff --git a/gdb/testsuite/gdb.fortran/omp-step.f90 b/gdb/testsuite/gdb.fortran/omp-step.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/omp-step.f90 -@@ -0,0 +1,32 @@ -+! 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 . -+ -+ use omp_lib -+ integer nthreads, i, a(1000) -+ nthreads = omp_get_num_threads() -+ if (nthreads .gt. 1000) call abort -+ -+ do i = 1, nthreads -+ a(i) = 0 -+ end do -+ print *, "start-here" -+!$omp parallel -+ a(omp_get_thread_num() + 1) = 1 -+!$omp end parallel -+ do i = 1, nthreads -+ if (a(i) .ne. 1) call abort -+ end do -+ print *, "success" -+ end diff --git a/gdb-dont-overwrite-fsgsbase-m32.patch b/gdb-dont-overwrite-fsgsbase-m32.patch new file mode 100644 index 0000000..ee9ad49 --- /dev/null +++ b/gdb-dont-overwrite-fsgsbase-m32.patch @@ -0,0 +1,139 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Tom de Vries +Date: Tue, 1 Jun 2021 10:14:31 -0700 +Subject: gdb-dont-overwrite-fsgsbase-m32.patch + +;; Backport "[gdb/server] Don't overwrite fs/gs_base with -m32" +;; (Tom de Vries) + +Consider a minimal test-case test.c: +... +int main (void) { return 0; } +... +compiled with -m32: +... +$ gcc test.c -m32 +... + +When running the exec using gdbserver on openSUSE Factory (currently running a +linux kernel version 5.10.5): +... +$ gdbserver localhost:12345 a.out +... +to which we connect in a gdb session, we run into a segfault in the inferior: +... +$ gdb -batch -q -ex "target remote localhost:12345" -ex continue +Program received signal SIGSEGV, Segmentation fault. +0xf7dd8bd2 in init_cacheinfo () at ../sysdeps/x86/cacheinfo.c:761 +... + +The segfault is caused by gdbserver overwriting $gs_base with 0 using +PTRACE_SETREGS. After it is overwritten, the next use of $gs in the inferior +will trigger the segfault. + +Before linux kernel version 5.9, the value used by PTRACE_SETREGS for $gs_base +was ignored, but starting version 5.9, the linux kernel has support for +intel architecture extension FSGSBASE, which allows users to modify $gs_base, +and consequently PTRACE_SETREGS can no longer ignore the $gs_base value. + +The overwrite of $gs_base with 0 is done by a memset in x86_fill_gregset, +which was added in commit 9e0aa64f551 "Fix gdbserver qGetTLSAddr for +x86_64 -m32". The memset intends to zero-extend 32-bit registers that are +tracked in the regcache to 64-bit when writing them into the PTRACE_SETREGS +data argument. But in addition, it overwrites other registers that are +not tracked in the regcache, such as $gs_base. + +Fix the segfault by redoing the fix from commit 9e0aa64f551 in minimal form. + +Tested on x86_64-linux: +- openSUSE Leap 15.2 (using kernel version 5.3.18): + - native + - gdbserver -m32 + - -m32 +- openSUSE Factory (using kernel version 5.10.5): + - native + - m32 + +gdbserver/ChangeLog: + +2021-01-20 Tom de Vries + + * linux-x86-low.cc (collect_register_i386): New function. + (x86_fill_gregset): Remove memset. Use collect_register_i386. + +diff --git a/gdbserver/linux-x86-low.cc b/gdbserver/linux-x86-low.cc +--- a/gdbserver/linux-x86-low.cc ++++ b/gdbserver/linux-x86-low.cc +@@ -397,6 +397,35 @@ x86_target::low_cannot_fetch_register (int regno) + return regno >= I386_NUM_REGS; + } + ++static void ++collect_register_i386 (struct regcache *regcache, int regno, void *buf) ++{ ++ collect_register (regcache, regno, buf); ++ ++#ifdef __x86_64__ ++ /* In case of x86_64 -m32, collect_register only writes 4 bytes, but the ++ space reserved in buf for the register is 8 bytes. Make sure the entire ++ reserved space is initialized. */ ++ ++ gdb_assert (register_size (regcache->tdesc, regno) == 4); ++ ++ if (regno == RAX) ++ { ++ /* Sign extend EAX value to avoid potential syscall restart ++ problems. ++ ++ See amd64_linux_collect_native_gregset() in ++ gdb/amd64-linux-nat.c for a detailed explanation. */ ++ *(int64_t *) buf = *(int32_t *) buf; ++ } ++ else ++ { ++ /* Zero-extend. */ ++ *(uint64_t *) buf = *(uint32_t *) buf; ++ } ++#endif ++} ++ + static void + x86_fill_gregset (struct regcache *regcache, void *buf) + { +@@ -411,32 +440,14 @@ x86_fill_gregset (struct regcache *regcache, void *buf) + + return; + } +- +- /* 32-bit inferior registers need to be zero-extended. +- Callers would read uninitialized memory otherwise. */ +- memset (buf, 0x00, X86_64_USER_REGS * 8); + #endif + + for (i = 0; i < I386_NUM_REGS; i++) +- collect_register (regcache, i, ((char *) buf) + i386_regmap[i]); +- +- collect_register_by_name (regcache, "orig_eax", +- ((char *) buf) + ORIG_EAX * REGSIZE); ++ collect_register_i386 (regcache, i, ((char *) buf) + i386_regmap[i]); + +-#ifdef __x86_64__ +- /* Sign extend EAX value to avoid potential syscall restart +- problems. +- +- See amd64_linux_collect_native_gregset() in gdb/amd64-linux-nat.c +- for a detailed explanation. */ +- if (register_size (regcache->tdesc, 0) == 4) +- { +- void *ptr = ((gdb_byte *) buf +- + i386_regmap[find_regno (regcache->tdesc, "eax")]); +- +- *(int64_t *) ptr = *(int32_t *) ptr; +- } +-#endif ++ /* Handle ORIG_EAX, which is not in i386_regmap. */ ++ collect_register_i386 (regcache, find_regno (regcache->tdesc, "orig_eax"), ++ ((char *) buf) + ORIG_EAX * REGSIZE); + } + + static void diff --git a/gdb-dts-rhel6-python-compat.patch b/gdb-dts-rhel6-python-compat.patch deleted file mode 100644 index 697c6f0..0000000 --- a/gdb-dts-rhel6-python-compat.patch +++ /dev/null @@ -1,315 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-dts-rhel6-python-compat.patch - -;; [rhel6] DTS backward Python compatibility API (BZ 1020004, Phil Muldoon). -;;=fedora - -https://bugzilla.redhat.com/show_bug.cgi?id=1020004 - -diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in ---- a/gdb/data-directory/Makefile.in -+++ b/gdb/data-directory/Makefile.in -@@ -71,6 +71,8 @@ PYTHON_FILE_LIST = \ - gdb/__init__.py \ - gdb/FrameDecorator.py \ - gdb/FrameIterator.py \ -+ gdb/FrameWrapper.py \ -+ gdb/backtrace.py \ - gdb/frames.py \ - gdb/printing.py \ - gdb/prompt.py \ -@@ -79,6 +81,7 @@ PYTHON_FILE_LIST = \ - gdb/xmethod.py \ - gdb/command/__init__.py \ - gdb/command/explore.py \ -+ gdb/command/backtrace.py \ - gdb/command/frame_filters.py \ - gdb/command/pretty_printers.py \ - gdb/command/prompt.py \ -diff --git a/gdb/python/lib/gdb/FrameWrapper.py b/gdb/python/lib/gdb/FrameWrapper.py -new file mode 100644 ---- /dev/null -+++ b/gdb/python/lib/gdb/FrameWrapper.py -@@ -0,0 +1,122 @@ -+# Wrapper API for frames. -+ -+# Copyright (C) 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 . -+ -+import gdb -+ -+# FIXME: arguably all this should be on Frame somehow. -+class FrameWrapper: -+ def __init__ (self, frame): -+ self.frame = frame; -+ -+ def write_symbol (self, stream, sym, block): -+ if len (sym.linkage_name): -+ nsym, is_field_of_this = gdb.lookup_symbol (sym.linkage_name, block) -+ if nsym.addr_class != gdb.SYMBOL_LOC_REGISTER: -+ sym = nsym -+ -+ stream.write (sym.print_name + "=") -+ try: -+ val = self.read_var (sym) -+ if val != None: -+ val = str (val) -+ # FIXME: would be nice to have a more precise exception here. -+ except RuntimeError as text: -+ val = text -+ if val == None: -+ stream.write ("???") -+ else: -+ stream.write (str (val)) -+ -+ def print_frame_locals (self, stream, func): -+ -+ try: -+ block = self.frame.block() -+ except RuntimeError: -+ block = None -+ -+ while block != None: -+ if block.is_global or block.is_static: -+ break -+ -+ for sym in block: -+ if sym.is_argument: -+ continue; -+ -+ self.write_symbol (stream, sym, block) -+ stream.write ('\n') -+ -+ def print_frame_args (self, stream, func): -+ -+ try: -+ block = self.frame.block() -+ except RuntimeError: -+ block = None -+ -+ while block != None: -+ if block.function != None: -+ break -+ block = block.superblock -+ -+ first = True -+ for sym in block: -+ if not sym.is_argument: -+ continue; -+ -+ if not first: -+ stream.write (", ") -+ -+ self.write_symbol (stream, sym, block) -+ first = False -+ -+ # FIXME: this should probably just be a method on gdb.Frame. -+ # But then we need stream wrappers. -+ def describe (self, stream, full): -+ if self.type () == gdb.DUMMY_FRAME: -+ stream.write (" \n") -+ elif self.type () == gdb.SIGTRAMP_FRAME: -+ stream.write (" \n") -+ else: -+ sal = self.find_sal () -+ pc = self.pc () -+ name = self.name () -+ if not name: -+ name = "??" -+ if pc != sal.pc or not sal.symtab: -+ stream.write (" 0x%08x in" % pc) -+ stream.write (" " + name + " (") -+ -+ func = self.function () -+ self.print_frame_args (stream, func) -+ -+ stream.write (")") -+ -+ if sal.symtab and sal.symtab.filename: -+ stream.write (" at " + sal.symtab.filename) -+ stream.write (":" + str (sal.line)) -+ -+ if not self.name () or (not sal.symtab or not sal.symtab.filename): -+ lib = gdb.solib_name (pc) -+ if lib: -+ stream.write (" from " + lib) -+ -+ stream.write ("\n") -+ -+ if full: -+ self.print_frame_locals (stream, func) -+ -+ def __getattr__ (self, name): -+ return getattr (self.frame, name) -diff --git a/gdb/python/lib/gdb/backtrace.py b/gdb/python/lib/gdb/backtrace.py -new file mode 100644 ---- /dev/null -+++ b/gdb/python/lib/gdb/backtrace.py -@@ -0,0 +1,42 @@ -+# Filtering backtrace. -+ -+# Copyright (C) 2008, 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 . -+ -+import gdb -+import itertools -+ -+# Our only exports. -+__all__ = ['push_frame_filter', 'create_frame_filter'] -+ -+old_frame_filter = None -+ -+def push_frame_filter (constructor): -+ """Register a new backtrace filter class with the 'backtrace' command. -+The filter will be passed an iterator as an argument. The iterator -+will return gdb.Frame-like objects. The filter should in turn act as -+an iterator returning such objects.""" -+ global old_frame_filter -+ if old_frame_filter == None: -+ old_frame_filter = constructor -+ else: -+ old_frame_filter = lambda iterator, filter = frame_filter: constructor (filter(iterator)) -+ -+def create_frame_filter (iter): -+ global old_frame_filter -+ if old_frame_filter is None: -+ return iter -+ return old_frame_filter (iter) -+ -diff --git a/gdb/python/lib/gdb/command/backtrace.py b/gdb/python/lib/gdb/command/backtrace.py -new file mode 100644 ---- /dev/null -+++ b/gdb/python/lib/gdb/command/backtrace.py -@@ -0,0 +1,106 @@ -+# New backtrace command. -+ -+# Copyright (C) 2008, 2009, 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 . -+ -+import gdb -+import gdb.backtrace -+import itertools -+from gdb.FrameIterator import FrameIterator -+from gdb.FrameWrapper import FrameWrapper -+import sys -+ -+class ReverseBacktraceParameter (gdb.Parameter): -+ """The new-backtrace command can show backtraces in 'reverse' order. -+This means that the innermost frame will be printed last. -+Note that reverse backtraces are more expensive to compute.""" -+ -+ set_doc = "Enable or disable reverse backtraces." -+ show_doc = "Show whether backtraces will be printed in reverse order." -+ -+ def __init__(self): -+ gdb.Parameter.__init__ (self, "reverse-backtrace", -+ gdb.COMMAND_STACK, gdb.PARAM_BOOLEAN) -+ # Default to compatibility with gdb. -+ self.value = False -+ -+class FilteringBacktrace (gdb.Command): -+ """Print backtrace of all stack frames, or innermost COUNT frames. -+With a negative argument, print outermost -COUNT frames. -+Use of the 'full' qualifier also prints the values of the local variables. -+Use of the 'raw' qualifier avoids any filtering by loadable modules. -+""" -+ -+ def __init__ (self): -+ # FIXME: this is not working quite well enough to replace -+ # "backtrace" yet. -+ gdb.Command.__init__ (self, "new-backtrace", gdb.COMMAND_STACK) -+ self.reverse = ReverseBacktraceParameter() -+ -+ def reverse_iter (self, iter): -+ result = [] -+ for item in iter: -+ result.append (item) -+ result.reverse() -+ return result -+ -+ def final_n (self, iter, x): -+ result = [] -+ for item in iter: -+ result.append (item) -+ return result[x:] -+ -+ def invoke (self, arg, from_tty): -+ i = 0 -+ count = 0 -+ filter = True -+ full = False -+ -+ for word in arg.split (" "): -+ if word == '': -+ continue -+ elif word == 'raw': -+ filter = False -+ elif word == 'full': -+ full = True -+ else: -+ count = int (word) -+ -+ # FIXME: provide option to start at selected frame -+ # However, should still number as if starting from newest -+ newest_frame = gdb.newest_frame() -+ iter = itertools.imap (FrameWrapper, -+ FrameIterator (newest_frame)) -+ if filter: -+ iter = gdb.backtrace.create_frame_filter (iter) -+ -+ # Now wrap in an iterator that numbers the frames. -+ iter = itertools.izip (itertools.count (0), iter) -+ -+ # Reverse if the user wanted that. -+ if self.reverse.value: -+ iter = self.reverse_iter (iter) -+ -+ # Extract sub-range user wants. -+ if count < 0: -+ iter = self.final_n (iter, count) -+ elif count > 0: -+ iter = itertools.islice (iter, 0, count) -+ -+ for pair in iter: -+ sys.stdout.write ("#%-2d" % pair[0]) -+ pair[1].describe (sys.stdout, full) -+ -+FilteringBacktrace() diff --git a/gdb-gdb27743-psymtab-imported-unit.patch b/gdb-gdb27743-psymtab-imported-unit.patch new file mode 100644 index 0000000..c129b6d --- /dev/null +++ b/gdb-gdb27743-psymtab-imported-unit.patch @@ -0,0 +1,281 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Tom Tromey +Date: Fri, 23 Apr 2021 11:28:48 -0600 +Subject: gdb-gdb27743-psymtab-imported-unit.patch + +;; Backport "Fix crash when expanding partial symtabs with DW_TAG_imported_unit" +;; (Tom Tromey, gdb/27743) + + From e7d77ce0c408e7019f9885b8be64c9cdb46dd312 Mon Sep 17 00:00:00 2001 + Subject: [PATCH] Fix crash when expanding partial symtabs with + DW_TAG_imported_unit + +PR gdb/27743 points out a gdb crash when expanding partial symtabs, +where one of the compilation units uses DW_TAG_imported_unit. + +The bug is that partial_map_expand_apply expects only to be called for +the outermost psymtab. However, filename searching doesn't (and +probably shouldn't) guarantee this. The fix is to walk upward to find +the outermost CU. + +A new test case is included. It is mostly copied from other test +cases, which really sped up the effort. + +This bug does not occur on trunk. There, +psym_map_symtabs_matching_filename is gone, replaced by +psymbol_functions::expand_symtabs_matching. When this find a match, +it calls psymtab_to_symtab, which does this same upward walk. + +Tested on x86-64 Fedora 32. + +I propose checking in this patch on the gdb-10 branch, and just the +new test case on trunk. + +gdb/ChangeLog +2021-04-23 Tom Tromey + + PR gdb/27743: + * psymtab.c (partial_map_expand_apply): Expand outermost psymtab. + +gdb/testsuite/ChangeLog +2021-04-23 Tom Tromey + + PR gdb/27743: + * gdb.dwarf2/imported-unit-bp.exp: New file. + * gdb.dwarf2/imported-unit-bp-main.c: New file. + * gdb.dwarf2/imported-unit-bp-alt.c: New file. + +diff --git a/gdb/psymtab.c b/gdb/psymtab.c +--- a/gdb/psymtab.c ++++ b/gdb/psymtab.c +@@ -127,9 +127,10 @@ partial_map_expand_apply (struct objfile *objfile, + { + struct compunit_symtab *last_made = objfile->compunit_symtabs; + +- /* Shared psymtabs should never be seen here. Instead they should +- be handled properly by the caller. */ +- gdb_assert (pst->user == NULL); ++ /* We may see a shared psymtab here, but we want to expand the ++ outermost symtab. */ ++ while (pst->user != nullptr) ++ pst = pst->user; + + /* Don't visit already-expanded psymtabs. */ + if (pst->readin_p (objfile)) +diff --git a/gdb/testsuite/gdb.dwarf2/imported-unit-bp-alt.c b/gdb/testsuite/gdb.dwarf2/imported-unit-bp-alt.c +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.dwarf2/imported-unit-bp-alt.c +@@ -0,0 +1,50 @@ ++/* Copyright 2020-2021 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 . */ ++ ++/* Used to insert labels with which we can build a fake line table. */ ++#define LL(N) asm ("line_label_" #N ": .globl line_label_" #N) ++ ++volatile int var; ++volatile int bar; ++ ++/* Generate some code to take up some space. */ ++#define FILLER do { \ ++ var = 99; \ ++} while (0) ++ ++int ++func (void) ++{ /* func prologue */ ++ asm ("func_label: .globl func_label"); ++ LL (1); // F1, Ln 16 ++ FILLER; ++ LL (2); // F1, Ln 17 ++ FILLER; ++ LL (3); // F2, Ln 21 ++ FILLER; ++ LL (4); // F2, Ln 22 // F1, Ln 18, !S ++ FILLER; ++ LL (5); // F1, Ln 19 !S ++ FILLER; ++ LL (6); // F1, Ln 20 ++ FILLER; ++ LL (7); ++ FILLER; ++ return 0; /* func end */ ++} ++ ++#ifdef WITHMAIN ++int main () { return 0; } ++#endif +diff --git a/gdb/testsuite/gdb.dwarf2/imported-unit-bp-main.c b/gdb/testsuite/gdb.dwarf2/imported-unit-bp-main.c +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.dwarf2/imported-unit-bp-main.c +@@ -0,0 +1,24 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2004-2021 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 (void); ++ ++int ++main() ++{ ++ return func (); ++} +diff --git a/gdb/testsuite/gdb.dwarf2/imported-unit-bp.exp b/gdb/testsuite/gdb.dwarf2/imported-unit-bp.exp +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.dwarf2/imported-unit-bp.exp +@@ -0,0 +1,128 @@ ++# Copyright 2020-2021 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 that "break /absolute/file:line" works ok with imported CUs. ++ ++load_lib dwarf.exp ++ ++# This test can only be run on targets which support DWARF-2 and use gas. ++if {![dwarf2_support]} { ++ return 0 ++} ++ ++# The .c files use __attribute__. ++if [get_compiler_info] { ++ return -1 ++} ++if !$gcc_compiled { ++ return 0 ++} ++ ++standard_testfile imported-unit-bp-alt.c .S imported-unit-bp-main.c ++ ++set build_options {nodebug optimize=-O1} ++ ++set asm_file [standard_output_file $srcfile2] ++Dwarf::assemble $asm_file { ++ global srcdir subdir srcfile srcfile ++ global build_options ++ declare_labels lines_label callee_subprog_label cu_label ++ ++ get_func_info func "$build_options additional_flags=-DWITHMAIN" ++ ++ cu {} { ++ compile_unit { ++ {language @DW_LANG_C} ++ {name ""} ++ } { ++ imported_unit { ++ {import %$cu_label} ++ } ++ } ++ } ++ ++ cu {} { ++ cu_label: compile_unit { ++ {producer "gcc"} ++ {language @DW_LANG_C} ++ {name ${srcfile}} ++ {comp_dir "/tmp"} ++ {low_pc 0 addr} ++ {stmt_list ${lines_label} DW_FORM_sec_offset} ++ } { ++ callee_subprog_label: subprogram { ++ {external 1 flag} ++ {name callee} ++ {inline 3 data1} ++ } ++ subprogram { ++ {external 1 flag} ++ {name func} ++ {low_pc $func_start addr} ++ {high_pc "$func_start + $func_len" addr} ++ } { ++ } ++ } ++ } ++ ++ lines {version 2 default_is_stmt 1} lines_label { ++ include_dir "/tmp" ++ file_name "$srcfile" 1 ++ ++ program { ++ {DW_LNE_set_address line_label_1} ++ {DW_LNS_advance_line 15} ++ {DW_LNS_copy} ++ ++ {DW_LNE_set_address line_label_2} ++ {DW_LNS_advance_line 1} ++ {DW_LNS_copy} ++ ++ {DW_LNE_set_address line_label_3} ++ {DW_LNS_advance_line 4} ++ {DW_LNS_copy} ++ ++ {DW_LNE_set_address line_label_4} ++ {DW_LNS_advance_line 1} ++ {DW_LNS_copy} ++ ++ {DW_LNS_advance_line -4} ++ {DW_LNS_negate_stmt} ++ {DW_LNS_copy} ++ ++ {DW_LNE_set_address line_label_5} ++ {DW_LNS_advance_line 1} ++ {DW_LNS_copy} ++ ++ {DW_LNE_set_address line_label_6} ++ {DW_LNS_advance_line 1} ++ {DW_LNS_negate_stmt} ++ {DW_LNS_copy} ++ ++ {DW_LNE_set_address line_label_7} ++ {DW_LNE_end_sequence} ++ } ++ } ++} ++ ++if { [prepare_for_testing "failed to prepare" ${testfile} \ ++ [list $srcfile $asm_file $srcfile3] $build_options] } { ++ return -1 ++} ++ ++gdb_reinitialize_dir /tmp ++ ++# Using an absolute path is important to see the bug. ++gdb_test "break /tmp/${srcfile}:19" "Breakpoint .* file $srcfile, line .*" diff --git a/gdb-gnat-dwarf-crash-3of3.patch b/gdb-gnat-dwarf-crash-3of3.patch deleted file mode 100644 index 4197661..0000000 --- a/gdb-gnat-dwarf-crash-3of3.patch +++ /dev/null @@ -1,219 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-gnat-dwarf-crash-3of3.patch - -;; Fix crash of -readnow /usr/lib/debug/usr/bin/gnatbind.debug (BZ 1069211). -;;=push+jan - -http://sourceware.org/ml/gdb-patches/2014-02/msg00731.html - ---6TrnltStXW4iwmi0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline - -Hi, - -PR 16581: - GDB crash on inherit_abstract_dies infinite recursion - https://sourceware.org/bugzilla/show_bug.cgi?id=16581 - -fixed crash from an infinite recursion. But in rare cases the new code can -now gdb_assert() due to weird DWARF file. - -I do not yet fully understand why the DWARF is as it is but just GDB should -never crash due to invalid DWARF anyway. The "invalid" DWARF I see only in -Fedora GCC build, not in FSF GCC build, more info at: - https://bugzilla.redhat.com/show_bug.cgi?id=1069382 - http://people.redhat.com/jkratoch/gcc-debuginfo-4.8.2-7.fc20.x86_64-gnatbind.debug - -Thanks, -Jan - ---6TrnltStXW4iwmi0 -Content-Type: text/plain; charset=us-ascii -Content-Disposition: inline; filename="complaint.patch" - -gdb/ -2014-02-24 Jan Kratochvil - - * dwarf2read.c (process_die): Change gdb_assert to complaint. - -diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c ---- a/gdb/dwarf2/read.c -+++ b/gdb/dwarf2/read.c -@@ -10162,6 +10162,13 @@ class process_die_scope - static void - process_die (struct die_info *die, struct dwarf2_cu *cu) - { -+ if (die->in_process) -+ { -+ complaint (_("DIE at 0x%s attempted to be processed twice"), -+ sect_offset_str (die->sect_off)); -+ return; -+ } -+ - process_die_scope scope (die, cu); - - switch (die->tag) -diff --git a/gdb/linux-nat.c b/gdb/linux-nat.c ---- a/gdb/linux-nat.c -+++ b/gdb/linux-nat.c -@@ -190,6 +190,12 @@ struct linux_nat_target *linux_target; - /* Does the current host support PTRACE_GETREGSET? */ - enum tribool have_ptrace_getregset = TRIBOOL_UNKNOWN; - -+#ifdef NEED_DETACH_SIGSTOP -+/* PID of the inferior stopped by SIGSTOP before attaching (or zero). */ -+static pid_t pid_was_stopped; -+ -+#endif -+ - static unsigned int debug_linux_nat; - static void - show_debug_linux_nat (struct ui_file *file, int from_tty, -@@ -1044,6 +1050,9 @@ linux_nat_post_attach_wait (ptid_t ptid, int *signalled) - if (linux_proc_pid_is_stopped (pid)) - { - linux_nat_debug_printf ("Attaching to a stopped process"); -+#ifdef NEED_DETACH_SIGSTOP -+ pid_was_stopped = ptid.pid (); -+#endif - - /* The process is definitely stopped. It is in a job control - stop, unless the kernel predates the TASK_STOPPED / -@@ -1359,6 +1368,25 @@ get_detach_signal (struct lwp_info *lp) - return gdb_signal_to_host (signo); - } - -+#ifdef NEED_DETACH_SIGSTOP -+ /* Workaround RHEL-5 kernel which has unreliable PTRACE_DETACH, SIGSTOP (that -+ many TIDs are left unstopped). See RH Bug 496732. */ -+ if (lp->ptid.pid () == pid_was_stopped) -+ { -+ int err; -+ -+ errno = 0; -+ err = kill_lwp (lp->ptid.lwp (), SIGSTOP); -+ if (debug_linux_nat) -+ { -+ fprintf_unfiltered (gdb_stdlog, -+ "SC: lwp kill %d %s\n", -+ err, -+ errno ? safe_strerror (errno) : "ERRNO-OK"); -+ } -+ } -+ -+#endif - return 0; - } - -@@ -1502,6 +1530,10 @@ linux_nat_target::detach (inferior *inf, int from_tty) - detach_one_lwp (main_lwp, &signo); - - detach_success (inf); -+ -+#ifdef NEED_DETACH_SIGSTOP -+ pid_was_stopped = 0; -+#endif - } - } - -@@ -1744,6 +1776,16 @@ linux_nat_target::resume (ptid_t ptid, int step, enum gdb_signal signo) - return; - } - -+#ifdef NEED_DETACH_SIGSTOP -+ /* At this point, we are going to resume the inferior and if we -+ have attached to a stopped process, we no longer should leave -+ it as stopped if the user detaches. PTID variable has PID set to LWP -+ while we need to check the real PID here. */ -+ -+ if (!step && lp && pid_was_stopped == lp->ptid.pid ()) -+ pid_was_stopped = 0; -+ -+#endif - if (resume_many) - iterate_over_lwps (ptid, [=] (struct lwp_info *info) - { -@@ -3617,6 +3659,10 @@ linux_nat_target::mourn_inferior () - - /* Let the arch-specific native code know this process is gone. */ - linux_target->low_forget_process (pid); -+#ifdef NEED_DETACH_SIGSTOP -+ -+ pid_was_stopped = 0; -+#endif - } - - /* Convert a native/host siginfo object, into/from the siginfo in the -diff --git a/gdb/testsuite/gdb.threads/attach-stopped.exp b/gdb/testsuite/gdb.threads/attach-stopped.exp ---- a/gdb/testsuite/gdb.threads/attach-stopped.exp -+++ b/gdb/testsuite/gdb.threads/attach-stopped.exp -@@ -56,7 +56,65 @@ proc corefunc { threadtype } { - gdb_reinitialize_dir $srcdir/$subdir - gdb_load ${binfile} - -- # Verify that we can attach to the stopped process. -+ # Verify that we can attach to the process by first giving its -+ # executable name via the file command, and using attach with the -+ # process ID. -+ -+ set test "$threadtype: set file, before attach1 to stopped process" -+ gdb_test_multiple "file $binfile" "$test" { -+ -re "Load new symbol table from.*y or n. $" { -+ gdb_test "y" "Reading symbols from $escapedbinfile\.\.\.*done." \ -+ "$test (re-read)" -+ } -+ -re "Reading symbols from $escapedbinfile\.\.\.*done.*$gdb_prompt $" { -+ pass "$test" -+ } -+ } -+ -+ set test "$threadtype: attach1 to stopped, after setting file" -+ gdb_test_multiple "attach $testpid" "$test" { -+ -re "Attaching to program.*`?$escapedbinfile'?, process $testpid.*$gdb_prompt $" { -+ pass "$test" -+ } -+ } -+ -+ # ".*sleep.*clone.*" would fail on s390x as bt stops at START_THREAD there. -+ if {[string equal $threadtype threaded]} { -+ gdb_test "thread apply all bt" ".*sleep.*start_thread.*" "$threadtype: attach1 to stopped bt" -+ } else { -+ gdb_test "bt" ".*sleep.*main.*" "$threadtype: attach1 to stopped bt" -+ } -+ -+ # Exit and detach the process. -+ -+ gdb_exit -+ -+ # Avoid some race: -+ sleep 2 -+ -+ if [catch {open /proc/${testpid}/status r} fileid] { -+ set line2 "NOTFOUND" -+ } else { -+ gets $fileid line1; -+ gets $fileid line2; -+ close $fileid; -+ } -+ -+ set test "$threadtype: attach1, exit leaves process stopped" -+ if {[string match "*(stopped)*" $line2]} { -+ pass $test -+ } else { -+ fail $test -+ } -+ -+ # At this point, the process should still be stopped -+ -+ gdb_start -+ gdb_reinitialize_dir $srcdir/$subdir -+ gdb_load ${binfile} -+ -+ # Verify that we can attach to the process just by giving the -+ # process ID. - - set test "$threadtype: attach2 to stopped, after setting file" - gdb_test_multiple "attach $testpid" "$test" { diff --git a/gdb-jit-reader-multilib.patch b/gdb-jit-reader-multilib.patch deleted file mode 100644 index 4bce5fc..0000000 --- a/gdb-jit-reader-multilib.patch +++ /dev/null @@ -1,46 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-jit-reader-multilib.patch - -;; Fix jit-reader.h for multi-lib. -;;=push+jan - -diff --git a/gdb/configure b/gdb/configure ---- a/gdb/configure -+++ b/gdb/configure -@@ -9968,10 +9968,12 @@ _ACEOF - - - --if test "x${ac_cv_sizeof_unsigned_long}" = "x8"; then -- TARGET_PTR="unsigned long" --elif test "x${ac_cv_sizeof_unsigned_long_long}" = "x8"; then -+# Try to keep TARGET_PTR the same across archs so that jit-reader.h file -+# content is the same for multilib distributions. -+if test "x${ac_cv_sizeof_unsigned_long_long}" = "x8"; then - TARGET_PTR="unsigned long long" -+elif test "x${ac_cv_sizeof_unsigned_long}" = "x8"; then -+ TARGET_PTR="unsigned long" - elif test "x${ac_cv_sizeof_unsigned___int128}" = "x16"; then - TARGET_PTR="unsigned __int128" - else -diff --git a/gdb/configure.ac b/gdb/configure.ac ---- a/gdb/configure.ac -+++ b/gdb/configure.ac -@@ -803,10 +803,12 @@ AC_CHECK_SIZEOF(unsigned long long) - AC_CHECK_SIZEOF(unsigned long) - AC_CHECK_SIZEOF(unsigned __int128) - --if test "x${ac_cv_sizeof_unsigned_long}" = "x8"; then -- TARGET_PTR="unsigned long" --elif test "x${ac_cv_sizeof_unsigned_long_long}" = "x8"; then -+# Try to keep TARGET_PTR the same across archs so that jit-reader.h file -+# content is the same for multilib distributions. -+if test "x${ac_cv_sizeof_unsigned_long_long}" = "x8"; then - TARGET_PTR="unsigned long long" -+elif test "x${ac_cv_sizeof_unsigned_long}" = "x8"; then -+ TARGET_PTR="unsigned long" - elif test "x${ac_cv_sizeof_unsigned___int128}" = "x16"; then - TARGET_PTR="unsigned __int128" - else diff --git a/gdb-moribund-utrace-workaround.patch b/gdb-moribund-utrace-workaround.patch deleted file mode 100644 index 869fc75..0000000 --- a/gdb-moribund-utrace-workaround.patch +++ /dev/null @@ -1,25 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-moribund-utrace-workaround.patch - -;; Workaround non-stop moribund locations exploited by kernel utrace (BZ 590623). -;;=push+jan: Currently it is still not fully safe. - -https://bugzilla.redhat.com/show_bug.cgi?id=590623 -http://sources.redhat.com/bugzilla/show_bug.cgi?id=11593 - -Bug in FSF GDB exploited by the ptrace-on-utrace interaction. - -diff --git a/gdb/breakpoint.c b/gdb/breakpoint.c ---- a/gdb/breakpoint.c -+++ b/gdb/breakpoint.c -@@ -11948,6 +11948,8 @@ update_global_location_list (enum ugll_insert_mode insert_mode) - = 3 * (thread_count (proc_target) + 1); - else - old_loc->events_till_retirement = 1; -+ /* Red Hat Bug 590623. */ -+ old_loc->events_till_retirement *= 10; - old_loc->owner = NULL; - - moribund_locations.push_back (old_loc); diff --git a/gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch b/gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch new file mode 100644 index 0000000..1419455 --- /dev/null +++ b/gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch @@ -0,0 +1,67 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Keith Seitz +Date: Mon, 16 Nov 2020 12:42:09 -0500 +Subject: gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch + +;; Backport of "Exclude debuginfo files from 'outside of ELF segments' +;; warning" (Keith Seitz) + + Exclude debuginfo files from "outside of ELF segments" warning + + When GDB loads an ELF file, it will warn when a section is not located + in an ELF segment: + + $ ./gdb -q -iex "set build-id-verbose 0" --ex "b systemctl_main" -ex "r" -batch --args systemctl kexec + Breakpoint 1 at 0xc24d: file ../src/systemctl/systemctl.c, line 8752. + warning: Loadable section ".note.gnu.property" outside of ELF segments + in .gnu_debugdata for /lib64/libgcc_s.so.1 + [Thread debugging using libthread_db enabled] + Using host libthread_db library "/lib64/libthread_db.so.1". + warning: Loadable section ".note.gnu.property" outside of ELF segments + in .gnu_debugdata for /lib64/libcap.so.2 + warning: Loadable section ".note.gnu.property" outside of ELF segments + in .gnu_debugdata for /lib64/libacl.so.1 + warning: Loadable section ".note.gnu.property" outside of ELF segments + in .gnu_debugdata for /lib64/libcryptsetup.so.12 + warning: Loadable section ".note.gnu.property" outside of ELF segments + in .gnu_debugdata for /lib64/libgcrypt.so.20 + warning: Loadable section ".note.gnu.property" outside of ELF segments + in .gnu_debugdata for /lib64/libip4tc.so.2 + [snip] + This has feature has also been reported by various users, most notably + the Fedora-EOL'd bug 1553086. + + Mark Wielaard explains the issue quite nicely in + + https://sourceware.org/bugzilla/show_bug.cgi?id=24717#c2 + + The short of it is, the ELF program headers for debuginfo files are + not suited to this particular use case. Consequently, the warning + generated above really is useless and should be ignored. + + This patch follows the same heuristic that BFD itself uses. + + gdb/ChangeLog + 2020-11-13 Keith Seitz + + https://bugzilla.redhat.com/show_bug.cgi?id=1553086 + * elfread.c (elf_symfile_segments): Omit "Loadable section ... + outside of ELF segments" warning for debugin + +diff --git a/gdb/elfread.c b/gdb/elfread.c +--- a/gdb/elfread.c ++++ b/gdb/elfread.c +@@ -147,7 +147,12 @@ elf_symfile_segments (bfd *abfd) + RealView) use SHT_NOBITS for uninitialized data. Since it is + uninitialized, it doesn't need a program header. Such + binaries are not relocatable. */ +- if (bfd_section_size (sect) > 0 && j == num_segments ++ ++ /* Exclude debuginfo files from this warning, too, since those ++ are often not strictly compliant with the standard. See, e.g., ++ ld/24717 for more discussion. */ ++ if (!is_debuginfo_file (abfd) ++ && bfd_section_size (sect) > 0 && j == num_segments + && (bfd_section_flags (sect) & SEC_LOAD) != 0) + warning (_("Loadable section \"%s\" outside of ELF segments"), + bfd_section_name (sect)); diff --git a/gdb-rhbz1909902-frame_id_p-assert-1.patch b/gdb-rhbz1909902-frame_id_p-assert-1.patch index 7bced66..8dd99a5 100644 --- a/gdb-rhbz1909902-frame_id_p-assert-1.patch +++ b/gdb-rhbz1909902-frame_id_p-assert-1.patch @@ -391,7 +391,7 @@ diff --git a/gdb/gdbthread.h b/gdb/gdbthread.h diff --git a/gdb/infrun.c b/gdb/infrun.c --- a/gdb/infrun.c +++ b/gdb/infrun.c -@@ -9017,8 +9017,10 @@ struct infcall_control_state +@@ -9006,8 +9006,10 @@ struct infcall_control_state enum stop_stack_kind stop_stack_dummy = STOP_NONE; int stopped_by_random_signal = 0; @@ -403,7 +403,7 @@ diff --git a/gdb/infrun.c b/gdb/infrun.c }; /* Save all of the information associated with the inferior<==>gdb -@@ -9047,27 +9049,12 @@ save_infcall_control_state () +@@ -9036,27 +9038,12 @@ save_infcall_control_state () inf_status->stop_stack_dummy = stop_stack_dummy; inf_status->stopped_by_random_signal = stopped_by_random_signal; @@ -433,7 +433,7 @@ diff --git a/gdb/infrun.c b/gdb/infrun.c /* Restore inferior session state to INF_STATUS. */ void -@@ -9095,21 +9082,8 @@ restore_infcall_control_state (struct infcall_control_state *inf_status) +@@ -9084,21 +9071,8 @@ restore_infcall_control_state (struct infcall_control_state *inf_status) if (target_has_stack) { diff --git a/gdb-rhbz1964167-convert-enum-range_type.patch b/gdb-rhbz1964167-convert-enum-range_type.patch new file mode 100644 index 0000000..ecf8042 --- /dev/null +++ b/gdb-rhbz1964167-convert-enum-range_type.patch @@ -0,0 +1,375 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Mon, 24 May 2021 17:10:28 -0700 +Subject: gdb-rhbz1964167-convert-enum-range_type.patch + +;; [fortran] Backport Andrew Burgess's commit which changes enum +;; range_type into a bit field enum. + +gdb: Convert enum range_type to a bit field enum + +The expression range_type enum represents the following ideas: + + - Lower bound is set to default, + - Upper bound is set to default, + - Upper bound is exclusive. + +There are currently 6 entries in the enum to represent the combination +of all those ideas. + +In a future commit I'd like to add stride information to the range, +this could in theory appear with any of the existing enum entries, so +this would take us to 12 enum entries. + +This feels like its getting a little out of hand, so in this commit I +switch the range_type enum over to being a flags style enum. There's +one entry to represent no flags being set, then 3 flags to represent +the 3 ideas above. Adding stride information will require adding only +one more enum flag. + +I've then gone through and updated the code to handle this change. + +There should be no user visible changes after this commit. + +gdb/ChangeLog: + + * expprint.c (print_subexp_standard): Update to reflect changes to + enum range_type. + (dump_subexp_body_standard): Likewise. + * expression.h (enum range_type): Convert to a bit field enum, and + make the enum unsigned. + * f-exp.y (subrange): Update to reflect changes to enum + range_type. + * f-lang.c (value_f90_subarray): Likewise. + * parse.c (operator_length_standard): Likewise. + * rust-exp.y (rust_parser::convert_ast_to_expression): Likewise. + * rust-lang.c (rust_range): Likewise. + (rust_compute_range): Likewise. + (rust_subscript): Likewise. + +diff --git a/gdb/expprint.c b/gdb/expprint.c +--- a/gdb/expprint.c ++++ b/gdb/expprint.c +@@ -584,17 +584,13 @@ print_subexp_standard (struct expression *exp, int *pos, + longest_to_int (exp->elts[pc + 1].longconst); + *pos += 2; + +- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE +- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE) ++ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE) + fputs_filtered ("EXCLUSIVE_", stream); + fputs_filtered ("RANGE(", stream); +- if (range_type == HIGH_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE) ++ if (!(range_type & RANGE_LOW_BOUND_DEFAULT)) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered ("..", stream); +- if (range_type == LOW_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT)) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered (")", stream); + return; +@@ -1114,36 +1110,19 @@ dump_subexp_body_standard (struct expression *exp, + longest_to_int (exp->elts[elt].longconst); + elt += 2; + +- switch (range_type) +- { +- case BOTH_BOUND_DEFAULT: +- fputs_filtered ("Range '..'", stream); +- break; +- case LOW_BOUND_DEFAULT: +- fputs_filtered ("Range '..EXP'", stream); +- break; +- case LOW_BOUND_DEFAULT_EXCLUSIVE: +- fputs_filtered ("ExclusiveRange '..EXP'", stream); +- break; +- case HIGH_BOUND_DEFAULT: +- fputs_filtered ("Range 'EXP..'", stream); +- break; +- case NONE_BOUND_DEFAULT: +- fputs_filtered ("Range 'EXP..EXP'", stream); +- break; +- case NONE_BOUND_DEFAULT_EXCLUSIVE: +- fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream); +- break; +- default: +- fputs_filtered ("Invalid Range!", stream); +- break; +- } ++ if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE) ++ fputs_filtered ("Exclusive", stream); ++ fputs_filtered ("Range '", stream); ++ if (!(range_type & RANGE_LOW_BOUND_DEFAULT)) ++ fputs_filtered ("EXP", stream); ++ fputs_filtered ("..", stream); ++ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT)) ++ fputs_filtered ("EXP", stream); ++ fputs_filtered ("'", stream); + +- if (range_type == HIGH_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if (!(range_type & RANGE_LOW_BOUND_DEFAULT)) + elt = dump_subexp (exp, stream, elt); +- if (range_type == LOW_BOUND_DEFAULT +- || range_type == NONE_BOUND_DEFAULT) ++ if (!(range_type & RANGE_HIGH_BOUND_DEFAULT)) + elt = dump_subexp (exp, stream, elt); + } + break; +diff --git a/gdb/expression.h b/gdb/expression.h +--- a/gdb/expression.h ++++ b/gdb/expression.h +@@ -185,22 +185,22 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *); + or inclusive. So we have six sorts of subrange. This enumeration + type is to identify this. */ + +-enum range_type ++enum range_type : unsigned + { +- /* Neither the low nor the high bound was given -- so this refers to +- the entire available range. */ +- BOTH_BOUND_DEFAULT, +- /* The low bound was not given and the high bound is inclusive. */ +- LOW_BOUND_DEFAULT, +- /* The high bound was not given and the low bound in inclusive. */ +- HIGH_BOUND_DEFAULT, +- /* Both bounds were given and both are inclusive. */ +- NONE_BOUND_DEFAULT, +- /* The low bound was not given and the high bound is exclusive. */ +- NONE_BOUND_DEFAULT_EXCLUSIVE, +- /* Both bounds were given. The low bound is inclusive and the high +- bound is exclusive. */ +- LOW_BOUND_DEFAULT_EXCLUSIVE, ++ /* This is a standard range. Both the lower and upper bounds are ++ defined, and the bounds are inclusive. */ ++ RANGE_STANDARD = 0, ++ ++ /* The low bound was not given. */ ++ RANGE_LOW_BOUND_DEFAULT = 1 << 0, ++ ++ /* The high bound was not given. */ ++ RANGE_HIGH_BOUND_DEFAULT = 1 << 1, ++ ++ /* The high bound of this range is exclusive. */ ++ RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2, + }; + ++DEF_ENUM_FLAGS_TYPE (enum range_type, range_types); ++ + #endif /* !defined (EXPRESSION_H) */ +diff --git a/gdb/f-exp.y b/gdb/f-exp.y +--- a/gdb/f-exp.y ++++ b/gdb/f-exp.y +@@ -287,26 +287,30 @@ arglist : arglist ',' exp %prec ABOVE_COMMA + /* There are four sorts of subrange types in F90. */ + + subrange: exp ':' exp %prec ABOVE_COMMA +- { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT); ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, RANGE_STANDARD); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: exp ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, ++ RANGE_HIGH_BOUND_DEFAULT); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: ':' exp %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, ++ RANGE_LOW_BOUND_DEFAULT); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + + subrange: ':' %prec ABOVE_COMMA + { write_exp_elt_opcode (pstate, OP_RANGE); +- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT); ++ write_exp_elt_longcst (pstate, ++ (RANGE_LOW_BOUND_DEFAULT ++ | RANGE_HIGH_BOUND_DEFAULT)); + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + +diff --git a/gdb/f-lang.c b/gdb/f-lang.c +--- a/gdb/f-lang.c ++++ b/gdb/f-lang.c +@@ -131,12 +131,12 @@ value_f90_subarray (struct value *array, + + *pos += 3; + +- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) ++ if (range_type & RANGE_LOW_BOUND_DEFAULT) + low_bound = range->bounds ()->low.const_val (); + else + low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); + +- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) ++ if (range_type & RANGE_HIGH_BOUND_DEFAULT) + high_bound = range->bounds ()->high.const_val (); + else + high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); +diff --git a/gdb/parse.c b/gdb/parse.c +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -921,21 +921,13 @@ operator_length_standard (const struct expression *expr, int endpos, + range_type = (enum range_type) + longest_to_int (expr->elts[endpos - 2].longconst); + +- switch (range_type) +- { +- case LOW_BOUND_DEFAULT: +- case LOW_BOUND_DEFAULT_EXCLUSIVE: +- case HIGH_BOUND_DEFAULT: +- args = 1; +- break; +- case BOTH_BOUND_DEFAULT: +- args = 0; +- break; +- case NONE_BOUND_DEFAULT: +- case NONE_BOUND_DEFAULT_EXCLUSIVE: +- args = 2; +- break; +- } ++ /* Assume the range has 2 arguments (low bound and high bound), then ++ reduce the argument count if any bounds are set to default. */ ++ args = 2; ++ if (range_type & RANGE_LOW_BOUND_DEFAULT) ++ --args; ++ if (range_type & RANGE_HIGH_BOUND_DEFAULT) ++ --args; + + break; + +diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y +--- a/gdb/rust-exp.y ++++ b/gdb/rust-exp.y +@@ -2492,24 +2492,29 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation, + + case OP_RANGE: + { +- enum range_type kind = BOTH_BOUND_DEFAULT; ++ enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT ++ | RANGE_LOW_BOUND_DEFAULT); + + if (operation->left.op != NULL) + { + convert_ast_to_expression (operation->left.op, top); +- kind = HIGH_BOUND_DEFAULT; ++ kind &= ~RANGE_LOW_BOUND_DEFAULT; + } + if (operation->right.op != NULL) + { + convert_ast_to_expression (operation->right.op, top); +- if (kind == BOTH_BOUND_DEFAULT) +- kind = (operation->inclusive +- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE); ++ if (kind == (RANGE_HIGH_BOUND_DEFAULT | RANGE_LOW_BOUND_DEFAULT)) ++ { ++ kind = RANGE_LOW_BOUND_DEFAULT; ++ if (!operation->inclusive) ++ kind |= RANGE_HIGH_BOUND_EXCLUSIVE; ++ } + else + { +- gdb_assert (kind == HIGH_BOUND_DEFAULT); +- kind = (operation->inclusive +- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE); ++ gdb_assert (kind == RANGE_HIGH_BOUND_DEFAULT); ++ kind = RANGE_STANDARD; ++ if (!operation->inclusive) ++ kind |= RANGE_HIGH_BOUND_EXCLUSIVE; + } + } + else +diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c +--- a/gdb/rust-lang.c ++++ b/gdb/rust-lang.c +@@ -1082,13 +1082,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside) + kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst); + *pos += 3; + +- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT +- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE) ++ if (!(kind & RANGE_LOW_BOUND_DEFAULT)) + low = evaluate_subexp (nullptr, exp, pos, noside); +- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE +- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE) ++ if (!(kind & RANGE_HIGH_BOUND_DEFAULT)) + high = evaluate_subexp (nullptr, exp, pos, noside); +- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT); ++ bool inclusive = !(kind & RANGE_HIGH_BOUND_EXCLUSIVE); + + if (noside == EVAL_SKIP) + return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1); +@@ -1171,13 +1169,13 @@ rust_range (struct expression *exp, int *pos, enum noside noside) + static void + rust_compute_range (struct type *type, struct value *range, + LONGEST *low, LONGEST *high, +- enum range_type *kind) ++ range_types *kind) + { + int i; + + *low = 0; + *high = 0; +- *kind = BOTH_BOUND_DEFAULT; ++ *kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT; + + if (type->num_fields () == 0) + return; +@@ -1185,15 +1183,15 @@ rust_compute_range (struct type *type, struct value *range, + i = 0; + if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0) + { +- *kind = HIGH_BOUND_DEFAULT; ++ *kind = RANGE_HIGH_BOUND_DEFAULT; + *low = value_as_long (value_field (range, 0)); + ++i; + } + if (type->num_fields () > i + && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0) + { +- *kind = (*kind == BOTH_BOUND_DEFAULT +- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT); ++ *kind = (*kind == (RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT) ++ ? RANGE_LOW_BOUND_DEFAULT : RANGE_STANDARD); + *high = value_as_long (value_field (range, i)); + + if (rust_inclusive_range_type_p (type)) +@@ -1211,7 +1209,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + struct type *rhstype; + LONGEST low, high_bound; + /* Initialized to appease the compiler. */ +- enum range_type kind = BOTH_BOUND_DEFAULT; ++ range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT; + LONGEST high = 0; + int want_slice = 0; + +@@ -1308,8 +1306,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + else + error (_("Cannot subscript non-array type")); + +- if (want_slice +- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT)) ++ if (want_slice && (kind & RANGE_LOW_BOUND_DEFAULT)) + low = low_bound; + if (low < 0) + error (_("Index less than zero")); +@@ -1327,7 +1324,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + CORE_ADDR addr; + struct value *addrval, *tem; + +- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT) ++ if (kind & RANGE_HIGH_BOUND_DEFAULT) + high = high_bound; + if (high < 0) + error (_("High index less than zero")); diff --git a/gdb-rhbz1964167-fortran-array-slices-at-prompt.patch b/gdb-rhbz1964167-fortran-array-slices-at-prompt.patch new file mode 100644 index 0000000..05e5890 --- /dev/null +++ b/gdb-rhbz1964167-fortran-array-slices-at-prompt.patch @@ -0,0 +1,2660 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Mon, 24 May 2021 22:46:21 -0700 +Subject: gdb-rhbz1964167-fortran-array-slices-at-prompt.patch + +;; [fortran] Backport Andrew Burgess's commit for Fortran array +;; slice support + +gdb/fortran: Add support for Fortran array slices at the GDB prompt + +This commit brings array slice support to GDB. + +WARNING: This patch contains a rather big hack which is limited to +Fortran arrays, this can be seen in gdbtypes.c and f-lang.c. More +details on this below. + +This patch rewrites two areas of GDB's Fortran support, the code to +extract an array slice, and the code to print an array. + +After this commit a user can, from the GDB prompt, ask for a slice of +a Fortran array and should get the correct result back. Slices can +(optionally) have the lower bound, upper bound, and a stride +specified. Slices can also have a negative stride. + +Fortran has the concept of repacking array slices. Within a compiled +Fortran program if a user passes a non-contiguous array slice to a +function then the compiler may have to repack the slice, this involves +copying the elements of the slice to a new area of memory before the +call, and copying the elements back to the original array after the +call. Whether repacking occurs will depend on which version of +Fortran is being used, and what type of function is being called. + +This commit adds support for both packed, and unpacked array slicing, +with the default being unpacked. + +With an unpacked array slice, when the user asks for a slice of an +array GDB creates a new type that accurately describes where the +elements of the slice can be found within the original array, a +value of this type is then returned to the user. The address of an +element within the slice will be equal to the address of an element +within the original array. + +A user can choose to select packed array slices instead using: + + (gdb) set fortran repack-array-slices on|off + (gdb) show fortran repack-array-slices + +With packed array slices GDB creates a new type that reflects how the +elements of the slice would look if they were laid out in contiguous +memory, allocates a value of this type, and then fetches the elements +from the original array and places then into the contents buffer of +the new value. + +One benefit of using packed slices over unpacked slices is the memory +usage, taking a small slice of N elements from a large array will +require (in GDB) N * ELEMENT_SIZE bytes of memory, while an unpacked +array will also include all of the "padding" between the +non-contiguous elements. There are new tests added that highlight +this difference. + +There is also a new debugging flag added with this commit that +introduces these commands: + + (gdb) set debug fortran-array-slicing on|off + (gdb) show debug fortran-array-slicing + +This prints information about how the array slices are being built. + +As both the repacking, and the array printing requires GDB to walk +through a multi-dimensional Fortran array visiting each element, this +commit adds the file f-array-walk.h, which introduces some +infrastructure to support this process. This means the array printing +code in f-valprint.c is significantly reduced. + +The only slight issue with this commit is the "rather big hack" that I +mentioned above. This hack allows us to handle one specific case, +array slices with negative strides. This is something that I don't +believe the current GDB value contents model will allow us to +correctly handle, and rather than rewrite the value contents code +right now, I'm hoping to slip this hack in as a work around. + +The problem is that, as I see it, the current value contents model +assumes that an object base address will be the lowest address within +that object, and that the contents of the object start at this base +address and occupy the TYPE_LENGTH bytes after that. + +( We do have the embedded_offset, which is used for C++ sub-classes, +such that an object can start at some offset from the content buffer, +however, the assumption that the object then occupies the next +TYPE_LENGTH bytes is still true within GDB. ) + +The problem is that Fortran arrays with a negative stride don't follow +this pattern. In this case the base address of the object points to +the element with the highest address, the contents of the array then +start at some offset _before_ the base address, and proceed for one +element _past_ the base address. + +As the stride for such an array would be negative then, in theory the +TYPE_LENGTH for this type would also be negative. However, in many +places a value in GDB will degrade to a pointer + length, and the +length almost always comes from the TYPE_LENGTH. + +It is my belief that in order to correctly model this case the value +content handling of GDB will need to be reworked to split apart the +value's content buffer (which is a block of memory with a length), and +the object's in memory base address and length, which could be +negative. + +Things are further complicated because arrays with negative strides +like this are always dynamic types. When a value has a dynamic type +and its base address needs resolving we actually store the address of +the object within the resolved dynamic type, not within the value +object itself. + +In short I don't currently see an easy path to cleanly support this +situation within GDB. And so I believe that leaves two options, +either add a work around, or catch cases where the user tries to make +use of a negative stride, or access an array with a negative stride, +and throw an error. + +This patch currently goes with adding a work around, which is that +when we resolve a dynamic Fortran array type, if the stride is +negative, then we adjust the base address to point to the lowest +address required by the array. The printing and slicing code is aware +of this adjustment and will correctly slice and print Fortran arrays. + +Where this hack will show through to the user is if they ask for the +address of an array in their program with a negative array stride, the +address they get from GDB will not match the address that would be +computed within the Fortran program. + +gdb/ChangeLog: + + * Makefile.in (HFILES_NO_SRCDIR): Add f-array-walker.h. + * NEWS: Mention new options. + * f-array-walker.h: New file. + * f-lang.c: Include 'gdbcmd.h' and 'f-array-walker.h'. + (repack_array_slices): New static global. + (show_repack_array_slices): New function. + (fortran_array_slicing_debug): New static global. + (show_fortran_array_slicing_debug): New function. + (value_f90_subarray): Delete. + (skip_undetermined_arglist): Delete. + (class fortran_array_repacker_base_impl): New class. + (class fortran_lazy_array_repacker_impl): New class. + (class fortran_array_repacker_impl): New class. + (fortran_value_subarray): Complete rewrite. + (set_fortran_list): New static global. + (show_fortran_list): Likewise. + (_initialize_f_language): Register new commands. + (fortran_adjust_dynamic_array_base_address_hack): New function. + * f-lang.h (fortran_adjust_dynamic_array_base_address_hack): + Declare. + * f-valprint.c: Include 'f-array-walker.h'. + (class fortran_array_printer_impl): New class. + (f77_print_array_1): Delete. + (f77_print_array): Delete. + (fortran_print_array): New. + (f_value_print_inner): Update to call fortran_print_array. + * gdbtypes.c: Include 'f-lang.h'. + (resolve_dynamic_type_internal): Call + fortran_adjust_dynamic_array_base_address_hack. + +gdb/testsuite/ChangeLog: + + * gdb.fortran/array-slices-bad.exp: New file. + * gdb.fortran/array-slices-bad.f90: New file. + * gdb.fortran/array-slices-sub-slices.exp: New file. + * gdb.fortran/array-slices-sub-slices.f90: New file. + * gdb.fortran/array-slices.exp: Rewrite tests. + * gdb.fortran/array-slices.f90: Rewrite tests. + * gdb.fortran/vla-sizeof.exp: Correct expected results. + +gdb/doc/ChangeLog: + + * gdb.texinfo (Debugging Output): Document 'set/show debug + fortran-array-slicing'. + (Special Fortran Commands): Document 'set/show fortran + repack-array-slices'. + +diff --git a/gdb/Makefile.in b/gdb/Makefile.in +--- a/gdb/Makefile.in ++++ b/gdb/Makefile.in +@@ -1268,6 +1268,7 @@ HFILES_NO_SRCDIR = \ + expression.h \ + extension.h \ + extension-priv.h \ ++ f-array-walker.h \ + f-lang.h \ + fbsd-nat.h \ + fbsd-tdep.h \ +diff --git a/gdb/NEWS b/gdb/NEWS +--- a/gdb/NEWS ++++ b/gdb/NEWS +@@ -111,6 +111,19 @@ maintenance print core-file-backed-mappings + Prints file-backed mappings loaded from a core file's note section. + Output is expected to be similar to that of "info proc mappings". + ++set debug fortran-array-slicing on|off ++show debug fortran-array-slicing ++ Print debugging when taking slices of Fortran arrays. ++ ++set fortran repack-array-slices on|off ++show fortran repack-array-slices ++ When taking slices from Fortran arrays and strings, if the slice is ++ non-contiguous within the original value then, when this option is ++ on, the new value will be repacked into a single contiguous value. ++ When this option is off, then the value returned will consist of a ++ descriptor that describes the slice within the memory of the ++ original parent value. ++ + * Changed commands + + alias [-a] [--] ALIAS = COMMAND [DEFAULT-ARGS...] +diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo +--- a/gdb/doc/gdb.texinfo ++++ b/gdb/doc/gdb.texinfo +@@ -16919,6 +16919,29 @@ This command prints the values contained in the Fortran @code{COMMON} + block whose name is @var{common-name}. With no argument, the names of + all @code{COMMON} blocks visible at the current program location are + printed. ++@cindex arrays slices (Fortran) ++@kindex set fortran repack-array-slices ++@kindex show fortran repack-array-slices ++@item set fortran repack-array-slices [on|off] ++@item show fortran repack-array-slices ++When taking a slice from an array, a Fortran compiler can choose to ++either produce an array descriptor that describes the slice in place, ++or it may repack the slice, copying the elements of the slice into a ++new region of memory. ++ ++When this setting is on, then @value{GDBN} will also repack array ++slices in some situations. When this setting is off, then ++@value{GDBN} will create array descriptors for slices that reference ++the original data in place. ++ ++@value{GDBN} will never repack an array slice if the data for the ++slice is contiguous within the original array. ++ ++@value{GDBN} will always repack string slices if the data for the ++slice is non-contiguous within the original string as @value{GDBN} ++does not support printing non-contiguous strings. ++ ++The default for this setting is @code{off}. + @end table + + @node Pascal +@@ -26507,6 +26530,16 @@ Show the current state of FreeBSD LWP debugging messages. + Turns on or off debugging messages from the FreeBSD native target. + @item show debug fbsd-nat + Show the current state of FreeBSD native target debugging messages. ++ ++@item set debug fortran-array-slicing ++@cindex fortran array slicing debugging info ++Turns on or off display of @value{GDBN} Fortran array slicing ++debugging info. The default is off. ++ ++@item show debug fortran-array-slicing ++Displays the current state of displaying @value{GDBN} Fortran array ++slicing debugging info. ++ + @item set debug frame + @cindex frame debugging info + Turns on or off display of @value{GDBN} frame debugging info. The +diff --git a/gdb/f-array-walker.h b/gdb/f-array-walker.h +new file mode 100644 +--- /dev/null ++++ b/gdb/f-array-walker.h +@@ -0,0 +1,265 @@ ++/* Copyright (C) 2020 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 . */ ++ ++/* Support classes to wrap up the process of iterating over a ++ multi-dimensional Fortran array. */ ++ ++#ifndef F_ARRAY_WALKER_H ++#define F_ARRAY_WALKER_H ++ ++#include "defs.h" ++#include "gdbtypes.h" ++#include "f-lang.h" ++ ++/* Class for calculating the byte offset for elements within a single ++ dimension of a Fortran array. */ ++class fortran_array_offset_calculator ++{ ++public: ++ /* Create a new offset calculator for TYPE, which is either an array or a ++ string. */ ++ explicit fortran_array_offset_calculator (struct type *type) ++ { ++ /* Validate the type. */ ++ type = check_typedef (type); ++ if (type->code () != TYPE_CODE_ARRAY ++ && (type->code () != TYPE_CODE_STRING)) ++ error (_("can only compute offsets for arrays and strings")); ++ ++ /* Get the range, and extract the bounds. */ ++ struct type *range_type = type->index_type (); ++ if (!get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound)) ++ error ("unable to read array bounds"); ++ ++ /* Figure out the stride for this array. */ ++ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type)); ++ m_stride = type->index_type ()->bounds ()->bit_stride (); ++ if (m_stride == 0) ++ m_stride = type_length_units (elt_type); ++ else ++ { ++ struct gdbarch *arch = get_type_arch (elt_type); ++ int unit_size = gdbarch_addressable_memory_unit_size (arch); ++ m_stride /= (unit_size * 8); ++ } ++ }; ++ ++ /* Get the byte offset for element INDEX within the type we are working ++ on. There is no bounds checking done on INDEX. If the stride is ++ negative then we still assume that the base address (for the array ++ object) points to the element with the lowest memory address, we then ++ calculate an offset assuming that index 0 will be the element at the ++ highest address, index 1 the next highest, and so on. This is not ++ quite how Fortran works in reality; in reality the base address of ++ the object would point at the element with the highest address, and ++ we would index backwards from there in the "normal" way, however, ++ GDB's current value contents model doesn't support having the base ++ address be near to the end of the value contents, so we currently ++ adjust the base address of Fortran arrays with negative strides so ++ their base address points at the lowest memory address. This code ++ here is part of working around this weirdness. */ ++ LONGEST index_offset (LONGEST index) ++ { ++ LONGEST offset; ++ if (m_stride < 0) ++ offset = std::abs (m_stride) * (m_upperbound - index); ++ else ++ offset = std::abs (m_stride) * (index - m_lowerbound); ++ return offset; ++ } ++ ++private: ++ ++ /* The stride for the type we are working with. */ ++ LONGEST m_stride; ++ ++ /* The upper bound for the type we are working with. */ ++ LONGEST m_upperbound; ++ ++ /* The lower bound for the type we are working with. */ ++ LONGEST m_lowerbound; ++}; ++ ++/* A base class used by fortran_array_walker. There's no virtual methods ++ here, sub-classes should just override the functions they want in order ++ to specialise the behaviour to their needs. The functionality ++ provided in these default implementations will visit every array ++ element, but do nothing for each element. */ ++ ++struct fortran_array_walker_base_impl ++{ ++ /* Called when iterating between the lower and upper bounds of each ++ dimension of the array. Return true if GDB should continue iterating, ++ otherwise, return false. ++ ++ SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should ++ be taken into consideration when deciding what to return. If ++ SHOULD_CONTINUE is false then this function must also return false, ++ the function is still called though in case extra work needs to be ++ done as part of the stopping process. */ ++ bool continue_walking (bool should_continue) ++ { return should_continue; } ++ ++ /* Called when GDB starts iterating over a dimension of the array. The ++ argument INNER_P is true for the inner most dimension (the dimension ++ containing the actual elements of the array), and false for more outer ++ dimensions. For a concrete example of how this function is called ++ see the comment on process_element below. */ ++ void start_dimension (bool inner_p) ++ { /* Nothing. */ } ++ ++ /* Called when GDB finishes iterating over a dimension of the array. The ++ argument INNER_P is true for the inner most dimension (the dimension ++ containing the actual elements of the array), and false for more outer ++ dimensions. LAST_P is true for the last call at a particular ++ dimension. For a concrete example of how this function is called ++ see the comment on process_element below. */ ++ void finish_dimension (bool inner_p, bool last_p) ++ { /* Nothing. */ } ++ ++ /* Called when processing the inner most dimension of the array, for ++ every element in the array. ELT_TYPE is the type of the element being ++ extracted, and ELT_OFF is the offset of the element from the start of ++ array being walked, and LAST_P is true only when this is the last ++ element that will be processed in this dimension. ++ ++ Given this two dimensional array ((1, 2) (3, 4)), the calls to ++ start_dimension, process_element, and finish_dimension look like this: ++ ++ start_dimension (false); ++ start_dimension (true); ++ process_element (TYPE, OFFSET, false); ++ process_element (TYPE, OFFSET, true); ++ finish_dimension (true, false); ++ start_dimension (true); ++ process_element (TYPE, OFFSET, false); ++ process_element (TYPE, OFFSET, true); ++ finish_dimension (true, true); ++ finish_dimension (false, true); */ ++ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) ++ { /* Nothing. */ } ++}; ++ ++/* A class to wrap up the process of iterating over a multi-dimensional ++ Fortran array. IMPL is used to specialise what happens as we walk over ++ the array. See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the ++ methods than can be used to customise the array walk. */ ++template ++class fortran_array_walker ++{ ++ /* Ensure that Impl is derived from the required base class. This just ++ ensures that all of the required API methods are available and have a ++ sensible default implementation. */ ++ gdb_static_assert ((std::is_base_of::value)); ++ ++public: ++ /* Create a new array walker. TYPE is the type of the array being walked ++ over, and ADDRESS is the base address for the object of TYPE in ++ memory. All other arguments are forwarded to the constructor of the ++ template parameter class IMPL. */ ++ template ++ fortran_array_walker (struct type *type, CORE_ADDR address, ++ Args... args) ++ : m_type (type), ++ m_address (address), ++ m_impl (type, address, args...) ++ { ++ m_ndimensions = calc_f77_array_dims (m_type); ++ } ++ ++ /* Walk the array. */ ++ void ++ walk () ++ { ++ walk_1 (1, m_type, 0, false); ++ } ++ ++private: ++ /* The core of the array walking algorithm. NSS is the current ++ dimension number being processed, TYPE is the type of this dimension, ++ and OFFSET is the offset (in bytes) for the start of this dimension. */ ++ void ++ walk_1 (int nss, struct type *type, int offset, bool last_p) ++ { ++ /* Extract the range, and get lower and upper bounds. */ ++ struct type *range_type = check_typedef (type)->index_type (); ++ LONGEST lowerbound, upperbound; ++ if (!get_discrete_bounds (range_type, &lowerbound, &upperbound)) ++ error ("failed to get range bounds"); ++ ++ /* CALC is used to calculate the offsets for each element in this ++ dimension. */ ++ fortran_array_offset_calculator calc (type); ++ ++ m_impl.start_dimension (nss == m_ndimensions); ++ ++ if (nss != m_ndimensions) ++ { ++ /* For dimensions other than the inner most, walk each element and ++ recurse while peeling off one more dimension of the array. */ ++ for (LONGEST i = lowerbound; ++ m_impl.continue_walking (i < upperbound + 1); ++ i++) ++ { ++ /* Use the index and the stride to work out a new offset. */ ++ LONGEST new_offset = offset + calc.index_offset (i); ++ ++ /* Now print the lower dimension. */ ++ struct type *subarray_type ++ = TYPE_TARGET_TYPE (check_typedef (type)); ++ walk_1 (nss + 1, subarray_type, new_offset, (i == upperbound)); ++ } ++ } ++ else ++ { ++ /* For the inner most dimension of the array, process each element ++ within this dimension. */ ++ for (LONGEST i = lowerbound; ++ m_impl.continue_walking (i < upperbound + 1); ++ i++) ++ { ++ LONGEST elt_off = offset + calc.index_offset (i); ++ ++ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type)); ++ if (is_dynamic_type (elt_type)) ++ { ++ CORE_ADDR e_address = m_address + elt_off; ++ elt_type = resolve_dynamic_type (elt_type, {}, e_address); ++ } ++ ++ m_impl.process_element (elt_type, elt_off, (i == upperbound)); ++ } ++ } ++ ++ m_impl.finish_dimension (nss == m_ndimensions, last_p || nss == 1); ++ } ++ ++ /* The array type being processed. */ ++ struct type *m_type; ++ ++ /* The address in target memory for the object of M_TYPE being ++ processed. This is required in order to resolve dynamic types. */ ++ CORE_ADDR m_address; ++ ++ /* An instance of the template specialisation class. */ ++ Impl m_impl; ++ ++ /* The total number of dimensions in M_TYPE. */ ++ int m_ndimensions; ++}; ++ ++#endif /* F_ARRAY_WALKER_H */ +diff --git a/gdb/f-lang.c b/gdb/f-lang.c +--- a/gdb/f-lang.c ++++ b/gdb/f-lang.c +@@ -36,9 +36,36 @@ + #include "c-lang.h" + #include "target-float.h" + #include "gdbarch.h" ++#include "gdbcmd.h" ++#include "f-array-walker.h" + + #include + ++/* Whether GDB should repack array slices created by the user. */ ++static bool repack_array_slices = false; ++ ++/* Implement 'show fortran repack-array-slices'. */ ++static void ++show_repack_array_slices (struct ui_file *file, int from_tty, ++ struct cmd_list_element *c, const char *value) ++{ ++ fprintf_filtered (file, _("Repacking of Fortran array slices is %s.\n"), ++ value); ++} ++ ++/* Debugging of Fortran's array slicing. */ ++static bool fortran_array_slicing_debug = false; ++ ++/* Implement 'show debug fortran-array-slicing'. */ ++static void ++show_fortran_array_slicing_debug (struct ui_file *file, int from_tty, ++ struct cmd_list_element *c, ++ const char *value) ++{ ++ fprintf_filtered (file, _("Debugging of Fortran array slicing is %s.\n"), ++ value); ++} ++ + /* Local functions */ + + /* Return the encoding that should be used for the character type +@@ -114,57 +141,6 @@ enum f_primitive_types { + nr_f_primitive_types + }; + +-/* Called from fortran_value_subarray to take a slice of an array or a +- string. ARRAY is the array or string to be accessed. EXP, POS, and +- NOSIDE are as for evaluate_subexp_standard. Return a value that is a +- slice of the array. */ +- +-static struct value * +-value_f90_subarray (struct value *array, +- struct expression *exp, int *pos, enum noside noside) +-{ +- int pc = (*pos) + 1; +- LONGEST low_bound, high_bound, stride; +- struct type *range = check_typedef (value_type (array)->index_type ()); +- enum range_flag range_flag +- = (enum range_flag) longest_to_int (exp->elts[pc].longconst); +- +- *pos += 3; +- +- if (range_flag & RANGE_LOW_BOUND_DEFAULT) +- low_bound = range->bounds ()->low.const_val (); +- else +- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); +- +- if (range_flag & RANGE_HIGH_BOUND_DEFAULT) +- high_bound = range->bounds ()->high.const_val (); +- else +- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); +- +- if (range_flag & RANGE_HAS_STRIDE) +- stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); +- else +- stride = 1; +- +- if (stride != 1) +- error (_("Fortran array strides are not currently supported")); +- +- return value_slice (array, low_bound, high_bound - low_bound + 1); +-} +- +-/* Helper for skipping all the arguments in an undetermined argument list. +- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST +- case of evaluate_subexp_standard as multiple, but not all, code paths +- require a generic skip. */ +- +-static void +-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, +- enum noside noside) +-{ +- for (int i = 0; i < nargs; ++i) +- evaluate_subexp (nullptr, exp, pos, noside); +-} +- + /* Return the number of dimensions for a Fortran array or string. */ + + int +@@ -189,6 +165,145 @@ calc_f77_array_dims (struct type *array_type) + return ndimen; + } + ++/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array ++ slices. This is a base class for two alternative repacking mechanisms, ++ one for when repacking from a lazy value, and one for repacking from a ++ non-lazy (already loaded) value. */ ++class fortran_array_repacker_base_impl ++ : public fortran_array_walker_base_impl ++{ ++public: ++ /* Constructor, DEST is the value we are repacking into. */ ++ fortran_array_repacker_base_impl (struct value *dest) ++ : m_dest (dest), ++ m_dest_offset (0) ++ { /* Nothing. */ } ++ ++ /* When we start processing the inner most dimension, this is where we ++ will be creating values for each element as we load them and then copy ++ them into the M_DEST value. Set a value mark so we can free these ++ temporary values. */ ++ void start_dimension (bool inner_p) ++ { ++ if (inner_p) ++ { ++ gdb_assert (m_mark == nullptr); ++ m_mark = value_mark (); ++ } ++ } ++ ++ /* When we finish processing the inner most dimension free all temporary ++ value that were created. */ ++ void finish_dimension (bool inner_p, bool last_p) ++ { ++ if (inner_p) ++ { ++ gdb_assert (m_mark != nullptr); ++ value_free_to_mark (m_mark); ++ m_mark = nullptr; ++ } ++ } ++ ++protected: ++ /* Copy the contents of array element ELT into M_DEST at the next ++ available offset. */ ++ void copy_element_to_dest (struct value *elt) ++ { ++ value_contents_copy (m_dest, m_dest_offset, elt, 0, ++ TYPE_LENGTH (value_type (elt))); ++ m_dest_offset += TYPE_LENGTH (value_type (elt)); ++ } ++ ++ /* The value being written to. */ ++ struct value *m_dest; ++ ++ /* The byte offset in M_DEST at which the next element should be ++ written. */ ++ LONGEST m_dest_offset; ++ ++ /* Set with a call to VALUE_MARK, and then reset after calling ++ VALUE_FREE_TO_MARK. */ ++ struct value *m_mark = nullptr; ++}; ++ ++/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array ++ slices. This class is specialised for repacking an array slice from a ++ lazy array value, as such it does not require the parent array value to ++ be loaded into GDB's memory; the parent value could be huge, while the ++ slice could be tiny. */ ++class fortran_lazy_array_repacker_impl ++ : public fortran_array_repacker_base_impl ++{ ++public: ++ /* Constructor. TYPE is the type of the slice being loaded from the ++ parent value, so this type will correctly reflect the strides required ++ to find all of the elements from the parent value. ADDRESS is the ++ address in target memory of value matching TYPE, and DEST is the value ++ we are repacking into. */ ++ explicit fortran_lazy_array_repacker_impl (struct type *type, ++ CORE_ADDR address, ++ struct value *dest) ++ : fortran_array_repacker_base_impl (dest), ++ m_addr (address) ++ { /* Nothing. */ } ++ ++ /* Create a lazy value in target memory representing a single element, ++ then load the element into GDB's memory and copy the contents into the ++ destination value. */ ++ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) ++ { ++ copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off)); ++ } ++ ++private: ++ /* The address in target memory where the parent value starts. */ ++ CORE_ADDR m_addr; ++}; ++ ++/* A class used by FORTRAN_VALUE_SUBARRAY when repacking Fortran array ++ slices. This class is specialised for repacking an array slice from a ++ previously loaded (non-lazy) array value, as such it fetches the ++ element values from the contents of the parent value. */ ++class fortran_array_repacker_impl ++ : public fortran_array_repacker_base_impl ++{ ++public: ++ /* Constructor. TYPE is the type for the array slice within the parent ++ value, as such it has stride values as required to find the elements ++ within the original parent value. ADDRESS is the address in target ++ memory of the value matching TYPE. BASE_OFFSET is the offset from ++ the start of VAL's content buffer to the start of the object of TYPE, ++ VAL is the parent object from which we are loading the value, and ++ DEST is the value into which we are repacking. */ ++ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address, ++ LONGEST base_offset, ++ struct value *val, struct value *dest) ++ : fortran_array_repacker_base_impl (dest), ++ m_base_offset (base_offset), ++ m_val (val) ++ { ++ gdb_assert (!value_lazy (val)); ++ } ++ ++ /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF) ++ from the content buffer of M_VAL then copy this extracted value into ++ the repacked destination value. */ ++ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) ++ { ++ struct value *elt ++ = value_from_component (m_val, elt_type, (elt_off + m_base_offset)); ++ copy_element_to_dest (elt); ++ } ++ ++private: ++ /* The offset into the content buffer of M_VAL to the start of the slice ++ being extracted. */ ++ LONGEST m_base_offset; ++ ++ /* The parent value from which we are extracting a slice. */ ++ struct value *m_val; ++}; ++ + /* Called from evaluate_subexp_standard to perform array indexing, and + sub-range extraction, for Fortran. As well as arrays this function + also handles strings as they can be treated like arrays of characters. +@@ -200,51 +315,394 @@ static struct value * + fortran_value_subarray (struct value *array, struct expression *exp, + int *pos, int nargs, enum noside noside) + { +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (array, exp, pos, noside); +- +- if (noside == EVAL_SKIP) ++ type *original_array_type = check_typedef (value_type (array)); ++ bool is_string_p = original_array_type->code () == TYPE_CODE_STRING; ++ ++ /* Perform checks for ARRAY not being available. The somewhat overly ++ complex logic here is just to keep backward compatibility with the ++ errors that we used to get before FORTRAN_VALUE_SUBARRAY was ++ rewritten. Maybe a future task would streamline the error messages we ++ get here, and update all the expected test results. */ ++ if (exp->elts[*pos].opcode != OP_RANGE) + { +- skip_undetermined_arglist (nargs, exp, pos, noside); +- /* Return the dummy value with the correct type. */ +- return array; ++ if (type_not_associated (original_array_type)) ++ error (_("no such vector element (vector not associated)")); ++ else if (type_not_allocated (original_array_type)) ++ error (_("no such vector element (vector not allocated)")); ++ } ++ else ++ { ++ if (type_not_associated (original_array_type)) ++ error (_("array not associated")); ++ else if (type_not_allocated (original_array_type)) ++ error (_("array not allocated")); + } + +- LONGEST subscript_array[MAX_FORTRAN_DIMS]; +- int ndimensions = 1; +- struct type *type = check_typedef (value_type (array)); ++ /* First check that the number of dimensions in the type we are slicing ++ matches the number of arguments we were passed. */ ++ int ndimensions = calc_f77_array_dims (original_array_type); ++ if (nargs != ndimensions) ++ error (_("Wrong number of subscripts")); + +- if (nargs > MAX_FORTRAN_DIMS) +- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); ++ /* This will be initialised below with the type of the elements held in ++ ARRAY. */ ++ struct type *inner_element_type; + +- ndimensions = calc_f77_array_dims (type); ++ /* Extract the types of each array dimension from the original array ++ type. We need these available so we can fill in the default upper and ++ lower bounds if the user requested slice doesn't provide that ++ information. Additionally unpacking the dimensions like this gives us ++ the inner element type. */ ++ std::vector dim_types; ++ { ++ dim_types.reserve (ndimensions); ++ struct type *type = original_array_type; ++ for (int i = 0; i < ndimensions; ++i) ++ { ++ dim_types.push_back (type); ++ type = TYPE_TARGET_TYPE (type); ++ } ++ /* TYPE is now the inner element type of the array, we start the new ++ array slice off as this type, then as we process the requested slice ++ (from the user) we wrap new types around this to build up the final ++ slice type. */ ++ inner_element_type = type; ++ } + +- if (nargs != ndimensions) +- error (_("Wrong number of subscripts")); ++ /* As we analyse the new slice type we need to understand if the data ++ being referenced is contiguous. Do decide this we must track the size ++ of an element at each dimension of the new slice array. Initially the ++ elements of the inner most dimension of the array are the same inner ++ most elements as the original ARRAY. */ ++ LONGEST slice_element_size = TYPE_LENGTH (inner_element_type); ++ ++ /* Start off assuming all data is contiguous, this will be set to false ++ if access to any dimension results in non-contiguous data. */ ++ bool is_all_contiguous = true; ++ ++ /* The TOTAL_OFFSET is the distance in bytes from the start of the ++ original ARRAY to the start of the new slice. This is calculated as ++ we process the information from the user. */ ++ LONGEST total_offset = 0; ++ ++ /* A structure representing information about each dimension of the ++ resulting slice. */ ++ struct slice_dim ++ { ++ /* Constructor. */ ++ slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx) ++ : low (l), ++ high (h), ++ stride (s), ++ index (idx) ++ { /* Nothing. */ } ++ ++ /* The low bound for this dimension of the slice. */ ++ LONGEST low; ++ ++ /* The high bound for this dimension of the slice. */ ++ LONGEST high; ++ ++ /* The byte stride for this dimension of the slice. */ ++ LONGEST stride; ++ ++ struct type *index; ++ }; ++ ++ /* The dimensions of the resulting slice. */ ++ std::vector slice_dims; ++ ++ /* Process the incoming arguments. These arguments are in the reverse ++ order to the array dimensions, that is the first argument refers to ++ the last array dimension. */ ++ if (fortran_array_slicing_debug) ++ debug_printf ("Processing array access:\n"); ++ for (int i = 0; i < nargs; ++i) ++ { ++ /* For each dimension of the array the user will have either provided ++ a ranged access with optional lower bound, upper bound, and ++ stride, or the user will have supplied a single index. */ ++ struct type *dim_type = dim_types[ndimensions - (i + 1)]; ++ if (exp->elts[*pos].opcode == OP_RANGE) ++ { ++ int pc = (*pos) + 1; ++ enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst; ++ *pos += 3; ++ ++ LONGEST low, high, stride; ++ low = high = stride = 0; ++ ++ if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0) ++ low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); ++ else ++ low = f77_get_lowerbound (dim_type); ++ if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0) ++ high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); ++ else ++ high = f77_get_upperbound (dim_type); ++ if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE) ++ stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); ++ else ++ stride = 1; ++ ++ if (stride == 0) ++ error (_("stride must not be 0")); ++ ++ /* Get information about this dimension in the original ARRAY. */ ++ struct type *target_type = TYPE_TARGET_TYPE (dim_type); ++ struct type *index_type = dim_type->index_type (); ++ LONGEST lb = f77_get_lowerbound (dim_type); ++ LONGEST ub = f77_get_upperbound (dim_type); ++ LONGEST sd = index_type->bit_stride (); ++ if (sd == 0) ++ sd = TYPE_LENGTH (target_type) * 8; ++ ++ if (fortran_array_slicing_debug) ++ { ++ debug_printf ("|-> Range access\n"); ++ std::string str = type_to_string (dim_type); ++ debug_printf ("| |-> Type: %s\n", str.c_str ()); ++ debug_printf ("| |-> Array:\n"); ++ debug_printf ("| | |-> Low bound: %ld\n", lb); ++ debug_printf ("| | |-> High bound: %ld\n", ub); ++ debug_printf ("| | |-> Bit stride: %ld\n", sd); ++ debug_printf ("| | |-> Byte stride: %ld\n", sd / 8); ++ debug_printf ("| | |-> Type size: %ld\n", ++ TYPE_LENGTH (dim_type)); ++ debug_printf ("| | '-> Target type size: %ld\n", ++ TYPE_LENGTH (target_type)); ++ debug_printf ("| |-> Accessing:\n"); ++ debug_printf ("| | |-> Low bound: %ld\n", ++ low); ++ debug_printf ("| | |-> High bound: %ld\n", ++ high); ++ debug_printf ("| | '-> Element stride: %ld\n", ++ stride); ++ } ++ ++ /* Check the user hasn't asked for something invalid. */ ++ if (high > ub || low < lb) ++ error (_("array subscript out of bounds")); ++ ++ /* Calculate what this dimension of the new slice array will look ++ like. OFFSET is the byte offset from the start of the ++ previous (more outer) dimension to the start of this ++ dimension. E_COUNT is the number of elements in this ++ dimension. REMAINDER is the number of elements remaining ++ between the last included element and the upper bound. For ++ example an access '1:6:2' will include elements 1, 3, 5 and ++ have a remainder of 1 (element #6). */ ++ LONGEST lowest = std::min (low, high); ++ LONGEST offset = (sd / 8) * (lowest - lb); ++ LONGEST e_count = std::abs (high - low) + 1; ++ e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride); ++ LONGEST new_low = 1; ++ LONGEST new_high = new_low + e_count - 1; ++ LONGEST new_stride = (sd * stride) / 8; ++ LONGEST last_elem = low + ((e_count - 1) * stride); ++ LONGEST remainder = high - last_elem; ++ if (low > high) ++ { ++ offset += std::abs (remainder) * TYPE_LENGTH (target_type); ++ if (stride > 0) ++ error (_("incorrect stride and boundary combination")); ++ } ++ else if (stride < 0) ++ error (_("incorrect stride and boundary combination")); ++ ++ /* Is the data within this dimension contiguous? It is if the ++ newly computed stride is the same size as a single element of ++ this dimension. */ ++ bool is_dim_contiguous = (new_stride == slice_element_size); ++ is_all_contiguous &= is_dim_contiguous; ++ ++ if (fortran_array_slicing_debug) ++ { ++ debug_printf ("| '-> Results:\n"); ++ debug_printf ("| |-> Offset = %ld\n", offset); ++ debug_printf ("| |-> Elements = %ld\n", e_count); ++ debug_printf ("| |-> Low bound = %ld\n", new_low); ++ debug_printf ("| |-> High bound = %ld\n", new_high); ++ debug_printf ("| |-> Byte stride = %ld\n", new_stride); ++ debug_printf ("| |-> Last element = %ld\n", last_elem); ++ debug_printf ("| |-> Remainder = %ld\n", remainder); ++ debug_printf ("| '-> Contiguous = %s\n", ++ (is_dim_contiguous ? "Yes" : "No")); ++ } ++ ++ /* Figure out how big (in bytes) an element of this dimension of ++ the new array slice will be. */ ++ slice_element_size = std::abs (new_stride * e_count); ++ ++ slice_dims.emplace_back (new_low, new_high, new_stride, ++ index_type); ++ ++ /* Update the total offset. */ ++ total_offset += offset; ++ } ++ else ++ { ++ /* There is a single index for this dimension. */ ++ LONGEST index ++ = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside)); ++ ++ /* Get information about this dimension in the original ARRAY. */ ++ struct type *target_type = TYPE_TARGET_TYPE (dim_type); ++ struct type *index_type = dim_type->index_type (); ++ LONGEST lb = f77_get_lowerbound (dim_type); ++ LONGEST ub = f77_get_upperbound (dim_type); ++ LONGEST sd = index_type->bit_stride () / 8; ++ if (sd == 0) ++ sd = TYPE_LENGTH (target_type); ++ ++ if (fortran_array_slicing_debug) ++ { ++ debug_printf ("|-> Index access\n"); ++ std::string str = type_to_string (dim_type); ++ debug_printf ("| |-> Type: %s\n", str.c_str ()); ++ debug_printf ("| |-> Array:\n"); ++ debug_printf ("| | |-> Low bound: %ld\n", lb); ++ debug_printf ("| | |-> High bound: %ld\n", ub); ++ debug_printf ("| | |-> Byte stride: %ld\n", sd); ++ debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type)); ++ debug_printf ("| | '-> Target type size: %ld\n", ++ TYPE_LENGTH (target_type)); ++ debug_printf ("| '-> Accessing:\n"); ++ debug_printf ("| '-> Index: %ld\n", index); ++ } ++ ++ /* If the array has actual content then check the index is in ++ bounds. An array without content (an unbound array) doesn't ++ have a known upper bound, so don't error check in that ++ situation. */ ++ if (index < lb ++ || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED ++ && index > ub) ++ || (VALUE_LVAL (array) != lval_memory ++ && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED)) ++ { ++ if (type_not_associated (dim_type)) ++ error (_("no such vector element (vector not associated)")); ++ else if (type_not_allocated (dim_type)) ++ error (_("no such vector element (vector not allocated)")); ++ else ++ error (_("no such vector element")); ++ } + +- gdb_assert (nargs > 0); ++ /* Calculate using the type stride, not the target type size. */ ++ LONGEST offset = sd * (index - lb); ++ total_offset += offset; ++ } ++ } + +- /* Now that we know we have a legal array subscript expression let us +- actually find out where this element exists in the array. */ ++ if (noside == EVAL_SKIP) ++ return array; + +- /* Take array indices left to right. */ +- for (int i = 0; i < nargs; i++) ++ /* Build a type that represents the new array slice in the target memory ++ of the original ARRAY, this type makes use of strides to correctly ++ find only those elements that are part of the new slice. */ ++ struct type *array_slice_type = inner_element_type; ++ for (const auto &d : slice_dims) + { +- /* Evaluate each subscript; it must be a legal integer in F77. */ +- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); ++ /* Create the range. */ ++ dynamic_prop p_low, p_high, p_stride; ++ ++ p_low.set_const_val (d.low); ++ p_high.set_const_val (d.high); ++ p_stride.set_const_val (d.stride); ++ ++ struct type *new_range ++ = create_range_type_with_stride ((struct type *) NULL, ++ TYPE_TARGET_TYPE (d.index), ++ &p_low, &p_high, 0, &p_stride, ++ true); ++ array_slice_type ++ = create_array_type (nullptr, array_slice_type, new_range); ++ } + +- /* Fill in the subscript array. */ +- subscript_array[i] = value_as_long (arg2); ++ if (fortran_array_slicing_debug) ++ { ++ debug_printf ("'-> Final result:\n"); ++ debug_printf (" |-> Type: %s\n", ++ type_to_string (array_slice_type).c_str ()); ++ debug_printf (" |-> Total offset: %ld\n", total_offset); ++ debug_printf (" |-> Base address: %s\n", ++ core_addr_to_string (value_address (array))); ++ debug_printf (" '-> Contiguous = %s\n", ++ (is_all_contiguous ? "Yes" : "No")); + } + +- /* Internal type of array is arranged right to left. */ +- for (int i = nargs; i > 0; i--) ++ /* Should we repack this array slice? */ ++ if (!is_all_contiguous && (repack_array_slices || is_string_p)) + { +- struct type *array_type = check_typedef (value_type (array)); +- LONGEST index = subscript_array[i - 1]; ++ /* Build a type for the repacked slice. */ ++ struct type *repacked_array_type = inner_element_type; ++ for (const auto &d : slice_dims) ++ { ++ /* Create the range. */ ++ dynamic_prop p_low, p_high, p_stride; ++ ++ p_low.set_const_val (d.low); ++ p_high.set_const_val (d.high); ++ p_stride.set_const_val (TYPE_LENGTH (repacked_array_type)); ++ ++ struct type *new_range ++ = create_range_type_with_stride ((struct type *) NULL, ++ TYPE_TARGET_TYPE (d.index), ++ &p_low, &p_high, 0, &p_stride, ++ true); ++ repacked_array_type ++ = create_array_type (nullptr, repacked_array_type, new_range); ++ } + +- array = value_subscripted_rvalue (array, index, +- f77_get_lowerbound (array_type)); ++ /* Now copy the elements from the original ARRAY into the packed ++ array value DEST. */ ++ struct value *dest = allocate_value (repacked_array_type); ++ if (value_lazy (array) ++ || (total_offset + TYPE_LENGTH (array_slice_type) ++ > TYPE_LENGTH (check_typedef (value_type (array))))) ++ { ++ fortran_array_walker p ++ (array_slice_type, value_address (array) + total_offset, dest); ++ p.walk (); ++ } ++ else ++ { ++ fortran_array_walker p ++ (array_slice_type, value_address (array) + total_offset, ++ total_offset, array, dest); ++ p.walk (); ++ } ++ array = dest; ++ } ++ else ++ { ++ if (VALUE_LVAL (array) == lval_memory) ++ { ++ /* If the value we're taking a slice from is not yet loaded, or ++ the requested slice is outside the values content range then ++ just create a new lazy value pointing at the memory where the ++ contents we're looking for exist. */ ++ if (value_lazy (array) ++ || (total_offset + TYPE_LENGTH (array_slice_type) ++ > TYPE_LENGTH (check_typedef (value_type (array))))) ++ array = value_at_lazy (array_slice_type, ++ value_address (array) + total_offset); ++ else ++ array = value_from_contents_and_address (array_slice_type, ++ (value_contents (array) ++ + total_offset), ++ (value_address (array) ++ + total_offset)); ++ } ++ else if (!value_lazy (array)) ++ { ++ const void *valaddr = value_contents (array) + total_offset; ++ array = allocate_value (array_slice_type); ++ memcpy (value_contents_raw (array), valaddr, TYPE_LENGTH (array_slice_type)); ++ } ++ else ++ error (_("cannot subscript arrays that are not in memory")); + } + + return array; +@@ -1031,11 +1489,50 @@ builtin_f_type (struct gdbarch *gdbarch) + return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data); + } + ++/* Command-list for the "set/show fortran" prefix command. */ ++static struct cmd_list_element *set_fortran_list; ++static struct cmd_list_element *show_fortran_list; ++ + void _initialize_f_language (); + void + _initialize_f_language () + { + f_type_data = gdbarch_data_register_post_init (build_fortran_types); ++ ++ add_basic_prefix_cmd ("fortran", no_class, ++ _("Prefix command for changing Fortran-specific settings."), ++ &set_fortran_list, "set fortran ", 0, &setlist); ++ ++ add_show_prefix_cmd ("fortran", no_class, ++ _("Generic command for showing Fortran-specific settings."), ++ &show_fortran_list, "show fortran ", 0, &showlist); ++ ++ add_setshow_boolean_cmd ("repack-array-slices", class_vars, ++ &repack_array_slices, _("\ ++Enable or disable repacking of non-contiguous array slices."), _("\ ++Show whether non-contiguous array slices are repacked."), _("\ ++When the user requests a slice of a Fortran array then we can either return\n\ ++a descriptor that describes the array in place (using the original array data\n\ ++in its existing location) or the original data can be repacked (copied) to a\n\ ++new location.\n\ ++\n\ ++When the content of the array slice is contiguous within the original array\n\ ++then the result will never be repacked, but when the data for the new array\n\ ++is non-contiguous within the original array repacking will only be performed\n\ ++when this setting is on."), ++ NULL, ++ show_repack_array_slices, ++ &set_fortran_list, &show_fortran_list); ++ ++ /* Debug Fortran's array slicing logic. */ ++ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance, ++ &fortran_array_slicing_debug, _("\ ++Set debugging of Fortran array slicing."), _("\ ++Show debugging of Fortran array slicing."), _("\ ++When on, debugging of Fortran array slicing is enabled."), ++ NULL, ++ show_fortran_array_slicing_debug, ++ &setdebuglist, &showdebuglist); + } + + /* See f-lang.h. */ +@@ -1074,3 +1571,56 @@ fortran_preserve_arg_pointer (struct value *arg, struct type *type) + return value_type (arg); + return type; + } ++ ++/* See f-lang.h. */ ++ ++CORE_ADDR ++fortran_adjust_dynamic_array_base_address_hack (struct type *type, ++ CORE_ADDR address) ++{ ++ gdb_assert (type->code () == TYPE_CODE_ARRAY); ++ ++ int ndimensions = calc_f77_array_dims (type); ++ LONGEST total_offset = 0; ++ ++ /* Walk through each of the dimensions of this array type and figure out ++ if any of the dimensions are "backwards", that is the base address ++ for this dimension points to the element at the highest memory ++ address and the stride is negative. */ ++ struct type *tmp_type = type; ++ for (int i = 0 ; i < ndimensions; ++i) ++ { ++ /* Grab the range for this dimension and extract the lower and upper ++ bounds. */ ++ tmp_type = check_typedef (tmp_type); ++ struct type *range_type = tmp_type->index_type (); ++ LONGEST lowerbound, upperbound, stride; ++ if (!get_discrete_bounds (range_type, &lowerbound, &upperbound)) ++ error ("failed to get range bounds"); ++ ++ /* Figure out the stride for this dimension. */ ++ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (tmp_type)); ++ stride = tmp_type->index_type ()->bounds ()->bit_stride (); ++ if (stride == 0) ++ stride = type_length_units (elt_type); ++ else ++ { ++ struct gdbarch *arch = get_type_arch (elt_type); ++ int unit_size = gdbarch_addressable_memory_unit_size (arch); ++ stride /= (unit_size * 8); ++ } ++ ++ /* If this dimension is "backward" then figure out the offset ++ adjustment required to point to the element at the lowest memory ++ address, and add this to the total offset. */ ++ LONGEST offset = 0; ++ if (stride < 0 && lowerbound < upperbound) ++ offset = (upperbound - lowerbound) * stride; ++ total_offset += offset; ++ tmp_type = TYPE_TARGET_TYPE (tmp_type); ++ } ++ ++ /* Adjust the address of this object and return it. */ ++ address += total_offset; ++ return address; ++} +diff --git a/gdb/f-lang.h b/gdb/f-lang.h +--- a/gdb/f-lang.h ++++ b/gdb/f-lang.h +@@ -64,7 +64,6 @@ extern void f77_get_dynamic_array_length (struct type *); + + extern int calc_f77_array_dims (struct type *); + +- + /* Fortran (F77) types */ + + struct builtin_f_type +@@ -122,4 +121,22 @@ extern struct value *fortran_argument_convert (struct value *value, + extern struct type *fortran_preserve_arg_pointer (struct value *arg, + struct type *type); + ++/* Fortran arrays can have a negative stride. When this happens it is ++ often the case that the base address for an object is not the lowest ++ address occupied by that object. For example, an array slice (10:1:-1) ++ will be encoded with lower bound 1, upper bound 10, a stride of ++ -ELEMENT_SIZE, and have a base address pointer that points at the ++ element with the highest address in memory. ++ ++ This really doesn't play well with our current model of value contents, ++ but could easily require a significant update in order to be supported ++ "correctly". ++ ++ For now, we manually force the base address to be the lowest addressed ++ element here. Yes, this will break some things, but it fixes other ++ things. The hope is that it fixes more than it breaks. */ ++ ++extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack ++ (struct type *type, CORE_ADDR address); ++ + #endif /* F_LANG_H */ +diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c +--- a/gdb/f-valprint.c ++++ b/gdb/f-valprint.c +@@ -35,6 +35,7 @@ + #include "dictionary.h" + #include "cli/cli-style.h" + #include "gdbarch.h" ++#include "f-array-walker.h" + + static void f77_get_dynamic_length_of_aggregate (struct type *); + +@@ -100,100 +101,103 @@ f77_get_dynamic_length_of_aggregate (struct type *type) + * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type))); + } + +-/* Actual function which prints out F77 arrays, Valaddr == address in +- the superior. Address == the address in the inferior. */ ++/* A class used by FORTRAN_PRINT_ARRAY as a specialisation of the array ++ walking template. This specialisation prints Fortran arrays. */ + +-static void +-f77_print_array_1 (int nss, int ndimensions, struct type *type, +- const gdb_byte *valaddr, +- int embedded_offset, CORE_ADDR address, +- struct ui_file *stream, int recurse, +- const struct value *val, +- const struct value_print_options *options, +- int *elts) ++class fortran_array_printer_impl : public fortran_array_walker_base_impl + { +- struct type *range_type = check_typedef (type)->index_type (); +- CORE_ADDR addr = address + embedded_offset; +- LONGEST lowerbound, upperbound; +- LONGEST i; +- +- get_discrete_bounds (range_type, &lowerbound, &upperbound); +- +- if (nss != ndimensions) +- { +- struct gdbarch *gdbarch = get_type_arch (type); +- size_t dim_size = type_length_units (TYPE_TARGET_TYPE (type)); +- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch); +- size_t byte_stride = type->bit_stride () / (unit_size * 8); +- if (byte_stride == 0) +- byte_stride = dim_size; +- size_t offs = 0; +- +- for (i = lowerbound; +- (i < upperbound + 1 && (*elts) < options->print_max); +- i++) +- { +- struct value *subarray = value_from_contents_and_address +- (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val) +- + offs, addr + offs); +- +- fprintf_filtered (stream, "("); +- f77_print_array_1 (nss + 1, ndimensions, value_type (subarray), +- value_contents_for_printing (subarray), +- value_embedded_offset (subarray), +- value_address (subarray), +- stream, recurse, subarray, options, elts); +- offs += byte_stride; +- fprintf_filtered (stream, ")"); +- +- if (i < upperbound) +- fprintf_filtered (stream, " "); +- } +- if (*elts >= options->print_max && i < upperbound) +- fprintf_filtered (stream, "..."); +- } +- else +- { +- for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max; +- i++, (*elts)++) +- { +- struct value *elt = value_subscript ((struct value *)val, i); +- +- common_val_print (elt, stream, recurse, options, current_language); +- +- if (i != upperbound) +- fprintf_filtered (stream, ", "); +- +- if ((*elts == options->print_max - 1) +- && (i != upperbound)) +- fprintf_filtered (stream, "..."); +- } +- } +-} ++public: ++ /* Constructor. TYPE is the array type being printed, ADDRESS is the ++ address in target memory for the object of TYPE being printed. VAL is ++ the GDB value (of TYPE) being printed. STREAM is where to print to, ++ RECOURSE is passed through (and prevents infinite recursion), and ++ OPTIONS are the printing control options. */ ++ explicit fortran_array_printer_impl (struct type *type, ++ CORE_ADDR address, ++ struct value *val, ++ struct ui_file *stream, ++ int recurse, ++ const struct value_print_options *options) ++ : m_elts (0), ++ m_val (val), ++ m_stream (stream), ++ m_recurse (recurse), ++ m_options (options) ++ { /* Nothing. */ } ++ ++ /* Called while iterating over the array bounds. When SHOULD_CONTINUE is ++ false then we must return false, as we have reached the end of the ++ array bounds for this dimension. However, we also return false if we ++ have printed too many elements (after printing '...'). In all other ++ cases, return true. */ ++ bool continue_walking (bool should_continue) ++ { ++ bool cont = should_continue && (m_elts < m_options->print_max); ++ if (!cont && should_continue) ++ fputs_filtered ("...", m_stream); ++ return cont; ++ } ++ ++ /* Called when we start iterating over a dimension. If it's not the ++ inner most dimension then print an opening '(' character. */ ++ void start_dimension (bool inner_p) ++ { ++ fputs_filtered ("(", m_stream); ++ } ++ ++ /* Called when we finish processing a batch of items within a dimension ++ of the array. Depending on whether this is the inner most dimension ++ or not we print different things, but this is all about adding ++ separators between elements, and dimensions of the array. */ ++ void finish_dimension (bool inner_p, bool last_p) ++ { ++ fputs_filtered (")", m_stream); ++ if (!last_p) ++ fputs_filtered (" ", m_stream); ++ } ++ ++ /* Called to process an element of ELT_TYPE at offset ELT_OFF from the ++ start of the parent object. */ ++ void process_element (struct type *elt_type, LONGEST elt_off, bool last_p) ++ { ++ /* Extract the element value from the parent value. */ ++ struct value *e_val ++ = value_from_component (m_val, elt_type, elt_off); ++ common_val_print (e_val, m_stream, m_recurse, m_options, current_language); ++ if (!last_p) ++ fputs_filtered (", ", m_stream); ++ ++m_elts; ++ } ++ ++private: ++ /* The number of elements printed so far. */ ++ int m_elts; ++ ++ /* The value from which we are printing elements. */ ++ struct value *m_val; ++ ++ /* The stream we should print too. */ ++ struct ui_file *m_stream; ++ ++ /* The recursion counter, passed through when we print each element. */ ++ int m_recurse; ++ ++ /* The print control options. Gives us the maximum number of elements to ++ print, and is passed through to each element that we print. */ ++ const struct value_print_options *m_options = nullptr; ++}; + +-/* This function gets called to print an F77 array, we set up some +- stuff and then immediately call f77_print_array_1(). */ ++/* This function gets called to print a Fortran array. */ + + static void +-f77_print_array (struct type *type, const gdb_byte *valaddr, +- int embedded_offset, +- CORE_ADDR address, struct ui_file *stream, +- int recurse, +- const struct value *val, +- const struct value_print_options *options) ++fortran_print_array (struct type *type, CORE_ADDR address, ++ struct ui_file *stream, int recurse, ++ const struct value *val, ++ const struct value_print_options *options) + { +- int ndimensions; +- int elts = 0; +- +- ndimensions = calc_f77_array_dims (type); +- +- if (ndimensions > MAX_FORTRAN_DIMS || ndimensions < 0) +- error (_("\ +-Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"), +- ndimensions, MAX_FORTRAN_DIMS); +- +- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset, +- address, stream, recurse, val, options, &elts); ++ fortran_array_walker p ++ (type, address, (struct value *) val, stream, recurse, options); ++ p.walk (); + } + + +@@ -236,12 +240,7 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse, + + case TYPE_CODE_ARRAY: + if (TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_CHAR) +- { +- fprintf_filtered (stream, "("); +- f77_print_array (type, valaddr, 0, +- address, stream, recurse, val, options); +- fprintf_filtered (stream, ")"); +- } ++ fortran_print_array (type, address, stream, recurse, val, options); + else + { + struct type *ch_type = TYPE_TARGET_TYPE (type); +diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c +--- a/gdb/gdbtypes.c ++++ b/gdb/gdbtypes.c +@@ -39,6 +39,7 @@ + #include "dwarf2/loc.h" + #include "gdbcore.h" + #include "floatformat.h" ++#include "f-lang.h" + #include + + /* Initialize BADNESS constants. */ +@@ -2695,7 +2696,16 @@ resolve_dynamic_type_internal (struct type *type, + prop = TYPE_DATA_LOCATION (resolved_type); + if (prop != NULL + && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) +- prop->set_const_val (value); ++ { ++ /* Start of Fortran hack. See comment in f-lang.h for what is going ++ on here.*/ ++ if (current_language->la_language == language_fortran ++ && resolved_type->code () == TYPE_CODE_ARRAY) ++ value = fortran_adjust_dynamic_array_base_address_hack (resolved_type, ++ value); ++ /* End of Fortran hack. */ ++ prop->set_const_val (value); ++ } + + return resolved_type; + } +@@ -3600,9 +3610,11 @@ is_scalar_type_recursive (struct type *t) + LONGEST low_bound, high_bound; + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (t)); + +- get_discrete_bounds (t->index_type (), &low_bound, &high_bound); +- +- return high_bound == low_bound && is_scalar_type_recursive (elt_type); ++ if (get_discrete_bounds (t->index_type (), &low_bound, &high_bound)) ++ return (high_bound == low_bound ++ && is_scalar_type_recursive (elt_type)); ++ else ++ return 0; + } + /* Are we dealing with a struct with one element? */ + else if (t->code () == TYPE_CODE_STRUCT && t->num_fields () == 1) +diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.exp b/gdb/testsuite/gdb.fortran/array-slices-bad.exp +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/array-slices-bad.exp +@@ -0,0 +1,69 @@ ++# Copyright 2020 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 invalid element and slice array accesses. ++ ++if {[skip_fortran_tests]} { return -1 } ++ ++standard_testfile ".f90" ++load_lib fortran.exp ++ ++if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ ++ {debug f90}]} { ++ return -1 ++} ++ ++if ![fortran_runto_main] { ++ untested "could not run to main" ++ return -1 ++} ++ ++# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] ++gdb_breakpoint [gdb_get_line_number "First Breakpoint"] ++gdb_breakpoint [gdb_get_line_number "Second Breakpoint"] ++gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] ++ ++gdb_continue_to_breakpoint "First Breakpoint" ++ ++# Access not yet allocated array. ++gdb_test "print other" " = " ++gdb_test "print other(0:4,2:3)" "array not allocated" ++gdb_test "print other(1,1)" "no such vector element \\(vector not allocated\\)" ++ ++# Access not yet associated pointer. ++gdb_test "print pointer2d" " = " ++gdb_test "print pointer2d(1:2,1:2)" "array not associated" ++gdb_test "print pointer2d(1,1)" "no such vector element \\(vector not associated\\)" ++ ++gdb_continue_to_breakpoint "Second Breakpoint" ++ ++# Accessing just outside the arrays. ++foreach name {array pointer2d other} { ++ gdb_test "print $name (0:,:)" "array subscript out of bounds" ++ gdb_test "print $name (:11,:)" "array subscript out of bounds" ++ gdb_test "print $name (:,0:)" "array subscript out of bounds" ++ gdb_test "print $name (:,:11)" "array subscript out of bounds" ++ ++ gdb_test "print $name (0,:)" "no such vector element" ++ gdb_test "print $name (11,:)" "no such vector element" ++ gdb_test "print $name (:,0)" "no such vector element" ++ gdb_test "print $name (:,11)" "no such vector element" ++} ++ ++# Stride in the wrong direction. ++gdb_test "print array (1:10:-1,:)" "incorrect stride and boundary combination" ++gdb_test "print array (:,1:10:-1)" "incorrect stride and boundary combination" ++gdb_test "print array (10:1:1,:)" "incorrect stride and boundary combination" ++gdb_test "print array (:,10:1:1)" "incorrect stride and boundary combination" +diff --git a/gdb/testsuite/gdb.fortran/array-slices-bad.f90 b/gdb/testsuite/gdb.fortran/array-slices-bad.f90 +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/array-slices-bad.f90 +@@ -0,0 +1,42 @@ ++! Copyright 2020 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 . ++ ++! ++! Start of test program. ++! ++program test ++ ++ ! Declare variables used in this test. ++ integer, dimension (1:10,1:10) :: array ++ integer, allocatable :: other (:, :) ++ integer, dimension(:,:), pointer :: pointer2d => null() ++ integer, dimension(1:10,1:10), target :: tarray ++ ++ print *, "" ! First Breakpoint. ++ ++ ! Allocate or associate any variables as needed. ++ allocate (other (1:10, 1:10)) ++ pointer2d => tarray ++ array = 0 ++ ++ print *, "" ! Second Breakpoint. ++ ++ ! All done. Deallocate. ++ deallocate (other) ++ ++ ! GDB catches this final breakpoint to indicate the end of the test. ++ print *, "" ! Final Breakpoint. ++ ++end program test +diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.exp +@@ -0,0 +1,111 @@ ++# Copyright 2020 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 . ++ ++# Create a slice of an array, then take a slice of that slice. ++ ++if {[skip_fortran_tests]} { return -1 } ++ ++standard_testfile ".f90" ++load_lib fortran.exp ++ ++if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ ++ {debug f90}]} { ++ return -1 ++} ++ ++if ![fortran_runto_main] { ++ untested "could not run to main" ++ return -1 ++} ++ ++# gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] ++gdb_breakpoint [gdb_get_line_number "Stop Here"] ++gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] ++ ++# We're going to print some reasonably large arrays. ++gdb_test_no_output "set print elements unlimited" ++ ++gdb_continue_to_breakpoint "Stop Here" ++ ++# Print a slice, capture the convenience variable name created. ++set cmd "print array (1:10:2, 1:10:2)" ++gdb_test_multiple $cmd $cmd { ++ -re "\r\n\\\$(\\d+) = .*\r\n$gdb_prompt $" { ++ set varname "\$$expect_out(1,string)" ++ } ++} ++ ++# Now check that we can correctly extract all the elements from this ++# slice. ++for { set j 1 } { $j < 6 } { incr j } { ++ for { set i 1 } { $i < 6 } { incr i } { ++ set val [expr ((($i - 1) * 2) + (($j - 1) * 20)) + 1] ++ gdb_test "print ${varname} ($i,$j)" " = $val" ++ } ++} ++ ++# Now take a slice of the slice. ++gdb_test "print ${varname} (3:5, 3:5)" \ ++ " = \\(\\(45, 47, 49\\) \\(65, 67, 69\\) \\(85, 87, 89\\)\\)" ++ ++# Now take a different slice of a slice. ++set cmd "print ${varname} (1:5:2, 1:5:2)" ++gdb_test_multiple $cmd $cmd { ++ -re "\r\n\\\$(\\d+) = \\(\\(1, 5, 9\\) \\(41, 45, 49\\) \\(81, 85, 89\\)\\)\r\n$gdb_prompt $" { ++ set varname "\$$expect_out(1,string)" ++ pass $gdb_test_name ++ } ++} ++ ++# Now take a slice from the slice, of a slice! ++set cmd "print ${varname} (1:3:2, 1:3:2)" ++gdb_test_multiple $cmd $cmd { ++ -re "\r\n\\\$(\\d+) = \\(\\(1, 9\\) \\(81, 89\\)\\)\r\n$gdb_prompt $" { ++ set varname "\$$expect_out(1,string)" ++ pass $gdb_test_name ++ } ++} ++ ++# And again! ++set cmd "print ${varname} (1:2:2, 1:2:2)" ++gdb_test_multiple $cmd $cmd { ++ -re "\r\n\\\$(\\d+) = \\(\\(1\\)\\)\r\n$gdb_prompt $" { ++ set varname "\$$expect_out(1,string)" ++ pass $gdb_test_name ++ } ++} ++ ++# Test taking a slice with stride of a string. This isn't actually ++# supported within gfortran (at least), but naturally drops out of how ++# GDB models arrays and strings in a similar way, so we may as well ++# test that this is still working. ++gdb_test "print str (1:26:2)" " = 'acegikmoqsuwy'" ++gdb_test "print str (26:1:-1)" " = 'zyxwvutsrqponmlkjihgfedcba'" ++gdb_test "print str (26:1:-2)" " = 'zxvtrpnljhfdb'" ++ ++# Now test the memory requirements of taking a slice from an array. ++# The idea is that we shouldn't require more memory to extract a slice ++# than the size of the slice. ++# ++# This will only work if array repacking is turned on, otherwise GDB ++# will create the slice by generating a new type that sits over the ++# existing value in memory. ++gdb_test_no_output "set fortran repack-array-slices on" ++set element_size [get_integer_valueof "sizeof (array (1,1))" "unknown"] ++set slice_size [expr $element_size * 4] ++gdb_test_no_output "set max-value-size $slice_size" ++gdb_test "print array (1:2, 1:2)" "= \\(\\(1, 2\\) \\(11, 12\\)\\)" ++gdb_test "print array (2:3, 2:3)" "= \\(\\(12, 13\\) \\(22, 23\\)\\)" ++gdb_test "print array (2:5:2, 2:5:2)" "= \\(\\(12, 14\\) \\(32, 34\\)\\)" +diff --git a/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.fortran/array-slices-sub-slices.f90 +@@ -0,0 +1,96 @@ ++! Copyright 2020 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 . ++ ++! ++! Start of test program. ++! ++program test ++ integer, dimension (1:10,1:11) :: array ++ character (len=26) :: str = "abcdefghijklmnopqrstuvwxyz" ++ ++ call fill_array_2d (array) ++ ++ ! GDB catches this final breakpoint to indicate the end of the test. ++ print *, "" ! Stop Here ++ ++ print *, array ++ print *, str ++ ++ ! GDB catches this final breakpoint to indicate the end of the test. ++ print *, "" ! Final Breakpoint. ++ ++contains ++ ++ ! Fill a 1D array with a unique positive integer in each element. ++ subroutine fill_array_1d (array) ++ integer, dimension (:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do j=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (j) = counter ++ counter = counter + 1 ++ end do ++ end subroutine fill_array_1d ++ ++ ! Fill a 2D array with a unique positive integer in each element. ++ subroutine fill_array_2d (array) ++ integer, dimension (:,:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do i=LBOUND (array, 2), UBOUND (array, 2), 1 ++ do j=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (j,i) = counter ++ counter = counter + 1 ++ end do ++ end do ++ end subroutine fill_array_2d ++ ++ ! Fill a 3D array with a unique positive integer in each element. ++ subroutine fill_array_3d (array) ++ integer, dimension (:,:,:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do i=LBOUND (array, 3), UBOUND (array, 3), 1 ++ do j=LBOUND (array, 2), UBOUND (array, 2), 1 ++ do k=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (k, j,i) = counter ++ counter = counter + 1 ++ end do ++ end do ++ end do ++ end subroutine fill_array_3d ++ ++ ! Fill a 4D array with a unique positive integer in each element. ++ subroutine fill_array_4d (array) ++ integer, dimension (:,:,:,:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do i=LBOUND (array, 4), UBOUND (array, 4), 1 ++ do j=LBOUND (array, 3), UBOUND (array, 3), 1 ++ do k=LBOUND (array, 2), UBOUND (array, 2), 1 ++ do l=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (l, k, j,i) = counter ++ counter = counter + 1 ++ end do ++ end do ++ end do ++ end do ++ print *, "" ++ end subroutine fill_array_4d ++end program test +diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp +--- a/gdb/testsuite/gdb.fortran/array-slices.exp ++++ b/gdb/testsuite/gdb.fortran/array-slices.exp +@@ -18,6 +18,21 @@ + # the subroutine. This should exercise GDB's ability to handle + # different strides for the different dimensions. + ++# Testing GDB's ability to print array (and string) slices, including ++# slices that make use of array strides. ++# ++# In the Fortran code various arrays of different ranks are filled ++# with data, and slices are passed to a series of show functions. ++# ++# In this test script we break in each of the show functions, print ++# the array slice that was passed in, and then move up the stack to ++# the parent frame and check GDB can manually extract the same slice. ++# ++# This test also checks that the size of the array slice passed to the ++# function (so as extracted and described by the compiler and the ++# debug information) matches the size of the slice manually extracted ++# by GDB. ++ + if {[skip_fortran_tests]} { return -1 } + + standard_testfile ".f90" +@@ -28,57 +43,224 @@ if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + return -1 + } + +-if ![fortran_runto_main] { +- untested "could not run to main" +- return -1 ++# Takes the name of an array slice as used in the test source, and extracts ++# the base array name. For example: 'array (1,2)' becomes 'array'. ++proc array_slice_to_var { slice_str } { ++ regexp "^(?:\\s*\\()*(\[^( \t\]+)" $slice_str matchvar varname ++ return $varname + } + +-gdb_breakpoint "show" +-gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] +- +-set array_contents \ +- [list \ +- " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \ +- " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \ +- " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \ +- " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \ +- " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \ +- " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \ +- " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \ +- " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ] +- +-set message_strings \ +- [list \ +- " = 'array'" \ +- " = 'array \\(1:5,1:5\\)'" \ +- " = 'array \\(1:10:2,1:10:2\\)'" \ +- " = 'array \\(1:10:3,1:10:2\\)'" \ +- " = 'array \\(1:10:5,1:10:3\\)'" ] +- +-set i 0 +-foreach result $array_contents msg $message_strings { +- incr i +- with_test_prefix "test $i" { +- gdb_continue_to_breakpoint "show" +- gdb_test "p array" $result +- gdb_test "p message" "$msg" ++proc run_test { repack } { ++ global binfile gdb_prompt ++ ++ clean_restart ${binfile} ++ ++ if ![fortran_runto_main] { ++ untested "could not run to main" ++ return -1 + } +-} + +-gdb_continue_to_breakpoint "continue to Final Breakpoint" ++ gdb_test_no_output "set fortran repack-array-slices $repack" ++ ++ # gdb_breakpoint [gdb_get_line_number "Display Message Breakpoint"] ++ gdb_breakpoint [gdb_get_line_number "Display Element"] ++ gdb_breakpoint [gdb_get_line_number "Display String"] ++ gdb_breakpoint [gdb_get_line_number "Display Array Slice 1D"] ++ gdb_breakpoint [gdb_get_line_number "Display Array Slice 2D"] ++ gdb_breakpoint [gdb_get_line_number "Display Array Slice 3D"] ++ gdb_breakpoint [gdb_get_line_number "Display Array Slice 4D"] ++ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] ++ ++ # We're going to print some reasonably large arrays. ++ gdb_test_no_output "set print elements unlimited" ++ ++ set found_final_breakpoint false ++ ++ # We place a limit on the number of tests that can be run, just in ++ # case something goes wrong, and GDB gets stuck in an loop here. ++ set test_count 0 ++ while { $test_count < 500 } { ++ with_test_prefix "test $test_count" { ++ incr test_count ++ ++ set found_final_breakpoint false ++ set expected_result "" ++ set func_name "" ++ gdb_test_multiple "continue" "continue" { ++ -re ".*GDB = (\[^\r\n\]+)\r\n" { ++ set expected_result $expect_out(1,string) ++ exp_continue ++ } ++ -re "! Display Element" { ++ set func_name "show_elem" ++ exp_continue ++ } ++ -re "! Display String" { ++ set func_name "show_str" ++ exp_continue ++ } ++ -re "! Display Array Slice (.)D" { ++ set func_name "show_$expect_out(1,string)d" ++ exp_continue ++ } ++ -re "! Final Breakpoint" { ++ set found_final_breakpoint true ++ exp_continue ++ } ++ -re "$gdb_prompt $" { ++ # We're done. ++ } ++ } + +-# Next test that asking for an array with stride at the CLI gives an +-# error. +-clean_restart ${testfile} ++ if ($found_final_breakpoint) { ++ break ++ } + +-if ![fortran_runto_main] then { +- perror "couldn't run to main" +- continue ++ # We want to take a look at the line in the previous frame that ++ # called the current function. I couldn't find a better way of ++ # doing this than 'up', which will print the line, then 'down' ++ # again. ++ # ++ # I don't want to fill the log with passes for these up/down ++ # commands, so we don't report any. If something goes wrong then we ++ # should get a fail from gdb_test_multiple. ++ set array_slice_name "" ++ set unique_id "" ++ array unset replacement_vars ++ array set replacement_vars {} ++ gdb_test_multiple "up" "up" { ++ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\r\n$gdb_prompt $" { ++ set array_slice_name $expect_out(1,string) ++ } ++ -re "\r\n\[0-9\]+\[ \t\]+call ${func_name} \\((\[^\r\n\]+)\\)\[ \t\]+! VARS=(\[^ \t\r\n\]+)\r\n$gdb_prompt $" { ++ set array_slice_name $expect_out(1,string) ++ set unique_id $expect_out(2,string) ++ } ++ } ++ if {$unique_id != ""} { ++ set str "" ++ foreach v [split $unique_id ,] { ++ set val [get_integer_valueof "${v}" "??"\ ++ "get variable '$v' for '$array_slice_name'"] ++ set replacement_vars($v) $val ++ if {$str != ""} { ++ set str "Str," ++ } ++ set str "$str$v=$val" ++ } ++ set unique_id " $str" ++ } ++ gdb_test_multiple "down" "down" { ++ -re "\r\n$gdb_prompt $" { ++ # Don't issue a pass here. ++ } ++ } ++ ++ # Check we have all the information we need to successfully run one ++ # of these tests. ++ if { $expected_result == "" } { ++ perror "failed to extract expected results" ++ return 0 ++ } ++ if { $array_slice_name == "" } { ++ perror "failed to extract array slice name" ++ return 0 ++ } ++ ++ # Check GDB can correctly print the array slice that was passed into ++ # the current frame. ++ set pattern [string_to_regexp " = $expected_result"] ++ gdb_test "p array" "$pattern" \ ++ "check value of '$array_slice_name'$unique_id" ++ ++ # Get the size of the slice. ++ set size_in_show \ ++ [get_integer_valueof "sizeof (array)" "show_unknown" \ ++ "get sizeof '$array_slice_name'$unique_id in show"] ++ set addr_in_show \ ++ [get_hexadecimal_valueof "&array" "show_unknown" \ ++ "get address '$array_slice_name'$unique_id in show"] ++ ++ # Now move into the previous frame, and see if GDB can extract the ++ # array slice from the original parent object. Again, use of ++ # gdb_test_multiple to avoid filling the logs with unnecessary ++ # passes. ++ gdb_test_multiple "up" "up" { ++ -re "\r\n$gdb_prompt $" { ++ # Do nothing. ++ } ++ } ++ ++ # Print the array slice, this will force GDB to manually extract the ++ # slice from the parent array. ++ gdb_test "p $array_slice_name" "$pattern" \ ++ "check array slice '$array_slice_name'$unique_id can be extracted" ++ ++ # Get the size of the slice in the calling frame. ++ set size_in_parent \ ++ [get_integer_valueof "sizeof ($array_slice_name)" \ ++ "parent_unknown" \ ++ "get sizeof '$array_slice_name'$unique_id in parent"] ++ ++ # Figure out the start and end addresses of the full array in the ++ # parent frame. ++ set full_var_name [array_slice_to_var $array_slice_name] ++ set start_addr [get_hexadecimal_valueof "&${full_var_name}" \ ++ "start unknown"] ++ set end_addr [get_hexadecimal_valueof \ ++ "(&${full_var_name}) + sizeof (${full_var_name})" \ ++ "end unknown"] ++ ++ # The Fortran compiler can choose to either send a descriptor that ++ # describes the array slice to the subroutine, or it can repack the ++ # slice into an array section and send that. ++ # ++ # We find the address range of the original array in the parent, ++ # and the address of the slice in the show function, if the ++ # address of the slice (from show) is in the range of the original ++ # array then repacking has not occurred, otherwise, the slice is ++ # outside of the parent, and repacking must have occurred. ++ # ++ # The goal here is to compare the sizes of the slice in show with ++ # the size of the slice extracted by GDB. So we can only compare ++ # sizes when GDB's repacking setting matches the repacking ++ # behaviour we got from the compiler. ++ if { ($addr_in_show < $start_addr || $addr_in_show >= $end_addr) \ ++ == ($repack == "on") } { ++ gdb_assert {$size_in_show == $size_in_parent} \ ++ "check sizes match" ++ } elseif { $repack == "off" } { ++ # GDB's repacking is off (so slices are left unpacked), but ++ # the compiler did pack this one. As a result we can't ++ # compare the sizes between the compiler's slice and GDB's ++ # slice. ++ verbose -log "slice '$array_slice_name' was repacked, sizes can't be compared" ++ } else { ++ # Like the above, but the reverse, GDB's repacking is on, but ++ # the compiler didn't repack this slice. ++ verbose -log "slice '$array_slice_name' was not repacked, sizes can't be compared" ++ } ++ ++ # If the array name we just tested included variable names, then ++ # test again with all the variables expanded. ++ if {$unique_id != ""} { ++ foreach v [array names replacement_vars] { ++ set val $replacement_vars($v) ++ set array_slice_name \ ++ [regsub "\\y${v}\\y" $array_slice_name $val] ++ } ++ gdb_test "p $array_slice_name" "$pattern" \ ++ "check array slice '$array_slice_name'$unique_id can be extracted, with variables expanded" ++ } ++ } ++ } ++ ++ # Ensure we reached the final breakpoint. If more tests have been added ++ # to the test script, and this starts failing, then the safety 'while' ++ # loop above might need to be increased. ++ gdb_assert {$found_final_breakpoint} "ran all tests" + } + +-gdb_breakpoint "show" +-gdb_continue_to_breakpoint "show" +-gdb_test "up" ".*" +-gdb_test "p array (1:10:2, 1:10:2)" \ +- "Fortran array strides are not currently supported" \ +- "using array stride gives an error" ++foreach_with_prefix repack { on off } { ++ run_test $repack ++} +diff --git a/gdb/testsuite/gdb.fortran/array-slices.f90 b/gdb/testsuite/gdb.fortran/array-slices.f90 +--- a/gdb/testsuite/gdb.fortran/array-slices.f90 ++++ b/gdb/testsuite/gdb.fortran/array-slices.f90 +@@ -13,58 +13,368 @@ + ! You should have received a copy of the GNU General Public License + ! along with this program. If not, see . + +-subroutine show (message, array) +- character (len=*) :: message ++subroutine show_elem (array) ++ integer :: array ++ ++ print *, "" ++ print *, "Expected GDB Output:" ++ print *, "" ++ ++ write(*, fmt="(A)", advance="no") "GDB = " ++ write(*, fmt="(I0)", advance="no") array ++ write(*, fmt="(A)", advance="yes") "" ++ ++ print *, "" ! Display Element ++end subroutine show_elem ++ ++subroutine show_str (array) ++ character (len=*) :: array ++ ++ print *, "" ++ print *, "Expected GDB Output:" ++ print *, "" ++ write (*, fmt="(A)", advance="no") "GDB = '" ++ write (*, fmt="(A)", advance="no") array ++ write (*, fmt="(A)", advance="yes") "'" ++ ++ print *, "" ! Display String ++end subroutine show_str ++ ++subroutine show_1d (array) ++ integer, dimension (:) :: array ++ ++ print *, "Array Contents:" ++ print *, "" ++ ++ do i=LBOUND (array, 1), UBOUND (array, 1), 1 ++ write(*, fmt="(i4)", advance="no") array (i) ++ end do ++ ++ print *, "" ++ print *, "Expected GDB Output:" ++ print *, "" ++ ++ write(*, fmt="(A)", advance="no") "GDB = (" ++ do i=LBOUND (array, 1), UBOUND (array, 1), 1 ++ if (i > LBOUND (array, 1)) then ++ write(*, fmt="(A)", advance="no") ", " ++ end if ++ write(*, fmt="(I0)", advance="no") array (i) ++ end do ++ write(*, fmt="(A)", advance="no") ")" ++ ++ print *, "" ! Display Array Slice 1D ++end subroutine show_1d ++ ++subroutine show_2d (array) + integer, dimension (:,:) :: array + +- print *, message ++ print *, "Array Contents:" ++ print *, "" ++ + do i=LBOUND (array, 2), UBOUND (array, 2), 1 + do j=LBOUND (array, 1), UBOUND (array, 1), 1 + write(*, fmt="(i4)", advance="no") array (j, i) + end do + print *, "" +- end do +- print *, array +- print *, "" ++ end do + +-end subroutine show ++ print *, "" ++ print *, "Expected GDB Output:" ++ print *, "" + +-program test ++ write(*, fmt="(A)", advance="no") "GDB = (" ++ do i=LBOUND (array, 2), UBOUND (array, 2), 1 ++ if (i > LBOUND (array, 2)) then ++ write(*, fmt="(A)", advance="no") " " ++ end if ++ write(*, fmt="(A)", advance="no") "(" ++ do j=LBOUND (array, 1), UBOUND (array, 1), 1 ++ if (j > LBOUND (array, 1)) then ++ write(*, fmt="(A)", advance="no") ", " ++ end if ++ write(*, fmt="(I0)", advance="no") array (j, i) ++ end do ++ write(*, fmt="(A)", advance="no") ")" ++ end do ++ write(*, fmt="(A)", advance="yes") ")" ++ ++ print *, "" ! Display Array Slice 2D ++end subroutine show_2d ++ ++subroutine show_3d (array) ++ integer, dimension (:,:,:) :: array ++ ++ print *, "" ++ print *, "Expected GDB Output:" ++ print *, "" ++ ++ write(*, fmt="(A)", advance="no") "GDB = (" ++ do i=LBOUND (array, 3), UBOUND (array, 3), 1 ++ if (i > LBOUND (array, 3)) then ++ write(*, fmt="(A)", advance="no") " " ++ end if ++ write(*, fmt="(A)", advance="no") "(" ++ do j=LBOUND (array, 2), UBOUND (array, 2), 1 ++ if (j > LBOUND (array, 2)) then ++ write(*, fmt="(A)", advance="no") " " ++ end if ++ write(*, fmt="(A)", advance="no") "(" ++ do k=LBOUND (array, 1), UBOUND (array, 1), 1 ++ if (k > LBOUND (array, 1)) then ++ write(*, fmt="(A)", advance="no") ", " ++ end if ++ write(*, fmt="(I0)", advance="no") array (k, j, i) ++ end do ++ write(*, fmt="(A)", advance="no") ")" ++ end do ++ write(*, fmt="(A)", advance="no") ")" ++ end do ++ write(*, fmt="(A)", advance="yes") ")" ++ ++ print *, "" ! Display Array Slice 3D ++end subroutine show_3d ++ ++subroutine show_4d (array) ++ integer, dimension (:,:,:,:) :: array ++ ++ print *, "" ++ print *, "Expected GDB Output:" ++ print *, "" ++ ++ write(*, fmt="(A)", advance="no") "GDB = (" ++ do i=LBOUND (array, 4), UBOUND (array, 4), 1 ++ if (i > LBOUND (array, 4)) then ++ write(*, fmt="(A)", advance="no") " " ++ end if ++ write(*, fmt="(A)", advance="no") "(" ++ do j=LBOUND (array, 3), UBOUND (array, 3), 1 ++ if (j > LBOUND (array, 3)) then ++ write(*, fmt="(A)", advance="no") " " ++ end if ++ write(*, fmt="(A)", advance="no") "(" ++ ++ do k=LBOUND (array, 2), UBOUND (array, 2), 1 ++ if (k > LBOUND (array, 2)) then ++ write(*, fmt="(A)", advance="no") " " ++ end if ++ write(*, fmt="(A)", advance="no") "(" ++ do l=LBOUND (array, 1), UBOUND (array, 1), 1 ++ if (l > LBOUND (array, 1)) then ++ write(*, fmt="(A)", advance="no") ", " ++ end if ++ write(*, fmt="(I0)", advance="no") array (l, k, j, i) ++ end do ++ write(*, fmt="(A)", advance="no") ")" ++ end do ++ write(*, fmt="(A)", advance="no") ")" ++ end do ++ write(*, fmt="(A)", advance="no") ")" ++ end do ++ write(*, fmt="(A)", advance="yes") ")" ++ ++ print *, "" ! Display Array Slice 4D ++end subroutine show_4d + ++! ++! Start of test program. ++! ++program test + interface +- subroutine show (message, array) +- character (len=*) :: message ++ subroutine show_str (array) ++ character (len=*) :: array ++ end subroutine show_str ++ ++ subroutine show_1d (array) ++ integer, dimension (:) :: array ++ end subroutine show_1d ++ ++ subroutine show_2d (array) + integer, dimension(:,:) :: array +- end subroutine show ++ end subroutine show_2d ++ ++ subroutine show_3d (array) ++ integer, dimension(:,:,:) :: array ++ end subroutine show_3d ++ ++ subroutine show_4d (array) ++ integer, dimension(:,:,:,:) :: array ++ end subroutine show_4d + end interface + ++ ! Declare variables used in this test. ++ integer, dimension (-10:-1,-10:-2) :: neg_array + integer, dimension (1:10,1:10) :: array + integer, allocatable :: other (:, :) ++ character (len=26) :: str_1 = "abcdefghijklmnopqrstuvwxyz" ++ integer, dimension (-2:2,-2:2,-2:2) :: array3d ++ integer, dimension (-3:3,7:10,-3:3,-10:-7) :: array4d ++ integer, dimension (10:20) :: array1d ++ integer, dimension(:,:), pointer :: pointer2d => null() ++ integer, dimension(-1:9,-1:9), target :: tarray + ++ ! Allocate or associate any variables as needed. + allocate (other (-5:4, -2:7)) ++ pointer2d => tarray + +- do i=LBOUND (array, 2), UBOUND (array, 2), 1 +- do j=LBOUND (array, 1), UBOUND (array, 1), 1 +- array (j,i) = ((i - 1) * UBOUND (array, 2)) + j +- end do +- end do ++ ! Fill arrays with contents ready for testing. ++ call fill_array_1d (array1d) ++ ++ call fill_array_2d (neg_array) ++ call fill_array_2d (array) ++ call fill_array_2d (other) ++ call fill_array_2d (tarray) ++ ++ call fill_array_3d (array3d) ++ call fill_array_4d (array4d) ++ ++ ! The tests. Each call to a show_* function must have a unique set ++ ! of arguments as GDB uses the arguments are part of the test name ++ ! string, so duplicate arguments will result in duplicate test ++ ! names. ++ ! ++ ! If a show_* line ends with VARS=... where '...' is a comma ++ ! separated list of variable names, these variables are assumed to ++ ! be part of the call line, and will be expanded by the test script, ++ ! for example: ++ ! ++ ! do x=1,9,1 ++ ! do y=x,10,1 ++ ! call show_1d (some_array (x,y)) ! VARS=x,y ++ ! end do ++ ! end do ++ ! ++ ! In this example the test script will automatically expand 'x' and ++ ! 'y' in order to better test different aspects of GDB. Do take ++ ! care, the expansion is not very "smart", so try to avoid clashing ++ ! with other text on the line, in the example above, avoid variables ++ ! named 'some' or 'array', as these will likely clash with ++ ! 'some_array'. ++ call show_str (str_1) ++ call show_str (str_1 (1:20)) ++ call show_str (str_1 (10:20)) + +- do i=LBOUND (other, 2), UBOUND (other, 2), 1 +- do j=LBOUND (other, 1), UBOUND (other, 1), 1 +- other (j,i) = ((i - 1) * UBOUND (other, 2)) + j ++ call show_elem (array1d (11)) ++ call show_elem (pointer2d (2,3)) ++ ++ call show_1d (array1d) ++ call show_1d (array1d (13:17)) ++ call show_1d (array1d (17:13:-1)) ++ call show_1d (array (1:5,1)) ++ call show_1d (array4d (1,7,3,:)) ++ call show_1d (pointer2d (-1:3, 2)) ++ call show_1d (pointer2d (-1, 2:4)) ++ ++ ! Enclosing the array slice argument in (...) causess gfortran to ++ ! repack the array. ++ call show_1d ((array (1:5,1))) ++ ++ call show_2d (pointer2d) ++ call show_2d (array) ++ call show_2d (array (1:5,1:5)) ++ do i=1,10,2 ++ do j=1,10,3 ++ call show_2d (array (1:10:i,1:10:j)) ! VARS=i,j ++ call show_2d (array (10:1:-i,1:10:j)) ! VARS=i,j ++ call show_2d (array (10:1:-i,10:1:-j)) ! VARS=i,j ++ call show_2d (array (1:10:i,10:1:-j)) ! VARS=i,j + end do + end do ++ call show_2d (array (6:2:-1,3:9)) ++ call show_2d (array (1:10:2, 1:10:2)) ++ call show_2d (other) ++ call show_2d (other (-5:0, -2:0)) ++ call show_2d (other (-5:4:2, -2:7:3)) ++ call show_2d (neg_array) ++ call show_2d (neg_array (-10:-3,-8:-4:2)) ++ ++ ! Enclosing the array slice argument in (...) causess gfortran to ++ ! repack the array. ++ call show_2d ((array (1:10:3, 1:10:2))) ++ call show_2d ((neg_array (-10:-3,-8:-4:2))) + +- call show ("array", array) +- call show ("array (1:5,1:5)", array (1:5,1:5)) +- call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2)) +- call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2)) +- call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3)) ++ call show_3d (array3d) ++ call show_3d (array3d(-1:1,-1:1,-1:1)) ++ call show_3d (array3d(1:-1:-1,1:-1:-1,1:-1:-1)) + +- call show ("other", other) +- call show ("other (-5:0, -2:0)", other (-5:0, -2:0)) +- call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3)) ++ ! Enclosing the array slice argument in (...) causess gfortran to ++ ! repack the array. ++ call show_3d ((array3d(1:-1:-1,1:-1:-1,1:-1:-1))) + ++ call show_4d (array4d) ++ call show_4d (array4d (-3:0,10:7:-1,0:3,-7:-10:-1)) ++ call show_4d (array4d (3:0:-1, 10:7:-1, :, -7:-10:-1)) ++ ++ ! Enclosing the array slice argument in (...) causess gfortran to ++ ! repack the array. ++ call show_4d ((array4d (3:-2:-2, 10:7:-2, :, -7:-10:-1))) ++ ++ ! All done. Deallocate. + deallocate (other) ++ ++ ! GDB catches this final breakpoint to indicate the end of the test. + print *, "" ! Final Breakpoint. ++ ++contains ++ ++ ! Fill a 1D array with a unique positive integer in each element. ++ subroutine fill_array_1d (array) ++ integer, dimension (:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do j=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (j) = counter ++ counter = counter + 1 ++ end do ++ end subroutine fill_array_1d ++ ++ ! Fill a 2D array with a unique positive integer in each element. ++ subroutine fill_array_2d (array) ++ integer, dimension (:,:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do i=LBOUND (array, 2), UBOUND (array, 2), 1 ++ do j=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (j,i) = counter ++ counter = counter + 1 ++ end do ++ end do ++ end subroutine fill_array_2d ++ ++ ! Fill a 3D array with a unique positive integer in each element. ++ subroutine fill_array_3d (array) ++ integer, dimension (:,:,:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do i=LBOUND (array, 3), UBOUND (array, 3), 1 ++ do j=LBOUND (array, 2), UBOUND (array, 2), 1 ++ do k=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (k, j,i) = counter ++ counter = counter + 1 ++ end do ++ end do ++ end do ++ end subroutine fill_array_3d ++ ++ ! Fill a 4D array with a unique positive integer in each element. ++ subroutine fill_array_4d (array) ++ integer, dimension (:,:,:,:) :: array ++ integer :: counter ++ ++ counter = 1 ++ do i=LBOUND (array, 4), UBOUND (array, 4), 1 ++ do j=LBOUND (array, 3), UBOUND (array, 3), 1 ++ do k=LBOUND (array, 2), UBOUND (array, 2), 1 ++ do l=LBOUND (array, 1), UBOUND (array, 1), 1 ++ array (l, k, j,i) = counter ++ counter = counter + 1 ++ end do ++ end do ++ end do ++ end do ++ print *, "" ++ end subroutine fill_array_4d + end program test +diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp +--- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp ++++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp +@@ -44,7 +44,7 @@ gdb_continue_to_breakpoint "vla1-allocated" + gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" + gdb_test "print sizeof(vla1(3,2,1))" "4" \ + "print sizeof element from allocated vla1" +-gdb_test "print sizeof(vla1(3:4,2,1))" "800" \ ++gdb_test "print sizeof(vla1(3:4,2,1))" "8" \ + "print sizeof sliced vla1" + + # Try to access values in undefined pointer to VLA (dangling) +@@ -61,7 +61,7 @@ gdb_continue_to_breakpoint "pvla-associated" + gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla" + gdb_test "print sizeof(pvla(3,2,1))" "4" \ + "print sizeof element from associated pvla" +-gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla" ++gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla" + + gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"] + gdb_continue_to_breakpoint "vla1-neg-bounds-v1" diff --git a/gdb-rhbz1964167-fortran-array-strides-in-expressions.patch b/gdb-rhbz1964167-fortran-array-strides-in-expressions.patch new file mode 100644 index 0000000..c23ec34 --- /dev/null +++ b/gdb-rhbz1964167-fortran-array-strides-in-expressions.patch @@ -0,0 +1,193 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Mon, 24 May 2021 22:30:32 -0700 +Subject: gdb-rhbz1964167-fortran-array-strides-in-expressions.patch + +;; [fortran] Backport Andrew Burgess's commit which adds support +;; for array strides in expressions. + +gdb/fortran: add support for parsing array strides in expressions + +With this commit GDB now understands the syntax of Fortran array +strides, a user can type an expression including an array stride, but +they will only get an error informing them that array strides are not +supported. + +This alone is an improvement on what we had before in GDB, better to +give the user a helpful message that a particular feature is not +supported than to just claim a syntax error. + +Before: + + (gdb) p array (1:10:2, 2:10:2) + A syntax error in expression, near `:2, 2:10:2)'. + +Now: + + (gdb) p array (1:10:2, 2:10:2) + Fortran array strides are not currently supported + +Later commits will allow GDB to handle array strides correctly. + +gdb/ChangeLog: + + * expprint.c (dump_subexp_body_standard): Print RANGE_HAS_STRIDE. + * expression.h (enum range_type): Add RANGE_HAS_STRIDE. + * f-exp.y (arglist): Allow for a series of subranges. + (subrange): Add cases for subranges with strides. + * f-lang.c (value_f90_subarray): Catch use of array strides and + throw an error. + * parse.c (operator_length_standard): Handle RANGE_HAS_STRIDE. + +gdb/testsuite/ChangeLog: + + * gdb.fortran/array-slices.exp: Add a new test. + +diff --git a/gdb/expprint.c b/gdb/expprint.c +--- a/gdb/expprint.c ++++ b/gdb/expprint.c +@@ -1118,12 +1118,16 @@ dump_subexp_body_standard (struct expression *exp, + fputs_filtered ("..", stream); + if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT)) + fputs_filtered ("EXP", stream); ++ if (range_flag & RANGE_HAS_STRIDE) ++ fputs_filtered (":EXP", stream); + fputs_filtered ("'", stream); + + if (!(range_flag & RANGE_LOW_BOUND_DEFAULT)) + elt = dump_subexp (exp, stream, elt); + if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT)) + elt = dump_subexp (exp, stream, elt); ++ if (range_flag & RANGE_HAS_STRIDE) ++ elt = dump_subexp (exp, stream, elt); + } + break; + +diff --git a/gdb/expression.h b/gdb/expression.h +--- a/gdb/expression.h ++++ b/gdb/expression.h +@@ -199,6 +199,9 @@ enum range_flag : unsigned + + /* The high bound of this range is exclusive. */ + RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2, ++ ++ /* The range has a stride. */ ++ RANGE_HAS_STRIDE = 1 << 3, + }; + + DEF_ENUM_FLAGS_TYPE (enum range_flag, range_flags); +diff --git a/gdb/f-exp.y b/gdb/f-exp.y +--- a/gdb/f-exp.y ++++ b/gdb/f-exp.y +@@ -284,6 +284,10 @@ arglist : arglist ',' exp %prec ABOVE_COMMA + { pstate->arglist_len++; } + ; + ++arglist : arglist ',' subrange %prec ABOVE_COMMA ++ { pstate->arglist_len++; } ++ ; ++ + /* There are four sorts of subrange types in F90. */ + + subrange: exp ':' exp %prec ABOVE_COMMA +@@ -314,6 +318,38 @@ subrange: ':' %prec ABOVE_COMMA + write_exp_elt_opcode (pstate, OP_RANGE); } + ; + ++/* And each of the four subrange types can also have a stride. */ ++subrange: exp ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, RANGE_HAS_STRIDE); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: exp ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, ++ (RANGE_HIGH_BOUND_DEFAULT ++ | RANGE_HAS_STRIDE)); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: ':' exp ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, ++ (RANGE_LOW_BOUND_DEFAULT ++ | RANGE_HAS_STRIDE)); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ ++subrange: ':' ':' exp %prec ABOVE_COMMA ++ { write_exp_elt_opcode (pstate, OP_RANGE); ++ write_exp_elt_longcst (pstate, ++ (RANGE_LOW_BOUND_DEFAULT ++ | RANGE_HIGH_BOUND_DEFAULT ++ | RANGE_HAS_STRIDE)); ++ write_exp_elt_opcode (pstate, OP_RANGE); } ++ ; ++ + complexnum: exp ',' exp + { } + ; +diff --git a/gdb/f-lang.c b/gdb/f-lang.c +--- a/gdb/f-lang.c ++++ b/gdb/f-lang.c +@@ -124,7 +124,7 @@ value_f90_subarray (struct value *array, + struct expression *exp, int *pos, enum noside noside) + { + int pc = (*pos) + 1; +- LONGEST low_bound, high_bound; ++ LONGEST low_bound, high_bound, stride; + struct type *range = check_typedef (value_type (array)->index_type ()); + enum range_flag range_flag + = (enum range_flag) longest_to_int (exp->elts[pc].longconst); +@@ -141,6 +141,14 @@ value_f90_subarray (struct value *array, + else + high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); + ++ if (range_flag & RANGE_HAS_STRIDE) ++ stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); ++ else ++ stride = 1; ++ ++ if (stride != 1) ++ error (_("Fortran array strides are not currently supported")); ++ + return value_slice (array, low_bound, high_bound - low_bound + 1); + } + +diff --git a/gdb/parse.c b/gdb/parse.c +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -924,6 +924,8 @@ operator_length_standard (const struct expression *expr, int endpos, + /* Assume the range has 2 arguments (low bound and high bound), then + reduce the argument count if any bounds are set to default. */ + args = 2; ++ if (range_flag & RANGE_HAS_STRIDE) ++ ++args; + if (range_flag & RANGE_LOW_BOUND_DEFAULT) + --args; + if (range_flag & RANGE_HIGH_BOUND_DEFAULT) +diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp +--- a/gdb/testsuite/gdb.fortran/array-slices.exp ++++ b/gdb/testsuite/gdb.fortran/array-slices.exp +@@ -66,3 +66,19 @@ foreach result $array_contents msg $message_strings { + } + + gdb_continue_to_breakpoint "continue to Final Breakpoint" ++ ++# Next test that asking for an array with stride at the CLI gives an ++# error. ++clean_restart ${testfile} ++ ++if ![fortran_runto_main] then { ++ perror "couldn't run to main" ++ continue ++} ++ ++gdb_breakpoint "show" ++gdb_continue_to_breakpoint "show" ++gdb_test "up" ".*" ++gdb_test "p array (1:10:2, 1:10:2)" \ ++ "Fortran array strides are not currently supported" \ ++ "using array stride gives an error" diff --git a/gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch b/gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch new file mode 100644 index 0000000..7b62022 --- /dev/null +++ b/gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch @@ -0,0 +1,209 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Mon, 24 May 2021 16:53:22 -0700 +Subject: gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch + +;; [fortran] Backport Andrew Burgess's commit which cleans up +;; array/string expression evaluation. + +gdb/fortran: Clean up array/string expression evaluation + +This commit is a refactor of part of the Fortran array and string +handling code. + +The current code is split into two blocks, linked, weirdly, with a +goto. After this commit all the code is moved to its own function, +and arrays and strings are now handled using the same code; this will +be useful later when I want to add array stride support where strings +will want to be treated just like arrays, but is a good clean up even +without the array stride work, which is why I'm merging it now. + +For now the new function is added as a static within eval.c, even +though the function is Fortran only. A following commit will remove +some of the Fortran specific code from eval.c into one of the Fortran +specific files, including this new function. + +There should be no user visible changes after this commit. + +gdb/ChangeLog: + + * eval.c (fortran_value_subarray): New function, content is taken + from... + (evaluate_subexp_standard): ...here, in two places. Now arrays + and strings both call the new function. + (calc_f77_array_dims): Add header comment, handle strings. + +diff --git a/gdb/eval.c b/gdb/eval.c +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -1260,6 +1260,67 @@ is_integral_or_integral_reference (struct type *type) + && is_integral_type (TYPE_TARGET_TYPE (type))); + } + ++/* Called from evaluate_subexp_standard to perform array indexing, and ++ sub-range extraction, for Fortran. As well as arrays this function ++ also handles strings as they can be treated like arrays of characters. ++ ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are ++ as for evaluate_subexp_standard, and NARGS is the number of arguments ++ in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ ++ ++static struct value * ++fortran_value_subarray (struct value *array, struct expression *exp, ++ int *pos, int nargs, enum noside noside) ++{ ++ if (exp->elts[*pos].opcode == OP_RANGE) ++ return value_f90_subarray (array, exp, pos, noside); ++ ++ if (noside == EVAL_SKIP) ++ { ++ skip_undetermined_arglist (nargs, exp, pos, noside); ++ /* Return the dummy value with the correct type. */ ++ return array; ++ } ++ ++ LONGEST subscript_array[MAX_FORTRAN_DIMS]; ++ int ndimensions = 1; ++ struct type *type = check_typedef (value_type (array)); ++ ++ if (nargs > MAX_FORTRAN_DIMS) ++ error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); ++ ++ ndimensions = calc_f77_array_dims (type); ++ ++ if (nargs != ndimensions) ++ error (_("Wrong number of subscripts")); ++ ++ gdb_assert (nargs > 0); ++ ++ /* Now that we know we have a legal array subscript expression let us ++ actually find out where this element exists in the array. */ ++ ++ /* Take array indices left to right. */ ++ for (int i = 0; i < nargs; i++) ++ { ++ /* Evaluate each subscript; it must be a legal integer in F77. */ ++ value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); ++ ++ /* Fill in the subscript array. */ ++ subscript_array[i] = value_as_long (arg2); ++ } ++ ++ /* Internal type of array is arranged right to left. */ ++ for (int i = nargs; i > 0; i--) ++ { ++ struct type *array_type = check_typedef (value_type (array)); ++ LONGEST index = subscript_array[i - 1]; ++ ++ array = value_subscripted_rvalue (array, index, ++ f77_get_lowerbound (array_type)); ++ } ++ ++ return array; ++} ++ + struct value * + evaluate_subexp_standard (struct type *expect_type, + struct expression *exp, int *pos, +@@ -1953,33 +2014,8 @@ evaluate_subexp_standard (struct type *expect_type, + switch (code) + { + case TYPE_CODE_ARRAY: +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- { +- if (noside == EVAL_SKIP) +- { +- skip_undetermined_arglist (nargs, exp, pos, noside); +- /* Return the dummy value with the correct type. */ +- return arg1; +- } +- goto multi_f77_subscript; +- } +- + case TYPE_CODE_STRING: +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (arg1, exp, pos, noside); +- else +- { +- if (noside == EVAL_SKIP) +- { +- skip_undetermined_arglist (nargs, exp, pos, noside); +- /* Return the dummy value with the correct type. */ +- return arg1; +- } +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- return value_subscript (arg1, value_as_long (arg2)); +- } ++ return fortran_value_subarray (arg1, exp, pos, nargs, noside); + + case TYPE_CODE_PTR: + case TYPE_CODE_FUNC: +@@ -2400,49 +2436,6 @@ evaluate_subexp_standard (struct type *expect_type, + } + return (arg1); + +- multi_f77_subscript: +- { +- LONGEST subscript_array[MAX_FORTRAN_DIMS]; +- int ndimensions = 1, i; +- struct value *array = arg1; +- +- if (nargs > MAX_FORTRAN_DIMS) +- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); +- +- ndimensions = calc_f77_array_dims (type); +- +- if (nargs != ndimensions) +- error (_("Wrong number of subscripts")); +- +- gdb_assert (nargs > 0); +- +- /* Now that we know we have a legal array subscript expression +- let us actually find out where this element exists in the array. */ +- +- /* Take array indices left to right. */ +- for (i = 0; i < nargs; i++) +- { +- /* Evaluate each subscript; it must be a legal integer in F77. */ +- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- +- /* Fill in the subscript array. */ +- +- subscript_array[i] = value_as_long (arg2); +- } +- +- /* Internal type of array is arranged right to left. */ +- for (i = nargs; i > 0; i--) +- { +- struct type *array_type = check_typedef (value_type (array)); +- LONGEST index = subscript_array[i - 1]; +- +- array = value_subscripted_rvalue (array, index, +- f77_get_lowerbound (array_type)); +- } +- +- return array; +- } +- + case BINOP_LOGICAL_AND: + arg1 = evaluate_subexp (nullptr, exp, pos, noside); + if (noside == EVAL_SKIP) +@@ -3354,12 +3347,17 @@ parse_and_eval_type (char *p, int length) + return expr->elts[1].type; + } + ++/* Return the number of dimensions for a Fortran array or string. */ ++ + int + calc_f77_array_dims (struct type *array_type) + { + int ndimen = 1; + struct type *tmp_type; + ++ if ((array_type->code () == TYPE_CODE_STRING)) ++ return 1; ++ + if ((array_type->code () != TYPE_CODE_ARRAY)) + error (_("Can't get dimensions for a non-array type")); + diff --git a/gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch b/gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch new file mode 100644 index 0000000..2cdb828 --- /dev/null +++ b/gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch @@ -0,0 +1,128 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Tue, 25 May 2021 17:34:57 -0700 +Subject: gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch + +;; [fortran] Backport Simon Marchi's commit which fixes a 32-bit build +;; problem in gdb/f-lang.c. + +gdb: fix format string warnings in f-lang.c + +I get a bunch of these warnings when compiling for i386 (32-bit): + + CXX f-lang.o + /home/simark/src/binutils-gdb/gdb/f-lang.c: In function 'value* fortran_value_subarray(value*, expression*, int*, int, noside)': + /home/simark/src/binutils-gdb/gdb/f-lang.c:453:48: error: format '%ld' expects argument of type 'long int', but argument 2 has type 'LONGEST' {aka 'long long int'} [-Werror=format=] + 453 | debug_printf ("| | |-> Low bound: %ld\n", lb); + | ~~^ ~~ + | | | + | | LONGEST {aka long long int} + | long int + | %lld + +Fix them by using plongest/pulongest. + +gdb/ChangeLog: + + * f-lang.c (fortran_value_subarray): Use plongest/pulongest. + +Change-Id: I666ead5593653d5a1a3dab2ffdc72942c928c7d2 + +diff --git a/gdb/f-lang.c b/gdb/f-lang.c +--- a/gdb/f-lang.c ++++ b/gdb/f-lang.c +@@ -463,21 +463,21 @@ fortran_value_subarray (struct value *array, struct expression *exp, + std::string str = type_to_string (dim_type); + debug_printf ("| |-> Type: %s\n", str.c_str ()); + debug_printf ("| |-> Array:\n"); +- debug_printf ("| | |-> Low bound: %ld\n", lb); +- debug_printf ("| | |-> High bound: %ld\n", ub); +- debug_printf ("| | |-> Bit stride: %ld\n", sd); +- debug_printf ("| | |-> Byte stride: %ld\n", sd / 8); +- debug_printf ("| | |-> Type size: %ld\n", +- TYPE_LENGTH (dim_type)); +- debug_printf ("| | '-> Target type size: %ld\n", +- TYPE_LENGTH (target_type)); ++ debug_printf ("| | |-> Low bound: %s\n", plongest (lb)); ++ debug_printf ("| | |-> High bound: %s\n", plongest (ub)); ++ debug_printf ("| | |-> Bit stride: %s\n", plongest (sd)); ++ debug_printf ("| | |-> Byte stride: %s\n", plongest (sd / 8)); ++ debug_printf ("| | |-> Type size: %s\n", ++ pulongest (TYPE_LENGTH (dim_type))); ++ debug_printf ("| | '-> Target type size: %s\n", ++ pulongest (TYPE_LENGTH (target_type))); + debug_printf ("| |-> Accessing:\n"); +- debug_printf ("| | |-> Low bound: %ld\n", +- low); +- debug_printf ("| | |-> High bound: %ld\n", +- high); +- debug_printf ("| | '-> Element stride: %ld\n", +- stride); ++ debug_printf ("| | |-> Low bound: %s\n", ++ plongest (low)); ++ debug_printf ("| | |-> High bound: %s\n", ++ plongest (high)); ++ debug_printf ("| | '-> Element stride: %s\n", ++ plongest (stride)); + } + + /* Check the user hasn't asked for something invalid. */ +@@ -519,13 +519,17 @@ fortran_value_subarray (struct value *array, struct expression *exp, + if (fortran_array_slicing_debug) + { + debug_printf ("| '-> Results:\n"); +- debug_printf ("| |-> Offset = %ld\n", offset); +- debug_printf ("| |-> Elements = %ld\n", e_count); +- debug_printf ("| |-> Low bound = %ld\n", new_low); +- debug_printf ("| |-> High bound = %ld\n", new_high); +- debug_printf ("| |-> Byte stride = %ld\n", new_stride); +- debug_printf ("| |-> Last element = %ld\n", last_elem); +- debug_printf ("| |-> Remainder = %ld\n", remainder); ++ debug_printf ("| |-> Offset = %s\n", plongest (offset)); ++ debug_printf ("| |-> Elements = %s\n", plongest (e_count)); ++ debug_printf ("| |-> Low bound = %s\n", plongest (new_low)); ++ debug_printf ("| |-> High bound = %s\n", ++ plongest (new_high)); ++ debug_printf ("| |-> Byte stride = %s\n", ++ plongest (new_stride)); ++ debug_printf ("| |-> Last element = %s\n", ++ plongest (last_elem)); ++ debug_printf ("| |-> Remainder = %s\n", ++ plongest (remainder)); + debug_printf ("| '-> Contiguous = %s\n", + (is_dim_contiguous ? "Yes" : "No")); + } +@@ -561,14 +565,16 @@ fortran_value_subarray (struct value *array, struct expression *exp, + std::string str = type_to_string (dim_type); + debug_printf ("| |-> Type: %s\n", str.c_str ()); + debug_printf ("| |-> Array:\n"); +- debug_printf ("| | |-> Low bound: %ld\n", lb); +- debug_printf ("| | |-> High bound: %ld\n", ub); +- debug_printf ("| | |-> Byte stride: %ld\n", sd); +- debug_printf ("| | |-> Type size: %ld\n", TYPE_LENGTH (dim_type)); +- debug_printf ("| | '-> Target type size: %ld\n", +- TYPE_LENGTH (target_type)); ++ debug_printf ("| | |-> Low bound: %s\n", plongest (lb)); ++ debug_printf ("| | |-> High bound: %s\n", plongest (ub)); ++ debug_printf ("| | |-> Byte stride: %s\n", plongest (sd)); ++ debug_printf ("| | |-> Type size: %s\n", ++ pulongest (TYPE_LENGTH (dim_type))); ++ debug_printf ("| | '-> Target type size: %s\n", ++ pulongest (TYPE_LENGTH (target_type))); + debug_printf ("| '-> Accessing:\n"); +- debug_printf ("| '-> Index: %ld\n", index); ++ debug_printf ("| '-> Index: %s\n", ++ plongest (index)); + } + + /* If the array has actual content then check the index is in +@@ -625,7 +631,8 @@ fortran_value_subarray (struct value *array, struct expression *exp, + debug_printf ("'-> Final result:\n"); + debug_printf (" |-> Type: %s\n", + type_to_string (array_slice_type).c_str ()); +- debug_printf (" |-> Total offset: %ld\n", total_offset); ++ debug_printf (" |-> Total offset: %s\n", ++ plongest (total_offset)); + debug_printf (" |-> Base address: %s\n", + core_addr_to_string (value_address (array))); + debug_printf (" '-> Contiguous = %s\n", diff --git a/gdb-rhbz1964167-fortran-range_type-to-range_flag.patch b/gdb-rhbz1964167-fortran-range_type-to-range_flag.patch new file mode 100644 index 0000000..fed239a --- /dev/null +++ b/gdb-rhbz1964167-fortran-range_type-to-range_flag.patch @@ -0,0 +1,224 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Mon, 24 May 2021 17:15:27 -0700 +Subject: gdb-rhbz1964167-fortran-range_type-to-range_flag.patch + +;; [fortran] Backport Andrew Burgess's commit which renames enum +;; range_type to enum range_flag. + +gdb: rename 'enum range_type' to 'enum range_flag' + +To avoid confusion with other parts of GDB relating to types and +ranges, rename this enum to make it clearer that it is a set of +individual flags rather than an enumeration of different types of +range. + +There should be no user visible changes after this commit. + +gdb/ChangeLog: + + * expprint.c (print_subexp_standard): Change enum range_type to + range_flag and rename variables to match. + (dump_subexp_body_standard): Likewise. + * expression.h (enum range_type): Rename to... + (enum range_flag): ...this. + (range_types): Rename to... + (range_flags): ...this. + * f-lang.c (value_f90_subarray): Change enum range_type to + range_flag and rename variables to match. + * parse.c (operator_length_standard): Likewise. + * rust-exp.y (rust_parser::convert_ast_to_expression): Change enum + range_type to range_flag. + * rust-lang.c (rust_evaluate_funcall): Likewise. + (rust_range): Likewise. + (rust_compute_range): Likewise. + (rust_subscript): Likewise. + +diff --git a/gdb/expprint.c b/gdb/expprint.c +--- a/gdb/expprint.c ++++ b/gdb/expprint.c +@@ -578,19 +578,19 @@ print_subexp_standard (struct expression *exp, int *pos, + + case OP_RANGE: + { +- enum range_type range_type; ++ enum range_flag range_flag; + +- range_type = (enum range_type) ++ range_flag = (enum range_flag) + longest_to_int (exp->elts[pc + 1].longconst); + *pos += 2; + +- if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE) ++ if (range_flag & RANGE_HIGH_BOUND_EXCLUSIVE) + fputs_filtered ("EXCLUSIVE_", stream); + fputs_filtered ("RANGE(", stream); +- if (!(range_type & RANGE_LOW_BOUND_DEFAULT)) ++ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT)) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered ("..", stream); +- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT)) ++ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT)) + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); + fputs_filtered (")", stream); + return; +@@ -1104,25 +1104,25 @@ dump_subexp_body_standard (struct expression *exp, + break; + case OP_RANGE: + { +- enum range_type range_type; ++ enum range_flag range_flag; + +- range_type = (enum range_type) ++ range_flag = (enum range_flag) + longest_to_int (exp->elts[elt].longconst); + elt += 2; + +- if (range_type & RANGE_HIGH_BOUND_EXCLUSIVE) ++ if (range_flag & RANGE_HIGH_BOUND_EXCLUSIVE) + fputs_filtered ("Exclusive", stream); + fputs_filtered ("Range '", stream); +- if (!(range_type & RANGE_LOW_BOUND_DEFAULT)) ++ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT)) + fputs_filtered ("EXP", stream); + fputs_filtered ("..", stream); +- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT)) ++ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT)) + fputs_filtered ("EXP", stream); + fputs_filtered ("'", stream); + +- if (!(range_type & RANGE_LOW_BOUND_DEFAULT)) ++ if (!(range_flag & RANGE_LOW_BOUND_DEFAULT)) + elt = dump_subexp (exp, stream, elt); +- if (!(range_type & RANGE_HIGH_BOUND_DEFAULT)) ++ if (!(range_flag & RANGE_HIGH_BOUND_DEFAULT)) + elt = dump_subexp (exp, stream, elt); + } + break; +diff --git a/gdb/expression.h b/gdb/expression.h +--- a/gdb/expression.h ++++ b/gdb/expression.h +@@ -185,7 +185,7 @@ extern void dump_prefix_expression (struct expression *, struct ui_file *); + or inclusive. So we have six sorts of subrange. This enumeration + type is to identify this. */ + +-enum range_type : unsigned ++enum range_flag : unsigned + { + /* This is a standard range. Both the lower and upper bounds are + defined, and the bounds are inclusive. */ +@@ -201,6 +201,6 @@ enum range_type : unsigned + RANGE_HIGH_BOUND_EXCLUSIVE = 1 << 2, + }; + +-DEF_ENUM_FLAGS_TYPE (enum range_type, range_types); ++DEF_ENUM_FLAGS_TYPE (enum range_flag, range_flags); + + #endif /* !defined (EXPRESSION_H) */ +diff --git a/gdb/f-lang.c b/gdb/f-lang.c +--- a/gdb/f-lang.c ++++ b/gdb/f-lang.c +@@ -126,17 +126,17 @@ value_f90_subarray (struct value *array, + int pc = (*pos) + 1; + LONGEST low_bound, high_bound; + struct type *range = check_typedef (value_type (array)->index_type ()); +- enum range_type range_type +- = (enum range_type) longest_to_int (exp->elts[pc].longconst); ++ enum range_flag range_flag ++ = (enum range_flag) longest_to_int (exp->elts[pc].longconst); + + *pos += 3; + +- if (range_type & RANGE_LOW_BOUND_DEFAULT) ++ if (range_flag & RANGE_LOW_BOUND_DEFAULT) + low_bound = range->bounds ()->low.const_val (); + else + low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); + +- if (range_type & RANGE_HIGH_BOUND_DEFAULT) ++ if (range_flag & RANGE_HIGH_BOUND_DEFAULT) + high_bound = range->bounds ()->high.const_val (); + else + high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); +diff --git a/gdb/parse.c b/gdb/parse.c +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -774,7 +774,7 @@ operator_length_standard (const struct expression *expr, int endpos, + { + int oplen = 1; + int args = 0; +- enum range_type range_type; ++ enum range_flag range_flag; + int i; + + if (endpos < 1) +@@ -918,15 +918,15 @@ operator_length_standard (const struct expression *expr, int endpos, + + case OP_RANGE: + oplen = 3; +- range_type = (enum range_type) ++ range_flag = (enum range_flag) + longest_to_int (expr->elts[endpos - 2].longconst); + + /* Assume the range has 2 arguments (low bound and high bound), then + reduce the argument count if any bounds are set to default. */ + args = 2; +- if (range_type & RANGE_LOW_BOUND_DEFAULT) ++ if (range_flag & RANGE_LOW_BOUND_DEFAULT) + --args; +- if (range_type & RANGE_HIGH_BOUND_DEFAULT) ++ if (range_flag & RANGE_HIGH_BOUND_DEFAULT) + --args; + + break; +diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y +--- a/gdb/rust-exp.y ++++ b/gdb/rust-exp.y +@@ -2492,7 +2492,7 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation, + + case OP_RANGE: + { +- enum range_type kind = (RANGE_HIGH_BOUND_DEFAULT ++ unsigned int kind = (RANGE_HIGH_BOUND_DEFAULT + | RANGE_LOW_BOUND_DEFAULT); + + if (operation->left.op != NULL) +diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c +--- a/gdb/rust-lang.c ++++ b/gdb/rust-lang.c +@@ -1070,7 +1070,6 @@ rust_evaluate_funcall (struct expression *exp, int *pos, enum noside noside) + static struct value * + rust_range (struct expression *exp, int *pos, enum noside noside) + { +- enum range_type kind; + struct value *low = NULL, *high = NULL; + struct value *addrval, *result; + CORE_ADDR addr; +@@ -1079,7 +1078,8 @@ rust_range (struct expression *exp, int *pos, enum noside noside) + struct type *temp_type; + const char *name; + +- kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst); ++ auto kind ++ = (enum range_flag) longest_to_int (exp->elts[*pos + 1].longconst); + *pos += 3; + + if (!(kind & RANGE_LOW_BOUND_DEFAULT)) +@@ -1169,7 +1169,7 @@ rust_range (struct expression *exp, int *pos, enum noside noside) + static void + rust_compute_range (struct type *type, struct value *range, + LONGEST *low, LONGEST *high, +- range_types *kind) ++ range_flags *kind) + { + int i; + +@@ -1209,7 +1209,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, + struct type *rhstype; + LONGEST low, high_bound; + /* Initialized to appease the compiler. */ +- range_types kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT; ++ range_flags kind = RANGE_LOW_BOUND_DEFAULT | RANGE_HIGH_BOUND_DEFAULT; + LONGEST high = 0; + int want_slice = 0; + diff --git a/gdb-rhbz1964167-fortran-whitespace_array.patch b/gdb-rhbz1964167-fortran-whitespace_array.patch new file mode 100644 index 0000000..9021559 --- /dev/null +++ b/gdb-rhbz1964167-fortran-whitespace_array.patch @@ -0,0 +1,137 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Mon, 24 May 2021 17:07:36 -0700 +Subject: gdb-rhbz1964167-fortran-whitespace_array.patch + +;; [fortran] Backport Andrew Burgess's commit which eliminates undesirable +;; whitespace when printing arrays. + +gdb/fortran: Change whitespace when printing arrays + +This commit makes the whitespace usage when printing Fortran arrays +more consistent, and more inline with how we print C arrays. + +Currently a 2 dimensional Fotran array is printed like this, I find +the marked whitespace unpleasant: + + (( 1, 2, 3) ( 4, 5, 6) ) + ^ ^ ^ + +After this commit the same array is printed like this: + + ((1, 2, 3) (4, 5, 6)) + +Which seems more inline with how we print C arrays, in the case of C +arrays we don't add extra whitespace before the first element. + +gdb/ChangeLog: + + * f-valprint.c (f77_print_array_1): Adjust printing of whitespace + for arrays. + +gdb/testsuite/ChangeLog: + + * gdb.fortran/array-slices.exp: Update expected results. + * gdb.fortran/class-allocatable-array.exp: Likewise. + * gdb.fortran/multi-dim.exp: Likewise. + * gdb.fortran/vla-type.exp: Likewise. + * gdb.mi/mi-vla-fortran.exp: Likewise. + +diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c +--- a/gdb/f-valprint.c ++++ b/gdb/f-valprint.c +@@ -137,14 +137,17 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type, + (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val) + + offs, addr + offs); + +- fprintf_filtered (stream, "( "); ++ fprintf_filtered (stream, "("); + 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 += byte_stride; +- fprintf_filtered (stream, ") "); ++ fprintf_filtered (stream, ")"); ++ ++ if (i < upperbound) ++ fprintf_filtered (stream, " "); + } + if (*elts >= options->print_max && i < upperbound) + fprintf_filtered (stream, "..."); +diff --git a/gdb/testsuite/gdb.fortran/array-slices.exp b/gdb/testsuite/gdb.fortran/array-slices.exp +--- a/gdb/testsuite/gdb.fortran/array-slices.exp ++++ b/gdb/testsuite/gdb.fortran/array-slices.exp +@@ -38,14 +38,14 @@ gdb_breakpoint [gdb_get_line_number "Final Breakpoint"] + + set array_contents \ + [list \ +- " = \\(\\( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\( 11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\( 21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\( 31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\( 41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\( 51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\( 61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\( 71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\( 81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\( 91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\) \\)" \ +- " = \\(\\( 1, 2, 3, 4, 5\\) \\( 11, 12, 13, 14, 15\\) \\( 21, 22, 23, 24, 25\\) \\( 31, 32, 33, 34, 35\\) \\( 41, 42, 43, 44, 45\\) \\)" \ +- " = \\(\\( 1, 3, 5, 7, 9\\) \\( 21, 23, 25, 27, 29\\) \\( 41, 43, 45, 47, 49\\) \\( 61, 63, 65, 67, 69\\) \\( 81, 83, 85, 87, 89\\) \\)" \ +- " = \\(\\( 1, 4, 7, 10\\) \\( 21, 24, 27, 30\\) \\( 41, 44, 47, 50\\) \\( 61, 64, 67, 70\\) \\( 81, 84, 87, 90\\) \\)" \ +- " = \\(\\( 1, 5, 9\\) \\( 31, 35, 39\\) \\( 61, 65, 69\\) \\( 91, 95, 99\\) \\)" \ +- " = \\(\\( -26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\( -19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\( -12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\( -5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\( 2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\( 9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\( 16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\( 23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\( 30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\( 37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\) \\)" \ +- " = \\(\\( -26, -25, -24, -23, -22, -21\\) \\( -19, -18, -17, -16, -15, -14\\) \\( -12, -11, -10, -9, -8, -7\\) \\)" \ +- " = \\(\\( -26, -24, -22, -20, -18\\) \\( -5, -3, -1, 1, 3\\) \\( 16, 18, 20, 22, 24\\) \\( 37, 39, 41, 43, 45\\) \\)" ] ++ " = \\(\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\) \\(11, 12, 13, 14, 15, 16, 17, 18, 19, 20\\) \\(21, 22, 23, 24, 25, 26, 27, 28, 29, 30\\) \\(31, 32, 33, 34, 35, 36, 37, 38, 39, 40\\) \\(41, 42, 43, 44, 45, 46, 47, 48, 49, 50\\) \\(51, 52, 53, 54, 55, 56, 57, 58, 59, 60\\) \\(61, 62, 63, 64, 65, 66, 67, 68, 69, 70\\) \\(71, 72, 73, 74, 75, 76, 77, 78, 79, 80\\) \\(81, 82, 83, 84, 85, 86, 87, 88, 89, 90\\) \\(91, 92, 93, 94, 95, 96, 97, 98, 99, 100\\)\\)" \ ++ " = \\(\\(1, 2, 3, 4, 5\\) \\(11, 12, 13, 14, 15\\) \\(21, 22, 23, 24, 25\\) \\(31, 32, 33, 34, 35\\) \\(41, 42, 43, 44, 45\\)\\)" \ ++ " = \\(\\(1, 3, 5, 7, 9\\) \\(21, 23, 25, 27, 29\\) \\(41, 43, 45, 47, 49\\) \\(61, 63, 65, 67, 69\\) \\(81, 83, 85, 87, 89\\)\\)" \ ++ " = \\(\\(1, 4, 7, 10\\) \\(21, 24, 27, 30\\) \\(41, 44, 47, 50\\) \\(61, 64, 67, 70\\) \\(81, 84, 87, 90\\)\\)" \ ++ " = \\(\\(1, 5, 9\\) \\(31, 35, 39\\) \\(61, 65, 69\\) \\(91, 95, 99\\)\\)" \ ++ " = \\(\\(-26, -25, -24, -23, -22, -21, -20, -19, -18, -17\\) \\(-19, -18, -17, -16, -15, -14, -13, -12, -11, -10\\) \\(-12, -11, -10, -9, -8, -7, -6, -5, -4, -3\\) \\(-5, -4, -3, -2, -1, 0, 1, 2, 3, 4\\) \\(2, 3, 4, 5, 6, 7, 8, 9, 10, 11\\) \\(9, 10, 11, 12, 13, 14, 15, 16, 17, 18\\) \\(16, 17, 18, 19, 20, 21, 22, 23, 24, 25\\) \\(23, 24, 25, 26, 27, 28, 29, 30, 31, 32\\) \\(30, 31, 32, 33, 34, 35, 36, 37, 38, 39\\) \\(37, 38, 39, 40, 41, 42, 43, 44, 45, 46\\)\\)" \ ++ " = \\(\\(-26, -25, -24, -23, -22, -21\\) \\(-19, -18, -17, -16, -15, -14\\) \\(-12, -11, -10, -9, -8, -7\\)\\)" \ ++ " = \\(\\(-26, -24, -22, -20, -18\\) \\(-5, -3, -1, 1, 3\\) \\(16, 18, 20, 22, 24\\) \\(37, 39, 41, 43, 45\\)\\)" ] + + set message_strings \ + [list \ +diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp +--- a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp ++++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp +@@ -40,4 +40,4 @@ gdb_continue_to_breakpoint "Break Here" + # cetainly going to fail. + gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)" + gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+" +-gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)" ++gdb_test "print this%_data%b" " = \\(\\(1, 2, 3\\) \\(4, 5, 6\\)\\)" +diff --git a/gdb/testsuite/gdb.fortran/multi-dim.exp b/gdb/testsuite/gdb.fortran/multi-dim.exp +--- a/gdb/testsuite/gdb.fortran/multi-dim.exp ++++ b/gdb/testsuite/gdb.fortran/multi-dim.exp +@@ -57,7 +57,7 @@ gdb_test "print foo(3,3,4)" \ + "print an invalid array index (3,3,4)" + + gdb_test "print foo" \ +- { = \(\( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 10\) \) \( \( 10, 10\) \( 10, 10\) \( 10, 20\) \) \)} \ ++ { = \(\(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 10\)\) \(\(10, 10\) \(10, 10\) \(10, 20\)\)\)} \ + "print full contents of the array" + + gdb_breakpoint [gdb_get_line_number "break-variable"] +diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp +--- a/gdb/testsuite/gdb.fortran/vla-type.exp ++++ b/gdb/testsuite/gdb.fortran/vla-type.exp +@@ -66,9 +66,9 @@ gdb_test "ptype twov" \ + "\\s+$int, allocatable :: ivla1\\\(5,12,99\\\)" \ + "\\s+$int, allocatable :: ivla2\\\(9,12\\\)" \ + "End Type two" ] +-gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\ +- \\\( 1, 1, 321, 1, 1\\\)\ +- \\\( 1, 1, 1, 1, 1\\\) .*" ++gdb_test "print twov" " = \\\( ivla1 = \\\(\\\(\\\(1, 1, 1, 1, 1\\\)\ ++ \\\(1, 1, 321, 1, 1\\\)\ ++ \\\(1, 1, 1, 1, 1\\\) .*" + + # Check type with attribute at beginn of type + gdb_breakpoint [gdb_get_line_number "threev-filled"] +diff --git a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp +--- a/gdb/testsuite/gdb.mi/mi-vla-fortran.exp ++++ b/gdb/testsuite/gdb.mi/mi-vla-fortran.exp +@@ -180,7 +180,7 @@ 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\\) \\)\"" \ ++ "590\\^done,value=\"\\(\\(2, 2, 2, 2, 2\\) \\(2, 2, 2, 2, 2\\)\\)\"" \ + "evaluate associated vla" + + mi_create_varobj_checked pvla2_associated pvla2 \ diff --git a/gdb-rhbz1964167-move-fortran-expr-handling.patch b/gdb-rhbz1964167-move-fortran-expr-handling.patch new file mode 100644 index 0000000..b921684 --- /dev/null +++ b/gdb-rhbz1964167-move-fortran-expr-handling.patch @@ -0,0 +1,787 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Kevin Buettner +Date: Mon, 24 May 2021 17:00:17 -0700 +Subject: gdb-rhbz1964167-move-fortran-expr-handling.patch + +;; [fortran] Backport Andrew Burgess's commit which moves Fortran +;; expression handling to f-lang.c. + +gdb/fortran: Move Fortran expression handling into f-lang.c + +The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled +in the generic expression handling code. There's no reason why this +should be the case, so this commit moves handling of this into Fortran +specific files. + +There should be no user visible changes after this commit. + +gdb/ChangeLog: + + * eval.c: Remove 'f-lang.h' include. + (value_f90_subarray): Moved to f-lang.c. + (eval_call): Renamed to... + (evaluate_subexp_do_call): ...this, is no longer static, header + comment moved into header file. + (evaluate_funcall): Update call to eval_call. + (skip_undetermined_arglist): Moved to f-lang.c. + (fortran_value_subarray): Likewise. + (evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling + moved to evaluate_subexp_f. + (calc_f77_array_dims): Moved to f-lang.c + * expprint.c (print_subexp_funcall): New function. + (print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling + moved to print_subexp_f, OP_FUNCALL uses new function. + (dump_subexp_body_funcall): New function. + (dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling + moved to dump_subexp_f, OP_FUNCALL uses new function. + * expression.h (evaluate_subexp_do_call): Declare. + * f-lang.c (value_f90_subarray): Moved from eval.c. + (skip_undetermined_arglist): Likewise. + (calc_f77_array_dims): Likewise. + (fortran_value_subarray): Likewise. + (evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support. + (operator_length_f): Likewise. + (print_subexp_f): Likewise. + (dump_subexp_body_f): Likewise. + * fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move + declaration of this operation to here. + * parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST + support moved to operator_length_f. + * parser-defs.h (dump_subexp_body_funcall): Declare. + (print_subexp_funcall): Declare. + * std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to + fortran-operator.def. + +diff --git a/gdb/eval.c b/gdb/eval.c +--- a/gdb/eval.c ++++ b/gdb/eval.c +@@ -26,7 +26,6 @@ + #include "frame.h" + #include "gdbthread.h" + #include "language.h" /* For CAST_IS_CONVERSION. */ +-#include "f-lang.h" /* For array bound stuff. */ + #include "cp-abi.h" + #include "infcall.h" + #include "objc-lang.h" +@@ -371,32 +370,6 @@ init_array_element (struct value *array, struct value *element, + return index; + } + +-static struct value * +-value_f90_subarray (struct value *array, +- struct expression *exp, int *pos, enum noside noside) +-{ +- int pc = (*pos) + 1; +- LONGEST low_bound, high_bound; +- struct type *range = check_typedef (value_type (array)->index_type ()); +- enum range_type range_type +- = (enum range_type) longest_to_int (exp->elts[pc].longconst); +- +- *pos += 3; +- +- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- low_bound = range->bounds ()->low.const_val (); +- else +- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); +- +- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) +- high_bound = range->bounds ()->high.const_val (); +- else +- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); +- +- return value_slice (array, low_bound, high_bound - low_bound + 1); +-} +- +- + /* Promote value ARG1 as appropriate before performing a unary operation + on this argument. + If the result is not appropriate for any particular language then it +@@ -749,17 +722,13 @@ eval_skip_value (expression *exp) + return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1); + } + +-/* Evaluate a function call. The function to be called is in +- ARGVEC[0] and the arguments passed to the function are in +- ARGVEC[1..NARGS]. FUNCTION_NAME is the name of the function, if +- known. DEFAULT_RETURN_TYPE is used as the function's return type +- if the return type is unknown. */ ++/* See expression.h. */ + +-static value * +-eval_call (expression *exp, enum noside noside, +- int nargs, value **argvec, +- const char *function_name, +- type *default_return_type) ++value * ++evaluate_subexp_do_call (expression *exp, enum noside noside, ++ int nargs, value **argvec, ++ const char *function_name, ++ type *default_return_type) + { + if (argvec[0] == NULL) + error (_("Cannot evaluate function -- may be inlined")); +@@ -1230,20 +1199,8 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos, + /* Nothing to be done; argvec already correctly set up. */ + } + +- return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type); +-} +- +-/* Helper for skipping all the arguments in an undetermined argument list. +- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST +- case of evaluate_subexp_standard as multiple, but not all, code paths +- require a generic skip. */ +- +-static void +-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, +- enum noside noside) +-{ +- for (int i = 0; i < nargs; ++i) +- evaluate_subexp (nullptr, exp, pos, noside); ++ return evaluate_subexp_do_call (exp, noside, nargs, argvec, ++ var_func_name, expect_type); + } + + /* Return true if type is integral or reference to integral */ +@@ -1260,67 +1217,6 @@ is_integral_or_integral_reference (struct type *type) + && is_integral_type (TYPE_TARGET_TYPE (type))); + } + +-/* Called from evaluate_subexp_standard to perform array indexing, and +- sub-range extraction, for Fortran. As well as arrays this function +- also handles strings as they can be treated like arrays of characters. +- ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are +- as for evaluate_subexp_standard, and NARGS is the number of arguments +- in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ +- +-static struct value * +-fortran_value_subarray (struct value *array, struct expression *exp, +- int *pos, int nargs, enum noside noside) +-{ +- if (exp->elts[*pos].opcode == OP_RANGE) +- return value_f90_subarray (array, exp, pos, noside); +- +- if (noside == EVAL_SKIP) +- { +- skip_undetermined_arglist (nargs, exp, pos, noside); +- /* Return the dummy value with the correct type. */ +- return array; +- } +- +- LONGEST subscript_array[MAX_FORTRAN_DIMS]; +- int ndimensions = 1; +- struct type *type = check_typedef (value_type (array)); +- +- if (nargs > MAX_FORTRAN_DIMS) +- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); +- +- ndimensions = calc_f77_array_dims (type); +- +- if (nargs != ndimensions) +- error (_("Wrong number of subscripts")); +- +- gdb_assert (nargs > 0); +- +- /* Now that we know we have a legal array subscript expression let us +- actually find out where this element exists in the array. */ +- +- /* Take array indices left to right. */ +- for (int i = 0; i < nargs; i++) +- { +- /* Evaluate each subscript; it must be a legal integer in F77. */ +- value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); +- +- /* Fill in the subscript array. */ +- subscript_array[i] = value_as_long (arg2); +- } +- +- /* Internal type of array is arranged right to left. */ +- for (int i = nargs; i > 0; i--) +- { +- struct type *array_type = check_typedef (value_type (array)); +- LONGEST index = subscript_array[i - 1]; +- +- array = value_subscripted_rvalue (array, index, +- f77_get_lowerbound (array_type)); +- } +- +- return array; +-} +- + struct value * + evaluate_subexp_standard (struct type *expect_type, + struct expression *exp, int *pos, +@@ -1335,7 +1231,6 @@ evaluate_subexp_standard (struct type *expect_type, + struct type *type; + int nargs; + struct value **argvec; +- int code; + int ix; + long mem_offset; + struct type **arg_types; +@@ -1976,84 +1871,6 @@ evaluate_subexp_standard (struct type *expect_type, + case OP_FUNCALL: + return evaluate_funcall (expect_type, exp, pos, noside); + +- case OP_F77_UNDETERMINED_ARGLIST: +- +- /* Remember that in F77, functions, substring ops and +- array subscript operations cannot be disambiguated +- at parse time. We have made all array subscript operations, +- substring operations as well as function calls come here +- and we now have to discover what the heck this thing actually was. +- If it is a function, we process just as if we got an OP_FUNCALL. */ +- +- nargs = longest_to_int (exp->elts[pc + 1].longconst); +- (*pos) += 2; +- +- /* First determine the type code we are dealing with. */ +- arg1 = evaluate_subexp (nullptr, exp, pos, noside); +- type = check_typedef (value_type (arg1)); +- code = type->code (); +- +- if (code == TYPE_CODE_PTR) +- { +- /* Fortran always passes variable to subroutines as pointer. +- So we need to look into its target type to see if it is +- array, string or function. If it is, we need to switch +- to the target value the original one points to. */ +- struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type)); +- +- if (target_type->code () == TYPE_CODE_ARRAY +- || target_type->code () == TYPE_CODE_STRING +- || target_type->code () == TYPE_CODE_FUNC) +- { +- arg1 = value_ind (arg1); +- type = check_typedef (value_type (arg1)); +- code = type->code (); +- } +- } +- +- switch (code) +- { +- case TYPE_CODE_ARRAY: +- case TYPE_CODE_STRING: +- return fortran_value_subarray (arg1, exp, pos, nargs, noside); +- +- case TYPE_CODE_PTR: +- case TYPE_CODE_FUNC: +- case TYPE_CODE_INTERNAL_FUNCTION: +- /* It's a function call. */ +- /* Allocate arg vector, including space for the function to be +- called in argvec[0] and a terminating NULL. */ +- argvec = (struct value **) +- alloca (sizeof (struct value *) * (nargs + 2)); +- argvec[0] = arg1; +- tem = 1; +- for (; tem <= nargs; tem++) +- { +- argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); +- /* Arguments in Fortran are passed by address. Coerce the +- arguments here rather than in value_arg_coerce as otherwise +- the call to malloc to place the non-lvalue parameters in +- target memory is hit by this Fortran specific logic. This +- results in malloc being called with a pointer to an integer +- followed by an attempt to malloc the arguments to malloc in +- target memory. Infinite recursion ensues. */ +- if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC) +- { +- bool is_artificial +- = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1); +- argvec[tem] = fortran_argument_convert (argvec[tem], +- is_artificial); +- } +- } +- argvec[tem] = 0; /* signal end of arglist */ +- if (noside == EVAL_SKIP) +- return eval_skip_value (exp); +- return eval_call (exp, noside, nargs, argvec, NULL, expect_type); +- +- default: +- error (_("Cannot perform substring on this type")); +- } +- + case OP_COMPLEX: + /* We have a complex number, There should be 2 floating + point numbers that compose it. */ +@@ -3346,27 +3163,3 @@ parse_and_eval_type (char *p, int length) + error (_("Internal error in eval_type.")); + return expr->elts[1].type; + } +- +-/* Return the number of dimensions for a Fortran array or string. */ +- +-int +-calc_f77_array_dims (struct type *array_type) +-{ +- int ndimen = 1; +- struct type *tmp_type; +- +- if ((array_type->code () == TYPE_CODE_STRING)) +- return 1; +- +- if ((array_type->code () != TYPE_CODE_ARRAY)) +- error (_("Can't get dimensions for a non-array type")); +- +- tmp_type = array_type; +- +- while ((tmp_type = TYPE_TARGET_TYPE (tmp_type))) +- { +- if (tmp_type->code () == TYPE_CODE_ARRAY) +- ++ndimen; +- } +- return ndimen; +-} +diff --git a/gdb/expprint.c b/gdb/expprint.c +--- a/gdb/expprint.c ++++ b/gdb/expprint.c +@@ -53,6 +53,25 @@ print_subexp (struct expression *exp, int *pos, + exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec); + } + ++/* See parser-defs.h. */ ++ ++void ++print_subexp_funcall (struct expression *exp, int *pos, ++ struct ui_file *stream) ++{ ++ (*pos) += 2; ++ unsigned nargs = longest_to_int (exp->elts[*pos].longconst); ++ print_subexp (exp, pos, stream, PREC_SUFFIX); ++ fputs_filtered (" (", stream); ++ for (unsigned tem = 0; tem < nargs; tem++) ++ { ++ if (tem != 0) ++ fputs_filtered (", ", stream); ++ print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); ++ } ++ fputs_filtered (")", stream); ++} ++ + /* Standard implementation of print_subexp for use in language_defn + vectors. */ + void +@@ -187,18 +206,7 @@ print_subexp_standard (struct expression *exp, int *pos, + return; + + case OP_FUNCALL: +- case OP_F77_UNDETERMINED_ARGLIST: +- (*pos) += 2; +- nargs = longest_to_int (exp->elts[pc + 1].longconst); +- print_subexp (exp, pos, stream, PREC_SUFFIX); +- fputs_filtered (" (", stream); +- for (tem = 0; tem < nargs; tem++) +- { +- if (tem != 0) +- fputs_filtered (", ", stream); +- print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); +- } +- fputs_filtered (")", stream); ++ print_subexp_funcall (exp, pos, stream); + return; + + case OP_NAME: +@@ -796,6 +804,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt) + return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt); + } + ++/* See parser-defs.h. */ ++ ++int ++dump_subexp_body_funcall (struct expression *exp, ++ struct ui_file *stream, int elt) ++{ ++ int nargs = longest_to_int (exp->elts[elt].longconst); ++ fprintf_filtered (stream, "Number of args: %d", nargs); ++ elt += 2; ++ ++ for (int i = 1; i <= nargs + 1; i++) ++ elt = dump_subexp (exp, stream, elt); ++ ++ return elt; ++} ++ + /* Default value for subexp_body in exp_descriptor vector. */ + + int +@@ -931,18 +955,7 @@ dump_subexp_body_standard (struct expression *exp, + elt += 2; + break; + case OP_FUNCALL: +- case OP_F77_UNDETERMINED_ARGLIST: +- { +- int i, nargs; +- +- nargs = longest_to_int (exp->elts[elt].longconst); +- +- fprintf_filtered (stream, "Number of args: %d", nargs); +- elt += 2; +- +- for (i = 1; i <= nargs + 1; i++) +- elt = dump_subexp (exp, stream, elt); +- } ++ elt = dump_subexp_body_funcall (exp, stream, elt); + break; + case OP_ARRAY: + { +diff --git a/gdb/expression.h b/gdb/expression.h +--- a/gdb/expression.h ++++ b/gdb/expression.h +@@ -155,6 +155,18 @@ enum noside + extern struct value *evaluate_subexp_standard + (struct type *, struct expression *, int *, enum noside); + ++/* Evaluate a function call. The function to be called is in ARGVEC[0] and ++ the arguments passed to the function are in ARGVEC[1..NARGS]. ++ FUNCTION_NAME is the name of the function, if known. ++ DEFAULT_RETURN_TYPE is used as the function's return type if the return ++ type is unknown. */ ++ ++extern struct value *evaluate_subexp_do_call (expression *exp, ++ enum noside noside, ++ int nargs, value **argvec, ++ const char *function_name, ++ type *default_return_type); ++ + /* From expprint.c */ + + extern void print_expression (struct expression *, struct ui_file *); +diff --git a/gdb/f-lang.c b/gdb/f-lang.c +--- a/gdb/f-lang.c ++++ b/gdb/f-lang.c +@@ -114,6 +114,134 @@ enum f_primitive_types { + nr_f_primitive_types + }; + ++/* Called from fortran_value_subarray to take a slice of an array or a ++ string. ARRAY is the array or string to be accessed. EXP, POS, and ++ NOSIDE are as for evaluate_subexp_standard. Return a value that is a ++ slice of the array. */ ++ ++static struct value * ++value_f90_subarray (struct value *array, ++ struct expression *exp, int *pos, enum noside noside) ++{ ++ int pc = (*pos) + 1; ++ LONGEST low_bound, high_bound; ++ struct type *range = check_typedef (value_type (array)->index_type ()); ++ enum range_type range_type ++ = (enum range_type) longest_to_int (exp->elts[pc].longconst); ++ ++ *pos += 3; ++ ++ if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) ++ low_bound = range->bounds ()->low.const_val (); ++ else ++ low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); ++ ++ if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) ++ high_bound = range->bounds ()->high.const_val (); ++ else ++ high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); ++ ++ return value_slice (array, low_bound, high_bound - low_bound + 1); ++} ++ ++/* Helper for skipping all the arguments in an undetermined argument list. ++ This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST ++ case of evaluate_subexp_standard as multiple, but not all, code paths ++ require a generic skip. */ ++ ++static void ++skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, ++ enum noside noside) ++{ ++ for (int i = 0; i < nargs; ++i) ++ evaluate_subexp (nullptr, exp, pos, noside); ++} ++ ++/* Return the number of dimensions for a Fortran array or string. */ ++ ++int ++calc_f77_array_dims (struct type *array_type) ++{ ++ int ndimen = 1; ++ struct type *tmp_type; ++ ++ if ((array_type->code () == TYPE_CODE_STRING)) ++ return 1; ++ ++ if ((array_type->code () != TYPE_CODE_ARRAY)) ++ error (_("Can't get dimensions for a non-array type")); ++ ++ tmp_type = array_type; ++ ++ while ((tmp_type = TYPE_TARGET_TYPE (tmp_type))) ++ { ++ if (tmp_type->code () == TYPE_CODE_ARRAY) ++ ++ndimen; ++ } ++ return ndimen; ++} ++ ++/* Called from evaluate_subexp_standard to perform array indexing, and ++ sub-range extraction, for Fortran. As well as arrays this function ++ also handles strings as they can be treated like arrays of characters. ++ ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are ++ as for evaluate_subexp_standard, and NARGS is the number of arguments ++ in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ ++ ++static struct value * ++fortran_value_subarray (struct value *array, struct expression *exp, ++ int *pos, int nargs, enum noside noside) ++{ ++ if (exp->elts[*pos].opcode == OP_RANGE) ++ return value_f90_subarray (array, exp, pos, noside); ++ ++ if (noside == EVAL_SKIP) ++ { ++ skip_undetermined_arglist (nargs, exp, pos, noside); ++ /* Return the dummy value with the correct type. */ ++ return array; ++ } ++ ++ LONGEST subscript_array[MAX_FORTRAN_DIMS]; ++ int ndimensions = 1; ++ struct type *type = check_typedef (value_type (array)); ++ ++ if (nargs > MAX_FORTRAN_DIMS) ++ error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); ++ ++ ndimensions = calc_f77_array_dims (type); ++ ++ if (nargs != ndimensions) ++ error (_("Wrong number of subscripts")); ++ ++ gdb_assert (nargs > 0); ++ ++ /* Now that we know we have a legal array subscript expression let us ++ actually find out where this element exists in the array. */ ++ ++ /* Take array indices left to right. */ ++ for (int i = 0; i < nargs; i++) ++ { ++ /* Evaluate each subscript; it must be a legal integer in F77. */ ++ value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); ++ ++ /* Fill in the subscript array. */ ++ subscript_array[i] = value_as_long (arg2); ++ } ++ ++ /* Internal type of array is arranged right to left. */ ++ for (int i = nargs; i > 0; i--) ++ { ++ struct type *array_type = check_typedef (value_type (array)); ++ LONGEST index = subscript_array[i - 1]; ++ ++ array = value_subscripted_rvalue (array, index, ++ f77_get_lowerbound (array_type)); ++ } ++ ++ return array; ++} ++ + /* Special expression evaluation cases for Fortran. */ + + static struct value * +@@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp, + TYPE_LENGTH (type)); + return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, + TYPE_LENGTH (TYPE_TARGET_TYPE (type))); ++ ++ ++ case OP_F77_UNDETERMINED_ARGLIST: ++ /* Remember that in F77, functions, substring ops and array subscript ++ operations cannot be disambiguated at parse time. We have made ++ all array subscript operations, substring operations as well as ++ function calls come here and we now have to discover what the heck ++ this thing actually was. If it is a function, we process just as ++ if we got an OP_FUNCALL. */ ++ int nargs = longest_to_int (exp->elts[pc + 1].longconst); ++ (*pos) += 2; ++ ++ /* First determine the type code we are dealing with. */ ++ arg1 = evaluate_subexp (nullptr, exp, pos, noside); ++ type = check_typedef (value_type (arg1)); ++ enum type_code code = type->code (); ++ ++ if (code == TYPE_CODE_PTR) ++ { ++ /* Fortran always passes variable to subroutines as pointer. ++ So we need to look into its target type to see if it is ++ array, string or function. If it is, we need to switch ++ to the target value the original one points to. */ ++ struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type)); ++ ++ if (target_type->code () == TYPE_CODE_ARRAY ++ || target_type->code () == TYPE_CODE_STRING ++ || target_type->code () == TYPE_CODE_FUNC) ++ { ++ arg1 = value_ind (arg1); ++ type = check_typedef (value_type (arg1)); ++ code = type->code (); ++ } ++ } ++ ++ switch (code) ++ { ++ case TYPE_CODE_ARRAY: ++ case TYPE_CODE_STRING: ++ return fortran_value_subarray (arg1, exp, pos, nargs, noside); ++ ++ case TYPE_CODE_PTR: ++ case TYPE_CODE_FUNC: ++ case TYPE_CODE_INTERNAL_FUNCTION: ++ { ++ /* It's a function call. Allocate arg vector, including ++ space for the function to be called in argvec[0] and a ++ termination NULL. */ ++ struct value **argvec = (struct value **) ++ alloca (sizeof (struct value *) * (nargs + 2)); ++ argvec[0] = arg1; ++ int tem = 1; ++ for (; tem <= nargs; tem++) ++ { ++ argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); ++ /* Arguments in Fortran are passed by address. Coerce the ++ arguments here rather than in value_arg_coerce as ++ otherwise the call to malloc to place the non-lvalue ++ parameters in target memory is hit by this Fortran ++ specific logic. This results in malloc being called ++ with a pointer to an integer followed by an attempt to ++ malloc the arguments to malloc in target memory. ++ Infinite recursion ensues. */ ++ if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC) ++ { ++ bool is_artificial ++ = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1); ++ argvec[tem] = fortran_argument_convert (argvec[tem], ++ is_artificial); ++ } ++ } ++ argvec[tem] = 0; /* signal end of arglist */ ++ if (noside == EVAL_SKIP) ++ return eval_skip_value (exp); ++ return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL, ++ expect_type); ++ } ++ ++ default: ++ error (_("Cannot perform substring on this type")); ++ } + } + + /* Should be unreachable. */ +@@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp, + oplen = 1; + args = 2; + break; ++ ++ case OP_F77_UNDETERMINED_ARGLIST: ++ oplen = 3; ++ args = 1 + longest_to_int (exp->elts[pc - 2].longconst); ++ break; + } + + *oplenp = oplen; +@@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos, + case BINOP_FORTRAN_MODULO: + print_binop_subexp_f (exp, pos, stream, prec, "MODULO"); + return; ++ ++ case OP_F77_UNDETERMINED_ARGLIST: ++ print_subexp_funcall (exp, pos, stream); ++ return; + } + } + +@@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp, + case BINOP_FORTRAN_MODULO: + operator_length_f (exp, (elt + 1), &oplen, &nargs); + break; ++ ++ case OP_F77_UNDETERMINED_ARGLIST: ++ return dump_subexp_body_funcall (exp, stream, elt); + } + + elt += oplen; +diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def +--- a/gdb/fortran-operator.def ++++ b/gdb/fortran-operator.def +@@ -17,6 +17,14 @@ + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + ++/* This is EXACTLY like OP_FUNCALL but is semantically different. ++ In F77, array subscript expressions, substring expressions and ++ function calls are all exactly the same syntactically. They ++ may only be disambiguated at runtime. Thus this operator, ++ which indicates that we have found something of the form ++ ( ). */ ++OP (OP_F77_UNDETERMINED_ARGLIST) ++ + /* Single operand builtins. */ + OP (UNOP_FORTRAN_KIND) + OP (UNOP_FORTRAN_FLOOR) +diff --git a/gdb/parse.c b/gdb/parse.c +--- a/gdb/parse.c ++++ b/gdb/parse.c +@@ -817,7 +817,6 @@ operator_length_standard (const struct expression *expr, int endpos, + break; + + case OP_FUNCALL: +- case OP_F77_UNDETERMINED_ARGLIST: + oplen = 3; + args = 1 + longest_to_int (expr->elts[endpos - 2].longconst); + break; +diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h +--- a/gdb/parser-defs.h ++++ b/gdb/parser-defs.h +@@ -338,6 +338,13 @@ extern int dump_subexp (struct expression *, struct ui_file *, int); + extern int dump_subexp_body_standard (struct expression *, + struct ui_file *, int); + ++/* Dump (to STREAM) a function call like expression at position ELT in the ++ expression array EXP. Return a new value for ELT just after the ++ function call expression. */ ++ ++extern int dump_subexp_body_funcall (struct expression *exp, ++ struct ui_file *stream, int elt); ++ + extern void operator_length (const struct expression *, int, int *, int *); + + extern void operator_length_standard (const struct expression *, int, int *, +@@ -440,6 +447,15 @@ extern void print_subexp (struct expression *, int *, struct ui_file *, + extern void print_subexp_standard (struct expression *, int *, + struct ui_file *, enum precedence); + ++/* Print a function call like expression to STREAM. This is called as a ++ helper function by which point the expression node identifying this as a ++ function call has already been stripped off and POS should point to the ++ number of function call arguments. EXP is the object containing the ++ list of expression elements. */ ++ ++extern void print_subexp_funcall (struct expression *exp, int *pos, ++ struct ui_file *stream); ++ + /* Function used to avoid direct calls to fprintf + in the code generated by the bison parser. */ + +diff --git a/gdb/std-operator.def b/gdb/std-operator.def +--- a/gdb/std-operator.def ++++ b/gdb/std-operator.def +@@ -168,14 +168,6 @@ OP (OP_FUNCALL) + pointer. This is an Objective C message. */ + OP (OP_OBJC_MSGCALL) + +-/* This is EXACTLY like OP_FUNCALL but is semantically different. +- In F77, array subscript expressions, substring expressions and +- function calls are all exactly the same syntactically. They +- may only be disambiguated at runtime. Thus this operator, +- which indicates that we have found something of the form +- ( ). */ +-OP (OP_F77_UNDETERMINED_ARGLIST) +- + /* OP_COMPLEX takes a type in the following element, followed by another + OP_COMPLEX, making three exp_elements. It is followed by two double + args, and converts them into a complex number of the given type. */ diff --git a/gdb-vla-intel-fix-print-char-array.patch b/gdb-vla-intel-fix-print-char-array.patch deleted file mode 100644 index 20508da..0000000 --- a/gdb-vla-intel-fix-print-char-array.patch +++ /dev/null @@ -1,59 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Sergio Durigan Junior -Date: Thu, 7 Dec 2017 16:20:31 -0500 -Subject: gdb-vla-intel-fix-print-char-array.patch - -;; Revert upstream commit 469412dd9ccc4de5874fd3299b105833f36b34cd - -Revert commit (only the part touching gdb/f-valprint.c): - - commit 469412dd9ccc4de5874fd3299b105833f36b34cd - Author: Christoph Weinmann - Date: Fri Sep 8 15:11:47 2017 +0200 - - Remove C/C++ relevant code in Fortran specific file. - - Remove code relevant for printing C/C++ Integer values in a - Fortran specific file to unify printing of Fortran values. - This does not change the output. - -And adjust its testcase. - -diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c ---- a/gdb/f-valprint.c -+++ b/gdb/f-valprint.c -@@ -310,7 +310,21 @@ f_value_print_inner (struct value *val, struct ui_file *stream, int recurse, - value_print_scalar_formatted (val, &opts, 0, stream); - } - else -- value_print_scalar_formatted (val, options, 0, stream); -+ { -+ value_print_scalar_formatted (val, options, 0, stream); -+ /* C and C++ has no single byte int type, char is used instead. -+ Since we don't know whether the value is really intended to -+ be used as an integer or a character, print the character -+ equivalent as well. */ -+ if (TYPE_LENGTH (type) == 1) -+ { -+ LONGEST c; -+ -+ fputs_filtered (" ", stream); -+ c = unpack_long (type, valaddr); -+ LA_PRINT_CHAR ((unsigned char) c, type, stream); -+ } -+ } - break; - - case TYPE_CODE_STRUCT: -diff --git a/gdb/testsuite/gdb.fortran/printing-types.exp b/gdb/testsuite/gdb.fortran/printing-types.exp ---- a/gdb/testsuite/gdb.fortran/printing-types.exp -+++ b/gdb/testsuite/gdb.fortran/printing-types.exp -@@ -30,7 +30,7 @@ if {![fortran_runto_main]} then { - gdb_breakpoint [gdb_get_line_number "write"] - gdb_continue_to_breakpoint "write" - --gdb_test "print oneByte" " = 1" -+gdb_test "print oneByte" " = 1 \'\\\\001\'" - gdb_test "print twobytes" " = 2" - gdb_test "print chvalue" " = \'a\'" - gdb_test "print logvalue" " = \.TRUE\." diff --git a/gdb-vla-intel-fortran-strides.patch b/gdb-vla-intel-fortran-strides.patch deleted file mode 100644 index 32f8bdb..0000000 --- a/gdb-vla-intel-fortran-strides.patch +++ /dev/null @@ -1,1778 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-vla-intel-fortran-strides.patch - -;; VLA (Fortran dynamic arrays) from Intel + archer-jankratochvil-vla tests. -;;=push - -git diff --stat -p gdb/master...gdb/users/bheckel/fortran-strides -dbfd7140bf4c0500d1f5d192be781f83f78f7922 - - gdb/dwarf2loc.c | 46 ++- - gdb/dwarf2loc.h | 6 + - gdb/dwarf2read.c | 13 +- - gdb/eval.c | 391 +++++++++++++++++++++----- - gdb/expprint.c | 20 +- - gdb/expression.h | 18 +- - gdb/f-exp.y | 42 ++- - gdb/f-valprint.c | 8 +- - gdb/gdbtypes.c | 34 ++- - gdb/gdbtypes.h | 18 +- - gdb/parse.c | 24 +- - gdb/rust-exp.y | 12 +- - gdb/rust-lang.c | 17 +- - gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++ - gdb/testsuite/gdb.fortran/vla-ptype.exp | 4 + - gdb/testsuite/gdb.fortran/vla-sizeof.exp | 4 + - gdb/testsuite/gdb.fortran/vla-stride.exp | 44 +++ - gdb/testsuite/gdb.fortran/vla-stride.f90 | 29 ++ - gdb/testsuite/gdb.fortran/vla.f90 | 10 + - gdb/valarith.c | 10 +- - gdb/valops.c | 197 +++++++++++-- - gdb/value.h | 2 + - 23 files changed, 1242 insertions(+), 183 deletions(-) - -diff --git a/gdb/eval.c b/gdb/eval.c ---- a/gdb/eval.c -+++ b/gdb/eval.c -@@ -371,29 +371,323 @@ init_array_element (struct value *array, struct value *element, - return index; - } - -+/* Evaluates any operation on Fortran arrays or strings with at least -+ one user provided parameter. Expects the input ARRAY to be either -+ an array, or a string. Evaluates EXP by incrementing POS, and -+ writes the content from the elt stack into a local struct. NARGS -+ specifies number of literal or range arguments the user provided. -+ NARGS must be the same number as ARRAY has dimensions. */ -+ - static struct value * --value_f90_subarray (struct value *array, -- struct expression *exp, int *pos, enum noside noside) -+value_f90_subarray (struct value *array, struct expression *exp, -+ int *pos, int nargs, enum noside noside) - { -- int pc = (*pos) + 1; -- LONGEST low_bound, high_bound; -- struct type *range = check_typedef (value_type (array)->index_type ()); -- enum range_type range_type -- = (enum range_type) longest_to_int (exp->elts[pc].longconst); -- -- *pos += 3; -- -- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) -- low_bound = range->bounds ()->low.const_val (); -- else -- low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); -+ int i, dim_count = 0; -+ struct value *new_array = array; -+ struct type *array_type = check_typedef (value_type (new_array)); -+ struct type *elt_type; -+ -+ typedef struct -+ { -+ enum range_type f90_range_type; -+ LONGEST low, high, stride; -+ } subscript_range; -+ -+ typedef enum subscript_kind -+ { -+ SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */ -+ SUBSCRIPT_INDEX /* e.g. "(literal)" */ -+ } kind; -+ -+ /* Local struct to hold user data for Fortran subarray dimensions. */ -+ struct subscript_store -+ { -+ /* For every dimension, we are either working on a range or an index -+ expression, so we store this info separately for later. */ -+ enum subscript_kind kind; -+ -+ /* We also store either the lower and upper bound info, or the index -+ number. Before evaluation of the input values, we do not know if we are -+ actually working on a range of ranges, or an index in a range. So as a -+ first step we store all input in a union. The array calculation itself -+ deals with this later on. */ -+ union element_range -+ { -+ subscript_range range; -+ LONGEST number; -+ } U; -+ } *subscript_array; -+ -+ /* Check if the number of arguments provided by the user matches -+ the number of dimension of the array. A string has only one -+ dimension. */ -+ if (nargs != calc_f77_array_dims (value_type (new_array))) -+ error (_("Wrong number of subscripts")); -+ -+ subscript_array = (struct subscript_store*) alloca (sizeof (*subscript_array) * nargs); -+ -+ /* Parse the user input into the SUBSCRIPT_ARRAY to store it. We need -+ to evaluate it first, as the input is from left-to-right. The -+ array is stored from right-to-left. So we have to use the user -+ input in reverse order. Later on, we need the input information to -+ re-calculate the output array. For multi-dimensional arrays, we -+ can be dealing with any possible combination of ranges and indices -+ for every dimension. */ -+ for (i = 0; i < nargs; i++) -+ { -+ struct subscript_store *index = &subscript_array[i]; -+ -+ /* The user input is a range, with or without lower and upper bound. -+ E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */ -+ if (exp->elts[*pos].opcode == OP_RANGE) -+ { -+ int pc = (*pos) + 1; -+ subscript_range *range; -+ -+ index->kind = SUBSCRIPT_RANGE; -+ range = &index->U.range; -+ -+ *pos += 3; -+ range->f90_range_type = (enum range_type) exp->elts[pc].longconst; -+ -+ /* If a lower bound was provided by the user, the bit has been -+ set and we can assign the value from the elt stack. Same for -+ upper bound. */ -+ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) -+ == SUBARRAY_LOW_BOUND) -+ range->low = value_as_long (evaluate_subexp (nullptr, exp, -+ pos, noside)); -+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) -+ == SUBARRAY_HIGH_BOUND) -+ range->high = value_as_long (evaluate_subexp (nullptr, exp, -+ pos, noside)); -+ -+ /* Assign the user's stride value if provided. */ -+ if ((range->f90_range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) -+ range->stride = value_as_long (evaluate_subexp (nullptr, exp, -+ pos, noside)); -+ -+ /* Assign the default stride value '1'. */ -+ else -+ range->stride = 1; - -- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) -- high_bound = range->bounds ()->high.const_val (); -- else -- high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); -+ /* Check the provided stride value is illegal, aka '0'. */ -+ if (range->stride == 0) -+ error (_("Stride must not be 0")); -+ } -+ /* User input is an index. E.g.: "p arry(5)". */ -+ else -+ { -+ struct value *val; -+ -+ index->kind = SUBSCRIPT_INDEX; -+ -+ /* Evaluate each subscript; it must be a legal integer in F77. This -+ ensures the validity of the provided index. */ -+ val = evaluate_subexp_with_coercion (exp, pos, noside); -+ index->U.number = value_as_long (val); -+ } -+ -+ } -+ -+ /* Traverse the array from right to left and set the high and low bounds -+ for later use. */ -+ for (i = nargs - 1; i >= 0; i--) -+ { -+ struct subscript_store *index = &subscript_array[i]; -+ struct type *index_type = array_type->index_type (); -+ -+ switch (index->kind) -+ { -+ case SUBSCRIPT_RANGE: -+ { -+ -+ /* When we hit the first range specified by the user, we must -+ treat any subsequent user entry as a range. We simply -+ increment DIM_COUNT which tells us how many times we are -+ calling VALUE_SLICE_1. */ -+ subscript_range *range = &index->U.range; -+ -+ /* If no lower bound was provided by the user, we take the -+ default boundary. Same for the high bound. */ -+ if ((range->f90_range_type & SUBARRAY_LOW_BOUND) == 0) -+ range->low = index_type->bounds ()->low.const_val (); -+ -+ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0) -+ range->high = index_type->bounds ()->high.const_val (); -+ -+ /* Both user provided low and high bound have to be inside the -+ array bounds. Throw an error if not. */ -+ if (range->low < index_type->bounds ()->low.const_val () -+ || range->low > index_type->bounds ()->high.const_val () -+ || range->high < index_type->bounds ()->low.const_val () -+ || range->high > index_type->bounds ()->high.const_val ()) -+ error (_("provided bound(s) outside array bound(s)")); -+ -+ /* For a negative stride the lower boundary must be larger than the -+ upper boundary. -+ For a positive stride the lower boundary must be smaller than the -+ upper boundary. */ -+ if ((range->stride < 0 && range->low < range->high) -+ || (range->stride > 0 && range->low > range->high)) -+ error (_("Wrong value provided for stride and boundaries")); -+ -+ } -+ break; -+ -+ case SUBSCRIPT_INDEX: -+ break; -+ -+ } -+ -+ array_type = TYPE_TARGET_TYPE (array_type); -+ } -+ -+ /* Reset ARRAY_TYPE before slicing.*/ -+ array_type = check_typedef (value_type (new_array)); -+ -+ /* Traverse the array from right to left and evaluate each corresponding -+ user input. VALUE_SUBSCRIPT is called for every index, until a range -+ expression is evaluated. After a range expression has been evaluated, -+ every subsequent expression is also treated as a range. */ -+ for (i = nargs - 1; i >= 0; i--) -+ { -+ struct subscript_store *index = &subscript_array[i]; -+ struct type *index_type = array_type->index_type (); -+ -+ switch (index->kind) -+ { -+ case SUBSCRIPT_RANGE: -+ { -+ -+ /* When we hit the first range specified by the user, we must -+ treat any subsequent user entry as a range. We simply -+ increment DIM_COUNT which tells us how many times we are -+ calling VALUE_SLICE_1. */ -+ subscript_range *range = &index->U.range; -+ -+ /* DIM_COUNT counts every user argument that is treated as a range. -+ This is necessary for expressions like 'print array(7, 8:9). -+ Here the first argument is a literal, but must be treated as a -+ range argument to allow the correct output representation. */ -+ dim_count++; -+ -+ new_array -+ = value_slice_1 (new_array, range->low, -+ range->high - range->low + 1, -+ range->stride, dim_count); -+ } -+ break; -+ -+ case SUBSCRIPT_INDEX: -+ { -+ /* DIM_COUNT only stays '0' when no range argument was processed -+ before, starting from the last dimension. This way we can -+ reduce the number of dimensions from the result array. -+ However, if a range has been processed before an index, we -+ treat the index like a range with equal low- and high bounds -+ to get the value offset right. */ -+ if (dim_count == 0) -+ new_array -+ = value_subscripted_rvalue (new_array, index->U.number, -+ f77_get_lowerbound (value_type -+ (new_array))); -+ else -+ { -+ dim_count++; -+ -+ /* We might end up here, because we have to treat the provided -+ index like a range. But now VALUE_SUBSCRIPTED_RVALUE -+ cannot do the range checks for us. So we have to make sure -+ ourselves that the user provided index is inside the -+ array bounds. Throw an error if not. */ -+ if (index->U.number < index_type->bounds ()->low.const_val () -+ && index->U.number > index_type->bounds ()->high.const_val ()) -+ error (_("provided bound(s) outside array bound(s)")); -+ -+ if (index->U.number > index_type->bounds ()->low.const_val () -+ && index->U.number > index_type->bounds ()->high.const_val ()) -+ error (_("provided bound(s) outside array bound(s)")); -+ -+ new_array = value_slice_1 (new_array, -+ index->U.number, -+ 1, /* COUNT is '1' element */ -+ 1, /* STRIDE set to '1' */ -+ dim_count); -+ } -+ -+ } -+ break; -+ } -+ array_type = TYPE_TARGET_TYPE (array_type); -+ } -+ -+ /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect -+ an array of arrays, depending on how many ranges have been provided by -+ the user. So we need to rebuild the array dimensions for printing it -+ correctly. -+ Starting from right to left in the user input, after we hit the first -+ range argument every subsequent argument is also treated as a range. -+ E.g.: -+ "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3 -+ ranges. -+ "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2 -+ ranges. -+ "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1 -+ range. */ -+ if (dim_count > 1) -+ { -+ struct value *v = NULL; -+ -+ elt_type = TYPE_TARGET_TYPE (value_type (new_array)); - -- return value_slice (array, low_bound, high_bound - low_bound + 1); -+ /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in -+ the output array. So we traverse the SUBSCRIPT_ARRAY again, looking -+ for a range entry. When we find one, we use the range info to create -+ an additional range_type to set the correct bounds and dimensions for -+ the output array. In addition, we may have a stride value that is not -+ '1', forcing us to adjust the number of elements in a range, according -+ to the stride value. */ -+ for (i = 0; i < nargs; i++) -+ { -+ struct subscript_store *index = &subscript_array[i]; -+ -+ if (index->kind == SUBSCRIPT_RANGE) -+ { -+ struct type *range_type, *interim_array_type; -+ -+ int new_length; -+ -+ /* The length of a sub-dimension with all elements between the -+ bounds plus the start element itself. It may be modified by -+ a user provided stride value. */ -+ new_length = index->U.range.high - index->U.range.low; -+ -+ new_length /= index->U.range.stride; -+ -+ range_type -+ = create_static_range_type (NULL, -+ elt_type, -+ index->U.range.low, -+ index->U.range.low + new_length); -+ -+ interim_array_type = create_array_type (NULL, -+ elt_type, -+ range_type); -+ -+ interim_array_type->set_code ( value_type (new_array)->code ()); -+ -+ v = allocate_value (interim_array_type); -+ -+ elt_type = value_type (v); -+ } -+ -+ } -+ value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (elt_type)); -+ return v; -+ } -+ -+ return new_array; - } - - -@@ -1233,19 +1527,6 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos, - return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type); - } - --/* Helper for skipping all the arguments in an undetermined argument list. -- This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST -- case of evaluate_subexp_standard as multiple, but not all, code paths -- require a generic skip. */ -- --static void --skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, -- enum noside noside) --{ -- for (int i = 0; i < nargs; ++i) -- evaluate_subexp (nullptr, exp, pos, noside); --} -- - /* Return true if type is integral or reference to integral */ - - static bool -@@ -1953,33 +2234,8 @@ evaluate_subexp_standard (struct type *expect_type, - switch (code) - { - case TYPE_CODE_ARRAY: -- if (exp->elts[*pos].opcode == OP_RANGE) -- return value_f90_subarray (arg1, exp, pos, noside); -- else -- { -- if (noside == EVAL_SKIP) -- { -- skip_undetermined_arglist (nargs, exp, pos, noside); -- /* Return the dummy value with the correct type. */ -- return arg1; -- } -- goto multi_f77_subscript; -- } -- - case TYPE_CODE_STRING: -- if (exp->elts[*pos].opcode == OP_RANGE) -- return value_f90_subarray (arg1, exp, pos, noside); -- else -- { -- if (noside == EVAL_SKIP) -- { -- skip_undetermined_arglist (nargs, exp, pos, noside); -- /* Return the dummy value with the correct type. */ -- return arg1; -- } -- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); -- return value_subscript (arg1, value_as_long (arg2)); -- } -+ return value_f90_subarray (arg1, exp, pos, nargs, noside); - - case TYPE_CODE_PTR: - case TYPE_CODE_FUNC: -@@ -2400,49 +2656,6 @@ evaluate_subexp_standard (struct type *expect_type, - } - return (arg1); - -- multi_f77_subscript: -- { -- LONGEST subscript_array[MAX_FORTRAN_DIMS]; -- int ndimensions = 1, i; -- struct value *array = arg1; -- -- if (nargs > MAX_FORTRAN_DIMS) -- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); -- -- ndimensions = calc_f77_array_dims (type); -- -- if (nargs != ndimensions) -- error (_("Wrong number of subscripts")); -- -- gdb_assert (nargs > 0); -- -- /* Now that we know we have a legal array subscript expression -- let us actually find out where this element exists in the array. */ -- -- /* Take array indices left to right. */ -- for (i = 0; i < nargs; i++) -- { -- /* Evaluate each subscript; it must be a legal integer in F77. */ -- arg2 = evaluate_subexp_with_coercion (exp, pos, noside); -- -- /* Fill in the subscript array. */ -- -- subscript_array[i] = value_as_long (arg2); -- } -- -- /* Internal type of array is arranged right to left. */ -- for (i = nargs; i > 0; i--) -- { -- struct type *array_type = check_typedef (value_type (array)); -- LONGEST index = subscript_array[i - 1]; -- -- array = value_subscripted_rvalue (array, index, -- f77_get_lowerbound (array_type)); -- } -- -- return array; -- } -- - case BINOP_LOGICAL_AND: - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - if (noside == EVAL_SKIP) -@@ -3360,6 +3573,9 @@ calc_f77_array_dims (struct type *array_type) - int ndimen = 1; - struct type *tmp_type; - -+ if (array_type->code () == TYPE_CODE_STRING) -+ return 1; -+ - if ((array_type->code () != TYPE_CODE_ARRAY)) - error (_("Can't get dimensions for a non-array type")); - -diff --git a/gdb/expprint.c b/gdb/expprint.c ---- a/gdb/expprint.c -+++ b/gdb/expprint.c -@@ -576,17 +576,14 @@ print_subexp_standard (struct expression *exp, int *pos, - longest_to_int (exp->elts[pc + 1].longconst); - *pos += 2; - -- if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE -- || range_type == LOW_BOUND_DEFAULT_EXCLUSIVE) -+ if ((range_type & SUBARRAY_HIGH_BOUND_EXCLUSIVE) -+ == SUBARRAY_HIGH_BOUND_EXCLUSIVE) - fputs_filtered ("EXCLUSIVE_", stream); - fputs_filtered ("RANGE(", stream); -- if (range_type == HIGH_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT_EXCLUSIVE) -+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); - fputs_filtered ("..", stream); -- if (range_type == LOW_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT) -+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); - fputs_filtered (")", stream); - return; -@@ -1103,22 +1100,24 @@ dump_subexp_body_standard (struct expression *exp, - - switch (range_type) - { -- case BOTH_BOUND_DEFAULT: -+ case SUBARRAY_NONE_BOUND: - fputs_filtered ("Range '..'", stream); - break; -- case LOW_BOUND_DEFAULT: -+ case SUBARRAY_HIGH_BOUND: - fputs_filtered ("Range '..EXP'", stream); - break; -- case LOW_BOUND_DEFAULT_EXCLUSIVE: -- fputs_filtered ("ExclusiveRange '..EXP'", stream); -- break; -- case HIGH_BOUND_DEFAULT: -+ case SUBARRAY_LOW_BOUND: - fputs_filtered ("Range 'EXP..'", stream); - break; -- case NONE_BOUND_DEFAULT: -+ case (SUBARRAY_LOW_BOUND -+ | SUBARRAY_HIGH_BOUND -+ | SUBARRAY_HIGH_BOUND_EXCLUSIVE): -+ fputs_filtered ("ExclusiveRange '..EXP'", stream); -+ break; -+ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND): - fputs_filtered ("Range 'EXP..EXP'", stream); - break; -- case NONE_BOUND_DEFAULT_EXCLUSIVE: -+ case (SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE): - fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream); - break; - default: -@@ -1126,11 +1125,9 @@ dump_subexp_body_standard (struct expression *exp, - break; - } - -- if (range_type == HIGH_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT) -+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) - elt = dump_subexp (exp, stream, elt); -- if (range_type == LOW_BOUND_DEFAULT -- || range_type == NONE_BOUND_DEFAULT) -+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) - elt = dump_subexp (exp, stream, elt); - } - break; -diff --git a/gdb/expression.h b/gdb/expression.h ---- a/gdb/expression.h -+++ b/gdb/expression.h -@@ -167,28 +167,27 @@ extern void dump_raw_expression (struct expression *, - struct ui_file *, const char *); - extern void dump_prefix_expression (struct expression *, struct ui_file *); - --/* In an OP_RANGE expression, either bound could be empty, indicating -- that its value is by default that of the corresponding bound of the -- array or string. Also, the upper end of the range can be exclusive -- or inclusive. So we have six sorts of subrange. This enumeration -- type is to identify this. */ -+/* In an OP_RANGE expression, either bound can be provided by the -+ user, or not. In addition to this, the user can also specify a -+ stride value to indicated only certain elements of the array. -+ Also, the upper end of the range can be exclusive or inclusive. -+ This enumeration type is to identify this. */ - - enum range_type --{ -- /* Neither the low nor the high bound was given -- so this refers to -- the entire available range. */ -- BOTH_BOUND_DEFAULT, -- /* The low bound was not given and the high bound is inclusive. */ -- LOW_BOUND_DEFAULT, -- /* The high bound was not given and the low bound in inclusive. */ -- HIGH_BOUND_DEFAULT, -- /* Both bounds were given and both are inclusive. */ -- NONE_BOUND_DEFAULT, -- /* The low bound was not given and the high bound is exclusive. */ -- NONE_BOUND_DEFAULT_EXCLUSIVE, -- /* Both bounds were given. The low bound is inclusive and the high -- bound is exclusive. */ -- LOW_BOUND_DEFAULT_EXCLUSIVE, --}; -+ { -+ SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */ -+ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */ -+ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */ -+ SUBARRAY_STRIDE = 0x4, /* "(::stride)" */ -+ /* The low bound was not given and the high bound is exclusive. -+ In this case we always use (SUBARRAY_HIGH_BOUND | -+ SUBARRAY_HIGH_BOUND_EXCLUSIVE). */ -+ SUBARRAY_HIGH_BOUND_EXCLUSIVE = 0x8, -+ /* Both bounds were given. The low bound is inclusive and the high -+ bound is exclusive. In this case, we use (SUBARRAY_LOW_BOUND | -+ SUBARRAY_HIGH_BOUND | SUBARRAY_HIGH_BOUND_EXCLUSIVE). */ -+ // SUBARRAY_LOW_BOUND_EXCLUSIVE = (SUBARRAY_LOW_BOUND -+ // | SUBARRAY_HIGH_BOUND_EXCLUSIVE), -+ }; - - #endif /* !defined (EXPRESSION_H) */ -diff --git a/gdb/f-exp.y b/gdb/f-exp.y ---- a/gdb/f-exp.y -+++ b/gdb/f-exp.y -@@ -282,31 +282,63 @@ arglist : subrange - - arglist : arglist ',' exp %prec ABOVE_COMMA - { pstate->arglist_len++; } -+ | arglist ',' subrange %prec ABOVE_COMMA -+ { pstate->arglist_len++; } - ; - - /* There are four sorts of subrange types in F90. */ - - subrange: exp ':' exp %prec ABOVE_COMMA -- { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT); -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, -+ SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - - subrange: exp ':' %prec ABOVE_COMMA - { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT); -+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - - subrange: ':' exp %prec ABOVE_COMMA - { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT); -+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - - subrange: ':' %prec ABOVE_COMMA - { write_exp_elt_opcode (pstate, OP_RANGE); -- write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT); -+ write_exp_elt_longcst (pstate, SUBARRAY_NONE_BOUND); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+/* Each subrange type can have a stride argument. */ -+subrange: exp ':' exp ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND -+ | SUBARRAY_HIGH_BOUND -+ | SUBARRAY_STRIDE); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+subrange: exp ':' ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_LOW_BOUND -+ | SUBARRAY_STRIDE); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+subrange: ':' exp ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_HIGH_BOUND -+ | SUBARRAY_STRIDE); -+ write_exp_elt_opcode (pstate, OP_RANGE); } -+ ; -+ -+subrange: ':' ':' exp %prec ABOVE_COMMA -+ { write_exp_elt_opcode (pstate, OP_RANGE); -+ write_exp_elt_longcst (pstate, SUBARRAY_STRIDE); - write_exp_elt_opcode (pstate, OP_RANGE); } - ; - -diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c ---- a/gdb/f-valprint.c -+++ b/gdb/f-valprint.c -@@ -129,6 +129,11 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type, - byte_stride = dim_size; - size_t offs = 0; - -+ 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++) -diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c ---- a/gdb/gdbtypes.c -+++ b/gdb/gdbtypes.c -@@ -1006,7 +1006,8 @@ create_static_range_type (struct type *result_type, struct type *index_type, - low.set_const_val (low_bound); - high.set_const_val (high_bound); - -- result_type = create_range_type (result_type, index_type, &low, &high, 0); -+ result_type = create_range_type (result_type, index_type, -+ &low, &high, 0); - - return result_type; - } -diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h ---- a/gdb/gdbtypes.h -+++ b/gdb/gdbtypes.h -@@ -1615,6 +1615,15 @@ extern unsigned type_align (struct type *); - space in struct type. */ - extern bool set_type_align (struct type *, ULONGEST); - -+#define TYPE_BYTE_STRIDE(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.data.const_val -+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.data.locexpr -+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.data.loclist -+#define TYPE_BYTE_STRIDE_KIND(range_type) \ -+ TYPE_RANGE_DATA(range_type)->stride.kind -+ - /* Property accessors for the type data location. */ - #define TYPE_DATA_LOCATION(thistype) \ - ((thistype)->dyn_prop (DYN_PROP_DATA_LOCATION)) -@@ -1633,6 +1642,26 @@ extern bool set_type_align (struct type *, ULONGEST); - #define TYPE_ASSOCIATED_PROP(thistype) \ - ((thistype)->dyn_prop (DYN_PROP_ASSOCIATED)) - -+/* Accessors for struct range_bounds data attached to an array type's -+ index type. */ -+ -+#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \ -+ ((arraytype)->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED) -+#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ -+ (arraytype->index_type ()->bounds ().low.kind () == PROP_UNDEFINED) -+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \ -+ (TYPE_BYTE_STRIDE(arraytype->index_type ()) == 0) -+ -+ -+#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ -+ (TYPE_HIGH_BOUND((arraytype)->index_type ())) -+ -+#define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \ -+ (TYPE_LOW_BOUND((arraytype)->index_type ())) -+ -+#define TYPE_ARRAY_BIT_STRIDE(arraytype) \ -+ (TYPE_BIT_STRIDE((arraytype)->index_type ())) -+ - /* C++ */ - - #define TYPE_SELF_TYPE(thistype) internal_type_self_type (thistype) -diff --git a/gdb/parse.c b/gdb/parse.c ---- a/gdb/parse.c -+++ b/gdb/parse.c -@@ -919,24 +919,20 @@ operator_length_standard (const struct expression *expr, int endpos, - - case OP_RANGE: - oplen = 3; -+ args = 0; - range_type = (enum range_type) - longest_to_int (expr->elts[endpos - 2].longconst); - -- switch (range_type) -- { -- case LOW_BOUND_DEFAULT: -- case LOW_BOUND_DEFAULT_EXCLUSIVE: -- case HIGH_BOUND_DEFAULT: -- args = 1; -- break; -- case BOTH_BOUND_DEFAULT: -- args = 0; -- break; -- case NONE_BOUND_DEFAULT: -- case NONE_BOUND_DEFAULT_EXCLUSIVE: -- args = 2; -- break; -- } -+ /* Increment the argument counter for each argument -+ provided by the user. */ -+ if ((range_type & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) -+ args++; -+ -+ if ((range_type & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) -+ args++; -+ -+ if ((range_type & SUBARRAY_STRIDE) == SUBARRAY_STRIDE) -+ args++; - - break; - -diff --git a/gdb/rust-exp.y b/gdb/rust-exp.y ---- a/gdb/rust-exp.y -+++ b/gdb/rust-exp.y -@@ -2492,24 +2492,28 @@ rust_parser::convert_ast_to_expression (const struct rust_op *operation, - - case OP_RANGE: - { -- enum range_type kind = BOTH_BOUND_DEFAULT; -+ enum range_type kind = SUBARRAY_NONE_BOUND; - - if (operation->left.op != NULL) - { - convert_ast_to_expression (operation->left.op, top); -- kind = HIGH_BOUND_DEFAULT; -+ kind = SUBARRAY_LOW_BOUND; - } - if (operation->right.op != NULL) - { - convert_ast_to_expression (operation->right.op, top); -- if (kind == BOTH_BOUND_DEFAULT) -- kind = (operation->inclusive -- ? LOW_BOUND_DEFAULT : LOW_BOUND_DEFAULT_EXCLUSIVE); -+ if (kind == SUBARRAY_NONE_BOUND) -+ { -+ kind = (range_type) SUBARRAY_HIGH_BOUND; -+ if (!operation->inclusive) -+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE); -+ } - else - { -- gdb_assert (kind == HIGH_BOUND_DEFAULT); -- kind = (operation->inclusive -- ? NONE_BOUND_DEFAULT : NONE_BOUND_DEFAULT_EXCLUSIVE); -+ gdb_assert (kind == SUBARRAY_LOW_BOUND); -+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND); -+ if (!operation->inclusive) -+ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND_EXCLUSIVE); - } - } - else -diff --git a/gdb/rust-lang.c b/gdb/rust-lang.c ---- a/gdb/rust-lang.c -+++ b/gdb/rust-lang.c -@@ -1082,13 +1082,11 @@ rust_range (struct expression *exp, int *pos, enum noside noside) - kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst); - *pos += 3; - -- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT -- || kind == NONE_BOUND_DEFAULT_EXCLUSIVE) -+ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND) - low = evaluate_subexp (nullptr, exp, pos, noside); -- if (kind == LOW_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT_EXCLUSIVE -- || kind == NONE_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT_EXCLUSIVE) -+ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND) - high = evaluate_subexp (nullptr, exp, pos, noside); -- bool inclusive = (kind == NONE_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT); -+ bool inclusive = (!((kind & SUBARRAY_HIGH_BOUND_EXCLUSIVE) == SUBARRAY_HIGH_BOUND_EXCLUSIVE)); - - if (noside == EVAL_SKIP) - return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1); -@@ -1177,7 +1175,7 @@ rust_compute_range (struct type *type, struct value *range, - - *low = 0; - *high = 0; -- *kind = BOTH_BOUND_DEFAULT; -+ *kind = SUBARRAY_NONE_BOUND; - - if (type->num_fields () == 0) - return; -@@ -1185,15 +1183,14 @@ rust_compute_range (struct type *type, struct value *range, - i = 0; - if (strcmp (TYPE_FIELD_NAME (type, 0), "start") == 0) - { -- *kind = HIGH_BOUND_DEFAULT; -+ *kind = SUBARRAY_LOW_BOUND; - *low = value_as_long (value_field (range, 0)); - ++i; - } - if (type->num_fields () > i - && strcmp (TYPE_FIELD_NAME (type, i), "end") == 0) - { -- *kind = (*kind == BOTH_BOUND_DEFAULT -- ? LOW_BOUND_DEFAULT : NONE_BOUND_DEFAULT); -+ *kind = (range_type) (*kind | SUBARRAY_HIGH_BOUND); - *high = value_as_long (value_field (range, i)); - - if (rust_inclusive_range_type_p (type)) -@@ -1211,7 +1208,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, - struct type *rhstype; - LONGEST low, high_bound; - /* Initialized to appease the compiler. */ -- enum range_type kind = BOTH_BOUND_DEFAULT; -+ enum range_type kind = SUBARRAY_NONE_BOUND; - LONGEST high = 0; - int want_slice = 0; - -@@ -1309,7 +1306,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, - error (_("Cannot subscript non-array type")); - - if (want_slice -- && (kind == BOTH_BOUND_DEFAULT || kind == LOW_BOUND_DEFAULT)) -+ && ((kind & SUBARRAY_LOW_BOUND) != SUBARRAY_LOW_BOUND)) - low = low_bound; - if (low < 0) - error (_("Index less than zero")); -@@ -1327,7 +1324,7 @@ rust_subscript (struct expression *exp, int *pos, enum noside noside, - CORE_ADDR addr; - struct value *addrval, *tem; - -- if (kind == BOTH_BOUND_DEFAULT || kind == HIGH_BOUND_DEFAULT) -+ if ((kind & SUBARRAY_HIGH_BOUND) != SUBARRAY_HIGH_BOUND) - high = high_bound; - if (high < 0) - error (_("High index less than zero")); -diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp -@@ -0,0 +1,421 @@ -+# Copyright 2015 Free Software Foundation, Inc. -+# -+# Contributed by Intel Corp. -+# -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+standard_testfile static-arrays.f90 -+ -+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } { -+ return -1 -+} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_breakpoint [gdb_get_line_number "BP1"] -+gdb_continue_to_breakpoint "BP1" ".*BP1.*" -+ -+# Tests subarrays of one dimensional arrays with subrange variations -+gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ -+ "print ar1." -+gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \ -+ "print ar1\(4:7\)" -+gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \ -+ "print ar1\(8:\)" -+gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \ -+ "print ar1\(:3\)" -+gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \ -+ "print ar1\(:\)" -+ -+# Check assignment -+gdb_test_no_output "set \$my_ary = ar1\(3:8\)" -+gdb_test "print \$my_ary" \ -+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ -+ "Assignment of subarray to variable" -+gdb_test_no_output "set ar1\(5\) = 42" -+ gdb_test "print ar1\(3:8\)" \ -+ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \ -+ "print ar1\(3:8\) after assignment" -+gdb_test "print \$my_ary" \ -+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \ -+ "Assignment of subarray to variable after original array changed" -+ -+# Test for subarrays of one dimensional arrays with literals -+ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \ -+ "print ar1\(3\)" -+ -+# Tests for subranges of 2 dimensional arrays with subrange variations -+gdb_test "print ar2\(2:3, 3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \ -+ "print ar2\(2:3, 3:4\)." -+gdb_test "print ar2\(8:9,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:9,8:\)" -+gdb_test "print ar2\(8:9,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ -+ "print ar2\(8:9,:2\)" -+ -+gdb_test "print ar2\(8:,8:9\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:,8:9\)" -+gdb_test "print ar2\(8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \ -+ "print ar2\(8:,8:\)" -+gdb_test "print ar2\(8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \ -+ "print ar2\(8:,:2\)" -+ -+gdb_test "print ar2\(:2,2:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \ -+ "print ar2\(:2,2:3\)" -+gdb_test "print ar2\(:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \ -+ "print ar2\(:2,8:\)" -+gdb_test "print ar2\(:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \ -+ "print ar2\(:2,:2\)" -+ -+# Test subranges of 2 dimensional arrays with literals and subrange variations -+gdb_test "print ar2\(7, 3:6\)" \ -+ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \ -+ "print ar2\(7, 3:6\)" -+gdb_test "print ar2\(7,8:\)" \ -+ "\\$\[0-9\]+ = \\(78, 79\\)" \ -+ "print ar2\(7,8:\)" -+gdb_test "print ar2\(7,:2\)" \ -+ "\\$\[0-9\]+ = \\(71, 72\\)" \ -+ "print ar2\(7,:2\)" -+ -+gdb_test "print ar2\(7:8,4\)" \ -+ "\\$\[0-9\]+ = \\(74, 84\\)" \ -+ "print ar2(7:8,4\)" -+gdb_test "print ar2\(8:,4\)" \ -+ "\\$\[0-9\]+ = \\(84, 94\\)" \ -+ "print ar2\(8:,4\)" -+gdb_test "print ar2\(:2,4\)" \ -+ "\\$\[0-9\]+ = \\(14, 24\\)" \ -+ "print ar2\(:2,4\)" -+gdb_test "print ar2\(3,4\)" \ -+ "\\$\[0-9\]+ = 34" \ -+ "print ar2\(3,4\)" -+ -+# Test subarrays of 3 dimensional arrays with literals and subrange variations -+gdb_test "print ar3\(2:4,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\ -+ \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \ -+ "print ar3\(2:4,3:4,7:8\)" -+gdb_test "print ar3\(2:3,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\ -+ \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \ -+ "print ar3\(2:3,4:5,8:\)" -+gdb_test "print ar3\(2:3,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\ -+ \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \ -+ "print ar3\(2:3,4:5,:2\)" -+ -+gdb_test "print ar3\(2:3,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\ -+ \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \ -+ "print ar3\(2:3,8:,7:8\)" -+gdb_test "print ar3\(2:3,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\ -+ \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \ -+ "print ar3\(2:3,8:,8:\)" -+gdb_test "print ar3\(2:3,8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\ -+ \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \ -+ "print ar3\(2:3,8:,:2\)" -+ -+gdb_test "print ar3\(2:3,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\ -+ \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \ -+ "print ar3\(2:3,:2,7:8\)" -+gdb_test "print ar3\(2:3,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\ -+ \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \ -+ "print ar3\(2:3,:2,8:\)" -+gdb_test "print ar3\(2:3,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\ -+ \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \ -+ "print ar3\(2:3,:2,:2\)" -+ -+gdb_test "print ar3\(8:,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\ -+ \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \ -+ "print ar3\(8:,3:4,7:8\)" -+gdb_test "print ar3\(8:,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\ -+ \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \ -+ "print ar3\(8:,4:5,8:\)" -+gdb_test "print ar3\(8:,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\ -+ \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \ -+ "print ar3\(8:,4:5,:2\)" -+ -+gdb_test "print ar3\(8:,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\ -+ \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \ -+ "print ar3\(8:,8:,7:8\)" -+gdb_test "print ar3\(8:,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\ -+ \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \ -+ "print ar3\(8:,8:,8:\)" -+gdb_test "print ar3\(8:,8:,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\ -+ \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \ -+ "print ar3\(8:,8:,:2\)" -+ -+gdb_test "print ar3\(8:,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\ -+ \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \ -+ "print ar3\(8:,:2,7:8\)" -+gdb_test "print ar3\(8:,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\ -+ \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \ -+ "print ar3\(8:,:2,8:\)" -+gdb_test "print ar3\(8:,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\ -+ \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \ -+ "print ar3\(8:,:2,:2\)" -+ -+ -+gdb_test "print ar3\(:2,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\ -+ \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \ -+ "print ar3 \(:2,3:4,7:8\)." -+gdb_test "print ar3\(:2,3:4,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\ -+ \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \ -+ "print ar3\(:2,3:4,8:\)" -+gdb_test "print ar3\(:2,3:4,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\ -+ \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \ -+ "print ar3\(:2,3:4,:2\)" -+ -+gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\ -+ 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \ -+ "print ar3\(:2,8:,7:8\)" -+gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\ -+ 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \ -+ "print ar3\(:2,8:,8:\)" -+gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\ -+ 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \ -+ "print ar3\(:2,8:,:2\)" -+ -+gdb_test "print ar3\(:2,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\ -+ \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \ -+ "print ar3\(:2,:2,7:8\)" -+gdb_test "print ar3\(:2,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\ -+ \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \ -+ "print ar3\(:2,:2,8:\)" -+gdb_test "print ar3\(:2,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\ -+ \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \ -+ "print ar3\(:2,:2,:2\)" -+ -+#Tests for subarrays of 3 dimensional arrays with literals and subranges -+gdb_test "print ar3\(3,3:4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \ -+ "print ar3\(3,3:4,7:8\)" -+gdb_test "print ar3\(3,4:5,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \ -+ "print ar3\(3,4:5,8:\)" -+gdb_test "print ar3\(3,4:5,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \ -+ "print ar3\(3,4:5,:2\)" -+gdb_test "print ar3\(3,4:5,3\)" \ -+ "\\$\[0-9\]+ = \\(343, 353\\)" \ -+ "print ar3\(3,4:5,3\)" -+ -+gdb_test "print ar3\(2,8:,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \ -+ "print ar3\(2,8:,7:8\)" -+gdb_test "print ar3\(2,8:,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \ -+ "print ar3\(2,8:,8:\)" -+gdb_test "print ar3\(2,8:,:2\)"\ -+ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \ -+ "print ar3\(2,8:,:2\)" -+gdb_test "print ar3\(2,8:,3\)" \ -+ "\\$\[0-9\]+ = \\(283, 293\\)" \ -+ "print ar3\(2,8:,3\)" -+ -+gdb_test "print ar3\(2,:2,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \ -+ "print ar3\(2,:2,7:8\)" -+gdb_test "print ar3\(2,:2,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \ -+ "print ar3\(2,:2,8:\)" -+gdb_test "print ar3\(2,:2,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \ -+ "print ar3\(2,:2,:2\)" -+gdb_test "print ar3\(2,:2,3\)" \ -+ "\\$\[0-9\]+ = \\(213, 223\\)" \ -+ "print ar3\(2,:2,3\)" -+ -+gdb_test "print ar3\(3,4,7:8\)" \ -+ "\\$\[0-9\]+ = \\(347, 348\\)" \ -+ "print ar3\(3,4,7:8\)" -+gdb_test "print ar3\(3,4,8:\)" \ -+ "\\$\[0-9\]+ = \\(348, 349\\)" \ -+i "print ar3\(3,4,8:\)" -+gdb_test "print ar3\(3,4,:2\)" \ -+ "\\$\[0-9\]+ = \\(341, 342\\)" \ -+ "print ar3\(3,4,:2\)" -+gdb_test "print ar3\(5,6,7\)" \ -+ "\\$\[0-9\]+ = 567" \ -+ "print ar3\(5,6,7\)" -+ -+gdb_test "print ar3\(3:4,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \ -+ "print ar3\(3:4,6,7:8\)" -+gdb_test "print ar3\(3:4,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \ -+ "print ar3\(3:4,6,8:\)" -+gdb_test "print ar3\(3:4,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \ -+ "print ar3\(3:4,6,:2\)" -+gdb_test "print ar3\(3:4,6,5\)" \ -+ "\\$\[0-9\]+ = \\(365, 465\\)" \ -+ "print ar3\(3:4,6,5\)" -+ -+gdb_test "print ar3\(8:,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \ -+ "print ar3\(8:,6,7:8\)" -+gdb_test "print ar3\(8:,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \ -+ "print ar3\(8:,6,8:\)" -+gdb_test "print ar3\(8:,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \ -+ "print ar3\(8:,6,:2\)" -+gdb_test "print ar3\(8:,6,5\)" \ -+ "\\$\[0-9\]+ = \\(865, 965\\)" \ -+ "print ar3\(8:,6,5\)" -+ -+gdb_test "print ar3\(:2,6,7:8\)" \ -+ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \ -+ "print ar3\(:2,6,7:8\)" -+gdb_test "print ar3\(:2,6,8:\)" \ -+ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \ -+ "print ar3\(:2,6,8:\)" -+gdb_test "print ar3\(:2,6,:2\)" \ -+ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \ -+ "print ar3\(:2,6,:2\)" -+gdb_test "print ar3\(:2,6,5\)" \ -+ "\\$\[0-9\]+ = \\(165, 265\\)" \ -+ "print ar3\(:2,6,5\)" -+ -+gdb_test "print ar3\(3:4,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \ -+ "print ar2\(3:4,5:6,4\)" -+gdb_test "print ar3\(8:,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \ -+ "print ar2\(8:,5:6,4\)" -+gdb_test "print ar3\(:2,5:6,4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \ -+ "print ar2\(:2,5:6,4\)" -+ -+# Stride > 1 -+gdb_test "print ar1\(2:6:2\)" \ -+ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \ -+ "print ar1\(2:6:2\)" -+gdb_test "print ar2\(2:6:2,3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \ -+ "print ar2\(2:6:2,3:4\)" -+gdb_test "print ar2\(2:6:2,3\)" \ -+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ -+ "print ar2\(2:6:2,3\)" -+gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\ -+ \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \ -+ "print ar3\(2:6:2,3:5:2,4:7:3\)" -+gdb_test "print ar3\(2:6:2,5,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\ -+ \\)" \ -+ "print ar3\(2:6:2,5,4:7:3\)" -+ -+# Stride < 0 -+gdb_test "print ar1\(8:2:-2\)" \ -+ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \ -+ "print ar1\(8:2:-2\)" -+gdb_test "print ar2\(8:2:-2,3:4\)" \ -+ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\ -+ \\)" \ -+ "print ar2\(8:2:-2,3:4\)" -+gdb_test "print ar2\(2:6:2,3\)" \ -+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \ -+ "print ar2\(2:6:2,3\)" -+gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\ -+ \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \ -+ "print ar3\(2:3,7:3:-4,4:7:3\)" -+gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \ -+ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\ -+ \\)" \ -+ "print ar3\(2:6:2,5,7:4:-3\)" -+ -+# Tests with negative and mixed indices -+gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\ -+ \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\ -+ 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\ -+ 392, 492\\) \\) \\)" \ -+ "print ar4(2:4, -2:1, -15:-14)" -+ -+gdb_test "p ar4\(7,-6:2:3,-7\)" \ -+ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \ -+ "print ar4(7,-6:2:3,-7)" -+ -+gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\ -+ 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\ -+ 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\ -+ 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\ -+ 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\ -+ 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\ -+ \\)" \ -+ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)" -+ -+gdb_test "p ar4\(:,:,:\)" \ -+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\ -+ 811, .*" \ -+ "print ar4(:,:,:)" -+ -+# Provoke error messages for bad user input -+gdb_test "print ar1\(0:4\)" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ -+ "print ar1\(0:4\)" -+gdb_test "print ar1\(8:12\)" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ -+ "print ar1\(8:12\)" -+gdb_test "print ar1\(8:2:\)" \ -+ "A syntax error in expression, near `\\)'." \ -+ "print ar1\(8:2:\)" -+gdb_test "print ar1\(8:2:2\)" \ -+ "Wrong value provided for stride and boundaries" \ -+ "print ar1\(8:2:2\)" -+gdb_test "print ar1\(2:8:-2\)" \ -+ "Wrong value provided for stride and boundaries" \ -+ "print ar1\(2:8:-2\)" -+gdb_test "print ar1\(2:7:0\)" \ -+ "Stride must not be 0" \ -+ "print ar1\(2:7:0\)" -+gdb_test "print ar1\(3:7\) = 42" \ -+ "Invalid cast." \ -+ "Assignment of value to subarray" -diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90 -@@ -0,0 +1,55 @@ -+! Copyright 2015 Free Software Foundation, Inc. -+! -+! Contributed by Intel Corp. -+! -+! This program is free software; you can redistribute it and/or modify -+! it under the terms of the GNU General Public License as published by -+! the Free Software Foundation; either version 3 of the License, or -+! (at your option) any later version. -+! -+! This program is distributed in the hope that it will be useful, -+! but WITHOUT ANY WARRANTY; without even the implied warranty of -+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+! GNU General Public License for more details. -+! -+! You should have received a copy of the GNU General Public License -+! along with this program. If not, see . -+ -+subroutine sub -+ integer, dimension(9) :: ar1 -+ integer, dimension(9,9) :: ar2 -+ integer, dimension(9,9,9) :: ar3 -+ integer, dimension(10,-7:3, -15:-5) :: ar4 -+ integer :: i,j,k -+ -+ ar1 = 1 -+ ar2 = 1 -+ ar3 = 1 -+ ar4 = 4 -+ -+ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...))) -+ do i = 1, 9, 1 -+ ar1(i) = i -+ do j = 1, 9, 1 -+ ar2(i,j) = i*10 + j -+ do k = 1, 9, 1 -+ ar3(i,j,k) = i*100 + j*10 + k -+ end do -+ end do -+ end do -+ -+ do i = 1, 10, 1 -+ do j = -7, 3, 1 -+ do k = -15, -5, 1 -+ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16) -+ end do -+ end do -+ end do -+ -+ ar1(1) = 11 !BP1 -+ return -+end -+ -+program testprog -+ call sub -+end -diff --git a/gdb/testsuite/gdb.fortran/vla-sizeof.exp b/gdb/testsuite/gdb.fortran/vla-sizeof.exp ---- a/gdb/testsuite/gdb.fortran/vla-sizeof.exp -+++ b/gdb/testsuite/gdb.fortran/vla-sizeof.exp -@@ -35,7 +35,8 @@ gdb_test "print sizeof(vla1)" " = 0" "print sizeof non-allocated vla1" - gdb_test "print sizeof(vla1(3,2,1))" \ - "no such vector element \\(vector not allocated\\)" \ - "print sizeof non-allocated indexed vla1" --gdb_test "print sizeof(vla1(3:4,2,1))" "array not allocated" \ -+gdb_test "print sizeof(vla1(3:4,2,1))" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ - "print sizeof non-allocated sliced vla1" - - # Try to access value in allocated VLA -@@ -44,7 +45,7 @@ gdb_continue_to_breakpoint "vla1-allocated" - gdb_test "print sizeof(vla1)" " = 4000" "print sizeof allocated vla1" - gdb_test "print sizeof(vla1(3,2,1))" "4" \ - "print sizeof element from allocated vla1" --gdb_test "print sizeof(vla1(3:4,2,1))" "800" \ -+gdb_test "print sizeof(vla1(3:4,2,1))" "8" \ - "print sizeof sliced vla1" - - # Try to access values in undefined pointer to VLA (dangling) -@@ -52,7 +53,8 @@ gdb_test "print sizeof(pvla)" " = 0" "print sizeof non-associated pvla" - gdb_test "print sizeof(pvla(3,2,1))" \ - "no such vector element \\(vector not associated\\)" \ - "print sizeof non-associated indexed pvla" --gdb_test "print sizeof(pvla(3:4,2,1))" "array not associated" \ -+gdb_test "print sizeof(pvla(3:4,2,1))" \ -+ "provided bound\\(s\\) outside array bound\\(s\\)" \ - "print sizeof non-associated sliced pvla" - - # Try to access values in pointer to VLA and compare them -@@ -61,7 +63,8 @@ gdb_continue_to_breakpoint "pvla-associated" - gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla" - gdb_test "print sizeof(pvla(3,2,1))" "4" \ - "print sizeof element from associated pvla" --gdb_test "print sizeof(pvla(3:4,2,1))" "800" "print sizeof sliced pvla" -+ -+gdb_test "print sizeof(pvla(3:4,2,1))" "8" "print sizeof sliced pvla" - - gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds-v1"] - gdb_continue_to_breakpoint "vla1-neg-bounds-v1" -diff --git a/gdb/testsuite/gdb.fortran/vla-stride.exp b/gdb/testsuite/gdb.fortran/vla-stride.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-stride.exp -@@ -0,0 +1,47 @@ -+# Copyright 2016 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+standard_testfile ".f90" -+ -+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ -+ {debug f90 quiet}] } { -+ return -1 -+} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_test_no_output "set max-value-size unlimited" \ -+ "set max-value-size to unlimited" -+ -+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 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-stride.f90 -@@ -0,0 +1,29 @@ -+! Copyright 2016 Free Software Foundation, Inc. -+! -+! This program is free software; you can redistribute it and/or modify -+! it under the terms of the GNU General Public License as published by -+! the Free Software Foundation; either version 3 of the License, or -+! (at your option) any later version. -+! -+! This program is distributed in the hope that it will be useful, -+! but WITHOUT ANY WARRANTY; without even the implied warranty of -+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+! GNU General Public License for more details. -+! -+! You should have received a copy of the GNU General Public License -+! along with this program. If not, see . -+ -+program vla_stride -+ integer, target, allocatable :: vla (:) -+ integer, pointer :: pvla (:) -+ -+ allocate(vla(10)) -+ vla = (/ (I, I = 1,10) /) -+ -+ pvla => vla(10:1:-1) -+ pvla => pvla(10:1:-1) -+ pvla => vla(1:10:2) ! re-reverse-elements -+ pvla => vla(5:4:-2) ! odd-elements -+ -+ pvla => null() ! single-element -+end program vla_stride -diff --git a/gdb/valops.c b/gdb/valops.c ---- a/gdb/valops.c -+++ b/gdb/valops.c -@@ -3756,13 +3756,42 @@ value_of_this_silent (const struct language_defn *lang) - - struct value * - value_slice (struct value *array, int lowbound, int length) -+{ -+ /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride -+ value of '1', which returns every element between LOWBOUND and -+ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1' -+ as we are only considering the highest dimension, or we are -+ working on a one dimensional array. So we call VALUE_SLICE_1 -+ exactly once. */ -+ return value_slice_1 (array, lowbound, length, 1, 1); -+} -+ -+/* VALUE_SLICE_1 is called for each array dimension to calculate the number -+ of elements as defined by the subscript expression. -+ CALL_COUNT is used to determine if we are calling the function once, e.g. -+ we are working on the current dimension of ARRAY, or if we are calling -+ the function repeatedly. In the later case we need to take elements -+ from the TARGET_TYPE of ARRAY. -+ With a CALL_COUNT greater than 1 we calculate the offsets for every element -+ that should be in the result array. Then we fetch the contents and then -+ copy them into the result array. The result array will have one dimension -+ less than the input array, so later on we need to recreate the indices and -+ ranges in the calling function. */ -+ -+struct value * -+value_slice_1 (struct value *array, int lowbound, int length, -+ int stride_length, int call_count) - { - struct type *slice_range_type, *slice_type, *range_type; -- LONGEST lowerbound, upperbound; -- struct value *slice; -- struct type *array_type; -+ struct type *array_type = check_typedef (value_type (array)); -+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); -+ unsigned int elt_size, elt_offs; -+ LONGEST ary_high_bound, ary_low_bound; -+ struct value *v; -+ int slice_range_size, i = 0, row_count = 1, elem_count = 1; - -- array_type = check_typedef (value_type (array)); -+ /* Check for legacy code if we are actually dealing with an array or -+ string. */ - if (array_type->code () != TYPE_CODE_ARRAY - && array_type->code () != TYPE_CODE_STRING) - error (_("cannot take slice of non-array")); -@@ -3772,45 +3801,155 @@ value_slice (struct value *array, int lowbound, int length) - if (type_not_associated (array_type)) - error (_("array not associated")); - -- range_type = array_type->index_type (); -- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) -- error (_("slice from bad array or bitstring")); -+ ary_low_bound = array_type->index_type ()->bounds ()->low.const_val (); -+ ary_high_bound = array_type->index_type ()->bounds ()->high.const_val (); -+ -+ /* When we are working on a multi-dimensional array, we need to get the -+ attributes of the underlying type. */ -+ if (call_count > 1) -+ { -+ ary_low_bound = elt_type->index_type ()->bounds ()->low.const_val (); -+ ary_high_bound = elt_type->index_type ()->bounds ()->high.const_val (); -+ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); -+ row_count = TYPE_LENGTH (array_type) -+ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); -+ } -+ -+ /* With a stride of '1', the number of elements per result row is equal to -+ the LENGTH of the subarray. With non-default stride values, we skip -+ elements, but have to add the start element to the total number of -+ elements per row. */ -+ if (stride_length == 1) -+ elem_count = length; -+ else -+ elem_count = ((length - 1) / stride_length) + 1; -+ -+ elt_size = TYPE_LENGTH (elt_type); -+ elt_offs = lowbound - ary_low_bound; -+ -+ elt_offs *= elt_size; - -- if (lowbound < lowerbound || length < 0 -- || lowbound + length - 1 > upperbound) -- error (_("slice out of range")); -+ /* Check for valid user input. In case of Fortran this was already done -+ in the calling function. */ -+ if (call_count == 1 -+ && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type) -+ && elt_offs >= TYPE_LENGTH (array_type))) -+ error (_("no such vector element")); -+ -+ /* CALL_COUNT is 1 when we are dealing either with the highest dimension -+ of the array, or a one dimensional array. Set RANGE_TYPE accordingly. -+ In both cases we calculate how many rows/elements will be in the output -+ array by setting slice_range_size. */ -+ if (call_count == 1) -+ { -+ range_type = array_type->index_type (); -+ slice_range_size = ary_low_bound + elem_count - 1; -+ -+ /* Check if the array bounds are valid. */ -+ if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0) -+ error (_("slice from bad array or bitstring")); -+ } -+ /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays. -+ So we need to get the type below the current one and set the RANGE_TYPE -+ accordingly. */ -+ else -+ { -+ range_type = TYPE_TARGET_TYPE (array_type)->index_type (); -+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1; -+ ary_low_bound = range_type->bounds ()->low.const_val (); -+ } - - /* FIXME-type-allocation: need a way to free this type when we are -- done with it. */ -- slice_range_type = create_static_range_type (NULL, -- TYPE_TARGET_TYPE (range_type), -- lowbound, -- lowbound + length - 1); -+ done with it. */ - -+ slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type), -+ ary_low_bound, slice_range_size); - { -- struct type *element_type = TYPE_TARGET_TYPE (array_type); -- LONGEST offset -- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type)); -+ struct type *element_type; - -- slice_type = create_array_type (NULL, -- element_type, -- slice_range_type); -- slice_type->set_code (array_type->code ()); -+ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy -+ code for subarrays. */ -+ if (call_count == 1 && stride_length == 1) -+ { -+ element_type = TYPE_TARGET_TYPE (array_type); -+ -+ slice_type = create_array_type (NULL, element_type, slice_range_type); -+ -+ slice_type->set_code (array_type->code ()); - -- if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) -- slice = allocate_value_lazy (slice_type); -+ if (VALUE_LVAL (array) == lval_memory && value_lazy (array)) -+ v = allocate_value_lazy (slice_type); -+ else -+ { -+ v = allocate_value (slice_type); -+ value_contents_copy (v, -+ value_embedded_offset (v), -+ array, -+ value_embedded_offset (array) + elt_offs, -+ elt_size * longest_to_int (length)); -+ } -+ -+ } -+ /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working -+ on a range of ranges. So we copy the relevant elements into the -+ new array we return. */ - else - { -- slice = allocate_value (slice_type); -- value_contents_copy (slice, 0, array, offset, -- type_length_units (slice_type)); -+ int j, offs_store = elt_offs; -+ LONGEST dst_offset = 0; -+ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type)); -+ -+ if (call_count == 1) -+ { -+ /* When CALL_COUNT is equal to 1 we are working on the current range -+ and use these elements directly. */ -+ element_type = TYPE_TARGET_TYPE (array_type); -+ } -+ else -+ { -+ /* Working on an array of arrays, the type of the elements is the type -+ of the subarrays' type. */ -+ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type)); -+ } -+ -+ slice_type = create_array_type (NULL, element_type, slice_range_type); -+ -+ /* If we have a one dimensional array, we copy its type code. For a -+ multi dimensional array we copy the embedded type's type code. */ -+ if (call_count == 1) -+ slice_type->set_code (array_type->code ()); -+ else -+ slice_type->set_code ((TYPE_TARGET_TYPE (array_type)->code ())); -+ -+ v = allocate_value (slice_type); -+ -+ /* Iterate through the rows of the outer array and set the new offset -+ for each row. */ -+ for (i = 0; i < row_count; i++) -+ { -+ elt_offs = offs_store + i * src_row_length; -+ -+ /* Iterate through the elements in each row to copy only those. */ -+ for (j = 1; j <= elem_count; j++) -+ { -+ /* Fetches the contents of ARRAY and copies them into V. */ -+ value_contents_copy (v, dst_offset, array, elt_offs, elt_size); -+ elt_offs += elt_size * stride_length; -+ dst_offset += elt_size; -+ } -+ } - } - -- set_value_component_location (slice, array); -- set_value_offset (slice, value_offset (array) + offset); -+ set_value_component_location (v, array); -+ if (VALUE_LVAL (v) == lval_register) -+ { -+ VALUE_REGNUM (v) = VALUE_REGNUM (array); -+ VALUE_NEXT_FRAME_ID (v) = VALUE_NEXT_FRAME_ID (array); -+ } -+ set_value_offset (v, value_offset (array) + elt_offs); - } - -- return slice; -+ return v; - } - - /* See value.h. */ -diff --git a/gdb/value.h b/gdb/value.h ---- a/gdb/value.h -+++ b/gdb/value.h -@@ -1144,6 +1144,8 @@ extern struct value *varying_to_slice (struct value *); - - extern struct value *value_slice (struct value *, int, int); - -+extern struct value *value_slice_1 (struct value *, int, int, int, int); -+ - /* Create a complex number. The type is the complex type; the values - are cast to the underlying scalar type before the complex number is - created. */ diff --git a/gdb-vla-intel-fortran-vla-strings.patch b/gdb-vla-intel-fortran-vla-strings.patch deleted file mode 100644 index 1e48ee8..0000000 --- a/gdb-vla-intel-fortran-vla-strings.patch +++ /dev/null @@ -1,1086 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-vla-intel-fortran-vla-strings.patch - -;;=push - -git diff --stat -p gdb/master...gdb/users/bheckel/fortran-vla-strings -0ad7d8d1a3a36c6e04e3b6d37d8825f18d595723 - - gdb/NEWS | 2 + - gdb/c-valprint.c | 22 +++++ - gdb/dwarf2read.c | 158 +++++++++++++++++++++++++----- - gdb/f-typeprint.c | 93 +++++++++--------- - gdb/gdbtypes.c | 44 ++++++++- - gdb/testsuite/gdb.cp/vla-cxx.cc | 9 ++ - gdb/testsuite/gdb.cp/vla-cxx.exp | 9 ++ - gdb/testsuite/gdb.fortran/pointers.exp | 143 +++++++++++++++++++++++++++ - gdb/testsuite/gdb.fortran/pointers.f90 | 109 +++++++++++++++++++++ - gdb/testsuite/gdb.fortran/print_type.exp | 100 +++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-ptype.exp | 12 +-- - gdb/testsuite/gdb.fortran/vla-strings.exp | 103 +++++++++++++++++++ - gdb/testsuite/gdb.fortran/vla-strings.f90 | 39 ++++++++ - gdb/testsuite/gdb.fortran/vla-type.exp | 7 +- - gdb/testsuite/gdb.fortran/vla-value.exp | 12 ++- - gdb/testsuite/gdb.mi/mi-var-child-f.exp | 7 +- - gdb/testsuite/gdb.mi/mi-vla-fortran.exp | 27 ++--- - gdb/typeprint.c | 19 ++++ - gdb/valops.c | 16 ++- - gdb/valprint.c | 6 -- - 20 files changed, 827 insertions(+), 110 deletions(-) - -diff --git a/gdb/NEWS b/gdb/NEWS ---- a/gdb/NEWS -+++ b/gdb/NEWS -@@ -985,6 +985,8 @@ SH-5/SH64 running OpenBSD SH-5/SH64 support in sh*-*-openbsd* - - *** Changes in GDB 8.1 - -+* Fortran: Support pointers to dynamic types. -+ - * GDB now supports dynamically creating arbitrary register groups specified - in XML target descriptions. This allows for finer grain grouping of - registers on systems with a large amount of registers. -diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c ---- a/gdb/c-valprint.c -+++ b/gdb/c-valprint.c -@@ -572,6 +572,28 @@ c_value_print (struct value *val, struct ui_file *stream, - else - { - /* normal case */ -+ if (type->code () == TYPE_CODE_PTR -+ && 1 == is_dynamic_type (type)) -+ { -+ CORE_ADDR addr; -+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (type))) -+ addr = value_address (val); -+ else -+ addr = value_as_address (val); -+ -+ /* We resolve the target-type only when the -+ pointer is associated. */ -+ if ((addr != 0) -+ && (0 == type_not_associated (type))) -+ TYPE_TARGET_TYPE (type) = -+ resolve_dynamic_type (TYPE_TARGET_TYPE (type), -+ {}, addr); -+ } -+ else -+ { -+ /* Do nothing. References are already resolved from the beginning, -+ only pointers are resolved when we actual need the target. */ -+ } - fprintf_filtered (stream, "("); - type_print (value_type (val), "", stream, -1); - fprintf_filtered (stream, ") "); -diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c ---- a/gdb/dwarf2/read.c -+++ b/gdb/dwarf2/read.c -@@ -1562,7 +1562,10 @@ static void read_signatured_type (signatured_type *sig_type, - - static int attr_to_dynamic_prop (const struct attribute *attr, - struct die_info *die, struct dwarf2_cu *cu, -- struct dynamic_prop *prop, struct type *type); -+ struct dynamic_prop *prop, -+ struct type *default_type, -+ const gdb_byte *additional_data, -+ int additional_data_size); - - /* memory allocation interface */ - -@@ -13631,7 +13634,7 @@ read_func_scope (struct die_info *die, struct dwarf2_cu *cu) - newobj->static_link - = XOBNEW (&objfile->objfile_obstack, struct dynamic_prop); - attr_to_dynamic_prop (attr, die, cu, newobj->static_link, -- cu->addr_type ()); -+ cu->addr_type (), NULL, 0); - } - - cu->list_in_scope = cu->get_builder ()->get_local_symbols (); -@@ -16073,7 +16076,7 @@ read_structure_type (struct die_info *die, struct dwarf2_cu *cu) - else - { - struct dynamic_prop prop; -- if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type ())) -+ if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type (), NULL, 0)) - type->add_dyn_prop (DYN_PROP_BYTE_SIZE, prop); - TYPE_LENGTH (type) = 0; - } -@@ -16764,7 +16767,7 @@ read_array_type (struct die_info *die, struct dwarf2_cu *cu) - byte_stride_prop - = (struct dynamic_prop *) alloca (sizeof (struct dynamic_prop)); - stride_ok = attr_to_dynamic_prop (attr, die, cu, byte_stride_prop, -- prop_type); -+ prop_type, NULL, 0); - if (!stride_ok) - { - complaint (_("unable to read array DW_AT_byte_stride " -@@ -17522,7 +17525,7 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu) - struct attribute *attr; - struct dynamic_prop prop; - bool length_is_constant = true; -- LONGEST length; -+ ULONGEST length = UINT_MAX; - - /* There are a couple of places where bit sizes might be made use of - when parsing a DW_TAG_string_type, however, no producer that we know -@@ -17543,6 +17546,10 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu) - } - } - -+ index_type = objfile_type (objfile)->builtin_int; -+ range_type = create_static_range_type (NULL, index_type, 1, length); -+ -+ /* If DW_AT_string_length is defined, the length is stored in memory. */ - attr = dwarf2_attr (die, DW_AT_string_length, cu); - if (attr != nullptr && !attr->form_is_constant ()) - { -@@ -17569,13 +17576,68 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu) - } - - /* Convert the attribute into a dynamic property. */ -- if (!attr_to_dynamic_prop (attr, die, cu, &prop, prop_type)) -+ if (!attr_to_dynamic_prop (attr, die, cu, &prop, prop_type, NULL, 0)) - length = 1; - else - length_is_constant = false; - } - else if (attr != nullptr) - { -+ if (attr->form_is_block ()) -+ { -+ 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 in combination with -+ DW_AT_bit_size. */ -+ if (byte_size != NULL && bit_size != NULL) -+ complaint (_("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, -+ DW_AT_byte_size describes the number of bytes that should be read -+ from the length memory location. */ -+ if (byte_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. */ -+ (gdb_byte) DW_UNSND(byte_size) }; -+ -+ if (!attr_to_dynamic_prop (attr, die, cu, &high, index_type, -+ append_ops, ARRAY_SIZE(append_ops))) -+ complaint (_("Could not parse DW_AT_byte_size")); -+ } -+ else if (bit_size != NULL) -+ complaint (_("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, index_type, -+ append_ops, ARRAY_SIZE(append_ops))) -+ complaint (_("Could not parse DW_AT_string_length")); -+ } -+ -+ range_type->bounds ()->high = high; -+ } -+ else -+ range_type->bounds ()->high.set_const_val (DW_UNSND(attr)); -+ - /* This DW_AT_string_length just contains the length with no - indirection. There's no need to create a dynamic property in this - case. Pass 0 for the default value as we know it will not be -@@ -17589,6 +17651,14 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu) - } - else - { -+ /* 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) -+ range_type->bounds ()->high.set_const_val (DW_UNSND(attr)); -+ else -+ range_type->bounds ()->high.set_const_val (1); -+ - /* Use 1 as a fallback length if we have nothing else. */ - length = 1; - } -@@ -17603,6 +17673,7 @@ read_tag_string_type (struct die_info *die, struct dwarf2_cu *cu) - low_bound.set_const_val (1); - range_type = create_range_type (NULL, index_type, &low_bound, &prop, 0); - } -+ - char_type = language_string_char_type (cu->language_defn, gdbarch); - type = create_string_type (NULL, char_type, range_type); - -@@ -18078,7 +18149,8 @@ read_base_type (struct die_info *die, 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, -- struct type *default_type) -+ struct type *default_type, -+ const gdb_byte *additional_data, int additional_data_size) - { - struct dwarf2_property_baton *baton; - dwarf2_per_objfile *per_objfile = cu->per_objfile; -@@ -18108,6 +18180,26 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, - break; - } - -+ if (additional_data != NULL && additional_data_size > 0) -+ { -+ gdb_byte *data; -+ -+ data = (gdb_byte *) obstack_alloc( -+ &cu->per_objfile->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->set_locexpr (baton); - gdb_assert (prop->baton () != NULL); - } -@@ -18142,11 +18234,31 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die, - baton->property_type = die_type (target_die, target_cu); - baton->locexpr.per_cu = cu->per_cu; - baton->locexpr.per_objfile = per_objfile; -- baton->locexpr.size = DW_BLOCK (target_attr)->size; -- baton->locexpr.data = DW_BLOCK (target_attr)->data; - baton->locexpr.is_reference = true; -+ -+ if (additional_data != NULL && additional_data_size > 0) -+ { -+ gdb_byte *data; -+ -+ data = (gdb_byte *) obstack_alloc (&cu->per_objfile->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->set_locexpr (baton); -- gdb_assert (prop->baton () != NULL); -+ gdb_assert (prop->baton() != NULL); - } - else - { -@@ -18308,8 +18420,8 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - } - - attr = dwarf2_attr (die, DW_AT_lower_bound, cu); -- if (attr != nullptr) -- attr_to_dynamic_prop (attr, die, cu, &low, base_type); -+ if (attr) -+ attr_to_dynamic_prop (attr, die, cu, &low, base_type, NULL, 0); - else if (!low_default_is_valid) - complaint (_("Missing DW_AT_lower_bound " - "- DIE at %s [in module %s]"), -@@ -18318,10 +18430,10 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - - struct attribute *attr_ub, *attr_count; - attr = attr_ub = dwarf2_attr (die, DW_AT_upper_bound, cu); -- if (!attr_to_dynamic_prop (attr, die, cu, &high, base_type)) -+ if (!attr_to_dynamic_prop (attr, die, cu, &high, base_type, NULL, 0)) - { - attr = attr_count = dwarf2_attr (die, DW_AT_count, cu); -- if (attr_to_dynamic_prop (attr, die, cu, &high, base_type)) -+ if (attr_to_dynamic_prop (attr, die, cu, &high, base_type, NULL, 0)) - { - /* If bounds are constant do the final calculation here. */ - if (low.kind () == PROP_CONST && high.kind () == PROP_CONST) -@@ -18372,7 +18484,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - { - struct type *prop_type = cu->addr_sized_int_type (false); - attr_to_dynamic_prop (attr_byte_stride, die, cu, &byte_stride_prop, -- prop_type); -+ prop_type, NULL, 0); - } - - struct dynamic_prop bit_stride_prop; -@@ -18392,7 +18504,7 @@ read_subrange_type (struct die_info *die, struct dwarf2_cu *cu) - { - struct type *prop_type = cu->addr_sized_int_type (false); - attr_to_dynamic_prop (attr_bit_stride, die, cu, &bit_stride_prop, -- prop_type); -+ prop_type, NULL, 0); - } - } - -@@ -24424,7 +24536,7 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) - if (attr != NULL) - { - struct type *prop_type = cu->addr_sized_int_type (false); -- if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type)) -+ if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type, NULL, 0)) - type->add_dyn_prop (DYN_PROP_ALLOCATED, prop); - } - -@@ -24433,13 +24545,13 @@ set_die_type (struct die_info *die, struct type *type, struct dwarf2_cu *cu) - if (attr != NULL) - { - struct type *prop_type = cu->addr_sized_int_type (false); -- if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type)) -+ if (attr_to_dynamic_prop (attr, die, cu, &prop, prop_type, NULL, 0)) - type->add_dyn_prop (DYN_PROP_ASSOCIATED, 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, cu->addr_type ())) -+ if (attr_to_dynamic_prop (attr, die, cu, &prop, cu->addr_type (), NULL, 0)) - type->add_dyn_prop (DYN_PROP_DATA_LOCATION, prop); - - if (per_objfile->die_type_hash == NULL) -diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c ---- a/gdb/f-typeprint.c -+++ b/gdb/f-typeprint.c -@@ -217,8 +217,9 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, - else - { - LONGEST lower_bound = f77_get_lowerbound (type); -+ - if (lower_bound != 1) /* Not the default. */ -- fprintf_filtered (stream, "%s:", plongest (lower_bound)); -+ fprintf_filtered (stream, "%s:", plongest (lower_bound)); - - /* Make sure that, if we have an assumed size array, we - print out a warning and print the upperbound as '*'. */ -@@ -229,7 +230,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, - { - LONGEST upper_bound = f77_get_upperbound (type); - -- fputs_filtered (plongest (upper_bound), stream); -+ fprintf_filtered (stream, "%s", plongest (upper_bound)); - } - } - -@@ -249,7 +250,7 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, - case TYPE_CODE_REF: - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0, - arrayprint_recurse_level, false); -- fprintf_filtered (stream, " )"); -+ fprintf_filtered (stream, ")"); - break; - - case TYPE_CODE_FUNC: -diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c ---- a/gdb/gdbtypes.c -+++ b/gdb/gdbtypes.c -@@ -1977,7 +1977,8 @@ is_dynamic_type_internal (struct type *type, int top_level) - type = check_typedef (type); - - /* We only want to recognize references at the outermost level. */ -- if (top_level && type->code () == TYPE_CODE_REF) -+ if (top_level && -+ (type->code () == TYPE_CODE_REF || type-> code() == TYPE_CODE_PTR)) - type = check_typedef (TYPE_TARGET_TYPE (type)); - - /* Types that have a dynamic TYPE_DATA_LOCATION are considered -@@ -2017,10 +2018,10 @@ is_dynamic_type_internal (struct type *type, int top_level) - || is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0)); - } - -- case TYPE_CODE_STRING: - /* Strings are very much like an array of characters, and can be - treated as one here. */ - case TYPE_CODE_ARRAY: -+ case TYPE_CODE_STRING: - { - gdb_assert (type->num_fields () == 1); - -@@ -2183,11 +2184,15 @@ resolve_dynamic_array_or_string (struct type *type, - - ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type)); - -- if (ary_dim != NULL && ary_dim->code () == TYPE_CODE_ARRAY) -+ if (ary_dim != NULL && (ary_dim->code () == TYPE_CODE_ARRAY -+ || ary_dim->code () == TYPE_CODE_STRING)) - elt_type = resolve_dynamic_array_or_string (ary_dim, addr_stack); - else - elt_type = TYPE_TARGET_TYPE (type); - -+ if (type->code () == TYPE_CODE_STRING) -+ return create_string_type (type, elt_type, range_type); -+ - prop = type->dyn_prop (DYN_PROP_BYTE_STRIDE); - if (prop != NULL) - { -@@ -2533,6 +2538,25 @@ resolve_dynamic_struct (struct type *type, - return resolved_type; - } - -+/* Worker for pointer types. */ -+ -+static struct type * -+resolve_dynamic_pointer (struct type *type, -+ struct property_addr_info *addr_stack) -+{ -+ struct dynamic_prop *prop; -+ CORE_ADDR value; -+ -+ type = copy_type (type); -+ -+ /* Resolve associated property. */ -+ prop = TYPE_ASSOCIATED_PROP (type); -+ if (prop != NULL && dwarf2_evaluate_property (prop, NULL, addr_stack, &value)) -+ prop->set_const_val (value); -+ -+ return type; -+} -+ - /* Worker for resolved_dynamic_type. */ - - static struct type * -@@ -2594,6 +2618,9 @@ resolve_dynamic_type_internal (struct type *type, - case TYPE_CODE_ARRAY: - resolved_type = resolve_dynamic_array_or_string (type, addr_stack); - break; -+ case TYPE_CODE_PTR: -+ resolved_type = resolve_dynamic_pointer (type, addr_stack); -+ break; - - case TYPE_CODE_RANGE: - resolved_type = resolve_dynamic_range (type, addr_stack); -diff --git a/gdb/testsuite/gdb.cp/vla-cxx.cc b/gdb/testsuite/gdb.cp/vla-cxx.cc ---- a/gdb/testsuite/gdb.cp/vla-cxx.cc -+++ b/gdb/testsuite/gdb.cp/vla-cxx.cc -@@ -15,6 +15,10 @@ - You should have received a copy of the GNU General Public License - along with this program. If not, see . */ - -+extern "C" { -+#include -+} -+ - struct container; - - struct element -@@ -40,11 +44,16 @@ int main(int argc, char **argv) - typedef typeof (vla) &vlareftypedef; - vlareftypedef vlaref2 (vla); - container c; -+ typeof (vla) *ptr = NULL; -+ -+ // Before pointer assignment -+ ptr = &vla; - - for (int i = 0; i < z; ++i) - vla[i] = 5 + 2 * i; - - // vlas_filled - vla[0] = 2 * vla[0]; -+ - return vla[2]; - } -diff --git a/gdb/testsuite/gdb.cp/vla-cxx.exp b/gdb/testsuite/gdb.cp/vla-cxx.exp ---- a/gdb/testsuite/gdb.cp/vla-cxx.exp -+++ b/gdb/testsuite/gdb.cp/vla-cxx.exp -@@ -23,6 +23,12 @@ if ![runto_main] { - return -1 - } - -+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] -+gdb_continue_to_breakpoint "Before pointer assignment" -+gdb_test "ptype ptr" "int \\(\\*\\)\\\[variable length\\\]" "ptype ptr, Before pointer assignment" -+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[variable length\\\]\\) 0x0" "print ptr, Before pointer assignment" -+gdb_test "print *ptr" "Cannot access memory at address 0x0" "print *ptr, Before pointer assignment" -+ - gdb_breakpoint [gdb_get_line_number "vlas_filled"] - gdb_continue_to_breakpoint "vlas_filled" - -@@ -33,3 +39,6 @@ gdb_test "print vlaref" " = \\(int \\(&\\)\\\[3\\\]\\) @$hex: \\{5, 7, 9\\}" - # bug being tested, it's better not to depend on the exact spelling. - gdb_test "print vlaref2" " = \\(.*\\) @$hex: \\{5, 7, 9\\}" - gdb_test "print c" " = \\{e = \\{c = @$hex\\}\\}" -+gdb_test "ptype ptr" "int \\(\\*\\)\\\[3\\\]" -+gdb_test "print ptr" "\\(int \\(\\*\\)\\\[3\\\]\\) $hex" -+gdb_test "print *ptr" " = \\{5, 7, 9\\}" -diff --git a/gdb/testsuite/gdb.fortran/pointers.exp b/gdb/testsuite/gdb.fortran/pointers.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/pointers.exp -@@ -0,0 +1,143 @@ -+# Copyright 2016 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+standard_testfile "pointers.f90" -+load_lib fortran.exp -+ -+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ -+ {debug f90 quiet}] } { -+ return -1 -+} -+ -+if ![runto_main] { -+ untested "could not run to main" -+ return -1 -+} -+ -+# Depending on the compiler being used, the type names can be printed differently. -+set logical [fortran_logical4] -+set real [fortran_real4] -+set int [fortran_int4] -+set complex [fortran_complex4] -+ -+ -+gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] -+gdb_continue_to_breakpoint "Before pointer assignment" -+gdb_test "print logp" "= \\(PTR TO -> \\( $logical\\)\\) 0x0" "print logp, not associated" -+gdb_test "print *logp" "Cannot access memory at address 0x0" "print *logp, not associated" -+gdb_test "print comp" "= \\(PTR TO -> \\( $complex\\)\\) 0x0" "print comp, not associated" -+gdb_test "print *comp" "Cannot access memory at address 0x0" "print *comp, not associated" -+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1\\)\\) 0x0" "print charp, not associated" -+gdb_test "print *charp" "Cannot access memory at address 0x0" "print *charp, not associated" -+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3\\)\\) 0x0" "print charap, not associated" -+gdb_test "print *charap" "Cannot access memory at address 0x0" "print *charap, not associated" -+gdb_test "print intp" "= \\(PTR TO -> \\( $int\\)\\) 0x0" "print intp, not associated" -+gdb_test "print *intp" "Cannot access memory at address 0x0" "print *intp, not associated" -+set test "print intap, not associated" -+gdb_test_multiple "print intap" $test { -+ -re " = \\(PTR TO -> \\( $int \\(:,:\\)\\)\\) \r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re " = \r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+gdb_test "print realp" "= \\(PTR TO -> \\( $real\\)\\) 0x0" "print realp, not associated" -+gdb_test "print *realp" "Cannot access memory at address 0x0" "print *realp, not associated" -+gdb_test "print \$my_var = intp" "= \\(PTR TO -> \\( $int\\)\\) 0x0" -+set test "print cyclicp1, not associated" -+gdb_test_multiple "print cyclicp1" $test { -+ -re "= \\( i = -?\\d+, p = 0x0 \\)\r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re "= \\( i = -?\\d+, p = \\)\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+set test "print cyclicp1%p, not associated" -+gdb_test_multiple "print cyclicp1%p" $test { -+ -re "= \\(PTR TO -> \\( Type typewithpointer\\)\\) 0x0\r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re "= \\(PTR TO -> \\( Type typewithpointer\\)\\) \r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+ -+ -+gdb_breakpoint [gdb_get_line_number "Before value assignment"] -+gdb_continue_to_breakpoint "Before value assignment" -+gdb_test "print *(twop)%ivla2" "= " -+ -+ -+gdb_breakpoint [gdb_get_line_number "After value assignment"] -+gdb_continue_to_breakpoint "After value assignment" -+gdb_test "print logp" "= \\(PTR TO -> \\( $logical\\)\\) $hex\( <.*>\)?" -+gdb_test "print *logp" "= \\.TRUE\\." -+gdb_test "print comp" "= \\(PTR TO -> \\( $complex\\)\\) $hex\( <.*>\)?" -+gdb_test "print *comp" "= \\(1,2\\)" -+gdb_test "print charp" "= \\(PTR TO -> \\( character\\*1\\)\\) $hex\( <.*>\)?" -+gdb_test "print *charp" "= 'a'" -+gdb_test "print charap" "= \\(PTR TO -> \\( character\\*3\\)\\) $hex\( <.*>\)?" -+gdb_test "print *charap" "= 'abc'" -+gdb_test "print intp" "= \\(PTR TO -> \\( $int\\)\\) $hex\( <.*>\)?" -+gdb_test "print *intp" "= 10" -+set test_name "print intap, associated" -+gdb_test_multiple "print intap" $test_name { -+ -re "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)\r\n$gdb_prompt $" { -+ pass $test_name -+ } -+ -re "= \\(PTR TO -> \\( $int \\(10,2\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" { -+ gdb_test "print *intap" "= \\(\\( 1, 1, 3(, 1){7}\\) \\( 1(, 1){9}\\) \\)" -+ pass $test_name -+ } -+} -+set test_name "print intvlap, associated" -+gdb_test_multiple "print intvlap" $test_name { -+ -re "= \\(2, 2, 2, 4(, 2){6}\\)\r\n$gdb_prompt $" { -+ pass $test_name -+ } -+ -re "= \\(PTR TO -> \\( $int \\(10\\)\\)\\) $hex\( <.*>\)?\r\n$gdb_prompt $" { -+ gdb_test "print *intvlap" "= \\(2, 2, 2, 4(, 2){6}\\)" -+ pass $test_name -+ } -+} -+gdb_test "print realp" "= \\(PTR TO -> \\( $real\\)\\) $hex\( <.*>\)?" -+gdb_test "print *realp" "= 3\\.14000\\d+" -+gdb_test "print arrayOfPtr(2)%p" "= \\(PTR TO -> \\( Type two\\)\\) $hex\( <.*>\)?" -+gdb_test "print *(arrayOfPtr(2)%p)" "= \\( ivla1 = \\(11, 12, 13\\), ivla2 = \\(\\( 211, 221\\) \\( 212, 222\\) \\) \\)" -+set test_name "print arrayOfPtr(3)%p" -+gdb_test_multiple $test_name $test_name { -+ -re "= \\(PTR TO -> \\( Type two\\)\\) \r\n$gdb_prompt $" { -+ pass $test_name -+ } -+ -re "= \\(PTR TO -> \\( Type two\\)\\) 0x0\r\n$gdb_prompt $" { -+ pass $test_name -+ } -+} -+set test_name "print *(arrayOfPtr(3)%p), associated" -+gdb_test_multiple "print *(arrayOfPtr(3)%p)" $test_name { -+ -re "Cannot access memory at address 0x0\r\n$gdb_prompt $" { -+ pass $test_name -+ } -+ -re "Attempt to take contents of a not associated pointer.\r\n$gdb_prompt $" { -+ pass $test_name -+ } -+} -+gdb_test "print cyclicp1" "= \\( i = 1, p = $hex\( <.*>\)? \\)" -+gdb_test "print cyclicp1%p" "= \\(PTR TO -> \\( Type typewithpointer\\)\\) $hex\( <.*>\)?" -+gdb_test "print *((integer*) &inta + 2)" "= 3" "print temporary pointer, array" -+gdb_test "print *((integer*) &intvla + 3)" "= 4" "print temporary pointer, allocated vla" -+gdb_test "print \$pc" "= \\(PTR TO -> \\( void \\(\\) \\(\\)\\)\\) $hex " "Print program counter" -diff --git a/gdb/testsuite/gdb.fortran/pointers.f90 b/gdb/testsuite/gdb.fortran/pointers.f90 ---- a/gdb/testsuite/gdb.fortran/pointers.f90 -+++ b/gdb/testsuite/gdb.fortran/pointers.f90 -@@ -20,21 +20,34 @@ program pointers - integer, allocatable :: ivla2 (:, :) - end type two - -+ type :: typeWithPointer -+ integer i -+ type(typeWithPointer), pointer:: p -+ end type typeWithPointer -+ -+ type :: twoPtr -+ type (two), pointer :: p -+ end type twoPtr -+ - logical, target :: logv - complex, target :: comv - character, target :: charv - character (len=3), target :: chara - integer, target :: intv - integer, target, dimension (10,2) :: inta -- real, target :: realv -- type(two), target :: twov -+ integer, target, allocatable, dimension (:) :: intvla -+ real, target :: realv -+ type(two), target :: twov -+ type(twoPtr) :: arrayOfPtr (3) -+ type(typeWithPointer), target:: cyclicp1,cyclicp2 - - logical, pointer :: logp - complex, pointer :: comp -- character, pointer :: charp -- character (len=3), pointer :: charap -+ character, pointer:: charp -+ character (len=3), pointer:: charap - integer, pointer :: intp - integer, pointer, dimension (:,:) :: intap -+ integer, pointer, dimension (:) :: intvlap - real, pointer :: realp - type(two), pointer :: twop - -@@ -44,8 +57,14 @@ program pointers - nullify (charap) - nullify (intp) - nullify (intap) -+ nullify (intvlap) - nullify (realp) - nullify (twop) -+ nullify (arrayOfPtr(1)%p) -+ nullify (arrayOfPtr(2)%p) -+ nullify (arrayOfPtr(3)%p) -+ nullify (cyclicp1%p) -+ nullify (cyclicp2%p) - - logp => logv ! Before pointer assignment - comp => comv -@@ -53,8 +72,14 @@ program pointers - charap => chara - intp => intv - intap => inta -+ intvlap => intvla - realp => realv - twop => twov -+ arrayOfPtr(2)%p => twov -+ cyclicp1%i = 1 -+ cyclicp1%p => cyclicp2 -+ cyclicp2%i = 2 -+ cyclicp2%p => cyclicp1 - - logv = associated(logp) ! Before value assignment - comv = cmplx(1,2) -@@ -63,6 +88,10 @@ program pointers - intv = 10 - inta(:,:) = 1 - inta(3,1) = 3 -+ allocate (intvla(10)) -+ intvla(:) = 2 -+ intvla(4) = 4 -+ intvlap => intvla - realv = 3.14 - - allocate (twov%ivla1(3)) -diff --git a/gdb/testsuite/gdb.fortran/print_type.exp b/gdb/testsuite/gdb.fortran/print_type.exp ---- a/gdb/testsuite/gdb.fortran/print_type.exp -+++ b/gdb/testsuite/gdb.fortran/print_type.exp -@@ -1,5 +1,6 @@ - # Copyright 2019-2020 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 -@@ -42,7 +43,7 @@ set complex [fortran_complex4] - # matches the string TYPE. - proc check_pointer_type { var_name type } { - gdb_test "ptype ${var_name}" \ -- "type = PTR TO -> \\( ${type} \\)" -+ "type = PTR TO -> \\( ${type}\\)" - } - - gdb_breakpoint [gdb_get_line_number "Before pointer assignment"] -@@ -87,7 +88,8 @@ gdb_test "ptype twop" \ - [multi_line "type = PTR TO -> \\( Type two" \ - " $int, allocatable :: ivla1\\(:\\)" \ - " $int, allocatable :: ivla2\\(:,:\\)" \ -- "End Type two \\)"] -+ "End Type two\\)"] -+ - - gdb_breakpoint [gdb_get_line_number "After value assignment"] - gdb_continue_to_breakpoint "After value assignment" -@@ -99,11 +101,11 @@ gdb_test "ptype intv" "type = $int" - gdb_test "ptype inta" "type = $int \\(10,2\\)" - gdb_test "ptype realv" "type = $real" - --gdb_test "ptype logp" "type = PTR TO -> \\( $logical \\)" --gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" --gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" --gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" --gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" -+gdb_test "ptype logp" "type = PTR TO -> \\( $logical\\)" -+gdb_test "ptype comp" "type = PTR TO -> \\( $complex\\)" -+gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1\\)" -+gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3\\)" -+gdb_test "ptype intp" "type = PTR TO -> \\( $int\\)" - set test "ptype intap" - gdb_test_multiple $test $test { - -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" { -@@ -113,4 +115,4 @@ gdb_test_multiple $test $test { - pass $test - } - } --gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" -+gdb_test "ptype realp" "type = PTR TO -> \\( $real\\)" -diff --git a/gdb/testsuite/gdb.fortran/vla-strings.exp b/gdb/testsuite/gdb.fortran/vla-strings.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-strings.exp -@@ -0,0 +1,103 @@ -+# Copyright 2016 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 3 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program. If not, see . -+ -+standard_testfile ".f90" -+ -+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ -+ {debug f90 quiet}] } { -+ return -1 -+} -+ -+# check that all fortran standard datatypes will be -+# handled correctly when using as VLA's -+ -+if ![runto_main] { -+ untested "could not run to main" -+ return -1 -+} -+ -+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"] -+gdb_continue_to_breakpoint "var_char-allocated-1" -+set test "whatis var_char first time" -+gdb_test_multiple "whatis var_char" $test { -+ -re "type = PTR TO -> \\( character\\*10\\)\r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re "type = character\\*10\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+set test "ptype var_char first time" -+gdb_test_multiple "ptype var_char" $test { -+ -re "type = PTR TO -> \\( character\\*10\\)\r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re "type = character\\*10\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+ -+ -+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" -+set test "print var_char, var_char-filled-1" -+gdb_test_multiple "print var_char" $test { -+ -re "= \\(PTR TO -> \\( character\\*3\\)\\) $hex\r\n$gdb_prompt $" { -+ gdb_test "print *var_char" "= 'foo'" "print *var_char, var_char-filled-1" -+ pass $test -+ } -+ -re "= 'foo'\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+set test "ptype var_char, var_char-filled-1" -+gdb_test_multiple "ptype var_char" $test { -+ -re "type = PTR TO -> \\( character\\*3\\)\r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re "type = character\\*3\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+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" -+set test "print var_char, var_char-filled-2" -+gdb_test_multiple "print var_char" $test { -+ -re "= \\(PTR TO -> \\( character\\*6\\)\\) $hex\r\n$gdb_prompt $" { -+ gdb_test "print *var_char" "= 'foobar'" "print *var_char, var_char-filled-2" -+ pass $test -+ } -+ -re "= 'foobar'\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -+set test "ptype var_char, var_char-filled-2" -+gdb_test_multiple "ptype var_char" $test { -+ -re "type = PTR TO -> \\( character\\*6\\)\r\n$gdb_prompt $" { -+ pass $test -+ } -+ -re "type = character\\*6\r\n$gdb_prompt $" { -+ pass $test -+ } -+} -diff --git a/gdb/testsuite/gdb.fortran/vla-strings.f90 b/gdb/testsuite/gdb.fortran/vla-strings.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-strings.f90 -@@ -0,0 +1,39 @@ -+! Copyright 2016 Free Software Foundation, Inc. -+! -+! This program is free software; you can redistribute it and/or modify -+! it under the terms of the GNU General Public License as published by -+! the Free Software Foundation; either version 3 of the License, or -+! (at your option) any later version. -+! -+! This program is distributed in the hope that it will be useful, -+! but WITHOUT ANY WARRANTY; without even the implied warranty of -+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+! GNU General Public License for more details. -+! -+! You should have received a copy of the GNU General Public License -+! along with this program. If not, see . -+ -+program vla_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-value.exp b/gdb/testsuite/gdb.fortran/vla-value.exp ---- a/gdb/testsuite/gdb.fortran/vla-value.exp -+++ b/gdb/testsuite/gdb.fortran/vla-value.exp -@@ -37,7 +37,7 @@ 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, allocatable \\\(:,:,:\\\) \\\)\\\) $hex" \ -+ " = \\\(PTR TO -> \\\( $real, allocatable \\\(:,:,:\\\)\\\)\\\) $hex" \ - "print non-allocated &vla1" - gdb_test "print vla1(1,1,1)" "no such vector element \\\(vector not allocated\\\)" \ - "print member in non-allocated vla1 (1)" -@@ -58,7 +58,7 @@ with_timeout_factor 15 { - "step over value assignment of vla1" - } - gdb_test "print &vla1" \ -- " = \\\(PTR TO -> \\\( $real, allocatable \\\(10,10,10\\\) \\\)\\\) $hex" \ -+ " = \\\(PTR TO -> \\\( $real, allocatable \\\(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)" -@@ -78,7 +78,7 @@ gdb_test "print vla1(9, 9, 9)" " = 999" \ - # Try to access values in undefined pointer to VLA (dangling) - gdb_test "print pvla" " = " "print undefined pvla" - gdb_test "print &pvla" \ -- " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\) \\\)\\\) $hex" \ -+ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $hex" \ - "print non-associated &pvla" - gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated\\\)" \ - "print undefined pvla(1,3,8)" -@@ -87,7 +87,7 @@ gdb_test "print pvla(1, 3, 8)" "no such vector element \\\(vector not associated - gdb_breakpoint [gdb_get_line_number "pvla-associated"] - gdb_continue_to_breakpoint "pvla-associated" - gdb_test "print &pvla" \ -- " = \\\(PTR TO -> \\\( $real \\\(10,10,10\\\) \\\)\\\) $hex" \ -+ " = \\\(PTR TO -> \\\( $real \\\(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)" -diff --git a/gdb/typeprint.c b/gdb/typeprint.c ---- a/gdb/typeprint.c -+++ b/gdb/typeprint.c -@@ -565,6 +565,25 @@ whatis_exp (const char *exp, int show) - printf_filtered (" */\n"); - } - -+ /* Resolve any dynamic target type, as we might print -+ additional information about the target. -+ For example, in Fortran and C we are printing the dimension of the -+ dynamic array the pointer is pointing to. */ -+ if (type->code () == TYPE_CODE_PTR -+ && is_dynamic_type (type) == 1) -+ { -+ CORE_ADDR addr; -+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE(type))) -+ addr = value_address (val); -+ else -+ addr = value_as_address (val); -+ -+ if (addr != 0 -+ && type_not_associated (type) == 0) -+ TYPE_TARGET_TYPE (type) = resolve_dynamic_type (TYPE_TARGET_TYPE (type), -+ {}, addr); -+ } -+ - LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags); - printf_filtered ("\n"); - } -diff --git a/gdb/valops.c b/gdb/valops.c ---- a/gdb/valops.c -+++ b/gdb/valops.c -@@ -1553,6 +1553,19 @@ value_ind (struct value *arg1) - if (base_type->code () == TYPE_CODE_PTR) - { - struct type *enc_type; -+ CORE_ADDR addr; -+ -+ if (type_not_associated (base_type)) -+ error (_("Attempt to take contents of a not associated pointer.")); -+ -+ if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type))) -+ addr = value_address (arg1); -+ else -+ addr = value_as_address (arg1); -+ -+ if (addr != 0) -+ TYPE_TARGET_TYPE (base_type) = -+ resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), {}, addr); - - /* We may be pointing to something embedded in a larger object. - Get the real type of the enclosing object. */ -@@ -1570,8 +1583,7 @@ value_ind (struct value *arg1) - else - { - /* Retrieve the enclosing object pointed to. */ -- base_addr = (value_as_address (arg1) -- - value_pointed_to_offset (arg1)); -+ base_addr = (addr - value_pointed_to_offset (arg1)); - } - arg2 = value_at_lazy (enc_type, base_addr); - enc_type = value_type (arg2); -diff --git a/gdb/valprint.c b/gdb/valprint.c ---- a/gdb/valprint.c -+++ b/gdb/valprint.c -@@ -1046,12 +1046,6 @@ value_check_printable (struct value *val, struct ui_file *stream, - return 0; - } - -- if (type_not_associated (value_type (val))) -- { -- val_print_not_associated (stream); -- return 0; -- } -- - if (type_not_allocated (value_type (val))) - { - val_print_not_allocated (stream); diff --git a/gdb-vla-intel-stringbt-fix.patch b/gdb-vla-intel-stringbt-fix.patch deleted file mode 100644 index 1a2bbb1..0000000 --- a/gdb-vla-intel-stringbt-fix.patch +++ /dev/null @@ -1,167 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Jan Kratochvil -Date: Fri, 1 Aug 2014 23:02:17 +0200 -Subject: gdb-vla-intel-stringbt-fix.patch - -;;=push+jan - -http://sourceware.org/ml/gdb-patches/2014-08/msg00025.html - -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 - -diff --git a/gdb/dwarf2/loc.c b/gdb/dwarf2/loc.c ---- a/gdb/dwarf2/loc.c -+++ b/gdb/dwarf2/loc.c -@@ -2249,6 +2249,20 @@ dwarf2_evaluate_loc_desc_full (struct type *type, struct frame_info *frame, - ctx.per_cu = per_cu; - ctx.obj_address = 0; - -+frame_id old_frame_id (get_frame_id (deprecated_safe_get_selected_frame ())); -+class RestoreCall { -+private: -+ const std::function func; -+public: -+ RestoreCall(std::function func_):func(func_) {} -+ ~RestoreCall() { func(); } -+} restore_frame([=]() { -+ frame_info *old_frame (frame_find_by_id (old_frame_id)); -+ if (old_frame != NULL) -+ select_frame (old_frame); -+}); -+if (frame != NULL) select_frame (frame); -+ - scoped_value_mark free_values; - - ctx.gdbarch = per_objfile->objfile->arch (); -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 ---- /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 ---- /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 ---- /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 diff --git a/gdb-vla-intel-tests.patch b/gdb-vla-intel-tests.patch deleted file mode 100644 index bfde742..0000000 --- a/gdb-vla-intel-tests.patch +++ /dev/null @@ -1,350 +0,0 @@ -From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 -From: Fedora GDB patches -Date: Fri, 27 Oct 2017 21:07:50 +0200 -Subject: gdb-vla-intel-tests.patch - -;;=fedoratest - -diff --git a/gdb/testsuite/gdb.fortran/ptr-indentation.exp b/gdb/testsuite/gdb.fortran/ptr-indentation.exp ---- a/gdb/testsuite/gdb.fortran/ptr-indentation.exp -+++ b/gdb/testsuite/gdb.fortran/ptr-indentation.exp -@@ -37,5 +37,5 @@ gdb_continue_to_breakpoint "BP1" - gdb_test "ptype tinsta" \ - [multi_line "type = Type tuserdef" \ - " $int :: i" \ -- " PTR TO -> \\( $real :: ptr \\)" \ -+ " PTR TO -> \\( $real :: ptr\\)" \ - "End Type tuserdef"] -diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp ---- a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp -+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp -@@ -42,7 +42,7 @@ gdb_test "ptype say_numbers" \ - "type = void \\(integer\\(kind=4\\), integer\\(kind=4\\), integer\\(kind=4\\)\\)" - - gdb_test "ptype fun_ptr" \ -- "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\) \\(REF TO -> \\( integer\\(kind=4\\) \\)\\) \\)" -+ "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\) \\(REF TO -> \\( integer\\(kind=4\\)\\)\\)\\)" - - gdb_test "ptype say_string" \ - "type = void \\(character\\*\\(\\*\\), integer\\(kind=\\d+\\)\\)" -diff --git a/gdb/testsuite/gdb.fortran/vla-func.exp b/gdb/testsuite/gdb.fortran/vla-func.exp -new file mode 100644 ---- /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\\\), allocatable \\\(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\\\), allocatable \\\(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 ---- /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, allocatable :: 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-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp ---- a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp -+++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp -@@ -33,5 +33,5 @@ set real4 [fortran_real4] - # Check the status of a pointer to a dynamic array. - gdb_breakpoint [gdb_get_line_number "pvla-associated"] - gdb_continue_to_breakpoint "pvla-associated" --gdb_test "print &pvla" " = \\(PTR TO -> \\( $real4 \\(10,10,10\\) \\)\\) ${hex}" \ -+gdb_test "print &pvla" " = \\(PTR TO -> \\( $real4 \\(10,10,10\\)\\)\\) ${hex}" \ - "print pvla pointer information" -diff --git a/gdb/testsuite/gdb.fortran/vla-stringsold.exp b/gdb/testsuite/gdb.fortran/vla-stringsold.exp -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-stringsold.exp -@@ -0,0 +1,101 @@ -+# 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 "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-stringsold.f90 b/gdb/testsuite/gdb.fortran/vla-stringsold.f90 -new file mode 100644 ---- /dev/null -+++ b/gdb/testsuite/gdb.fortran/vla-stringsold.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/whatis_type.exp b/gdb/testsuite/gdb.fortran/whatis_type.exp ---- a/gdb/testsuite/gdb.fortran/whatis_type.exp -+++ b/gdb/testsuite/gdb.fortran/whatis_type.exp -@@ -44,7 +44,7 @@ gdb_test "whatis t2" "type = Type t2" - gdb_test "whatis t2v" "type = Type t2" - gdb_test "whatis t3" "type = Type t3" - gdb_test "whatis t3v" "type = Type t3" --gdb_test "whatis t3p" "type = PTR TO -> \\( Type t3 \\)" -+gdb_test "whatis t3p" "type = PTR TO -> \\( Type t3\\)" - - gdb_test "ptype t1" \ - [multi_line "type = Type t1" \ -@@ -73,4 +73,4 @@ gdb_test "ptype t3p" \ - [multi_line "type = PTR TO -> \\( Type t3" \ - " $int :: t3_i" \ - " Type t2 :: t2_n" \ -- "End Type t3 \\)"] -+ "End Type t3\\)"] diff --git a/gdb.spec b/gdb.spec index 6e82e2f..45528d1 100644 --- a/gdb.spec +++ b/gdb.spec @@ -33,11 +33,11 @@ Name: %{?scl_prefix}gdb # See timestamp of source gnulib installed into gnulib/ . %global snapgnulib 20200630 %global tarname gdb-%{version} -Version: 10.1 +Version: 10.2 # The release always contains a leading reserved number, start it at 1. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. -Release: 4%{?dist} +Release: 1%{?dist} License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and LGPLv3+ and BSD and Public Domain and GFDL # Do not provide URL for snapshots as the file lasts there only for 2 days. @@ -195,16 +195,6 @@ Source7: v%{libipt_version}.tar.gz #=fedora Patch1142: v1.5-libipt-static.patch -## [testsuite] Fix false selftest.exp FAIL from system readline-6.3+ (Patrick Palka). -##=fedoratest -#Patch1075: gdb-testsuite-readline63-sigint.patch -##=fedoratest -Patch1119: gdb-testsuite-readline63-sigint-revert.patch - -# Fix broken configure tests compromised by LTO -#push=Should be pushed upstream. -Patch2000: gdb-config.patch - # Include the auto-generated file containing the "Patch:" directives. # See README.local-patches for more details. Patch9998: _gdb.spec.Patch.include @@ -477,23 +467,6 @@ find -name "*.info*"|xargs rm -f # See README.local-patches for more details. %include %{PATCH9999} -%if 0%{!?el6:1} -for i in \ - gdb/python/lib/gdb/FrameWrapper.py \ - gdb/python/lib/gdb/backtrace.py \ - gdb/python/lib/gdb/command/backtrace.py \ - ;do - test -e $i - : >$i -done -%endif - -%if 0%{?rhel:1} && 0%{?rhel} <= 7 -%patch1119 -p1 -%endif - -%patch2000 -p1 - # The above patches twiddle a .m4 file for configure, so update the affected # configure files pushd libiberty @@ -788,8 +761,6 @@ perl -i.relocatable -pe 's/^(D\[".*_RELOCATABLE"\]=" )1(")$/${1}0$2/' gdb/config %make_build CFLAGS="$CFLAGS $FPROFILE_CFLAGS" LDFLAGS="$LDFLAGS $FPROFILE_CFLAGS" V=1 ! grep '_RELOCATABLE.*1' gdb/config.h -grep '^#define HAVE_LIBSELINUX 1$' gdb/config.h -grep '^#define HAVE_SELINUX_SELINUX_H 1$' gdb/config.h if [ "$fprofile" = "-fprofile" ] then @@ -1071,13 +1042,6 @@ rm -f $RPM_BUILD_ROOT%{_datadir}/gdb/system-gdbinit/elinos.py rm -f $RPM_BUILD_ROOT%{_datadir}/gdb/system-gdbinit/wrs-linux.py rmdir $RPM_BUILD_ROOT%{_datadir}/gdb/system-gdbinit -# Patch848: gdb-dts-rhel6-python-compat.patch -%if 0%{!?el6:1} -rm -f $RPM_BUILD_ROOT%{_datadir}/gdb/python/gdb/FrameWrapper.py -rm -f $RPM_BUILD_ROOT%{_datadir}/gdb/python/gdb/backtrace.py -rm -f $RPM_BUILD_ROOT%{_datadir}/gdb/python/gdb/command/backtrace.py -%endif - %files # File must begin with "/": {GFDL,COPYING3,COPYING,COPYING.LIB,COPYING3.LIB} %if 0%{!?el6:1} @@ -1184,6 +1148,49 @@ fi %endif %changelog +* Thu Jun 24 2021 Kevin Buettner - 10.2-1 +- Rebase to FSF GDB 10.2. +- Drop gdb-6.3-test-pie-20050107.patch. +- Drop gdb-6.3-test-self-20050110.patch. +- Drop gdb-6.5-bz218379-ppc-solib-trampoline-test.patch. +- Drop gdb-6.6-buildid-locate-core-as-arg.patch. +- Drop gdb-6.8-quit-never-aborts.patch. +- Drop gdb-archer-pie-addons-keep-disabled.patch. +- Drop gdb-archer-pie-addons.patch. +- Drop gdb-archer-vla-tests.patch. +- Drop gdb-archer.patch. +- Drop gdb-attach-fail-reasons-5of5.patch. +- Drop gdb-btrobust.patch. +- Drop gdb-bz1219747-attach-kills.patch. +- Drop gdb-bz533176-fortran-omp-step.patch. +- Drop gdb-dts-rhel6-python-compat.patch. +- Drop gdb-gnat-dwarf-crash-3of3.patch. +- Drop gdb-jit-reader-multilib.patch. +- Drop gdb-moribund-utrace-workaround.patch. +- Drop gdb-rhbz1930528-fix-gnulib-build-error.patch. +- Drop gdb-rhbz1932645-aarch64-ptrace-header-order.patch. +- Drop gdb-vla-intel-fix-print-char-array.patch. +- Drop gdb-vla-intel-fortran-strides.patch. +- Drop gdb-vla-intel-stringbt-fix.patch. +- Drop gdb-vla-intel-tests.patch. +- Drop process_psymtab_comp_unit-type-unit.patch. +- Drop gdb-testsuite-readline63-sigint-revert.patch. +- Drop gdb-config.patch. +- Add following upstream patches for Fortran stride / slice support: + gdb-rhbz1964167-convert-enum-range_type.patch + gdb-rhbz1964167-fortran-array-slices-at-prompt.patch + gdb-rhbz1964167-fortran-array-strides-in-expressions.patch + gdb-rhbz1964167-fortran-clean-up-array-expression-evaluation.patch + gdb-rhbz1964167-fortran-range_type-to-range_flag.patch + gdb-rhbz1964167-fortran-whitespace_array.patch + gdb-rhbz1964167-move-fortran-expr-handling.patch +- Backport "Exclude debuginfo files from 'outside ELF segments' warning". + (Keith Seitz, RH BZ 1898252) +- Backport "Fix crash when expanding partial symtab..." + (Tom Tromey. gdb/27743) +- Backport "[gdb/server] Don't overwrite fs/gs_base with -m32" +- (Tom de Vries) + * Thu Mar 11 2021 Kevin Buettner - 10.1-4 - Update libipt to version 2.0.4. diff --git a/sources b/sources index 5758b05..ecc7784 100644 --- a/sources +++ b/sources @@ -1,3 +1,3 @@ SHA512 (gdb-libstdc++-v3-python-8.1.1-20180626.tar.xz) = a8b1c54dd348cfeb37da73f968742896be3dd13a4215f8d8519870c2abea915f5176c3fa6989ddd10f20020a16f0fab20cbae68ee8d58a82234d8778023520f8 -SHA512 (gdb-10.1.tar.xz) = 0dc54380435c6853db60f1e388b94836d294dfa9ad7f518385a27db4edd03cb970f8717d5f1e9c9a0d4a33d7fcf91bc2e5d6c9cf9e4b561dcc74e65b806c1537 SHA512 (v2.0.4.tar.gz) = 596d2dac25fdbd3e5660d7e1feeb7e8d5d359d1d0e19b62ef593449037df236db1d4d98820f0031061b5573ed67797a85a77fb9991e215abaabc4bfe16ceaec8 +SHA512 (gdb-10.2.tar.xz) = 3653762ac008e065c37cd641653184c9ff7ce51ee2222ade1122bec9d6cc64dffd4fb74888ef11ac1942064a08910e96b7865112ad37f4602eb0a16bed074caa From 037f6d3daff16b79f15cc015bd2b5080172177b7 Mon Sep 17 00:00:00 2001 From: Bruno Larsen Date: Thu, 23 Sep 2021 10:50:55 -0300 Subject: [PATCH 2/7] Backport [gdb/cli] Don't assert on empty string for core-file (Tom de Vries) Resolves: RHBZ 1916516 --- _gdb.spec.Patch.include | 4 ++ _gdb.spec.patch.include | 1 + _patch_order | 1 + ...16516-pathstuff.cc132-internal-error.patch | 67 +++++++++++++++++++ gdb.spec | 6 +- 5 files changed, 78 insertions(+), 1 deletion(-) create mode 100644 gdb-rhbz1916516-pathstuff.cc132-internal-error.patch diff --git a/_gdb.spec.Patch.include b/_gdb.spec.Patch.include index 6374bfc..b8a5eae 100644 --- a/_gdb.spec.Patch.include +++ b/_gdb.spec.Patch.include @@ -364,3 +364,7 @@ Patch087: gdb-gdb27743-psymtab-imported-unit.patch # (Tom de Vries) Patch088: gdb-dont-overwrite-fsgsbase-m32.patch +#[gdb/cli] Don't assert on empty string for core-file +#(Tom de Vries) +Patch089: gdb-rhbz1916516-pathstuff.cc132-internal-error.patch + diff --git a/_gdb.spec.patch.include b/_gdb.spec.patch.include index b6c1352..dd1a19f 100644 --- a/_gdb.spec.patch.include +++ b/_gdb.spec.patch.include @@ -86,3 +86,4 @@ %patch086 -p1 %patch087 -p1 %patch088 -p1 +%patch089 -p1 diff --git a/_patch_order b/_patch_order index 1293fad..b171f1b 100644 --- a/_patch_order +++ b/_patch_order @@ -86,3 +86,4 @@ gdb-rhbz1964167-fortran-fix-type-format-mismatch-in-f-lang.c.patch gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch gdb-gdb27743-psymtab-imported-unit.patch gdb-dont-overwrite-fsgsbase-m32.patch +gdb-rhbz1916516-pathstuff.cc132-internal-error.patch diff --git a/gdb-rhbz1916516-pathstuff.cc132-internal-error.patch b/gdb-rhbz1916516-pathstuff.cc132-internal-error.patch new file mode 100644 index 0000000..6801743 --- /dev/null +++ b/gdb-rhbz1916516-pathstuff.cc132-internal-error.patch @@ -0,0 +1,67 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Tom de Vries +Date: Mon, 30 Aug 2021 16:03:15 +0200 +Subject: gdb-rhbz1916516-pathstuff.cc132-internal-error.patch + +;;[gdb/cli] Don't assert on empty string for core-file +;;(Tom de Vries) + +With current gdb we run into: +... +$ gdb -batch '' '' +: No such file or directory. +pathstuff.cc:132: internal-error: \ + gdb::unique_xmalloc_ptr gdb_abspath(const char*): \ + Assertion `path != NULL && path[0] != '\0'' failed. +... + +Fix this by skipping the call to gdb_abspath in core_target_open in the +empty-string case, such that we have instead: +... +$ gdb -batch '' '' +: No such file or directory. +: No such file or directory. +$ +... + +Tested on x86_64-linux. + +gdb/ChangeLog: + +2021-08-30 Tom de Vries + + PR cli/28290 + * gdb/corelow.c (core_target_open): Skip call to gdb_abspath in the + empty-string case. + +gdb/testsuite/ChangeLog: + +2021-08-30 Tom de Vries + + PR cli/28290 + * gdb.base/batch-exit-status.exp: Add gdb '' and gdb '' '' tests. + +diff --git a/gdb/corelow.c b/gdb/corelow.c +--- a/gdb/corelow.c ++++ b/gdb/corelow.c +@@ -446,7 +446,8 @@ core_target_open (const char *arg, int from_tty) + } + + gdb::unique_xmalloc_ptr filename (tilde_expand (arg)); +- if (!IS_ABSOLUTE_PATH (filename.get ())) ++ if (strlen (filename.get ()) != 0 ++ && !IS_ABSOLUTE_PATH (filename.get ())) + filename = gdb_abspath (filename.get ()); + + flags = O_BINARY | O_LARGEFILE; +diff --git a/gdb/testsuite/gdb.base/batch-exit-status.exp b/gdb/testsuite/gdb.base/batch-exit-status.exp +--- a/gdb/testsuite/gdb.base/batch-exit-status.exp ++++ b/gdb/testsuite/gdb.base/batch-exit-status.exp +@@ -76,3 +76,7 @@ test_exit_status 1 "-batch -x $good_commands -x $bad_commands" \ + "-batch -x good-commands -x bad-commands" + test_exit_status 1 "-batch -x $good_commands -ex \"set not-a-thing 4\"" \ + "-batch -x good-commands -ex \"set not-a-thing 4\"" ++ ++set no_such_re ": No such file or directory\\." ++test_exit_status 1 "-batch \"\"" $no_such_re ++test_exit_status 1 "-batch \"\" \"\"" [multi_line $no_such_re $no_such_re] diff --git a/gdb.spec b/gdb.spec index 45528d1..30b5488 100644 --- a/gdb.spec +++ b/gdb.spec @@ -37,7 +37,7 @@ Version: 10.2 # The release always contains a leading reserved number, start it at 1. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. -Release: 1%{?dist} +Release: 2%{?dist} License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and LGPLv3+ and BSD and Public Domain and GFDL # Do not provide URL for snapshots as the file lasts there only for 2 days. @@ -1148,6 +1148,10 @@ fi %endif %changelog +* Thu Sep 23 2021 Bruno Larsen - 10.2-2 +- Backport "[gdb/cli] Don't assert on empty string for core-file" + (Tom de Vries) + * Thu Jun 24 2021 Kevin Buettner - 10.2-1 - Rebase to FSF GDB 10.2. - Drop gdb-6.3-test-pie-20050107.patch. From 1f44109aba476f876b1c1deea801b54d7afe0d73 Mon Sep 17 00:00:00 2001 From: Bruno Larsen Date: Thu, 23 Sep 2021 12:05:47 -0300 Subject: [PATCH 3/7] Backport [gdb] Improve early exits for env var in debuginfod-support.c (Tom de Vries) Resolves: RHBZ 1970741 --- _gdb.spec.Patch.include | 4 ++ _gdb.spec.patch.include | 1 + _patch_order | 1 + ...-early-exit-for-empty-debuginfod-url.patch | 51 +++++++++++++++++++ gdb.spec | 4 ++ 5 files changed, 61 insertions(+) create mode 100644 gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch diff --git a/_gdb.spec.Patch.include b/_gdb.spec.Patch.include index b8a5eae..0b2200f 100644 --- a/_gdb.spec.Patch.include +++ b/_gdb.spec.Patch.include @@ -368,3 +368,7 @@ Patch088: gdb-dont-overwrite-fsgsbase-m32.patch #(Tom de Vries) Patch089: gdb-rhbz1916516-pathstuff.cc132-internal-error.patch +#[gdb] Improve early exits for env var in debuginfod-support.c +#(Tom de Vries) +Patch090: gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch + diff --git a/_gdb.spec.patch.include b/_gdb.spec.patch.include index dd1a19f..3f40bb5 100644 --- a/_gdb.spec.patch.include +++ b/_gdb.spec.patch.include @@ -87,3 +87,4 @@ %patch087 -p1 %patch088 -p1 %patch089 -p1 +%patch090 -p1 diff --git a/_patch_order b/_patch_order index b171f1b..d0e201a 100644 --- a/_patch_order +++ b/_patch_order @@ -87,3 +87,4 @@ gdb-rhbz1898252-loadable-section-outside-ELF-segments.patch gdb-gdb27743-psymtab-imported-unit.patch gdb-dont-overwrite-fsgsbase-m32.patch gdb-rhbz1916516-pathstuff.cc132-internal-error.patch +gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch diff --git a/gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch b/gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch new file mode 100644 index 0000000..c1865c4 --- /dev/null +++ b/gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch @@ -0,0 +1,51 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: Bruno Larsen +Date: Thu, 23 Sep 2021 11:19:09 -0300 +Subject: gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch + +;;[gdb] Improve early exits for env var in debuginfod-support.c +;;(Tom de Vries) + +There's an early exit in libdebuginfod's debuginfod_query_server, which checks +both for: +- getenv (DEBUGINFOD_URLS_ENV_VAR) == NULL, and +- (getenv (DEBUGINFOD_URLS_ENV_VAR))[0] == '\0'. + +In debuginfod_source_query and debuginfod_debuginfo_query (which both +end up calling debuginfod_query_server) there are also early exits checking +the same env var, but those just check for NULL. + +Make the early exit tests in debuginfod-support.c match those in +libdebuginfod. + +gdb/ChangeLog: + +2020-11-18 Tom de Vries + + * debuginfod-support.c (debuginfod_source_query) + (debuginfod_debuginfo_query): Also do early exit if + "(getenv (DEBUGINFOD_URLS_ENV_VAR))[0] == '\0'". + +diff --git a/gdb/debuginfod-support.c b/gdb/debuginfod-support.c +--- a/gdb/debuginfod-support.c ++++ b/gdb/debuginfod-support.c +@@ -98,7 +98,8 @@ debuginfod_source_query (const unsigned char *build_id, + const char *srcpath, + gdb::unique_xmalloc_ptr *destname) + { +- if (getenv (DEBUGINFOD_URLS_ENV_VAR) == NULL) ++ const char *urls_env_var = getenv (DEBUGINFOD_URLS_ENV_VAR); ++ if (urls_env_var == NULL || urls_env_var[0] == '\0') + return scoped_fd (-ENOSYS); + + debuginfod_client *c = debuginfod_init (); +@@ -135,7 +136,8 @@ debuginfod_debuginfo_query (const unsigned char *build_id, + const char *filename, + gdb::unique_xmalloc_ptr *destname) + { +- if (getenv (DEBUGINFOD_URLS_ENV_VAR) == NULL) ++ const char *urls_env_var = getenv (DEBUGINFOD_URLS_ENV_VAR); ++ if (urls_env_var == NULL || urls_env_var[0] == '\0') + return scoped_fd (-ENOSYS); + + debuginfod_client *c = debuginfod_init (); diff --git a/gdb.spec b/gdb.spec index 30b5488..76baf87 100644 --- a/gdb.spec +++ b/gdb.spec @@ -1148,6 +1148,10 @@ fi %endif %changelog +* Thu Sep 23 2021 Bruno Larsen - 10.2-2 +- Backport "[gdb] Improve early exits for env var in debuginfod-support.c" + (Tom de Vries) + * Thu Sep 23 2021 Bruno Larsen - 10.2-2 - Backport "[gdb/cli] Don't assert on empty string for core-file" (Tom de Vries) From 0713bd2398e7933637fac3bfdc580fe681ef9657 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandra=20H=C3=A1jkov=C3=A1?= Date: Sun, 26 Sep 2021 23:49:29 +0200 Subject: [PATCH 4/7] =?UTF-8?q?Backport=20upstream=20patch=20which=20fixes?= =?UTF-8?q?=20internal-error:=20Unexpected=20type=20field=20location=20kin?= =?UTF-8?q?d=20(RHBZ=201976887,=20Alexandra=20H=C3=A1jkov=C3=A1).?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- _gdb.spec.Patch.include | 4 +++ _gdb.spec.patch.include | 1 + _patch_order | 1 + gdb-rhbz1976887-field-location-kind.patch | 30 +++++++++++++++++++++++ gdb.spec | 6 ++++- 5 files changed, 41 insertions(+), 1 deletion(-) create mode 100644 gdb-rhbz1976887-field-location-kind.patch diff --git a/_gdb.spec.Patch.include b/_gdb.spec.Patch.include index 0b2200f..d975b3c 100644 --- a/_gdb.spec.Patch.include +++ b/_gdb.spec.Patch.include @@ -372,3 +372,7 @@ Patch089: gdb-rhbz1916516-pathstuff.cc132-internal-error.patch #(Tom de Vries) Patch090: gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch +#Backport upstream patch which fixes internal-error: Unexpected +# type field location kind (RHBZ 1976887). +Patch091: gdb-rhbz1976887-field-location-kind.patch + diff --git a/_gdb.spec.patch.include b/_gdb.spec.patch.include index 3f40bb5..ad51f50 100644 --- a/_gdb.spec.patch.include +++ b/_gdb.spec.patch.include @@ -88,3 +88,4 @@ %patch088 -p1 %patch089 -p1 %patch090 -p1 +%patch091 -p1 diff --git a/_patch_order b/_patch_order index d0e201a..f0e152e 100644 --- a/_patch_order +++ b/_patch_order @@ -88,3 +88,4 @@ gdb-gdb27743-psymtab-imported-unit.patch gdb-dont-overwrite-fsgsbase-m32.patch gdb-rhbz1916516-pathstuff.cc132-internal-error.patch gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch +gdb-rhbz1976887-field-location-kind.patch diff --git a/gdb-rhbz1976887-field-location-kind.patch b/gdb-rhbz1976887-field-location-kind.patch new file mode 100644 index 0000000..6638438 --- /dev/null +++ b/gdb-rhbz1976887-field-location-kind.patch @@ -0,0 +1,30 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Alexandra=20H=C3=A1jkov=C3=A1?= +Date: Sun, 26 Sep 2021 23:39:22 +0200 +Subject: gdb-rhbz1976887-field-location-kind.patch + +;;Backport upstream patch which fixes internal-error: Unexpected +;; type field location kind (RHBZ 1976887). + +gdbtypes.c: Add the case for FIELD_LOC_KIND_DWARF_BLOCK + +The case for FIELD_LOC_KIND_DWARF_BLOCK was missing for +switch TYPE_FIELD_LOC_KIND. Thas caused an internal-error +under some circumstances. + +Fixes bug 28030. + +diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c +--- a/gdb/gdbtypes.c ++++ b/gdb/gdbtypes.c +@@ -5434,6 +5434,10 @@ copy_type_recursive (struct objfile *objfile, + xstrdup (TYPE_FIELD_STATIC_PHYSNAME (type, + i))); + break; ++ case FIELD_LOC_KIND_DWARF_BLOCK: ++ SET_FIELD_DWARF_BLOCK (new_type->field (i), ++ TYPE_FIELD_DWARF_BLOCK (type, i)); ++ break; + default: + internal_error (__FILE__, __LINE__, + _("Unexpected type field location kind: %d"), diff --git a/gdb.spec b/gdb.spec index 76baf87..b4b7bbb 100644 --- a/gdb.spec +++ b/gdb.spec @@ -37,7 +37,7 @@ Version: 10.2 # The release always contains a leading reserved number, start it at 1. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. -Release: 2%{?dist} +Release: 3%{?dist} License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and LGPLv3+ and BSD and Public Domain and GFDL # Do not provide URL for snapshots as the file lasts there only for 2 days. @@ -1148,6 +1148,10 @@ fi %endif %changelog +* Fri Sep 24 2021 Alexandra Hájková - 10.2-3 +- Backport upstream patch which fixes internal-error: Unexpected + type field location kind (RHBZ 1976887, Alexandra Hájková). + * Thu Sep 23 2021 Bruno Larsen - 10.2-2 - Backport "[gdb] Improve early exits for env var in debuginfod-support.c" (Tom de Vries) From 1bdd88c886cd2aa0b88215ccc9bbd1a16c8f227f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandra=20H=C3=A1jkov=C3=A1?= Date: Sun, 26 Sep 2021 23:55:31 +0200 Subject: [PATCH 5/7] Backport test for RHBZ 1976887 (Kevin Buettner). --- _gdb.spec.Patch.include | 3 + _gdb.spec.patch.include | 1 + _patch_order | 1 + gdb-test-for-rhbz1976887.patch | 591 +++++++++++++++++++++++++++++++++ gdb.spec | 3 + 5 files changed, 599 insertions(+) create mode 100644 gdb-test-for-rhbz1976887.patch diff --git a/_gdb.spec.Patch.include b/_gdb.spec.Patch.include index d975b3c..e97d205 100644 --- a/_gdb.spec.Patch.include +++ b/_gdb.spec.Patch.include @@ -376,3 +376,6 @@ Patch090: gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch # type field location kind (RHBZ 1976887). Patch091: gdb-rhbz1976887-field-location-kind.patch + +Patch092: gdb-test-for-rhbz1976887.patch + diff --git a/_gdb.spec.patch.include b/_gdb.spec.patch.include index ad51f50..481c43f 100644 --- a/_gdb.spec.patch.include +++ b/_gdb.spec.patch.include @@ -89,3 +89,4 @@ %patch089 -p1 %patch090 -p1 %patch091 -p1 +%patch092 -p1 diff --git a/_patch_order b/_patch_order index f0e152e..2233461 100644 --- a/_patch_order +++ b/_patch_order @@ -89,3 +89,4 @@ gdb-dont-overwrite-fsgsbase-m32.patch gdb-rhbz1916516-pathstuff.cc132-internal-error.patch gdb-rhbz1970741-early-exit-for-empty-debuginfod-url.patch gdb-rhbz1976887-field-location-kind.patch +gdb-test-for-rhbz1976887.patch diff --git a/gdb-test-for-rhbz1976887.patch b/gdb-test-for-rhbz1976887.patch new file mode 100644 index 0000000..6e9b355 --- /dev/null +++ b/gdb-test-for-rhbz1976887.patch @@ -0,0 +1,591 @@ +From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Alexandra=20H=C3=A1jkov=C3=A1?= +Date: Sun, 26 Sep 2021 23:52:21 +0200 +Subject: gdb-test-for-rhbz1976887.patch + +; Backport test for RHBZ 1976887 (Kevin Buettner). +Test case reproducing PR28030 bug + +The original reproducer for PR28030 required use of a specific +compiler version - gcc-c++-11.1.1-3.fc34 is mentioned in the PR, +though it seems probable that other gcc versions might also be able to +reproduce the bug as well. This commit introduces a test case which, +using the DWARF assembler, provides a reproducer which is independent +of the compiler version. (Well, it'll work with whatever compilers +the DWARF assembler works with.) + +To the best of my knowledge, it's also the first test case which uses +the DWARF assembler to provide debug info for a shared object. That +being the case, I provided more than the usual commentary which should +allow this case to be used as a template when a combo shared +library / DWARF assembler test case is required in the future. + +I provide some details regarding the bug in a comment near the +beginning of locexpr-dml.exp. + +This problem was difficult to reproduce; I found myself constantly +referring to the backtrace while trying to figure out what (else) I +might be missing while trying to create a reproducer. Below is a +partial backtrace which I include for posterity. + + #0 internal_error ( + file=0xc50110 "/ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/gdbtypes.c", line=5575, + fmt=0xc520c0 "Unexpected type field location kind: %d") + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdbsupport/errors.cc:51 + #1 0x00000000006ef0c5 in copy_type_recursive (objfile=0x1635930, + type=0x274c260, copied_types=0x30bb290) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/gdbtypes.c:5575 + #2 0x00000000006ef382 in copy_type_recursive (objfile=0x1635930, + type=0x274ca10, copied_types=0x30bb290) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/gdbtypes.c:5602 + #3 0x0000000000a7409a in preserve_one_value (value=0x24269f0, + objfile=0x1635930, copied_types=0x30bb290) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/value.c:2529 + #4 0x000000000072012a in gdbscm_preserve_values ( + extlang=0xc55720 , objfile=0x1635930, + copied_types=0x30bb290) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/guile/scm-value.c:94 + #5 0x00000000006a3f82 in preserve_ext_lang_values (objfile=0x1635930, + copied_types=0x30bb290) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/extension.c:568 + #6 0x0000000000a7428d in preserve_values (objfile=0x1635930) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/value.c:2579 + #7 0x000000000082d514 in objfile::~objfile (this=0x1635930, + __in_chrg=) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/objfiles.c:549 + #8 0x0000000000831cc8 in std::_Sp_counted_ptr::_M_dispose (this=0x1654580) + at /usr/include/c++/11/bits/shared_ptr_base.h:348 + #9 0x00000000004e6617 in std::_Sp_counted_base<(__gnu_cxx::_Lock_policy)2>::_M_release (this=0x1654580) at /usr/include/c++/11/bits/shared_ptr_base.h:168 + #10 0x00000000004e1d2f in std::__shared_count<(__gnu_cxx::_Lock_policy)2>::~__shared_count (this=0x190bb88, __in_chrg=) + at /usr/include/c++/11/bits/shared_ptr_base.h:705 + #11 0x000000000082feee in std::__shared_ptr::~__shared_ptr (this=0x190bb80, __in_chrg=) + at /usr/include/c++/11/bits/shared_ptr_base.h:1154 + #12 0x000000000082ff0a in std::shared_ptr::~shared_ptr ( + this=0x190bb80, __in_chrg=) + at /usr/include/c++/11/bits/shared_ptr.h:122 + #13 0x000000000085ed7e in __gnu_cxx::new_allocator > >::destroy > (this=0x114bc00, + __p=0x190bb80) at /usr/include/c++/11/ext/new_allocator.h:168 + #14 0x000000000085e88d in std::allocator_traits > > >::destroy > (__a=..., + __p=0x190bb80) at /usr/include/c++/11/bits/alloc_traits.h:531 + #15 0x000000000085e50c in std::__cxx11::list, std::allocator > >::_M_erase (this=0x114bc00, __position= + std::shared_ptr (expired, weak count 1) = {get() = 0x1635930}) + at /usr/include/c++/11/bits/stl_list.h:1925 + #16 0x000000000085df0e in std::__cxx11::list, std::allocator > >::erase (this=0x114bc00, __position= + std::shared_ptr (expired, weak count 1) = {get() = 0x1635930}) + at /usr/include/c++/11/bits/list.tcc:158 + #17 0x000000000085c748 in program_space::remove_objfile (this=0x114bbc0, + objfile=0x1635930) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/progspace.c:210 + #18 0x000000000082d3ae in objfile::unlink (this=0x1635930) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/objfiles.c:487 + #19 0x000000000082e68c in objfile_purge_solibs () + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/objfiles.c:875 + #20 0x000000000092dd37 in no_shared_libraries (ignored=0x0, from_tty=1) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/solib.c:1236 + #21 0x00000000009a37fe in target_pre_inferior (from_tty=1) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/target.c:2496 + #22 0x00000000007454d6 in run_command_1 (args=0x0, from_tty=1, + run_how=RUN_NORMAL) + at /ironwood1/sourceware-git/f34-pr28030/bld/../../worktree-pr28030/gdb/infcmd.c:437 + +I'll note a few points regarding this backtrace: + +Frame #1 is where the internal error occurs. It's caused by an +unhandled case for FIELD_LOC_KIND_DWARF_BLOCK. The fix for this bug +adds support for this case. + +Frame #22 - it's a partial backtrace - shows that GDB is attempting to +(re)run the program. You can see the exact command sequence that was +used for reproducing this problem in the PR (at +https://sourceware.org/bugzilla/show_bug.cgi?id=28030), but in a +nutshell, after starting the program and advancing to the appropriate +source line, GDB was asked to step into libstdc++; a "finish" command +was issued, returning a value. The fact that a value was returned is +very important. GDB was then used to step back into libstdc++. A +breakpoint was set on a source line in the library after which a "run" +command was issued. + +Frame #19 shows a call to objfile_purge_solibs. It's aptly named. + +Frame #7 is a call to the destructor for one of the objfile solibs; it +turned out to be the one for libstdc++. + +Frames #6 thru #3 show various value preservation frames. If you look +at preserve_values() in gdb/value.c, the value history is preserved +first, followed by internal variables, followed by values for the +extension languages (python and guile). + +diff --git a/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location-lib.c b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location-lib.c +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location-lib.c +@@ -0,0 +1,48 @@ ++/* Copyright (C) 2021 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 . */ ++ ++#include "locexpr-data-member-location.h" ++ ++struct A g_A = {3, 4}; ++struct B g_B = { {8, 9}, 10, 11 }; ++ ++B * ++foo () ++{ /* foo prologue */ ++ asm ("foo_label: .globl foo_label"); ++ return &g_B; /* foo return */ ++} /* foo end */ ++ ++B * ++bar (B *v) ++{ /* bar prologue */ ++ asm ("bar_label: .globl bar_label"); ++ return v; /* bar return */ ++} /* bar end */ ++ ++/* Some of the DWARF assembler procs (e.g. function_range) compile ++ this file, expecting it to be a complete program with a main() ++ function. When IS_SHAREDLIB is NOT defined, we have main() as ++ defined below. */ ++ ++#ifndef IS_SHAREDLIB ++int ++main () ++{ ++ B *b = foo (); ++} ++#endif +diff --git a/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location-main.c b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location-main.c +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location-main.c +@@ -0,0 +1,27 @@ ++/* Copyright (C) 2021 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 . */ ++ ++#include "locexpr-data-member-location.h" ++ ++int ++main (void) ++{ ++ B *v1; ++ v1 = bar (foo ()); ++ ++ return 0; ++} +diff --git a/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location.exp b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location.exp +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location.exp +@@ -0,0 +1,349 @@ ++# Copyright 2021 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 case uses the DWARF assembler to reproduce the problem ++# described by PR28030. The bug turned out to be that ++# FIELD_LOC_KIND_DWARF_BLOCK was not handled when recursively copying ++# a value's type when preserving the value history during the freeing ++# up of objfiles associated with a shared object. (Yes, figuring out ++# how to make this happen in a concise test case turned out to be ++# challenging.) ++# ++# The following elements proved to be necessary for reproducing the ++# problem: ++# ++# 1) A location expression needed to be used with ++# DW_AT_data_member_location rather than a simple offset. ++# Moreover, this location expression needed to use opcodes ++# which GDB's DWARF reader could not convert to a simple ++# offset. (Note, however, that GDB could probably be improved ++# to handle the opcodes chosen for this test; if decode_locdesc() ++# in dwarf2/read.c is ever updated to handle both DW_OP_pick and ++# DW_OP_drop, then this test could end up passing even if ++# the bug it's intended to test has not been fixed.) ++# ++# 2) The debug info containing the above DWARF info needed ++# to be associated with a shared object since the problem ++# occurred while GDB was preserving values during the ++# purging of shared objects. ++# ++# 3) After performing some simple gdb commands, the program is ++# run again. In the course of running the objfile destructor ++# associated with the shared object, values are preserved ++# along with their types. As noted earlier, it was during ++# the recursive type copy that the bug was observed. ++# ++# Therefore, due to #2 above, this test case creates debug info ++# which is then used by a shared object. ++ ++# This test can't be run on targets lacking shared library support. ++if [skip_shlib_tests] { ++ return 0 ++} ++ ++load_lib dwarf.exp ++ ++# This test can only be run on targets which support DWARF-2 and use gas. ++if ![dwarf2_support] { ++ return 0 ++} ++ ++# gdb_test_file_name is the name of this file without the .exp ++# extension. Use it to form basenames for the main program ++# and shared object. ++set main_basename ${::gdb_test_file_name}-main ++set lib_basename ${::gdb_test_file_name}-lib ++ ++# We're generating DWARF assembly for the shared object; therefore, ++# the source file for the library / shared object must be listed first ++# (in the standard_testfile invocation) since ${srcfile} is used by ++# get_func_info (for determining the start, end, and length of a ++# function). ++# ++# The output of Dwarf::assemble will be placed in $lib_basename.S ++# which will be ${srcfile3} after the execution of standard_testfile. ++ ++standard_testfile $lib_basename.c $main_basename.c $lib_basename.S ++ ++set libsrc "${::srcdir}/${::subdir}/${::srcfile}" ++set lib_so [standard_output_file ${lib_basename}.so] ++set asm_file [standard_output_file ${::srcfile3}] ++ ++# We need to know the size of some types in order to write some of the ++# debugging info that we're about to generate. For that, we ask GDB ++# by debugging the shared object associated with this test case. ++ ++# Compile the shared library: -DIS_SHAREDLIB prevents main() from ++# being defined. Note that debugging symbols will be present for ++# this compilation. ++if {[gdb_compile_shlib $libsrc $lib_so \ ++ {additional_flags=-DIS_SHAREDLIB debug}] != ""} { ++ untested "failed to compile shared library" ++ return ++} ++ ++# Start a fresh GDB and load the shared library. ++clean_restart $lib_so ++ ++# Using our running GDB session, determine sizes of several types. ++set long_size [get_sizeof "long" -1] ++set addr_size [get_sizeof "void *" -1] ++set struct_A_size [get_sizeof "g_A" -1] ++set struct_B_size [get_sizeof "g_B" -1] ++ ++if { $long_size == -1 || $addr_size == -1 \ ++ || $struct_A_size == -1 || $struct_B_size == -1} { ++ perror "Can't determine type sizes" ++ return ++} ++ ++# Retrieve struct offset of MBR in struct TP ++proc get_offsetof { tp mbr } { ++ return [get_integer_valueof "&((${tp} *) 0)->${mbr}" -1] ++} ++ ++# Use running GDB session to get struct offsets ++set A_a [get_offsetof A a] ++set A_x [get_offsetof A x] ++set B_a [get_offsetof B a] ++set B_b [get_offsetof B b] ++set B_x2 [get_offsetof B x2] ++ ++# Create the DWARF. ++Dwarf::assemble ${asm_file} { ++ declare_labels L ++ ++ # Find start, end, and length of functions foo and bar. ++ # These calls to get_func_info will create and set variables ++ # foo_start, bar_start, foo_end, bar_end, foo_len, and ++ # bar_len. ++ # ++ # In order to get the right answers, get_func_info (and, ++ # underneath, function_range) should use the same compiler flags ++ # as those used to make a shared object. For any targets that get ++ # this far, -fpic is probably correct. ++ # ++ # Also, it should be noted that IS_SHAREDLIB is NOT defined as one ++ # of the additional flags. Not defining IS_SHAREDLIB will cause a ++ # main() to be defined for the compilation of the shared library ++ # source file which happens as a result of using get_func_info; ++ # this is currently required in order to this facility. ++ set flags {additional_flags=-fpic debug} ++ get_func_info foo $flags ++ get_func_info bar $flags ++ ++ cu {} { ++ DW_TAG_compile_unit { ++ {DW_AT_language @DW_LANG_C_plus_plus} ++ {name ${::srcfile}} ++ {stmt_list $L DW_FORM_sec_offset} ++ } { ++ declare_labels int_label class_A_label class_B_label \ ++ B_ptr_label ++ ++ int_label: DW_TAG_base_type { ++ {DW_AT_byte_size ${::long_size} DW_FORM_udata} ++ {DW_AT_encoding @DW_ATE_signed} ++ {DW_AT_name "int"} ++ } ++ ++ class_A_label: DW_TAG_class_type { ++ {DW_AT_name "A"} ++ {DW_AT_byte_size ${::struct_A_size} DW_FORM_sdata} ++ } { ++ DW_TAG_member { ++ {DW_AT_name "a"} ++ {DW_AT_type :$int_label} ++ {DW_AT_data_member_location ${::A_a} DW_FORM_udata} ++ } ++ DW_TAG_member { ++ {DW_AT_name "x"} ++ {DW_AT_type :$int_label} ++ {DW_AT_data_member_location ${::A_x} DW_FORM_udata} ++ } ++ } ++ ++ class_B_label: DW_TAG_class_type { ++ {DW_AT_name "B"} ++ {DW_AT_byte_size ${::struct_B_size} DW_FORM_sdata} ++ } { ++ # While there are easier / better ways to specify an ++ # offset used by DW_AT_data_member_location than that ++ # used below, we need a location expression here in ++ # order to reproduce the bug. Moreover, this location ++ # expression needs to use opcodes that aren't handled ++ # by decode_locdesc() in dwarf2/read.c; if we use ++ # opcodes that _are_ handled by that function, the ++ # location expression will be converted into a simple ++ # offset - which will then (again) not reproduce the ++ # bug. At the time that this test was written, ++ # neither DW_OP_pick nor DW_OP_drop were being handled ++ # by decode_locdesc(); this is why those opcodes were ++ # chosen. ++ DW_TAG_inheritance { ++ {DW_AT_type :$class_A_label} ++ {DW_AT_data_member_location { ++ DW_OP_constu ${::B_a} ++ DW_OP_plus ++ DW_OP_pick 0 ++ DW_OP_drop} SPECIAL_expr} ++ {DW_AT_accessibility 1 DW_FORM_data1} ++ } ++ DW_TAG_member { ++ {DW_AT_name "b"} ++ {DW_AT_type :$int_label} ++ {DW_AT_data_member_location ${::B_b} DW_FORM_udata} ++ } ++ DW_TAG_member { ++ {DW_AT_name "x2"} ++ {DW_AT_type :$int_label} ++ {DW_AT_data_member_location ${::B_x2} DW_FORM_udata} ++ } ++ } ++ ++ B_ptr_label: DW_TAG_pointer_type { ++ {DW_AT_type :$class_B_label} ++ {DW_AT_byte_size ${::addr_size} DW_FORM_sdata} ++ } ++ ++ DW_TAG_variable { ++ {DW_AT_name "g_A"} ++ {DW_AT_type :$class_A_label} ++ {DW_AT_external 1 flag} ++ {DW_AT_location {DW_OP_addr [gdb_target_symbol "g_A"]} \ ++ SPECIAL_expr} ++ } ++ ++ DW_TAG_variable { ++ {DW_AT_name "g_B"} ++ {DW_AT_type :$class_B_label} ++ {DW_AT_external 1 flag} ++ {DW_AT_location {DW_OP_addr [gdb_target_symbol "g_B"]} \ ++ SPECIAL_expr} ++ } ++ ++ # We can't use MACRO_AT for the definitions of foo and bar ++ # because it doesn't provide a way to pass the appropriate ++ # flags. Therefore, we list the name, low_pc, and high_pc ++ # explicitly. ++ DW_TAG_subprogram { ++ {DW_AT_name foo} ++ {DW_AT_low_pc $foo_start DW_FORM_addr} ++ {DW_AT_high_pc $foo_end DW_FORM_addr} ++ {DW_AT_type :${B_ptr_label}} ++ {DW_AT_external 1 flag} ++ } ++ ++ DW_TAG_subprogram { ++ {DW_AT_name bar} ++ {DW_AT_low_pc $bar_start DW_FORM_addr} ++ {DW_AT_high_pc $bar_end DW_FORM_addr} ++ {DW_AT_type :${B_ptr_label}} ++ {DW_AT_external 1 flag} ++ } { ++ DW_TAG_formal_parameter { ++ {DW_AT_name v} ++ {DW_AT_type :${B_ptr_label}} ++ } ++ } ++ } ++ } ++ ++ lines {version 2} L { ++ include_dir "${::srcdir}/${::subdir}" ++ file_name "${::srcfile}" 1 ++ ++ # Generate a line table program. ++ program { ++ {DW_LNE_set_address $foo_start} ++ {line [gdb_get_line_number "foo prologue"]} ++ {DW_LNS_copy} ++ {DW_LNE_set_address foo_label} ++ {line [gdb_get_line_number "foo return"]} ++ {DW_LNS_copy} ++ {line [gdb_get_line_number "foo end"]} ++ {DW_LNS_copy} ++ {DW_LNE_set_address $foo_end} ++ {DW_LNS_advance_line 1} ++ {DW_LNS_copy} ++ {DW_LNE_end_sequence} ++ ++ {DW_LNE_set_address $bar_start} ++ {line [gdb_get_line_number "bar prologue"]} ++ {DW_LNS_copy} ++ {DW_LNE_set_address bar_label} ++ {line [gdb_get_line_number "bar return"]} ++ {DW_LNS_copy} ++ {line [gdb_get_line_number "bar end"]} ++ {DW_LNS_copy} ++ {DW_LNE_set_address $bar_end} ++ {DW_LNS_advance_line 1} ++ {DW_LNS_copy} ++ {DW_LNE_end_sequence} ++ } ++ } ++} ++ ++# Compile the shared object again, but this time include / use the ++# DWARF info that we've created above. Note that (again) ++# -DIS_SHAREDLIB is used to prevent inclusion of main() in the shared ++# object. Also note the use of the "nodebug" option. Any debugging ++# information that we need will be provided by the DWARF info created ++# above. ++if {[gdb_compile_shlib [list $libsrc $asm_file] $lib_so \ ++ {additional_flags=-DIS_SHAREDLIB nodebug}] != ""} { ++ untested "failed to compile shared library" ++ return ++} ++ ++# Compile the main program for use with the shared object. ++if [prepare_for_testing "failed to prepare" ${testfile} \ ++ ${::srcfile2} [list debug shlib=$lib_so]] { ++ return -1 ++} ++ ++# Do whatever is necessary to make sure that the shared library is ++# loaded for remote targets. ++gdb_load_shlib ${lib_so} ++ ++if ![runto_main] then { ++ fail "can't run to main" ++ return ++} ++ ++# Step into foo so that we can finish out of it. ++gdb_test "step" "foo .. at .* foo end.*" "step into foo" ++ ++# Finishing out of foo will create a value that will later need to ++# be preserved when restarting the program. ++gdb_test "finish" "= \\(class B \\*\\) ${::hex} .*" "finish out of foo" ++ ++# Dereferencing and printing the return value isn't necessary ++# for reproducing the bug, but we should make sure that the ++# return value is what we expect it to be. ++gdb_test "p *$" { = { = {a = 8, x = 9}, b = 10, x2 = 11}} \ ++ "dereference return value" ++ ++# The original PR28030 reproducer stepped back into the shared object, ++# so we'll do the same here: ++gdb_test "step" "bar \\(.*" "step into bar" ++ ++# We don't want a clean restart here since that will be too clean. ++# The original reproducer for PR28030 set a breakpoint in the shared ++# library and then restarted via "run". The command below does roughly ++# the same thing. It's at this step that an internal error would ++# occur for PR28030. The "message" argument tells runto to turn on ++# the printing of PASSes while runto is doing its job. ++runto "bar" message +diff --git a/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location.h b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location.h +new file mode 100644 +--- /dev/null ++++ b/gdb/testsuite/gdb.dwarf2/locexpr-data-member-location.h +@@ -0,0 +1,30 @@ ++/* Copyright (C) 2021 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 . */ ++ ++typedef struct A { ++ long a; ++ long x; ++} A; ++ ++typedef struct B { ++ A a; ++ long b; ++ long x2; ++} B; ++ ++extern B *foo (); ++extern B *bar (B *v); diff --git a/gdb.spec b/gdb.spec index b4b7bbb..29b1010 100644 --- a/gdb.spec +++ b/gdb.spec @@ -1148,6 +1148,9 @@ fi %endif %changelog +* Fri Sep 24 2021 Alexandra Hájková - 10.2-3 +- Backport test for RHBZ 1976887 (Kevin Buettner). + * Fri Sep 24 2021 Alexandra Hájková - 10.2-3 - Backport upstream patch which fixes internal-error: Unexpected type field location kind (RHBZ 1976887, Alexandra Hájková). From 2c9320f3f2aa36423c6f8027b8c724dc767ee67d Mon Sep 17 00:00:00 2001 From: Michal Kolar Date: Sun, 14 Feb 2021 17:15:34 +0000 Subject: [PATCH 6/7] init FMF CI gating --- .fmf/version | 1 + gating.yaml | 20 +++++++++++++++++ plans/ci.fmf | 6 ++++++ tests/README | 31 --------------------------- tests/debug-system-binary/cmds | 2 +- tests/debug-system-binary/main.fmf | 17 +++++++++++++++ tests/debug-system-binary/runtest.sh | 3 +-- tests/debug-toolset-binary/cmds | 1 - tests/debug-toolset-binary/main.fmf | 22 +++++++++++++++++++ tests/debug-toolset-binary/runtest.sh | 3 +-- tests/inventory | 3 --- tests/tests.yml | 24 --------------------- 12 files changed, 69 insertions(+), 64 deletions(-) create mode 100644 .fmf/version create mode 100644 gating.yaml create mode 100644 plans/ci.fmf delete mode 100644 tests/README create mode 100644 tests/debug-system-binary/main.fmf create mode 100644 tests/debug-toolset-binary/main.fmf delete mode 100755 tests/inventory delete mode 100644 tests/tests.yml diff --git a/.fmf/version b/.fmf/version new file mode 100644 index 0000000..d00491f --- /dev/null +++ b/.fmf/version @@ -0,0 +1 @@ +1 diff --git a/gating.yaml b/gating.yaml new file mode 100644 index 0000000..6107f0d --- /dev/null +++ b/gating.yaml @@ -0,0 +1,20 @@ +--- !Policy +product_versions: + - fedora-* +decision_context: bodhi_update_push_stable +subject_type: koji_build +rules: + - !PassingTestCaseRule {test_case_name: fedora-ci.koji-build.tier0.functional} + - !PassingTestCaseRule {test_case_name: baseos-qe.koji-build.scratch-build.validation} +--- !Policy +product_versions: + - rhel-8 +decision_context: osci_compose_gate +rules: + - !PassingTestCaseRule {test_case_name: osci.brew-build.tier0.functional} +--- !Policy +product_versions: + - rhel-9 +decision_context: osci_compose_gate +rules: + - !PassingTestCaseRule {test_case_name: osci.brew-build.tier0.functional} diff --git a/plans/ci.fmf b/plans/ci.fmf new file mode 100644 index 0000000..1ad2c12 --- /dev/null +++ b/plans/ci.fmf @@ -0,0 +1,6 @@ +summary: CI Gating Plan +discover: + how: fmf + directory: tests +execute: + how: beakerlib diff --git a/tests/README b/tests/README deleted file mode 100644 index 0a1388a..0000000 --- a/tests/README +++ /dev/null @@ -1,31 +0,0 @@ -Justification - -Adds tests according to the CI wiki specifically the standard test -interface in the spec. - -The playbook includes Tier1 level test cases that have been tested in -the following contexts and is passing reliably: Classic and -Container. Test logs are stored in the artifacts directory. - -The following steps are used to execute the tests using the standard -test interface: Test environment - -Make sure you have installed packages from the spec - - # rpm -q ansible python2-dnf libselinux-python standard-test-roles - ansible-2.3.2.0-1.fc26.noarch - python2-dnf-2.6.3-11.fc26.noarch - libselinux-python-2.6-7.fc26.x86_64 - standard-test-roles-2.4-1.fc26.noarch - -Run tests for Classic (must be run as root) - - # export ANSIBLE_INVENTORY=$(test -e inventory && echo inventory || echo /usr/share/ansible/inventory) - # ansible-playbook --tags=classic tests.yml - -Run tests for Container (must be run as root) - - # export ANSIBLE_INVENTORY=$(test -e inventory && echo inventory || echo /usr/share/ansible/inventory) - # export TEST_SUBJECTS=docker:docker.io/library/fedora:26 - # ansible-playbook --tags=container tests.yml - diff --git a/tests/debug-system-binary/cmds b/tests/debug-system-binary/cmds index fdc5030..0046765 100644 --- a/tests/debug-system-binary/cmds +++ b/tests/debug-system-binary/cmds @@ -1,4 +1,4 @@ -sta +start si 30 n 10 up diff --git a/tests/debug-system-binary/main.fmf b/tests/debug-system-binary/main.fmf new file mode 100644 index 0000000..e9d5c18 --- /dev/null +++ b/tests/debug-system-binary/main.fmf @@ -0,0 +1,17 @@ +summary: Debug a system binary. +description: '' +contact: +- Marek Polacek +component: +- gdb +test: ./runtest.sh +framework: beakerlib +recommend: +- gdb +- coreutils +- coreutils-debuginfo +- glibc +- glibc-debuginfo +duration: 5m +extra-summary: /tools/gdb/Sanity/debug-system-binary +extra-task: /tools/gdb/Sanity/debug-system-binary diff --git a/tests/debug-system-binary/runtest.sh b/tests/debug-system-binary/runtest.sh index ad07d5e..0c18dd8 100755 --- a/tests/debug-system-binary/runtest.sh +++ b/tests/debug-system-binary/runtest.sh @@ -27,8 +27,7 @@ # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Include Beaker environment -. /usr/bin/rhts-environment.sh || exit 1 -. /usr/lib/beakerlib/beakerlib.sh || exit 1 +. /usr/share/beakerlib/beakerlib.sh || exit 1 CMD="gdb" BIN="$(which $CMD)" diff --git a/tests/debug-toolset-binary/cmds b/tests/debug-toolset-binary/cmds index 9508e2c..b625c13 100644 --- a/tests/debug-toolset-binary/cmds +++ b/tests/debug-toolset-binary/cmds @@ -14,5 +14,4 @@ frame 1 b xexit c c -c q diff --git a/tests/debug-toolset-binary/main.fmf b/tests/debug-toolset-binary/main.fmf new file mode 100644 index 0000000..04b7702 --- /dev/null +++ b/tests/debug-toolset-binary/main.fmf @@ -0,0 +1,22 @@ +summary: We debug a binary that is delivered via the Toolset. +description: '' +contact: +- Marek Polacek +component: +- gdb +test: ./runtest.sh +framework: beakerlib +recommend: +- gdb +- coreutils +- binutils +- binutils-debuginfo +- glibc +- glibc-debuginfo +- gcc +- gcc-debuginfo +- zlib +- zlib-debuginfo +duration: 5m +extra-summary: /tools/gdb/Sanity/debug-toolset-binary +extra-task: /tools/gdb/Sanity/debug-toolset-binary diff --git a/tests/debug-toolset-binary/runtest.sh b/tests/debug-toolset-binary/runtest.sh index c0a6527..65cc2c7 100755 --- a/tests/debug-toolset-binary/runtest.sh +++ b/tests/debug-toolset-binary/runtest.sh @@ -32,8 +32,7 @@ # but in fact, it doesn't have to. It should not fail either way. # Include Beaker environment -. /usr/bin/rhts-environment.sh || exit 1 -. /usr/lib/beakerlib/beakerlib.sh || exit 1 +. /usr/share/beakerlib/beakerlib.sh || exit 1 CMD="gdb" BIN="$(which $CMD)" diff --git a/tests/inventory b/tests/inventory deleted file mode 100755 index b118a5a..0000000 --- a/tests/inventory +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/bash -export TEST_DOCKER_EXTRA_ARGS="--privileged" -exec merge-standard-inventory "$@" diff --git a/tests/tests.yml b/tests/tests.yml deleted file mode 100644 index 89d4222..0000000 --- a/tests/tests.yml +++ /dev/null @@ -1,24 +0,0 @@ ---- -# This first play always runs on the local staging system -- hosts: localhost - roles: - - role: standard-test-beakerlib - tags: - - classic - - container - tests: - - debug-toolset-binary - - debug-system-binary - required_packages: - - gdb - - coreutils - - binutils - - binutils-debuginfo - - glibc - - glibc-debuginfo - - gcc - - gcc-debuginfo - - zlib - - zlib-debuginfo - - coreutils-debuginfo - - which From 35351989b880ff22df2b1bafac08abff808dcb06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alexandra=20H=C3=A1jkov=C3=A1?= Date: Mon, 11 Oct 2021 14:44:19 +0200 Subject: [PATCH 7/7] gdb/build-id.c: make GDB advise to use dnf debuginfo-install filename instead dnf --enablerepo='*debug*' install filename Fixes rhbz1874275. Modifies gdb-6.6-buildid-locate-rpm.patch. --- gdb-6.6-buildid-locate-rpm.patch | 2 +- gdb.spec | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/gdb-6.6-buildid-locate-rpm.patch b/gdb-6.6-buildid-locate-rpm.patch index 83b83b0..a4fba50 100644 --- a/gdb-6.6-buildid-locate-rpm.patch +++ b/gdb-6.6-buildid-locate-rpm.patch @@ -678,7 +678,7 @@ diff --git a/gdb/build-id.c b/gdb/build-id.c +#else + "yum" +#endif -+ " --enablerepo='*debug*' install", debug); ++ " debuginfo-install", debug); + } } diff --git a/gdb.spec b/gdb.spec index 29b1010..6516463 100644 --- a/gdb.spec +++ b/gdb.spec @@ -37,7 +37,7 @@ Version: 10.2 # The release always contains a leading reserved number, start it at 1. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. -Release: 3%{?dist} +Release: 4%{?dist} License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ and GPLv2+ with exceptions and GPL+ and LGPLv2+ and LGPLv3+ and BSD and Public Domain and GFDL # Do not provide URL for snapshots as the file lasts there only for 2 days. @@ -1148,6 +1148,9 @@ fi %endif %changelog +* Fri Oct 11 2021 Alexandra Hájková - 10.2-4 +- Fix RHBZ 1874275 by modifying gdb-6.6-buildid-locate-rpm.patch (Alexandra Hájková). + * Fri Sep 24 2021 Alexandra Hájková - 10.2-3 - Backport test for RHBZ 1976887 (Kevin Buettner).