* exec.c (exec_file_attach): Print a more useful error message if the
user did "gdb core".
-Index: gdb-7.9.50.20150531/gdb/exec.c
+Index: gdb-7.12.50.20170226/gdb/exec.c
===================================================================
---- gdb-7.9.50.20150531.orig/gdb/exec.c 2015-05-31 03:48:29.000000000 +0200
-+++ gdb-7.9.50.20150531/gdb/exec.c 2015-05-31 20:07:35.092878685 +0200
+--- gdb-7.12.50.20170226.orig/gdb/exec.c 2017-02-27 22:18:00.945026211 +0100
++++ gdb-7.12.50.20170226/gdb/exec.c 2017-02-27 22:18:08.111076350 +0100
@@ -35,6 +35,7 @@
#include "progspace.h"
#include "gdb_bfd.h"
#include <fcntl.h>
#include "readline/readline.h"
-@@ -298,12 +299,27 @@ exec_file_attach (const char *filename,
+@@ -359,12 +360,27 @@
if (!bfd_check_format_matches (exec_bfd, bfd_object, &matching))
{
}
if (build_section_table (exec_bfd, §ions, §ions_end))
-Index: gdb-7.9.50.20150531/gdb/main.c
+Index: gdb-7.12.50.20170226/gdb/main.c
===================================================================
---- gdb-7.9.50.20150531.orig/gdb/main.c 2015-05-31 20:07:34.183872824 +0200
-+++ gdb-7.9.50.20150531/gdb/main.c 2015-05-31 20:10:05.095845935 +0200
-@@ -435,6 +435,37 @@ typedef struct cmdarg {
- /* Define type VEC (cmdarg_s). */
- DEF_VEC_O (cmdarg_s);
+--- gdb-7.12.50.20170226.orig/gdb/main.c 2017-02-27 22:18:00.945026211 +0100
++++ gdb-7.12.50.20170226/gdb/main.c 2017-02-27 22:18:08.112076357 +0100
+@@ -459,6 +459,37 @@
+ 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
+ END_CATCH
+}
+
- static int
- captured_main (void *data)
+ static void
+ captured_main_1 (struct captured_main_args *context, int &python_script)
{
-@@ -923,6 +954,8 @@ captured_main (void *data)
+@@ -910,6 +941,8 @@
{
symarg = argv[optind];
execarg = argv[optind];
optind++;
}
-@@ -1080,11 +1113,25 @@ captured_main (void *data)
+@@ -1060,11 +1093,25 @@
&& symarg != NULL
&& strcmp (execarg, symarg) == 0)
{
+ as a core file. */
+ if (catch_command_errors_const (func, execarg, !batch_flag)
+ && core_bfd == NULL)
- catch_command_errors_const (symbol_file_add_main, symarg,
+ catch_command_errors_const (symbol_file_add_main_adapter, symarg,
!batch_flag);
}
-Index: gdb-7.9.50.20150531/gdb/common/common-exceptions.h
+Index: gdb-7.12.50.20170226/gdb/common/common-exceptions.h
===================================================================
---- gdb-7.9.50.20150531.orig/gdb/common/common-exceptions.h 2015-05-31 03:48:29.000000000 +0200
-+++ gdb-7.9.50.20150531/gdb/common/common-exceptions.h 2015-05-31 20:07:35.093878692 +0200
-@@ -105,6 +105,9 @@ enum errors {
+--- gdb-7.12.50.20170226.orig/gdb/common/common-exceptions.h 2017-02-27 22:18:00.946026218 +0100
++++ gdb-7.12.50.20170226/gdb/common/common-exceptions.h 2017-02-27 22:18:08.112076357 +0100
+@@ -106,6 +106,9 @@
"_ERROR" is appended to the name. */
MAX_COMPLETIONS_REACHED_ERROR,
NULL after it is free'd, otherwise the code below thinks that it is still
valid and doesn't print the necessary warning ("Try: yum install ...").
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/rhbz981154-misleading-yum-install-warning.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/rhbz981154-misleading-yum-install-warning.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/rhbz981154-misleading-yum-install-warning.exp 2016-02-15 23:31:06.327941085 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/rhbz981154-misleading-yum-install-warning.exp 2017-02-26 19:14:58.492609659 +0100
@@ -0,0 +1,97 @@
+# Copyright (C) 2014 Free Software Foundation, Inc.
+
+
+# Leaving the link there will cause breakage in the next run.
+remote_exec build "rm -f [standard_output_file ${build_id_without_debug}]"
-Index: gdb-7.10.90.20160211/gdb/build-id.c
+Index: gdb-7.12.50.20170207/gdb/build-id.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/build-id.c 2016-02-15 23:30:55.389863424 +0100
-+++ gdb-7.10.90.20160211/gdb/build-id.c 2016-02-15 23:30:55.778866186 +0100
+--- gdb-7.12.50.20170207.orig/gdb/build-id.c 2017-02-26 19:14:51.943562799 +0100
++++ gdb-7.12.50.20170207/gdb/build-id.c 2017-02-26 19:14:58.492609659 +0100
@@ -589,7 +589,10 @@
do_cleanups (inner);
+ continue;
+ }
- if (build_id_verify (abfd, build_id_len, build_id))
+ if (build_id_verify (abfd.get(), build_id_len, build_id))
break;
--- /dev/null
+warning: Skipping deprecated .gdb_index section
+https://bugzilla.redhat.com/show_bug.cgi?id=953585
+
+diff -dup -rup gdb-7.10.50.20160106-orig/gdb/build-id.c gdb-7.10.50.20160106/gdb/build-id.c
+--- gdb-7.10.50.20160106-orig/gdb/build-id.c 2016-01-09 14:40:39.420385241 +0100
++++ gdb-7.10.50.20160106/gdb/build-id.c 2016-01-09 14:41:05.944549393 +0100
+@@ -713,7 +713,11 @@ static int missing_rpm_list_entries;
+ /* Returns the count of newly added rpms. */
+
+ static int
++#ifndef GDB_INDEX_VERIFY_VENDOR
+ missing_rpm_enlist (const char *filename)
++#else
++missing_rpm_enlist_1 (const char *filename, int verify_vendor)
++#endif
+ {
+ static int rpm_init_done = 0;
+ rpmts ts;
+@@ -817,7 +821,11 @@ missing_rpm_enlist (const char *filename
+ mi = rpmtsInitIterator_p (ts, RPMTAG_BASENAMES, filename, 0);
+ if (mi != NULL)
+ {
++#ifndef GDB_INDEX_VERIFY_VENDOR
+ for (;;)
++#else
++ if (!verify_vendor) for (;;)
++#endif
+ {
+ Header h;
+ char *debuginfo, **slot, *s, *s2;
+@@ -935,6 +943,37 @@ missing_rpm_enlist (const char *filename
+ xfree (debuginfo);
+ count++;
+ }
++#ifdef GDB_INDEX_VERIFY_VENDOR
++ else /* verify_vendor */
++ {
++ int vendor_pass = 0, vendor_fail = 0;
++
++ for (;;)
++ {
++ Header h;
++ errmsg_t err;
++ char *vendor;
++
++ h = rpmdbNextIterator_p (mi);
++ if (h == NULL)
++ break;
++
++ vendor = headerFormat_p (h, "%{vendor}", &err);
++ if (!vendor)
++ {
++ warning (_("Error querying the rpm file `%s': %s"), filename,
++ err);
++ continue;
++ }
++ if (strcmp (vendor, "Red Hat, Inc.") == 0)
++ vendor_pass = 1;
++ else
++ vendor_fail = 1;
++ xfree (vendor);
++ }
++ count = vendor_pass != 0 && vendor_fail == 0;
++ }
++#endif
+
+ rpmdbFreeIterator_p (mi);
+ }
+@@ -945,6 +984,21 @@ missing_rpm_enlist (const char *filename
+ }
+
+ static int
++#ifdef GDB_INDEX_VERIFY_VENDOR
++missing_rpm_enlist (const char *filename)
++{
++ return missing_rpm_enlist_1 (filename, 0);
++}
++
++extern int rpm_verify_vendor (const char *filename);
++int
++rpm_verify_vendor (const char *filename)
++{
++ return missing_rpm_enlist_1 (filename, 1);
++}
++
++static int
++#endif
+ missing_rpm_list_compar (const char *const *ap, const char *const *bp)
+ {
+ return strcoll (*ap, *bp);
+diff -dup -rup gdb-7.10.50.20160106-orig/gdb/dwarf2read.c gdb-7.10.50.20160106/gdb/dwarf2read.c
+--- gdb-7.10.50.20160106-orig/gdb/dwarf2read.c 2016-01-09 14:40:39.416385216 +0100
++++ gdb-7.10.50.20160106/gdb/dwarf2read.c 2016-01-09 14:41:05.942549381 +0100
+@@ -3111,6 +3111,16 @@ read_index_from_section (struct objfile
+ "set use-deprecated-index-sections on". */
+ if (version < 6 && !deprecated_ok)
+ {
++#ifdef GDB_INDEX_VERIFY_VENDOR
++ extern int rpm_verify_vendor (const char *filename);
++
++ /* Red Hat Developer Toolset exception. */
++ if (rpm_verify_vendor (filename))
++ {}
++ else
++ {
++
++#endif
+ static int warning_printed = 0;
+ if (!warning_printed)
+ {
+@@ -3122,6 +3132,10 @@ to use the section anyway."),
+ warning_printed = 1;
+ }
+ return 0;
++#ifdef GDB_INDEX_VERIFY_VENDOR
++
++ }
++#endif
+ }
+ /* Version 7 indices generated by gold refer to the CU for a symbol instead
+ of the TU (for symbols coming from TUs),
-Index: gdb-7.10.50.20160106/gdb/event-top.c
+Index: gdb-7.11.50.20160630/gdb/event-top.c
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/event-top.c
-+++ gdb-7.10.50.20160106/gdb/event-top.c
-@@ -37,6 +37,7 @@
- #include "gdbcmd.h" /* for dont_repeat() */
- #include "annotate.h"
- #include "maint.h"
+--- gdb-7.11.50.20160630.orig/gdb/event-top.c 2016-07-02 23:43:24.085214144 +0200
++++ gdb-7.11.50.20160630/gdb/event-top.c 2016-07-03 14:37:12.572130734 +0200
+@@ -40,6 +40,7 @@
+ #include "buffer.h"
+ #include "ser-event.h"
+ #include "gdb_select.h"
+#include "symfile.h"
/* readline include files. */
#include "readline/readline.h"
-@@ -180,6 +181,8 @@ rl_callback_read_char_wrapper (gdb_clien
- void
- cli_command_loop (void *data)
- {
-+ debug_flush_missing ();
-+
- display_gdb_prompt (0);
-
- /* Now it's time to start the event loop. */
-@@ -298,6 +301,8 @@ display_gdb_prompt (const char *new_prom
+@@ -347,6 +348,8 @@
/* Reset the nesting depth used when trace-commands is set. */
reset_command_nest_depth ();
old_chain = make_cleanup (free_current_contents, &actual_gdb_prompt);
/* Do not call the python hook on an explicit prompt change as
-Index: gdb-7.10.50.20160106/gdb/symfile.h
+@@ -794,7 +797,10 @@
+ command_handler (cmd);
+
+ if (ui->prompt_state != PROMPTED)
+- display_gdb_prompt (0);
++ {
++ debug_flush_missing ();
++ display_gdb_prompt (0);
++ }
+ }
+ }
+
+Index: gdb-7.11.50.20160630/gdb/symfile.h
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/symfile.h
-+++ gdb-7.10.50.20160106/gdb/symfile.h
-@@ -587,6 +587,8 @@ void map_symbol_filenames (symbol_filena
+--- gdb-7.11.50.20160630.orig/gdb/symfile.h 2016-07-03 14:34:32.032753668 +0200
++++ gdb-7.11.50.20160630/gdb/symfile.h 2016-07-03 14:37:12.573130742 +0200
+@@ -592,6 +592,8 @@
/* build-id support. */
extern struct bfd_build_id *build_id_addr_get (CORE_ADDR addr);
extern void debug_print_missing (const char *binary, const char *debug);
/* From dwarf2read.c */
-Index: gdb-7.10.50.20160106/gdb/testsuite/lib/gdb.exp
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/testsuite/lib/gdb.exp
-+++ gdb-7.10.50.20160106/gdb/testsuite/lib/gdb.exp
-@@ -1642,7 +1642,7 @@ proc default_gdb_start { } {
- warning "Couldn't set the width to 0."
- }
- }
-- # Turn off the missing warnings as the testsuite does not expect it.
-+ # Turn off the missing RPMs warnings as the testsuite does not expect it.
- send_gdb "set build-id-verbose 0\n"
- gdb_expect 10 {
- -re "$gdb_prompt $" {
-Index: gdb-7.10.50.20160106/gdb/testsuite/lib/mi-support.exp
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/testsuite/lib/mi-support.exp
-+++ gdb-7.10.50.20160106/gdb/testsuite/lib/mi-support.exp
-@@ -204,7 +204,7 @@ proc default_mi_gdb_start { args } {
- warning "Couldn't set the width to 0."
- }
- }
-- # Turn off the missing warnings as the testsuite does not expect it.
-+ # Turn off the missing RPMs warnings as the testsuite does not expect it.
- send_gdb "190-gdb-set build-id-verbose 0\n"
- gdb_expect 10 {
- -re ".*190-gdb-set build-id-verbose 0\r\n190\\\^done\r\n$mi_gdb_prompt$" {
-Index: gdb-7.10.50.20160106/gdb/tui/tui-interp.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/tui/tui-interp.c
-+++ gdb-7.10.50.20160106/gdb/tui/tui-interp.c
-@@ -31,6 +31,7 @@
- #include "tui/tui-io.h"
- #include "infrun.h"
- #include "observer.h"
-+#include "symfile.h"
-
- static struct ui_out *tui_ui_out (struct interp *self);
-
-Index: gdb-7.10.50.20160106/gdb/aclocal.m4
+Index: gdb-7.11.50.20160630/gdb/aclocal.m4
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/aclocal.m4
-+++ gdb-7.10.50.20160106/gdb/aclocal.m4
+--- gdb-7.11.50.20160630.orig/gdb/aclocal.m4 2016-07-02 23:43:24.085214144 +0200
++++ gdb-7.11.50.20160630/gdb/aclocal.m4 2016-07-03 14:37:12.576130768 +0200
@@ -11,6 +11,221 @@
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
# AM_AUX_DIR_EXPAND -*- Autoconf -*-
# Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc.
-Index: gdb-7.10.50.20160106/gdb/config.in
+Index: gdb-7.11.50.20160630/gdb/config.in
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/config.in
-+++ gdb-7.10.50.20160106/gdb/config.in
+--- gdb-7.11.50.20160630.orig/gdb/config.in 2016-07-02 23:43:24.085214144 +0200
++++ gdb-7.11.50.20160630/gdb/config.in 2016-07-03 14:37:12.576130768 +0200
@@ -33,6 +33,9 @@
/* Define to BFD's default target vector. */
#undef DEFAULT_BFD_VEC
/* Define to 1 if translation of program messages to the user's native
language is requested. */
#undef ENABLE_NLS
-@@ -258,6 +261,9 @@
+@@ -261,6 +264,9 @@
/* Define if Python 2.7 is being used. */
#undef HAVE_LIBPYTHON2_7
/* Define to 1 if you have the <libunwind-ia64.h> header file. */
#undef HAVE_LIBUNWIND_IA64_H
-Index: gdb-7.10.50.20160106/gdb/configure
+Index: gdb-7.11.50.20160630/gdb/configure
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/configure
-+++ gdb-7.10.50.20160106/gdb/configure
-@@ -705,6 +705,11 @@ PKGVERSION
+--- gdb-7.11.50.20160630.orig/gdb/configure 2016-07-02 23:43:24.085214144 +0200
++++ gdb-7.11.50.20160630/gdb/configure 2016-07-03 14:37:12.581130811 +0200
+@@ -705,6 +705,11 @@
HAVE_NATIVE_GCORE_TARGET
TARGET_OBS
subdirs
GDB_DATADIR
DEBUGDIR
MAKEINFO_EXTRA_FLAGS
-@@ -813,6 +818,7 @@ with_gdb_datadir
+@@ -814,6 +819,7 @@
with_relocated_sources
with_auto_load_dir
with_auto_load_safe_path
enable_targets
enable_64_bit_bfd
enable_gdbcli
-@@ -869,6 +875,11 @@ CCC
+@@ -870,6 +876,11 @@
CPP
MAKEINFO
MAKEINFOFLAGS
YACC
YFLAGS
XMKMF'
-@@ -1540,6 +1551,8 @@ Optional Packages:
+@@ -1541,6 +1552,8 @@
[--with-auto-load-dir]
--without-auto-load-safe-path
do not restrict auto-loaded files locations
--with-libunwind-ia64 use libunwind frame unwinding for ia64 targets
--with-curses use the curses library instead of the termcap
library
-@@ -1595,6 +1608,13 @@ Some influential environment variables:
+@@ -1595,6 +1608,13 @@
MAKEINFO Parent configure detects if it is of sufficient version.
MAKEINFOFLAGS
Parameters for MAKEINFO.
YACC The `Yet Another C Compiler' implementation to use. Defaults to
the first program found out of: `bison -y', `byacc', `yacc'.
YFLAGS The list of arguments that will be passed by default to $YACC.
-@@ -5655,6 +5675,494 @@ _ACEOF
+@@ -5613,6 +5633,494 @@
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_auto_load_safe_path" >&5
$as_echo "$with_auto_load_safe_path" >&6; }
subdirs="$subdirs testsuite"
-Index: gdb-7.10.50.20160106/gdb/configure.ac
+Index: gdb-7.11.50.20160630/gdb/configure.ac
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/configure.ac
-+++ gdb-7.10.50.20160106/gdb/configure.ac
-@@ -177,6 +177,199 @@ AC_DEFINE_DIR(AUTO_LOAD_SAFE_PATH, escap
+--- gdb-7.11.50.20160630.orig/gdb/configure.ac 2016-07-02 23:43:24.085214144 +0200
++++ gdb-7.11.50.20160630/gdb/configure.ac 2016-07-03 14:37:12.582130819 +0200
+@@ -177,6 +177,199 @@
[Directories safe to hold auto-loaded files.])
AC_MSG_RESULT([$with_auto_load_safe_path])
AC_CONFIG_SUBDIRS(testsuite)
# Check whether to support alternative target configurations
-Index: gdb-7.10.50.20160106/gdb/corelow.c
+Index: gdb-7.11.50.20160630/gdb/corelow.c
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/corelow.c
-+++ gdb-7.10.50.20160106/gdb/corelow.c
-@@ -310,7 +310,7 @@ build_id_locate_exec (int from_tty)
+--- gdb-7.11.50.20160630.orig/gdb/corelow.c 2016-07-03 14:34:32.022753582 +0200
++++ gdb-7.11.50.20160630/gdb/corelow.c 2016-07-03 14:37:12.582130819 +0200
+@@ -310,7 +310,7 @@
symfile_objfile->flags |= OBJF_BUILD_ID_CORE_LOADED;
}
else
do_cleanups (back_to);
-Index: gdb-7.10.50.20160106/gdb/build-id.c
+Index: gdb-7.11.50.20160630/gdb/build-id.c
===================================================================
---- gdb-7.10.50.20160106.orig/gdb/build-id.c
-+++ gdb-7.10.50.20160106/gdb/build-id.c
+--- gdb-7.11.50.20160630.orig/gdb/build-id.c 2016-07-03 14:36:50.124938187 +0200
++++ gdb-7.11.50.20160630/gdb/build-id.c 2016-07-03 14:42:25.171812134 +0200
@@ -35,6 +35,7 @@
#include "elf/common.h"
#include "elf-bfd.h"
#define BUILD_ID_VERBOSE_NONE 0
#define BUILD_ID_VERBOSE_FILENAMES 1
-@@ -665,8 +666,366 @@ build_id_to_filename (const struct bfd_b
+@@ -665,8 +666,366 @@
return result;
}
+ return 0;
+ }
+
-+ if (!((headerFormat_p = dlsym (h, "headerFormat"))
-+ && (rpmReadConfigFiles_p = dlsym (h, "rpmReadConfigFiles"))
-+ && (rpmdbFreeIterator_p = dlsym (h, "rpmdbFreeIterator"))
-+ && (rpmdbNextIterator_p = dlsym (h, "rpmdbNextIterator"))
-+ && (rpmtsCreate_p = dlsym (h, "rpmtsCreate"))
-+ && (rpmtsFree_p = dlsym (h, "rpmtsFree"))
-+ && (rpmtsInitIterator_p = dlsym (h, "rpmtsInitIterator"))))
++ if (!((headerFormat_p = (char *(*) (Header h, const char * fmt, errmsg_t *errmsg)) dlsym (h, "headerFormat"))
++ && (rpmReadConfigFiles_p = (int (*) (const char * file, const char * target)) dlsym (h, "rpmReadConfigFiles"))
++ && (rpmdbFreeIterator_p = (rpmdbMatchIterator (*) (rpmdbMatchIterator mi)) dlsym (h, "rpmdbFreeIterator"))
++ && (rpmdbNextIterator_p = (Header (*) (rpmdbMatchIterator mi)) dlsym (h, "rpmdbNextIterator"))
++ && (rpmtsCreate_p = (rpmts (*) (void)) dlsym (h, "rpmtsCreate"))
++ && (rpmtsFree_p = (rpmts (*) (rpmts ts)) dlsym (h, "rpmtsFree"))
++ && (rpmtsInitIterator_p = (rpmdbMatchIterator (*) (const rpmts ts, rpmTag rpmtag, const void *keyp, size_t keylen)) dlsym (h, "rpmtsInitIterator"))))
+ {
+ warning (_("Opened library \"%s\" is incompatible (%s), "
+ "missing debuginfos notifications will not be displayed"),
+ if (s > debuginfo && memcmp (s, ".src.rpm", srcrpmlen) == 0)
+ {
+ /* s2 = `-%{release}.src.rpm-debuginfo.%{arch}' */
-+ s2 = memrchr (debuginfo, '-', s - debuginfo);
++ s2 = (char *) memrchr (debuginfo, '-', s - debuginfo);
+ }
+ if (s2)
+ {
+ /* s2 = `-%{version}-%{release}.src.rpm-debuginfo.%{arch}' */
-+ s2 = memrchr (debuginfo, '-', s2 - debuginfo);
++ s2 = (char *) memrchr (debuginfo, '-', s2 - debuginfo);
+ }
+ if (!s2)
+ {
+
+ /* RPMDBI_PACKAGES requires keylen == sizeof (int). */
+ /* RPMDBI_LABEL is an interface for NVR-based dbiFindByLabel(). */
-+ mi_debuginfo = rpmtsInitIterator_p (ts, RPMDBI_LABEL, debuginfo, 0);
++ mi_debuginfo = rpmtsInitIterator_p (ts, (rpmTag) RPMDBI_LABEL, debuginfo, 0);
+ xfree (debuginfo);
+ if (mi_debuginfo)
+ {
+
+ *slot = debuginfo;
+
-+ missing_rpm = xmalloc (sizeof (*missing_rpm) + strlen (debuginfo));
++ missing_rpm = (struct missing_rpm *) xmalloc (sizeof (*missing_rpm) + strlen (debuginfo));
+ strcpy (missing_rpm->rpm, debuginfo);
+ missing_rpm->next = missing_rpm_list;
+ missing_rpm_list = missing_rpm;
+ if (missing_rpm_list_entries == 0)
+ return;
+
-+ array = xmalloc (sizeof (*array) * missing_rpm_list_entries);
++ array = (char **) xmalloc (sizeof (*array) * missing_rpm_list_entries);
+ cleanups = make_cleanup (xfree, array);
+
+ array_iter = array;
avoidance. */
struct missing_filepair
-@@ -720,11 +1079,17 @@ missing_filepair_change (void)
+@@ -720,11 +1079,17 @@
/* All their memory came just from missing_filepair_OBSTACK. */
missing_filepair_hash = NULL;
}
missing_filepair_change ();
}
-@@ -791,14 +1156,39 @@ debug_print_missing (const char *binary,
+@@ -791,14 +1156,39 @@
*slot = missing_filepair;
+gdb returns an incorrect back trace when applying a debuginfo
+https://bugzilla.redhat.com/show_bug.cgi?id=1339862
+
Index: gdb-7.9.90.20150709/gdb/solib-svr4.c
===================================================================
--- gdb-7.9.90.20150709.orig/gdb/solib-svr4.c 2015-07-09 18:18:54.526417766 +0200
xfree (build_id_filename);
xfree (build_id);
+--- /dev/null 2016-07-02 20:29:01.679404943 +0200
++++ gdb-7.11.50.20160721/gdb/testsuite/gdb.base/gcore-buildid-exec-but-not-solib.exp 2016-07-31 23:04:49.062753722 +0200
+@@ -0,0 +1,105 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++if {[skip_shlib_tests]} {
++ return 0
++}
++
++set testfile "gcore-buildid-exec-but-not-solib"
++set srcmainfile ${testfile}-main.c
++set srclibfile ${testfile}-lib.c
++set libfile [standard_output_file ${testfile}-lib.so]
++set objfile [standard_output_file ${testfile}-main.o]
++set executable ${testfile}-main
++set binfile [standard_output_file ${executable}]
++set gcorefile [standard_output_file ${executable}.gcore]
++set outdir [file dirname $binfile]
++
++if { [gdb_compile_shlib ${srcdir}/${subdir}/${srclibfile} ${libfile} "debug additional_flags=-Wl,--build-id"] != ""
++ || [gdb_compile ${srcdir}/${subdir}/${srcmainfile} ${objfile} object {debug}] != "" } {
++ unsupported "-Wl,--build-id compilation failed"
++ return -1
++}
++set opts [list debug shlib=${libfile} "additional_flags=-Wl,--build-id"]
++if { [gdb_compile ${objfile} ${binfile} executable $opts] != "" } {
++ unsupported "-Wl,--build-id compilation failed"
++ return -1
++}
++
++clean_restart $executable
++gdb_load_shlib $libfile
++
++# Does this gdb support gcore?
++set test "help gcore"
++gdb_test_multiple $test $test {
++ -re "Undefined command: .gcore.*\r\n$gdb_prompt $" {
++ # gcore command not supported -- nothing to test here.
++ unsupported "gdb does not support gcore on this target"
++ return -1;
++ }
++ -re "Save a core file .*\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++
++if { ![runto lib] } then {
++ return -1
++}
++
++set escapedfilename [string_to_regexp ${gcorefile}]
++
++set test "save a corefile"
++gdb_test_multiple "gcore ${gcorefile}" $test {
++ -re "Saved corefile ${escapedfilename}\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "Can't create a corefile\r\n$gdb_prompt $" {
++ unsupported $test
++ return -1
++ }
++}
++
++# Now restart gdb and load the corefile.
++
++clean_restart $executable
++gdb_load_shlib $libfile
++
++set buildid [build_id_debug_filename_get $libfile]
++
++regsub {\.debug$} $buildid {} buildid
++
++set debugdir [standard_output_file ${testfile}-debugdir]
++file delete -force -- $debugdir
++
++file mkdir $debugdir/[file dirname $libfile]
++file copy $libfile $debugdir/${libfile}
++
++file mkdir $debugdir/[file dirname $buildid]
++file copy $libfile $debugdir/${buildid}
++
++remote_exec build "ln -s /lib ${debugdir}/"
++remote_exec build "ln -s /lib64 ${debugdir}/"
++# /usr is not needed, all the libs are in /lib64: libm.so.6 libc.so.6 ld-linux-x86-64.so.2
++
++gdb_test "set solib-absolute-prefix $debugdir"
++
++gdb_test_no_output "set debug-file-directory $debugdir" "set debug-file-directory"
++
++gdb_test "core ${gcorefile}" "Core was generated by .*" "re-load generated corefile"
++
++gdb_test "frame" "#0 \[^\r\n\]* lib .*" "library got loaded"
++
++gdb_test "bt"
++gdb_test "info shared"
+--- /dev/null 2016-07-02 20:29:01.679404943 +0200
++++ gdb-7.11.50.20160721/gdb/testsuite/gdb.base/gcore-buildid-exec-but-not-solib-main.c 2016-07-28 21:06:40.977786922 +0200
+@@ -0,0 +1,25 @@
++/* Copyright 2010 Free Software Foundation, Inc.
++
++ This file is part of GDB.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++extern void lib (void);
++
++int
++main (void)
++{
++ lib ();
++ return 0;
++}
+--- /dev/null 2016-07-02 20:29:01.679404943 +0200
++++ gdb-7.11.50.20160721/gdb/testsuite/gdb.base/gcore-buildid-exec-but-not-solib-lib.c 2016-07-28 21:06:40.977786922 +0200
+@@ -0,0 +1,21 @@
++/* Copyright 2010 Free Software Foundation, Inc.
++
++ This file is part of GDB.
++
++ This program is free software; you can redistribute it and/or modify
++ it under the terms of the GNU General Public License as published by
++ the Free Software Foundation; either version 3 of the License, or
++ (at your option) any later version.
++
++ This program is distributed in the hope that it will be useful,
++ but WITHOUT ANY WARRANTY; without even the implied warranty of
++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++ GNU General Public License for more details.
++
++ You should have received a copy of the GNU General Public License
++ along with this program. If not, see <http://www.gnu.org/licenses/>. */
++
++void
++lib (void)
++{
++}
-Index: gdb-7.10.90.20160211/gdb/corelow.c
+Index: gdb-7.99.90.20170420/gdb/corelow.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/corelow.c 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/corelow.c 2016-02-15 23:26:46.516096395 +0100
+--- gdb-7.99.90.20170420.orig/gdb/corelow.c 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/corelow.c 2017-04-20 23:00:43.358629183 +0200
@@ -45,6 +45,10 @@
#include "gdb_bfd.h"
#include "completer.h"
#ifndef O_LARGEFILE
#define O_LARGEFILE 0
-@@ -266,6 +270,53 @@
+@@ -266,6 +270,54 @@
inferior_ptid = ptid; /* Yes, make it current. */
}
+ {
+ make_cleanup (xfree, execfilename);
+ exec_file_attach (execfilename, from_tty);
-+ symbol_file_add_main (execfilename, from_tty);
++ symbol_file_add_main (execfilename,
++ symfile_add_flag (!from_tty ? 0 : SYMFILE_VERBOSE));
+ if (symfile_objfile != NULL)
+ symfile_objfile->flags |= OBJF_BUILD_ID_CORE_LOADED;
+ }
/* This routine opens and sets up the core file bfd. */
static void
-@@ -404,6 +455,14 @@
+@@ -402,6 +454,14 @@
switch_to_thread (thread->ptid);
}
post_create_inferior (&core_ops, from_tty);
/* Now go through the target stack looking for threads since there
-@@ -1068,4 +1127,11 @@
+@@ -1079,4 +1139,11 @@
init_core_ops ();
add_target_with_completer (&core_ops, filename_completer);
+ NULL, NULL, NULL,
+ &setlist, &showlist);
}
-Index: gdb-7.10.90.20160211/gdb/doc/gdb.texinfo
+Index: gdb-7.99.90.20170420/gdb/doc/gdb.texinfo
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/doc/gdb.texinfo 2016-02-15 23:25:36.455598958 +0100
-+++ gdb-7.10.90.20160211/gdb/doc/gdb.texinfo 2016-02-15 23:26:06.362811302 +0100
-@@ -18684,6 +18684,27 @@
+--- gdb-7.99.90.20170420.orig/gdb/doc/gdb.texinfo 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/doc/gdb.texinfo 2017-04-20 23:00:43.366629228 +0200
+@@ -18987,6 +18987,27 @@
@end table
@cindex @code{.gnu_debuglink} sections
@cindex debug link sections
A debug link is a special section of the executable file named
-Index: gdb-7.10.90.20160211/gdb/solib-svr4.c
+Index: gdb-7.99.90.20170420/gdb/solib-svr4.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/solib-svr4.c 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/solib-svr4.c 2016-02-15 23:26:46.613097083 +0100
+--- gdb-7.99.90.20170420.orig/gdb/solib-svr4.c 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/solib-svr4.c 2017-04-20 23:00:43.367629234 +0200
@@ -45,6 +45,7 @@
#include "auxv.h"
#include "gdb_bfd.h"
static struct link_map_offsets *svr4_fetch_link_map_offsets (void);
static int svr4_have_link_map_offsets (void);
-@@ -1416,9 +1417,52 @@
+@@ -1420,9 +1421,52 @@
continue;
}
xfree (buffer);
/* If this entry has no name, or its name matches the name
-Index: gdb-7.10.90.20160211/gdb/elfread.c
+Index: gdb-7.99.90.20170420/gdb/elfread.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/elfread.c 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/elfread.c 2016-02-15 23:26:06.364811316 +0100
-@@ -1259,9 +1259,10 @@
+--- gdb-7.99.90.20170420.orig/gdb/elfread.c 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/elfread.c 2017-04-20 23:00:43.367629234 +0200
+@@ -1265,8 +1265,9 @@
&& objfile->separate_debug_objfile == NULL
&& objfile->separate_debug_objfile_backlink == NULL)
{
-- char *debugfile;
-+ char *debugfile, *build_id_filename;
-
-- debugfile = find_separate_debug_file_by_buildid (objfile);
-+ debugfile = find_separate_debug_file_by_buildid (objfile,
-+ &build_id_filename);
++ gdb::unique_xmalloc_ptr<char> build_id_filename;
+ gdb::unique_xmalloc_ptr<char> debugfile
+- (find_separate_debug_file_by_buildid (objfile));
++ (find_separate_debug_file_by_buildid (objfile, &build_id_filename));
if (debugfile == NULL)
- debugfile = find_separate_debug_file_by_debuglink (objfile);
-@@ -1275,6 +1276,12 @@
- symbol_file_add_separate (abfd, debugfile, symfile_flags, objfile);
- do_cleanups (cleanup);
+ debugfile.reset (find_separate_debug_file_by_debuglink (objfile));
+@@ -1278,6 +1279,10 @@
+ symbol_file_add_separate (abfd.get (), debugfile.get (),
+ symfile_flags, objfile);
}
+ /* Check if any separate debug info has been extracted out. */
+ else if (bfd_get_section_by_name (objfile->obfd, ".gnu_debuglink")
+ != NULL)
-+ debug_print_missing (objfile_name (objfile), build_id_filename);
-+
-+ xfree (build_id_filename);
++ debug_print_missing (objfile_name (objfile), build_id_filename.get ());
}
}
-Index: gdb-7.10.90.20160211/gdb/symfile.h
+Index: gdb-7.99.90.20170420/gdb/symfile.h
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/symfile.h 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/symfile.h 2016-02-15 23:26:46.516096395 +0100
-@@ -584,6 +584,10 @@
+--- gdb-7.99.90.20170420.orig/gdb/symfile.h 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/symfile.h 2017-04-20 23:00:43.368629240 +0200
+@@ -567,6 +567,10 @@
void map_symbol_filenames (symbol_filename_ftype *fun, void *data,
int need_fullname);
/* From dwarf2read.c */
/* Names for a dwarf2 debugging section. The field NORMAL is the normal
-Index: gdb-7.10.90.20160211/gdb/testsuite/lib/gdb.exp
+Index: gdb-7.99.90.20170420/gdb/testsuite/lib/gdb.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/lib/gdb.exp 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/lib/gdb.exp 2016-02-15 23:26:46.516096395 +0100
-@@ -1640,6 +1640,16 @@
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/lib/gdb.exp 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/lib/gdb.exp 2017-04-20 23:00:43.369629245 +0200
+@@ -1646,6 +1646,16 @@
warning "Couldn't set the width to 0."
}
}
return 0
}
-Index: gdb-7.10.90.20160211/gdb/testsuite/lib/mi-support.exp
+Index: gdb-7.99.90.20170420/gdb/testsuite/lib/mi-support.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/lib/mi-support.exp 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/lib/mi-support.exp 2016-02-15 23:26:46.516096395 +0100
-@@ -204,6 +204,16 @@
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/lib/mi-support.exp 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/lib/mi-support.exp 2017-04-20 23:00:43.369629245 +0200
+@@ -309,6 +309,16 @@
warning "Couldn't set the width to 0."
}
}
+ }
+ }
- # Create the new PTY for the inferior process.
if { $separate_inferior_pty } {
-Index: gdb-7.10.90.20160211/gdb/objfiles.h
+ mi_create_inferior_pty
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.base/new-ui-pending-input.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/objfiles.h 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/objfiles.h 2016-02-15 23:26:06.366811330 +0100
-@@ -489,6 +489,10 @@
-
- #define OBJF_NOT_FILENAME (1 << 6)
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.base/new-ui-pending-input.exp 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.base/new-ui-pending-input.exp 2017-04-20 23:00:43.369629245 +0200
+@@ -62,6 +62,7 @@
+ set options ""
+ append options " -iex \"set height 0\""
+ append options " -iex \"set width 0\""
++ append options " -iex \"set build-id-verbose 0\""
+ append options " -iex \"new-ui console $extra_tty_name\""
+ append options " -ex \"b $bpline\""
+ append options " -ex \"run\""
+Index: gdb-7.99.90.20170420/gdb/objfiles.h
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/objfiles.h 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/objfiles.h 2017-04-20 23:00:43.370629251 +0200
+@@ -444,6 +444,10 @@
+ htab_t static_links;
+ };
+/* This file was loaded according to the BUILD_ID_CORE_LOADS rules. */
+
-+#define OBJF_BUILD_ID_CORE_LOADED (1 << 12)
++#define OBJF_BUILD_ID_CORE_LOADED static_cast<enum objfile_flag>(1 << 12)
+
/* Declarations for functions defined in objfiles.c */
- extern struct objfile *allocate_objfile (bfd *, const char *name, int);
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/corefile.exp
+ extern struct objfile *allocate_objfile (bfd *, const char *name,
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.base/corefile.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/gdb.base/corefile.exp 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/corefile.exp 2016-02-15 23:26:55.178157896 +0100
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.base/corefile.exp 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.base/corefile.exp 2017-04-20 23:00:43.370629251 +0200
@@ -293,3 +293,33 @@
pass $test
}
+ gdb_test "info files" "Local exec file:\r\n\[ \t\]*`[string_to_regexp $debugdir/$buildid]', file type .*"
+ pass $wholetest
+}
-Index: gdb-7.10.90.20160211/gdb/build-id.c
+Index: gdb-7.99.90.20170420/gdb/build-id.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/build-id.c 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/build-id.c 2016-02-15 23:26:46.516096395 +0100
+--- gdb-7.99.90.20170420.orig/gdb/build-id.c 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/build-id.c 2017-04-20 23:03:00.060399474 +0200
@@ -26,11 +26,67 @@
#include "objfiles.h"
#include "filenames.h"
+ && memcmp (xnp->name, "GNU", sizeof "GNU") == 0)
+ {
+ size_t size = descsz;
-+ gdb_byte *data = (void *) descdata;
++ gdb_byte *data = (gdb_byte *) descdata;
+ struct bfd_build_id *retval;
+
-+ retval = xmalloc (sizeof *retval - 1 + size);
++ retval = (struct bfd_build_id *) xmalloc (sizeof *retval - 1 + size);
+ retval->size = size;
+ memcpy (retval->data, data, size);
+
+ gdb_byte *buf;
+ int err;
+
-+ buf = xmalloc (hdr->p_filesz);
++ buf = (gdb_byte *) xmalloc (hdr->p_filesz);
+ err = target_read_memory (loadbase + i_phdr[i].p_vaddr, buf,
+ hdr->p_filesz);
+ if (err == 0)
+ x_phdrs_size = (bfd_get_arch_size (templ) == 64 ? sizeof (Elf64_External_Phdr)
+ : sizeof (Elf32_External_Phdr));
+
-+ i_phdrs = xmalloc (i_ehdr.e_phnum * (sizeof *i_phdrs + x_phdrs_size));
-+ x_phdrs_ptr = (void *) &i_phdrs[i_ehdr.e_phnum];
++ i_phdrs = (Elf_Internal_Phdr *) xmalloc (i_ehdr.e_phnum * (sizeof *i_phdrs + x_phdrs_size));
++ x_phdrs_ptr = (gdb_byte *) &i_phdrs[i_ehdr.e_phnum];
+ err = target_read_memory (ehdr_vma + i_ehdr.e_phoff, (bfd_byte *) x_phdrs_ptr,
+ i_ehdr.e_phnum * x_phdrs_size);
+ if (err)
+ {
+ struct build_id_addr_sect *candidate;
+
-+ candidate = xmalloc (sizeof *candidate);
++ candidate = (struct build_id_addr_sect *) xmalloc (sizeof *candidate);
+ candidate->next = build_id_addr_sect;
+ build_id_addr_sect = candidate;
+ candidate->sect = sect;
if (found == NULL)
warning (_("File \"%s\" has no build-id, file skipped"),
-@@ -65,23 +463,56 @@
+@@ -65,23 +463,54 @@
return retval;
}
+ target = xstrdup (buf);
+ else
+ {
-+ char *dir = ldirname (symlink);
++ const std::string dir (ldirname (symlink));
+
-+ if (dir == NULL)
-+ return xstrdup (symlink);
+ target = xstrprintf ("%s"
+#ifndef HAVE_DOS_BASED_FILE_SYSTEM
+ "/"
+#else /* HAVE_DOS_BASED_FILE_SYSTEM */
+ "\\"
+#endif /* HAVE_DOS_BASED_FILE_SYSTEM */
-+ "%s", dir, buf);
++ "%s", dir.c_str(), buf);
+ }
+
+ retval = link_resolve (target, level + 1);
+
/* See build-id.h. */
- bfd *
+ gdb_bfd_ref_ptr
-build_id_to_debug_bfd (size_t build_id_len, const bfd_byte *build_id)
+build_id_to_debug_bfd (size_t build_id_len, const bfd_byte *build_id,
+ char **link_return, int add_debug_suffix)
VEC (char_ptr) *debugdir_vec;
struct cleanup *back_to;
int ix;
- bfd *abfd = NULL;
+ gdb_bfd_ref_ptr abfd;
- int alloc_len;
/* DEBUG_FILE_DIRECTORY/.build-id/ab/cdef */
- + (sizeof "/.build-id/" - 1) + 1
- + 2 * build_id_len + (sizeof ".debug" - 1) + 1);
- link = (char *) alloca (alloc_len);
-+ link = xmalloc (strlen (debug_file_directory) + 2 * build_id_len + 50);
++ link = (char *) xmalloc (strlen (debug_file_directory) + 2 * build_id_len + 50);
/* Keep backward compatibility so that DEBUG_FILE_DIRECTORY being "" will
cause "/.build-id/..." lookups. */
-@@ -94,9 +525,12 @@
+@@ -94,9 +523,12 @@
size_t debugdir_len = strlen (debugdir);
const gdb_byte *data = build_id;
size_t size = build_id_len;
memcpy (link, debugdir, debugdir_len);
s = &link[debugdir_len];
-@@ -110,47 +544,281 @@
+@@ -110,45 +542,290 @@
*s++ = '/';
while (size-- > 0)
s += sprintf (s, "%02x", (unsigned) *data++);
+ inner = make_cleanup (xfree, filename);
+ abfd = gdb_bfd_open (filename, gnutarget, -1);
+ do_cleanups (inner);
++
++ if (abfd == NULL)
++ continue;
- if (filename == NULL)
- continue;
-+ if (abfd == NULL)
-+ continue;
++ if (build_id_verify (abfd.get(), build_id_len, build_id))
++ break;
- /* We expect to be silent on the non-existing files. */
- inner = make_cleanup (xfree, filename);
- abfd = gdb_bfd_open (filename, gnutarget, -1);
- do_cleanups (inner);
-+ if (build_id_verify (abfd, build_id_len, build_id))
-+ break;
++ abfd.release ();
- if (abfd == NULL)
- continue;
-+ gdb_bfd_unref (abfd);
-+ abfd = NULL;
-
-- if (build_id_verify (abfd, build_id_len, build_id))
-- break;
+ filename = NULL;
+ }
-- gdb_bfd_unref (abfd);
-- abfd = NULL;
+- if (build_id_verify (abfd.get(), build_id_len, build_id))
+- break;
+ if (filename != NULL)
+ {
+ /* LINK_ALL is not used below in this non-NULL FILENAME case. */
+ xfree (link0);
+ break;
+ }
-+
+
+- abfd.release ();
+ /* If the symlink has target request to install the target.
+ BASE-debuginfo.rpm contains the symlink but BASE.rpm may be missing.
+ https://bugzilla.redhat.com/show_bug.cgi?id=981154 */
+ {
+ size_t len_orig = strlen (link_all);
+
-+ link_all = xrealloc (link_all,
-+ len_orig + 1 + strlen (link0_resolved) + 1);
++ link_all = (char *) xrealloc (link_all,
++ len_orig + 1 + strlen (link0_resolved) + 1);
+
+ /* Use whitespace instead of DIRNAME_SEPARATOR to be compatible with
+ its possible use as an argument for installation command. */
+char *
+build_id_to_filename (const struct bfd_build_id *build_id, char **link_return)
+{
-+ bfd *abfd;
++ gdb_bfd_ref_ptr abfd;
+ char *result;
+
+ abfd = build_id_to_debug_bfd (build_id->size, build_id->data, link_return, 0);
+ return NULL;
+
+ result = xstrdup (bfd_get_filename (abfd));
-+ gdb_bfd_unref (abfd);
++ abfd.release ();
+ return result;
+}
+
+ if (*slot != NULL)
+ return;
+
-+ missing_filepair = obstack_alloc (&missing_filepair_obstack,
-+ sizeof (*missing_filepair) - 1
-+ + binary_len0 + debug_len0);
++ missing_filepair = (struct missing_filepair *) obstack_alloc (&missing_filepair_obstack,
++ sizeof (*missing_filepair) - 1
++ + binary_len0 + debug_len0);
+ missing_filepair->binary = missing_filepair->data;
+ memcpy (missing_filepair->binary, binary, binary_len0);
+ if (debug != NULL)
char *
-find_separate_debug_file_by_buildid (struct objfile *objfile)
+find_separate_debug_file_by_buildid (struct objfile *objfile,
-+ char **build_id_filename_return)
++ gdb::unique_xmalloc_ptr<char> *build_id_filename_return)
{
const struct bfd_build_id *build_id;
+ build_id = build_id_bfd_shdr_get (objfile->obfd);
if (build_id != NULL)
{
- bfd *abfd;
-
-- abfd = build_id_to_debug_bfd (build_id->size, build_id->data);
-+ abfd = build_id_to_debug_bfd (build_id->size, build_id->data,
-+ build_id_filename_return, 1);
++ char *build_id_filename_cstr = NULL;
+ gdb_bfd_ref_ptr abfd (build_id_to_debug_bfd (build_id->size,
+- build_id->data));
++ build_id->data,
++ (!build_id_filename_return ? NULL : &build_id_filename_cstr), 1));
++ if (build_id_filename_return)
++ {
++ if (!build_id_filename_cstr)
++ gdb_assert (!*build_id_filename_return);
++ else
++ {
++ *build_id_filename_return = gdb::unique_xmalloc_ptr<char> (build_id_filename_cstr);
++ build_id_filename_cstr = NULL;
++ }
++ }
/* Prevent looping on a stripped .debug file. */
if (abfd != NULL
- && filename_cmp (bfd_get_filename (abfd),
-@@ -170,3 +838,21 @@
+ && filename_cmp (bfd_get_filename (abfd.get ()),
+@@ -160,3 +837,21 @@
}
return NULL;
}
+
+ observer_attach_executable_changed (debug_print_executable_changed);
+}
-Index: gdb-7.10.90.20160211/gdb/build-id.h
+Index: gdb-7.99.90.20170420/gdb/build-id.h
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/build-id.h 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/build-id.h 2016-02-15 23:26:06.368811345 +0100
-@@ -20,9 +20,10 @@
- #ifndef BUILD_ID_H
- #define BUILD_ID_H
+--- gdb-7.99.90.20170420.orig/gdb/build-id.h 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/build-id.h 2017-04-20 23:00:43.371629257 +0200
+@@ -22,9 +22,10 @@
+
+ #include "gdb_bfd.h"
-/* Locate NT_GNU_BUILD_ID from ABFD and return its content. */
+/* Separate debuginfo files have corrupted PHDR but SHDR is correct there.
/* Return true if ABFD has NT_GNU_BUILD_ID matching the CHECK value.
Otherwise, issue a warning and return false. */
-@@ -36,13 +37,18 @@
+@@ -38,13 +39,19 @@
the caller. */
- extern bfd *build_id_to_debug_bfd (size_t build_id_len,
-- const bfd_byte *build_id);
-+ const bfd_byte *build_id, char **link_return,
-+ int add_debug_suffix);
+ extern gdb_bfd_ref_ptr build_id_to_debug_bfd (size_t build_id_len,
+- const bfd_byte *build_id);
++ const bfd_byte *build_id,
++ char **link_return,
++ int add_debug_suffix);
+
+extern char *build_id_to_filename (const struct bfd_build_id *build_id,
+ char **link_return);
-extern char *find_separate_debug_file_by_buildid (struct objfile *objfile);
+extern char *find_separate_debug_file_by_buildid (struct objfile *objfile,
-+ char **build_id_filename_return);
++ gdb::unique_xmalloc_ptr<char> *build_id_filename_return);
#endif /* BUILD_ID_H */
-Index: gdb-7.10.90.20160211/gdb/dwarf2read.c
+Index: gdb-7.99.90.20170420/gdb/dwarf2read.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/dwarf2read.c 2016-02-15 23:25:36.461599001 +0100
-+++ gdb-7.10.90.20160211/gdb/dwarf2read.c 2016-02-15 23:26:06.373811380 +0100
-@@ -2516,7 +2516,7 @@
+--- gdb-7.99.90.20170420.orig/gdb/dwarf2read.c 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/dwarf2read.c 2017-04-20 23:00:43.375629279 +0200
+@@ -2671,7 +2671,7 @@
}
if (dwz_bfd == NULL)
if (dwz_bfd == NULL)
error (_("could not find '.gnu_debugaltlink' file for %s"),
-Index: gdb-7.10.90.20160211/gdb/python/py-objfile.c
+Index: gdb-7.99.90.20170420/gdb/python/py-objfile.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/python/py-objfile.c 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/python/py-objfile.c 2016-02-15 23:26:06.373811380 +0100
-@@ -139,7 +139,7 @@
+--- gdb-7.99.90.20170420.orig/gdb/python/py-objfile.c 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/python/py-objfile.c 2017-04-20 23:00:43.375629279 +0200
+@@ -137,7 +137,7 @@
TRY
{
}
CATCH (except, RETURN_MASK_ALL)
{
-@@ -548,7 +548,7 @@
+@@ -544,7 +544,7 @@
/* Don't return separate debug files. */
if (objfile->separate_debug_objfile_backlink != NULL)
continue;
if (obfd_build_id == NULL)
continue;
if (objfpy_build_id_matches (obfd_build_id, build_id))
-Index: gdb-7.10.90.20160211/gdb/coffread.c
+Index: gdb-7.99.90.20170420/gdb/coffread.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/coffread.c 2016-02-15 23:25:00.859346221 +0100
-+++ gdb-7.10.90.20160211/gdb/coffread.c 2016-02-15 23:26:06.374811387 +0100
-@@ -739,7 +739,7 @@
+--- gdb-7.99.90.20170420.orig/gdb/coffread.c 2017-04-20 23:00:35.415584426 +0200
++++ gdb-7.99.90.20170420/gdb/coffread.c 2017-04-20 23:00:43.376629285 +0200
+@@ -734,7 +734,7 @@
{
char *debugfile;
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.ada/packed_array.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.ada/packed_array.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/gdb.ada/packed_array.exp 2016-02-15 23:33:29.830959972 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.ada/packed_array.exp 2016-02-15 23:35:56.289999846 +0100
+--- gdb-7.12.50.20170207.orig/gdb/testsuite/gdb.ada/packed_array.exp 2017-02-26 19:15:28.552824751 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.ada/packed_array.exp 2017-02-26 19:15:36.597882316 +0100
@@ -56,5 +56,11 @@
# are. Observed with (FSF GNU Ada 4.5.3 20110124).
xfail $test
+ }
}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-pointer-foo.S
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S 2016-02-15 23:35:56.290999853 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-pointer-foo.S 2017-02-26 19:15:36.598882323 +0100
+@@ -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
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-pointer.c
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-pointer.c 2017-02-26 19:15:36.598882323 +0100
+@@ -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 <http://www.gnu.org/licenses/>. */
++
++#if 0
++
++void
++foo (int size)
++{
++ typedef char array_t[size];
++ array_t array;
++ int i;
++
++ for (i = 0; i < size; i++)
++ array[i] = i;
++
++ array[0] = 0; /* break-here */
++}
++
++#else
++
++void foo (int size);
++
++int
++main (void)
++{
++ foo (26);
++ foo (78);
++ return 0;
++}
++
++#endif
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-pointer.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-pointer.exp 2017-02-26 19:15:36.598882323 +0100
+@@ -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 <http://www.gnu.org/licenses/>.
++
++if ![istarget "x86_64-*-*"] then {
++ verbose "Skipping over gdb.arch/x86_64-vla-pointer.exp test made only for x86_64."
++ return
++}
++
++set testfile x86_64-vla-pointer
++set srcasmfile ${testfile}-foo.S
++set srcfile ${testfile}.c
++set binfile [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"
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-typedef-foo.S 2017-02-26 19:15:36.598882323 +0100
@@ -0,0 +1,455 @@
+ .file "x86_64-vla-typedef.c"
+ .section .debug_abbrev,"",@progbits
+ .string "GNU C 4.3.2 20081105 (Red Hat 4.3.2-7)"
+ .ident "GCC: (GNU) 4.3.2 20081105 (Red Hat 4.3.2-7)"
+ .section .note.GNU-stack,"",@progbits
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c 2016-02-15 23:35:56.290999853 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-typedef.c 2017-02-26 19:15:36.599882330 +0100
@@ -0,0 +1,45 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+}
+
+#endif
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp 2016-02-15 23:35:56.290999853 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.arch/x86_64-vla-typedef.exp 2017-02-26 19:15:36.599882330 +0100
@@ -0,0 +1,64 @@
+# Copyright 2009 Free Software Foundation, Inc.
+
+gdb_test "whatis array" "type = array_t" "second: whatis array"
+
+gdb_test "ptype array" "type = char \\\[78\\\]" "second: ptype array"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/arrayidx.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/arrayidx.c
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/gdb.base/arrayidx.c 2016-02-15 23:33:29.830959972 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/arrayidx.c 2016-02-15 23:35:56.290999853 +0100
+--- gdb-7.12.50.20170207.orig/gdb/testsuite/gdb.base/arrayidx.c 2017-02-26 19:15:28.555824772 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/arrayidx.c 2017-02-26 19:15:36.599882330 +0100
@@ -17,6 +17,13 @@
int array[] = {1, 2, 3, 4};
int
main (void)
{
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/arrayidx.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/arrayidx.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/gdb.base/arrayidx.exp 2016-02-15 23:33:29.830959972 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/arrayidx.exp 2016-02-15 23:35:56.291999860 +0100
+--- gdb-7.12.50.20170207.orig/gdb/testsuite/gdb.base/arrayidx.exp 2017-02-26 19:15:28.555824772 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/arrayidx.exp 2017-02-26 19:15:36.599882330 +0100
@@ -49,4 +49,12 @@
"\\{\\\[0\\\] = 1, \\\[1\\\] = 2, \\\[2\\\] = 3, \\\[3\\\] = 4\\}" \
- "Print array with array-indexes on"
+ "print array with array-indexes on"
-
+set test "p unbound.a == &unbound.a\[0\]"
+ unsupported "$test (no GCC)"
+ }
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/internal-var-field-address.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/internal-var-field-address.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/internal-var-field-address.c 2016-02-15 23:35:56.291999860 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/internal-var-field-address.c 2017-02-26 19:15:36.599882330 +0100
@@ -0,0 +1,20 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+struct {
+ int field;
+} staticstruct = { 1 };
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/internal-var-field-address.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/internal-var-field-address.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/internal-var-field-address.exp 2016-02-15 23:35:56.291999860 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/internal-var-field-address.exp 2017-02-26 19:15:36.600882337 +0100
@@ -0,0 +1,26 @@
+# Copyright 2009 Free Software Foundation, Inc.
+
+
+gdb_test {set $varstruct = staticstruct}
+gdb_test {p $varstruct.field} " = 1"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-frame.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-frame.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-frame.c 2016-02-15 23:35:56.291999860 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-frame.c 2017-02-26 19:15:36.600882337 +0100
@@ -0,0 +1,31 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ f (s);
+ return 0;
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-frame.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-frame.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-frame.exp 2016-02-15 23:35:56.291999860 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-frame.exp 2017-02-26 19:15:36.600882337 +0100
@@ -0,0 +1,38 @@
+# Copyright 2011 Free Software Foundation, Inc.
+#
+}
+
+gdb_test "bt full" "\r\n +s = \"X\\\\000\"\r\n.*"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-overflow.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-overflow.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-overflow.c 2016-02-15 23:35:56.291999860 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-overflow.c 2017-02-26 19:15:36.600882337 +0100
@@ -0,0 +1,30 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+
+ return 0;
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-overflow.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-overflow.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla-overflow.exp 2016-02-15 23:35:56.292999867 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla-overflow.exp 2017-02-26 19:15:36.600882337 +0100
@@ -0,0 +1,109 @@
+# Copyright 2008 Free Software Foundation, Inc.
+
+gdb_test "bt" "in \[^ \]*abort \\(.* in main \\(.*" "Backtrace after abort()"
+
+verbose -log "kb_found in bt after abort() = [expr [memory_v_pages_get] * $pagesize / 1024]"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla.c 2016-02-15 23:35:56.292999867 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla.c 2017-02-26 19:15:36.600882337 +0100
@@ -0,0 +1,55 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ foo (78);
+ return 0;
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.base/vla.exp 2016-02-15 23:35:56.292999867 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.base/vla.exp 2017-02-26 19:15:36.600882337 +0100
@@ -0,0 +1,62 @@
+# Copyright 2008 Free Software Foundation, Inc.
+
+gdb_test "p temp1" " = '1' <repeats 78 times>" "second: print temp1"
+gdb_test "p temp2" " = '2' <repeats 78 times>" "second: print temp2"
+gdb_test "p temp3" " = '3' <repeats 48 times>" "second: print temp3"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.cp/gdb9593.cc
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.cp/gdb9593.cc 2017-02-26 19:15:36.601882344 +0100
+@@ -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 <http://www.gnu.org/licenses/>.
++ */
++#include <iostream>
++
++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 (...)
++ {
++ }
++}
++
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.cp/gdb9593.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S 2016-02-15 23:35:56.292999867 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.cp/gdb9593.exp 2017-02-26 19:15:36.601882344 +0100
+@@ -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 <http://www.gnu.org/licenses/>.
++
++
++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"
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.S 2017-02-26 19:15:36.601882344 +0100
@@ -0,0 +1,246 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ .string "char"
+.Luint_str:
+ .string "unsigned int"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp 2016-02-15 23:35:56.292999867 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-bound-loclist.exp 2017-02-26 19:15:36.602882352 +0100
@@ -0,0 +1,66 @@
+# Copyright 2010 Free Software Foundation, Inc.
+
+
+# The register contains unpredictable value - the array size.
+gdb_test "ptype reg_string" {type = char \[-?[0-9]+\]}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-stripped.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-stripped.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-stripped.c 2016-02-15 23:35:56.293999874 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-stripped.c 2017-02-26 19:15:36.602882352 +0100
@@ -0,0 +1,42 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ func1 (1, 2);
+ return 0;
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 2016-02-15 23:35:56.293999874 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-stripped.exp 2017-02-26 19:15:36.602882352 +0100
@@ -0,0 +1,79 @@
+# Copyright 2006 Free Software Foundation, Inc.
+
+
+set testfile "dw2-stripped"
+set srcfile ${testfile}.c
-+set binfile ${objdir}/${subdir}/${testfile}.x
++set binfile [standard_output_file ${testfile}.x]
+
+remote_exec build "rm -f ${binfile}"
+
+gdb_test "step" \
+ "func.* \\(.*\\) at .*" \
+ "step"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S 2016-02-15 23:35:56.293999874 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.S 2017-02-26 19:15:36.602882352 +0100
@@ -0,0 +1,83 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+
+ .byte 0x0 /* Terminator */
+ .byte 0x0 /* Terminator */
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp 2016-02-15 23:35:56.293999874 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-struct-member-data-location.exp 2017-02-26 19:15:36.602882352 +0100
@@ -0,0 +1,37 @@
+# Copyright 2009 Free Software Foundation, Inc.
+
+clean_restart $binfile
+
+gdb_test "ptype struct some_struct" "type = struct some_struct {\[\r\n \t\]*void field;\[\r\n \t\]*}"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S 2016-02-15 23:35:56.293999874 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.S 2017-02-26 19:15:36.602882352 +0100
@@ -0,0 +1,121 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+ .byte 0x0 /* Terminator */
+
+ .byte 0x0 /* Terminator */
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp 2016-02-15 23:35:56.293999874 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.dwarf2/dw2-subrange-no-type.exp 2017-02-26 19:15:36.603882359 +0100
@@ -0,0 +1,39 @@
+# Copyright 2012 Free Software Foundation, Inc.
+
+
+gdb_test "ptype notype_string" {type = char \[129\]}
+gdb_test "p notype_string" " = 'x' <repeats 129 times>"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dwarf-stride.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dwarf-stride.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dwarf-stride.exp 2016-02-15 23:35:56.294999881 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dwarf-stride.exp 2017-02-26 19:15:36.603882359 +0100
@@ -0,0 +1,42 @@
+# Copyright 2009 Free Software Foundation, Inc.
+
+gdb_continue_to_breakpoint "break-here" ".*break-here.*"
+gdb_test "p c40pt(1)" " = '0-hello.*"
+gdb_test "p c40pt(2)" " = '1-hello.*"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dwarf-stride.f90
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dwarf-stride.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dwarf-stride.f90 2016-02-15 23:35:56.294999881 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dwarf-stride.f90 2017-02-26 19:15:36.603882359 +0100
@@ -0,0 +1,40 @@
+! Copyright 2009 Free Software Foundation, Inc.
+!
+ print *, c40pt ! break-here
+
+end program repro
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dynamic.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dynamic.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dynamic.exp 2016-02-15 23:36:39.358305635 +0100
-@@ -0,0 +1,151 @@
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dynamic.exp 2017-02-26 19:15:36.603882359 +0100
+@@ -0,0 +1,154 @@
+# Copyright 2007 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+
+gdb_breakpoint [gdb_get_line_number "varx-init"]
+gdb_continue_to_breakpoint "varx-init"
-+gdb_test "p varx" "\\$\[0-9\]* = <not allocated>" "p varx unallocated"
-+gdb_test "ptype varx" "type = <not allocated>" "ptype varx unallocated"
-+gdb_test "p varx(1,5,17)" {no such vector element \(vector not allocated\)} "p varx(1,5,17) unallocated"
-+gdb_test "p varx(1,5,17)=1" {no such vector element \(vector not allocated\)} "p varx(1,5,17)=1 unallocated"
-+gdb_test "ptype varx(1,5,17)" {no such vector element \(vector not allocated\)} "ptype varx(1,5,17) unallocated"
++
++# http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#5
++# Do not: gdb_test "p varx" "\\$\[0-9\]* = <not allocated>" "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"
+gdb_test "p varx(1, 5, 17)" "\\$\[0-9\]* = 7"
+gdb_test "p varx(2, 6, 18)" "\\$\[0-9\]* = 8"
+gdb_test "p varx(6, 15, 28)" "\\$\[0-9\]* = 9"
-+gdb_test "p varv" "\\$\[0-9\]* = <not associated>" "p varv unassociated"
-+gdb_test "ptype varv" "type = <not associated>" "ptype varv unassociated"
++# http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#5
++# Do not: gdb_test "p varv" "\\$\[0-9\]* = <not associated>" "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 {
+gdb_continue_to_breakpoint "varv-deassociated"
+# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type.
+gdb_test "p varv" "\\$\[0-9\]* = (<not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "p varv deassociated"
-+gdb_test "ptype varv" "type = (<not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "ptype varv deassociated"
++gdb_test "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\]* = <not allocated>" "p varx deallocated"
-+gdb_test "ptype varx" "type = <not allocated>" "ptype varx deallocated"
++gdb_test "ptype varx" {type = real\(kind=4\) \(:,:,:\)} "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_test "p vart(3,8)" "\\$\[0-9\]* = 9"
+# maps to foo::vary(1,3)
+gdb_test "p vart(2,9)" "\\$\[0-9\]* = 10"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dynamic.f90
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dynamic.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/dynamic.f90 2016-02-15 23:35:56.294999881 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/dynamic.f90 2017-02-26 19:15:36.603882359 +0100
@@ -0,0 +1,98 @@
+! Copyright 2007 Free Software Foundation, Inc.
+!
+ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort
+ if (x (3, 1) .ne. 10) call abort
+end
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/string.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/string.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/string.exp 2016-02-15 23:36:39.359305642 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/string.exp 2017-02-26 19:15:36.604882366 +0100
@@ -0,0 +1,59 @@
+# Copyright 2008 Free Software Foundation, Inc.
+
+gdb_continue_to_breakpoint "var-finish"
+gdb_test "p e" "\\$\[0-9\]* = 'e '" "p e re-set"
+gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f2 ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\)" "p *f re-set"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/string.f90
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/string.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/string.f90 2016-02-15 23:35:56.295999888 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/string.f90 2017-02-26 19:15:36.604882366 +0100
@@ -0,0 +1,37 @@
+! Copyright 2008 Free Software Foundation, Inc.
+!
+ h = 'h'
+ call foo (g, h)
+end
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/subrange.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/subrange.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/subrange.exp 2016-02-15 23:35:56.295999888 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/subrange.exp 2017-02-26 19:15:36.604882366 +0100
@@ -0,0 +1,72 @@
+# Copyright 2011 Free Software Foundation, Inc.
+
+gdb_unload
+setup_kfail "*-*-*" "vlaregression/9999"
+gdb_test {p $a (3, 2:2)} { = \(23\)}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/subrange.f90
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/subrange.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.fortran/subrange.f90 2016-02-15 23:35:56.295999888 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.fortran/subrange.f90 2017-02-26 19:15:36.604882366 +0100
@@ -0,0 +1,28 @@
+! Copyright 2011 Free Software Foundation, Inc.
+!
+ ptr => a
+ write (*,*) a ! break-static
+end
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.mi/mi2-var-stale-type.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.mi/mi2-var-stale-type.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.mi/mi2-var-stale-type.c 2016-02-15 23:35:56.295999888 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.mi/mi2-var-stale-type.c 2017-02-26 19:15:36.604882366 +0100
@@ -0,0 +1,26 @@
+/* Copyright 2011 Free Software Foundation, Inc.
+
+
+ return 0;
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp 2016-02-15 23:35:56.295999888 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.mi/mi2-var-stale-type.exp 2017-02-26 19:15:36.604882366 +0100
@@ -0,0 +1,57 @@
+# Copyright 2011 Free Software Foundation, Inc.
+#
+mi_create_varobj "vla" "vla" "create local variable vla"
+
+mi_gdb_test "-var-update *" "\\^done,changelist=.*" "-var-update *"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.opt/array-from-register-func.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/array-from-register-func.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.opt/array-from-register-func.c 2016-02-15 23:35:56.295999888 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/array-from-register-func.c 2017-02-26 19:15:36.604882366 +0100
@@ -0,0 +1,22 @@
+/* This file is part of GDB, the GNU debugger.
+
+{
+ return arr[0];
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.opt/array-from-register.c
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/array-from-register.c
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.opt/array-from-register.c 2016-02-15 23:35:56.296999895 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/array-from-register.c 2017-02-26 19:15:36.605882373 +0100
@@ -0,0 +1,28 @@
+/* This file is part of GDB, the GNU debugger.
+
+
+ return 0;
+}
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.opt/array-from-register.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/array-from-register.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.opt/array-from-register.exp 2016-02-15 23:35:56.296999895 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/array-from-register.exp 2017-02-26 19:15:36.605882373 +0100
@@ -0,0 +1,33 @@
+# Copyright 2009 Free Software Foundation, Inc.
+#
+# Seen regression:
+# Address requested for identifier "arr" which is in register $rdi
+gdb_test "p arr\[0\]" "\\$\[0-9\]+ = 42"
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.pascal/arrays.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/fortran-string.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/fortran-string.exp 2017-02-26 19:15:36.605882373 +0100
+@@ -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 <jan.kratochvil@redhat.com>.
++
++# 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'"
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/fortran-string.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.opt/fortran-string.f90 2017-02-26 19:15:36.605882373 +0100
+@@ -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 <jakub@redhat.com>.
++! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
++
++ subroutine f(s)
++ character*(*) s
++ s = s
++ end
++
++ program main
++ call f ('foo')
++ end
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.pascal/arrays.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.pascal/arrays.exp 2016-02-15 23:36:39.359305642 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.pascal/arrays.exp 2017-02-26 19:15:36.605882373 +0100
@@ -0,0 +1,104 @@
+# Copyright 2008, 2009 Free Software Foundation, Inc.
+#
+}
+gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char"
+
-Index: gdb-7.10.90.20160211/gdb/testsuite/gdb.pascal/arrays.pas
+Index: gdb-7.12.50.20170207/gdb/testsuite/gdb.pascal/arrays.pas
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.90.20160211/gdb/testsuite/gdb.pascal/arrays.pas 2016-02-15 23:35:56.296999895 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/gdb.pascal/arrays.pas 2017-02-26 19:15:36.605882373 +0100
@@ -0,0 +1,82 @@
+{
+ Copyright 2008, 2009 Free Software Foundation, Inc.
+ s := 'test'#0'string';
+ writeln(s); { set breakpoint 2 here }
+end.
-Index: gdb-7.10.90.20160211/gdb/testsuite/lib/gdb.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/lib/gdb.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/lib/gdb.exp 2016-02-15 23:35:55.326993008 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/lib/gdb.exp 2016-02-15 23:35:56.297999903 +0100
-@@ -173,6 +173,11 @@
+--- gdb-7.12.50.20170207.orig/gdb/testsuite/lib/gdb.exp 2017-02-26 19:15:28.564824836 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/lib/gdb.exp 2017-02-26 19:15:36.607882387 +0100
+@@ -178,6 +178,11 @@
send_gdb "y\n"
exp_continue
}
-re "Discard symbol table from .*y or n.*$" {
send_gdb "y\n"
exp_continue
-Index: gdb-7.10.90.20160211/gdb/testsuite/lib/pascal.exp
+Index: gdb-7.12.50.20170207/gdb/testsuite/lib/pascal.exp
===================================================================
---- gdb-7.10.90.20160211.orig/gdb/testsuite/lib/pascal.exp 2016-02-15 23:33:29.830959972 +0100
-+++ gdb-7.10.90.20160211/gdb/testsuite/lib/pascal.exp 2016-02-15 23:35:56.298999910 +0100
+--- gdb-7.12.50.20170207.orig/gdb/testsuite/lib/pascal.exp 2017-02-26 19:15:28.565824844 +0100
++++ gdb-7.12.50.20170207/gdb/testsuite/lib/pascal.exp 2017-02-26 19:15:36.607882387 +0100
@@ -37,6 +37,9 @@
global pascal_compiler_is_fpc
global gpc_compiler
+++ /dev/null
-Re: [PATCH 04/23] vla: make dynamic fortran arrays functional.
-https://sourceware.org/ml/gdb-patches/2014-06/msg00570.html
-
-Index: gdb-7.10.50.20151027/gdb/valarith.c
-===================================================================
---- gdb-7.10.50.20151027.orig/gdb/valarith.c 2015-11-03 20:41:48.543504999 +0100
-+++ gdb-7.10.50.20151027/gdb/valarith.c 2015-11-03 20:46:36.995238888 +0100
-@@ -193,10 +193,17 @@ value_subscripted_rvalue (struct value *
- struct type *array_type = check_typedef (value_type (array));
- struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
- unsigned int elt_size = type_length_units (elt_type);
-- unsigned int elt_offs = longest_to_int (index - lowerbound);
-+ unsigned int elt_offs;
- LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
- struct value *v;
-
-+ if (TYPE_NOT_ASSOCIATED (array_type))
-+ error (_("no such vector element (vector not associated)"));
-+ if (TYPE_NOT_ALLOCATED (array_type))
-+ error (_("no such vector element (vector not allocated)"));
-+
-+ elt_offs = longest_to_int (index - lowerbound);
-+
- if (elt_stride > 0)
- elt_offs *= elt_stride;
- else if (elt_stride < 0)
-@@ -210,14 +217,7 @@ value_subscripted_rvalue (struct value *
-
- if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
- && elt_offs >= type_length_units (array_type)))
-- {
-- if (type_not_associated (array_type))
-- error (_("no such vector element (vector not associated)"));
-- else if (type_not_allocated (array_type))
-- error (_("no such vector element (vector not allocated)"));
-- else
-- error (_("no such vector element"));
-- }
-+ error (_("no such vector element"));
-
- if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
- v = allocate_value_lazy (elt_type);
--- /dev/null
+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(-)
+
+Index: gdb-7.99.90.20170420/gdb/dwarf2loc.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/dwarf2loc.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/dwarf2loc.c 2017-04-20 22:26:14.356446562 +0200
+@@ -2622,11 +2622,14 @@
+ /* See dwarf2loc.h. */
+
+ int
+-dwarf2_evaluate_property (const struct dynamic_prop *prop,
++dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
+ struct frame_info *frame,
+ struct property_addr_info *addr_stack,
+- CORE_ADDR *value)
++ CORE_ADDR *value,
++ int is_signed)
+ {
++ int rc = 0;
++
+ if (prop == NULL)
+ return 0;
+
+@@ -2650,7 +2653,7 @@
+
+ *value = value_as_address (val);
+ }
+- return 1;
++ rc = 1;
+ }
+ }
+ break;
+@@ -2672,7 +2675,7 @@
+ if (!value_optimized_out (val))
+ {
+ *value = value_as_address (val);
+- return 1;
++ rc = 1;
+ }
+ }
+ }
+@@ -2680,8 +2683,8 @@
+
+ case PROP_CONST:
+ *value = prop->data.const_val;
+- return 1;
+-
++ rc = 1;
++ break;
+ case PROP_ADDR_OFFSET:
+ {
+ struct dwarf2_property_baton *baton
+@@ -2702,11 +2705,38 @@
+ val = value_at (baton->offset_info.type,
+ pinfo->addr + baton->offset_info.offset);
+ *value = value_as_address (val);
+- return 1;
++ rc = 1;
+ }
++ break;
++ }
++
++ if (rc == 1 && is_signed == 1)
++ {
++ /* If we have a valid return candidate and it's value is signed,
++ we have to sign-extend the value because CORE_ADDR on 64bit machine has
++ 8 bytes but address size of an 32bit application is 4 bytes. */
++ struct gdbarch * gdbarch = target_gdbarch ();
++ const int addr_bit = gdbarch_addr_bit (gdbarch);
++ const CORE_ADDR neg_mask = ((~0) << (addr_bit - 1));
++
++ /* Check if signed bit is set and sign-extend values. */
++ if (*value & (neg_mask))
++ *value |= (neg_mask );
+ }
++ return rc;
++}
+
+- return 0;
++int
++dwarf2_evaluate_property (const struct dynamic_prop *prop,
++ struct frame_info *frame,
++ struct property_addr_info *addr_stack,
++ CORE_ADDR *value)
++{
++ return dwarf2_evaluate_property_signed (prop,
++ frame,
++ addr_stack,
++ value,
++ 0);
+ }
+
+ /* See dwarf2loc.h. */
+Index: gdb-7.99.90.20170420/gdb/dwarf2loc.h
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/dwarf2loc.h 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/dwarf2loc.h 2017-04-20 22:26:14.356446562 +0200
+@@ -143,6 +143,12 @@
+ struct property_addr_info *addr_stack,
+ CORE_ADDR *value);
+
++int dwarf2_evaluate_property_signed (const struct dynamic_prop *prop,
++ struct frame_info *frame,
++ struct property_addr_info *addr_stack,
++ CORE_ADDR *value,
++ int is_signed);
++
+ /* A helper for the compiler interface that compiles a single dynamic
+ property to C code.
+
+Index: gdb-7.99.90.20170420/gdb/dwarf2read.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/dwarf2read.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/dwarf2read.c 2017-04-20 22:27:08.510788562 +0200
+@@ -15268,7 +15268,7 @@
+ struct type *base_type, *orig_base_type;
+ struct type *range_type;
+ struct attribute *attr;
+- struct dynamic_prop low, high;
++ struct dynamic_prop low, high, stride;
+ int low_default_is_valid;
+ int high_bound_is_count = 0;
+ const char *name;
+@@ -15288,7 +15288,9 @@
+
+ low.kind = PROP_CONST;
+ high.kind = PROP_CONST;
++ stride.kind = PROP_CONST;
+ high.data.const_val = 0;
++ stride.data.const_val = 0;
+
+ /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
+ omitting DW_AT_lower_bound. */
+@@ -15321,6 +15323,13 @@
+ break;
+ }
+
++ attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
++ if (attr)
++ if (!attr_to_dynamic_prop (attr, die, cu, &stride))
++ complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
++ "- DIE at 0x%x [in module %s]"),
++ to_underlying (die->sect_off), objfile_name (cu->objfile));
++
+ attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
+ if (attr)
+ attr_to_dynamic_prop (attr, die, cu, &low);
+@@ -15397,7 +15406,7 @@
+ && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
+ high.data.const_val |= negative_mask;
+
+- range_type = create_range_type (NULL, orig_base_type, &low, &high);
++ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
+
+ if (high_bound_is_count)
+ TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
+Index: gdb-7.99.90.20170420/gdb/eval.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/eval.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/eval.c 2017-04-20 22:26:14.362446600 +0200
+@@ -379,29 +379,325 @@
+ 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;
++ int i, dim_count = 0;
+ LONGEST low_bound, high_bound;
+- struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
+- enum range_type range_type
+- = (enum range_type) longest_to_int (exp->elts[pc].longconst);
+-
+- *pos += 3;
++ struct value *new_array = array;
++ struct type *array_type = check_typedef (value_type (new_array));
++ struct type *elt_type;
++
++ typedef struct subscript_range
++ {
++ 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];
+
+- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+- low_bound = TYPE_LOW_BOUND (range);
+- else
+- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
++ /* 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;
+
+- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+- high_bound = TYPE_HIGH_BOUND (range);
+- else
+- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
++ 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 (NULL_TYPE, exp,
++ pos, noside));
++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)
++ == SUBARRAY_HIGH_BOUND)
++ range->high = value_as_long (evaluate_subexp (NULL_TYPE, 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 (NULL_TYPE, exp,
++ pos, noside));
++
++ /* Assign the default stride value '1'. */
++ else
++ range->stride = 1;
++
++ /* 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 = TYPE_INDEX_TYPE (array_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 = TYPE_LOW_BOUND (index_type);
++
++ if ((range->f90_range_type & SUBARRAY_HIGH_BOUND) == 0)
++ range->high = TYPE_HIGH_BOUND (index_type);
++
++ /* Both user provided low and high bound have to be inside the
++ array bounds. Throw an error if not. */
++ if (range->low < TYPE_LOW_BOUND (index_type)
++ || range->low > TYPE_HIGH_BOUND (index_type)
++ || range->high < TYPE_LOW_BOUND (index_type)
++ || range->high > TYPE_HIGH_BOUND (index_type))
++ 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;
+
+- return value_slice (array, low_bound, high_bound - low_bound + 1);
++ }
++
++ 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 = TYPE_INDEX_TYPE (array_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 < TYPE_LOW_BOUND (index_type)
++ && index->U.number > TYPE_HIGH_BOUND (index_type))
++ error (_("provided bound(s) outside array bound(s)"));
++
++ if (index->U.number > TYPE_LOW_BOUND (index_type)
++ && index->U.number > TYPE_HIGH_BOUND (index_type))
++ 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));
++
++ /* 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);
++
++ TYPE_CODE (interim_array_type)
++ = TYPE_CODE (value_type (new_array));
++
++ 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;
+ }
+
+
+@@ -1790,19 +2086,8 @@
+ switch (code)
+ {
+ case TYPE_CODE_ARRAY:
+- if (exp->elts[*pos].opcode == OP_RANGE)
+- return value_f90_subarray (arg1, exp, pos, noside);
+- else
+- goto multi_f77_subscript;
+-
+ case TYPE_CODE_STRING:
+- if (exp->elts[*pos].opcode == OP_RANGE)
+- return value_f90_subarray (arg1, exp, pos, noside);
+- else
+- {
+- 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:
+@@ -2203,49 +2488,6 @@
+ }
+ 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 (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+@@ -3102,6 +3344,9 @@
+ int ndimen = 1;
+ struct type *tmp_type;
+
++ if (TYPE_CODE (array_type) == TYPE_CODE_STRING)
++ return 1;
++
+ if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
+ error (_("Can't get dimensions for a non-array type"));
+
+Index: gdb-7.99.90.20170420/gdb/expprint.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/expprint.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/expprint.c 2017-04-20 22:26:14.363446607 +0200
+@@ -568,12 +568,10 @@
+ *pos += 2;
+
+ fputs_filtered ("RANGE(", stream);
+- if (range_type == HIGH_BOUND_DEFAULT
+- || range_type == NONE_BOUND_DEFAULT)
++ 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;
+@@ -1055,16 +1053,16 @@
+
+ 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 HIGH_BOUND_DEFAULT:
++ case SUBARRAY_LOW_BOUND:
+ fputs_filtered ("Range 'EXP..'", stream);
+ break;
+- case NONE_BOUND_DEFAULT:
++ case (SUBARRAY_LOW_BOUND | SUBARRAY_HIGH_BOUND):
+ fputs_filtered ("Range 'EXP..EXP'", stream);
+ break;
+ default:
+@@ -1072,11 +1070,9 @@
+ 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;
+Index: gdb-7.99.90.20170420/gdb/expression.h
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/expression.h 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/expression.h 2017-04-20 22:26:14.363446607 +0200
+@@ -154,17 +154,17 @@
+ 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. So we have four 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. This enumeration type is to identify
++ this. */
++
+ enum range_type
+ {
+- BOTH_BOUND_DEFAULT, /* "(:)" */
+- LOW_BOUND_DEFAULT, /* "(:high)" */
+- HIGH_BOUND_DEFAULT, /* "(low:)" */
+- NONE_BOUND_DEFAULT /* "(low:high)" */
++ SUBARRAY_NONE_BOUND = 0x0, /* "( : )" */
++ SUBARRAY_LOW_BOUND = 0x1, /* "(low:)" */
++ SUBARRAY_HIGH_BOUND = 0x2, /* "(:high)" */
++ SUBARRAY_STRIDE = 0x4 /* "(::stride)" */
+ };
+
+ #endif /* !defined (EXPRESSION_H) */
+Index: gdb-7.99.90.20170420/gdb/f-exp.y
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/f-exp.y 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/f-exp.y 2017-04-20 22:26:14.363446607 +0200
+@@ -254,31 +254,63 @@
+
+ arglist : arglist ',' exp %prec ABOVE_COMMA
+ { arglist_len++; }
++ | arglist ',' subrange %prec ABOVE_COMMA
++ { 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); }
+ ;
+
+Index: gdb-7.99.90.20170420/gdb/f-valprint.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/f-valprint.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/f-valprint.c 2017-04-20 22:26:14.364446613 +0200
+@@ -121,8 +121,14 @@
+
+ if (nss != ndimensions)
+ {
+- size_t dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
++ size_t dim_size;
+ size_t offs = 0;
++ LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
++
++ if (byte_stride)
++ dim_size = byte_stride;
++ else
++ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
+
+ for (i = lowerbound;
+ (i < upperbound + 1 && (*elts) < options->print_max);
+Index: gdb-7.99.90.20170420/gdb/gdbtypes.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/gdbtypes.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/gdbtypes.c 2017-04-20 22:26:14.365446619 +0200
+@@ -862,7 +862,8 @@
+ struct type *
+ create_range_type (struct type *result_type, struct type *index_type,
+ const struct dynamic_prop *low_bound,
+- const struct dynamic_prop *high_bound)
++ const struct dynamic_prop *high_bound,
++ const struct dynamic_prop *stride)
+ {
+ if (result_type == NULL)
+ result_type = alloc_type_copy (index_type);
+@@ -877,6 +878,7 @@
+ TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
+ TYPE_RANGE_DATA (result_type)->low = *low_bound;
+ TYPE_RANGE_DATA (result_type)->high = *high_bound;
++ TYPE_RANGE_DATA (result_type)->stride = *stride;
+
+ if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
+ TYPE_UNSIGNED (result_type) = 1;
+@@ -905,7 +907,7 @@
+ create_static_range_type (struct type *result_type, struct type *index_type,
+ LONGEST low_bound, LONGEST high_bound)
+ {
+- struct dynamic_prop low, high;
++ struct dynamic_prop low, high, stride;
+
+ low.kind = PROP_CONST;
+ low.data.const_val = low_bound;
+@@ -913,7 +915,11 @@
+ high.kind = PROP_CONST;
+ high.data.const_val = high_bound;
+
+- result_type = create_range_type (result_type, index_type, &low, &high);
++ stride.kind = PROP_CONST;
++ stride.data.const_val = 0;
++
++ result_type = create_range_type (result_type, index_type,
++ &low, &high, &stride);
+
+ return result_type;
+ }
+@@ -1110,16 +1116,20 @@
+ && (!type_not_associated (result_type)
+ && !type_not_allocated (result_type)))
+ {
+- LONGEST low_bound, high_bound;
++ LONGEST low_bound, high_bound, byte_stride;
+
+ if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
+ low_bound = high_bound = 0;
+ element_type = check_typedef (element_type);
++ byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
++
+ /* Be careful when setting the array length. Ada arrays can be
+ empty arrays with the high_bound being smaller than the low_bound.
+ In such cases, the array length should be zero. */
+ if (high_bound < low_bound)
+ TYPE_LENGTH (result_type) = 0;
++ else if (byte_stride > 0)
++ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
+ else if (bit_stride > 0)
+ TYPE_LENGTH (result_type) =
+ (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
+@@ -1912,12 +1922,12 @@
+ CORE_ADDR value;
+ struct type *static_range_type, *static_target_type;
+ const struct dynamic_prop *prop;
+- struct dynamic_prop low_bound, high_bound;
++ struct dynamic_prop low_bound, high_bound, stride;
+
+ gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
+
+ prop = &TYPE_RANGE_DATA (dyn_range_type)->low;
+- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
++ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
+ {
+ low_bound.kind = PROP_CONST;
+ low_bound.data.const_val = value;
+@@ -1929,7 +1939,7 @@
+ }
+
+ prop = &TYPE_RANGE_DATA (dyn_range_type)->high;
+- if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
++ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
+ {
+ high_bound.kind = PROP_CONST;
+ high_bound.data.const_val = value;
+@@ -1944,12 +1954,20 @@
+ high_bound.data.const_val = 0;
+ }
+
++ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
++ if (dwarf2_evaluate_property_signed (prop, NULL, addr_stack, &value, 1))
++ {
++ stride.kind = PROP_CONST;
++ stride.data.const_val = value;
++ }
++
+ static_target_type
+ = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
+ addr_stack, 0);
+ static_range_type = create_range_type (copy_type (dyn_range_type),
+ static_target_type,
+- &low_bound, &high_bound);
++ &low_bound, &high_bound, &stride);
++
+ TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
+ return static_range_type;
+ }
+Index: gdb-7.99.90.20170420/gdb/gdbtypes.h
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/gdbtypes.h 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/gdbtypes.h 2017-04-20 22:26:14.365446619 +0200
+@@ -551,6 +551,10 @@
+
+ struct dynamic_prop high;
+
++ /* * Stride of range. */
++
++ struct dynamic_prop stride;
++
+ /* True if HIGH range bound contains the number of elements in the
+ subrange. This affects how the final hight bound is computed. */
+
+@@ -713,7 +717,6 @@
+ /* * Union member used for range types. */
+
+ struct range_bounds *bounds;
+-
+ } flds_bnds;
+
+ /* * Slot to point to additional language-specific fields of this
+@@ -1228,6 +1231,15 @@
+ TYPE_RANGE_DATA(range_type)->high.kind
+ #define TYPE_LOW_BOUND_KIND(range_type) \
+ TYPE_RANGE_DATA(range_type)->low.kind
++#define TYPE_BYTE_STRIDE(range_type) \
++ TYPE_RANGE_DATA(range_type)->stride.data.const_val
++#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
++ TYPE_RANGE_DATA(range_type)->stride.data.locexpr
++#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
++ TYPE_RANGE_DATA(range_type)->stride.data.loclist
++#define TYPE_BYTE_STRIDE_KIND(range_type) \
++ TYPE_RANGE_DATA(range_type)->stride.kind
++
+
+ /* Property accessors for the type data location. */
+ #define TYPE_DATA_LOCATION(thistype) \
+@@ -1262,6 +1274,9 @@
+ TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
+ #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
+ TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
++#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
++ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
++
+
+ #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
+ (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
+@@ -1776,6 +1791,7 @@
+
+ extern struct type *create_range_type (struct type *, struct type *,
+ const struct dynamic_prop *,
++ const struct dynamic_prop *,
+ const struct dynamic_prop *);
+
+ extern struct type *create_array_type (struct type *, struct type *,
+Index: gdb-7.99.90.20170420/gdb/parse.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/parse.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/parse.c 2017-04-20 22:26:14.366446625 +0200
+@@ -1007,22 +1007,20 @@
+
+ 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 HIGH_BOUND_DEFAULT:
+- args = 1;
+- break;
+- case BOTH_BOUND_DEFAULT:
+- args = 0;
+- break;
+- case NONE_BOUND_DEFAULT:
+- 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;
+
+Index: gdb-7.99.90.20170420/gdb/rust-exp.y
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/rust-exp.y 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/rust-exp.y 2017-04-20 22:26:14.366446625 +0200
+@@ -2409,23 +2409,17 @@
+
+ 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 (state, operation->left.op, top);
+- kind = HIGH_BOUND_DEFAULT;
++ kind = SUBARRAY_LOW_BOUND;
+ }
+ if (operation->right.op != NULL)
+ {
+ convert_ast_to_expression (state, operation->right.op, top);
+- if (kind == BOTH_BOUND_DEFAULT)
+- kind = LOW_BOUND_DEFAULT;
+- else
+- {
+- gdb_assert (kind == HIGH_BOUND_DEFAULT);
+- kind = NONE_BOUND_DEFAULT;
+- }
++ kind = (range_type) (kind | SUBARRAY_HIGH_BOUND);
+ }
+ write_exp_elt_opcode (state, OP_RANGE);
+ write_exp_elt_longcst (state, kind);
+Index: gdb-7.99.90.20170420/gdb/rust-lang.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/rust-lang.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/rust-lang.c 2017-04-20 22:26:14.367446632 +0200
+@@ -1314,9 +1314,9 @@
+ kind = (enum range_type) longest_to_int (exp->elts[*pos + 1].longconst);
+ *pos += 3;
+
+- if (kind == HIGH_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT)
++ if ((kind & SUBARRAY_LOW_BOUND) == SUBARRAY_LOW_BOUND)
+ low = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+- if (kind == LOW_BOUND_DEFAULT || kind == NONE_BOUND_DEFAULT)
++ if ((kind & SUBARRAY_HIGH_BOUND) == SUBARRAY_HIGH_BOUND)
+ high = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+
+ if (noside == EVAL_SKIP)
+@@ -1405,7 +1405,7 @@
+
+ *low = 0;
+ *high = 0;
+- *kind = BOTH_BOUND_DEFAULT;
++ *kind = SUBARRAY_NONE_BOUND;
+
+ if (TYPE_NFIELDS (type) == 0)
+ return;
+@@ -1413,15 +1413,14 @@
+ 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_NFIELDS (type) > 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));
+ }
+ }
+@@ -1436,7 +1435,7 @@
+ 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;
+
+@@ -1498,7 +1497,7 @@
+ 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"));
+@@ -1516,7 +1515,7 @@
+ 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"));
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.exp 2017-04-20 22:26:14.367446632 +0200
+@@ -0,0 +1,421 @@
++# Copyright 2015 Free Software Foundation, Inc.
++#
++# Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
++#
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++standard_testfile 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"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/static-arrays.f90 2017-04-20 22:26:14.368446638 +0200
+@@ -0,0 +1,55 @@
++! Copyright 2015 Free Software Foundation, Inc.
++!
++! Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
++!
++! This program is free software; you can redistribute it and/or modify
++! it under the terms of the GNU General Public License as published by
++! the Free Software Foundation; either version 3 of the License, or
++! (at your option) any later version.
++!
++! This program is distributed in the hope that it will be useful,
++! but WITHOUT ANY WARRANTY; without even the implied warranty of
++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++! GNU General Public License for more details.
++!
++! You should have received a copy of the GNU General Public License
++! along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++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
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:26:14.368446638 +0200
+@@ -98,3 +98,7 @@
+ gdb_test "ptype vla2(5, 45, 20)" \
+ "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla2(5, 45, 20) not allocated"
++
++gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
++gdb_continue_to_breakpoint "vla1-neg-bounds"
++gdb_test "ptype vla1" "type = $real \\(-2:1,-5:4,-3:-1\\)" "ptype vla1 negative bounds"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-sizeof.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-sizeof.exp 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-sizeof.exp 2017-04-20 22:26:14.368446638 +0200
+@@ -44,3 +44,7 @@
+ gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+ gdb_continue_to_breakpoint "pvla-associated"
+ gdb_test "print sizeof(pvla)" " = 4000" "print sizeof associated pvla"
++
++gdb_breakpoint [gdb_get_line_number "vla1-neg-bounds"]
++gdb_continue_to_breakpoint "vla1-neg-bounds"
++gdb_test "print sizeof(vla1)" " = 480" "print sizeof vla1 negative bounds"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.exp 2017-04-20 22:26:14.368446638 +0200
+@@ -0,0 +1,44 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
++gdb_continue_to_breakpoint "re-reverse-elements"
++gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
++ "print re-reverse-elements"
++gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
++gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
++
++gdb_breakpoint [gdb_get_line_number "odd-elements"]
++gdb_continue_to_breakpoint "odd-elements"
++gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
++gdb_test "print pvla(1)" " = 1" "print first odd-element"
++gdb_test "print pvla(5)" " = 9" "print last odd-element"
++
++gdb_breakpoint [gdb_get_line_number "single-element"]
++gdb_continue_to_breakpoint "single-element"
++gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
++gdb_test "print pvla(1)" " = 5" "print one single-element"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-stride.f90 2017-04-20 22:26:14.368446638 +0200
+@@ -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 <http://www.gnu.org/licenses/>.
++
++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
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla.f90
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla.f90 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla.f90 2017-04-20 22:26:14.368446638 +0200
+@@ -54,4 +54,14 @@
+
+ allocate (vla3 (2,2)) ! vla2-deallocated
+ vla3(:,:) = 13
++
++ allocate (vla1 (-2:1, -5:4, -3:-1))
++ l = allocated(vla1)
++
++ vla1(:, :, :) = 1
++ vla1(-2, -3, -1) = -231
++
++ deallocate (vla1) ! vla1-neg-bounds
++ l = allocated(vla1)
++
+ end program vla
+Index: gdb-7.99.90.20170420/gdb/valarith.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/valarith.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/valarith.c 2017-04-20 22:26:14.369446644 +0200
+@@ -193,10 +193,16 @@
+ struct type *array_type = check_typedef (value_type (array));
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
+ ULONGEST elt_size = type_length_units (elt_type);
+- ULONGEST elt_offs = elt_size * (index - lowerbound);
++ LONGEST elt_offs = index - lowerbound;
++ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
++
++ if (elt_stride != 0)
++ elt_offs *= elt_stride;
++ else
++ elt_offs *= elt_size;
+
+ if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
+- && elt_offs >= type_length_units (array_type)))
++ && abs (elt_offs) >= type_length_units (array_type)))
+ {
+ if (type_not_associated (array_type))
+ error (_("no such vector element (vector not associated)"));
+Index: gdb-7.99.90.20170420/gdb/valops.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/valops.c 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/valops.c 2017-04-20 22:26:14.370446651 +0200
+@@ -3786,55 +3786,194 @@
+ 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 (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
+ && TYPE_CODE (array_type) != TYPE_CODE_STRING)
+ error (_("cannot take slice of non-array"));
+
+- range_type = TYPE_INDEX_TYPE (array_type);
+- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+- error (_("slice from bad array or bitstring"));
+-
+- if (lowbound < lowerbound || length < 0
+- || lowbound + length - 1 > upperbound)
+- error (_("slice out of range"));
++ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type));
++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type));
++
++ /* 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 = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type));
++ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type));
++ 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;
++
++ /* 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 = TYPE_INDEX_TYPE (array_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_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
++ slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
++ ary_low_bound = TYPE_LOW_BOUND (range_type);
++ }
+
+ /* FIXME-type-allocation: need a way to free this type when we are
+- done with it. */
+- slice_range_type = create_static_range_type ((struct 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));
+-
+- slice_type = create_array_type ((struct type *) NULL,
+- element_type,
+- slice_range_type);
+- TYPE_CODE (slice_type) = TYPE_CODE (array_type);
++ struct type *element_type;
++
++ /* 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);
++
++ TYPE_CODE (slice_type) = TYPE_CODE (array_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));
++ }
+
+- if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
+- slice = allocate_value_lazy (slice_type);
++ }
++ /* 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)
++ TYPE_CODE (slice_type) = TYPE_CODE (array_type);
++ else
++ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
++
++ 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;
+ }
+
+ /* Create a value for a FORTRAN complex number. Currently most of the
+Index: gdb-7.99.90.20170420/gdb/value.h
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/value.h 2017-04-20 22:25:43.973254685 +0200
++++ gdb-7.99.90.20170420/gdb/value.h 2017-04-20 22:26:14.370446651 +0200
+@@ -1106,6 +1106,8 @@
+
+ extern struct value *value_slice (struct value *, int, int);
+
++extern struct value *value_slice_1 (struct value *, int, int, int, int);
++
+ extern struct value *value_literal_complex (struct value *, struct value *,
+ struct type *);
+
--- /dev/null
+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(-)
+
+Index: gdb-7.99.90.20170420/gdb/NEWS
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/NEWS 2017-04-20 22:27:47.076032111 +0200
++++ gdb-7.99.90.20170420/gdb/NEWS 2017-04-20 22:27:49.946050236 +0200
+@@ -1,6 +1,8 @@
+ What has changed in GDB?
+ (Organized release by release)
+
++* Fortran: Support pointers to dynamic types.
++
+ *** Changes in GDB 8.0
+
+ * GDB now supports access to the PKU register on GNU/Linux. The register is
+Index: gdb-7.99.90.20170420/gdb/c-valprint.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/c-valprint.c 2017-04-20 22:27:47.077032118 +0200
++++ gdb-7.99.90.20170420/gdb/c-valprint.c 2017-04-20 22:27:49.947050243 +0200
+@@ -650,6 +650,28 @@
+ else
+ {
+ /* normal case */
++ if (TYPE_CODE (type) == 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),
++ NULL, 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, ") ");
+Index: gdb-7.99.90.20170420/gdb/dwarf2read.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/dwarf2read.c 2017-04-20 22:27:47.091032206 +0200
++++ gdb-7.99.90.20170420/gdb/dwarf2read.c 2017-04-20 22:28:28.878296105 +0200
+@@ -1872,7 +1872,8 @@
+
+ static int attr_to_dynamic_prop (const struct attribute *attr,
+ struct die_info *die, struct dwarf2_cu *cu,
+- struct dynamic_prop *prop);
++ struct dynamic_prop *prop, const gdb_byte *additional_data,
++ int additional_data_size);
+
+ /* memory allocation interface */
+
+@@ -11557,7 +11558,7 @@
+ {
+ newobj->static_link
+ = XOBNEW (&objfile->objfile_obstack, struct dynamic_prop);
+- attr_to_dynamic_prop (attr, die, cu, newobj->static_link);
++ attr_to_dynamic_prop (attr, die, cu, newobj->static_link, NULL, 0);
+ }
+
+ cu->list_in_scope = &local_symbols;
+@@ -14791,29 +14792,94 @@
+ struct gdbarch *gdbarch = get_objfile_arch (objfile);
+ struct type *type, *range_type, *index_type, *char_type;
+ struct attribute *attr;
+- unsigned int length;
++ unsigned int length = UINT_MAX;
+
++ index_type = objfile_type (objfile)->builtin_int;
++ range_type = create_static_range_type (NULL, index_type, 1, length);
++
++ /* If DW_AT_string_length is defined, the length is stored in memory. */
+ attr = dwarf2_attr (die, DW_AT_string_length, cu);
+ if (attr)
+ {
+- length = DW_UNSND (attr);
++ if (attr_form_is_block (attr))
++ {
++ struct attribute *byte_size, *bit_size;
++ struct dynamic_prop high;
++
++ byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
++ bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
++
++ /* DW_AT_byte_size should never occur in combination with
++ DW_AT_bit_size. */
++ if (byte_size != NULL && bit_size != NULL)
++ complaint (&symfile_complaints,
++ _("DW_AT_byte_size AND "
++ "DW_AT_bit_size found together at the same time."));
++
++ /* If DW_AT_string_length AND DW_AT_byte_size exist together,
++ 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. */
++ DW_UNSND(byte_size) };
++
++ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
++ ARRAY_SIZE(append_ops)))
++ complaint (&symfile_complaints,
++ _("Could not parse DW_AT_byte_size"));
++ }
++ else if (bit_size != NULL)
++ complaint (&symfile_complaints,
++ _("DW_AT_string_length AND "
++ "DW_AT_bit_size found but not supported yet."));
++ /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
++ is the address size of the target machine. */
++ else
++ {
++ const gdb_byte append_ops[] =
++ { DW_OP_deref };
++
++ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
++ ARRAY_SIZE(append_ops)))
++ complaint (&symfile_complaints,
++ _("Could not parse DW_AT_string_length"));
++ }
++
++ TYPE_RANGE_DATA (range_type)->high = high;
++ }
++ else
++ {
++ TYPE_HIGH_BOUND (range_type) = DW_UNSND(attr);
++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
++ }
+ }
+ else
+ {
+- /* Check for the DW_AT_byte_size attribute. */
++ /* Check for the DW_AT_byte_size attribute, which represents the length
++ in this case. */
+ attr = dwarf2_attr (die, DW_AT_byte_size, cu);
+ if (attr)
+- {
+- length = DW_UNSND (attr);
+- }
++ {
++ TYPE_HIGH_BOUND (range_type) = DW_UNSND(attr);
++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
++ }
+ else
+- {
+- length = 1;
+- }
++ {
++ TYPE_HIGH_BOUND (range_type) = 1;
++ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
++ }
+ }
+
+- index_type = objfile_type (objfile)->builtin_int;
+- range_type = create_static_range_type (NULL, index_type, 1, length);
+ char_type = language_string_char_type (cu->language_defn, gdbarch);
+ type = create_string_type (NULL, char_type, range_type);
+
+@@ -15163,7 +15229,8 @@
+
+ static int
+ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
+- struct dwarf2_cu *cu, struct dynamic_prop *prop)
++ struct dwarf2_cu *cu, struct dynamic_prop *prop,
++ const gdb_byte *additional_data, int additional_data_size)
+ {
+ struct dwarf2_property_baton *baton;
+ struct obstack *obstack = &cu->objfile->objfile_obstack;
+@@ -15173,14 +15240,33 @@
+
+ if (attr_form_is_block (attr))
+ {
+- baton = XOBNEW (obstack, struct dwarf2_property_baton);
++ baton = XOBNEW(obstack, struct dwarf2_property_baton);
+ baton->referenced_type = NULL;
+ baton->locexpr.per_cu = cu->per_cu;
+- baton->locexpr.size = DW_BLOCK (attr)->size;
+- baton->locexpr.data = DW_BLOCK (attr)->data;
++
++ if (additional_data != NULL && additional_data_size > 0)
++ {
++ gdb_byte *data;
++
++ data = (gdb_byte *) obstack_alloc(
++ &cu->objfile->objfile_obstack,
++ DW_BLOCK (attr)->size + additional_data_size);
++ memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
++ memcpy (data + DW_BLOCK (attr)->size, additional_data,
++ additional_data_size);
++
++ baton->locexpr.data = data;
++ baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
++ }
++ else
++ {
++ baton->locexpr.data = DW_BLOCK (attr)->data;
++ baton->locexpr.size = DW_BLOCK (attr)->size;
++ }
++
+ prop->data.baton = baton;
+ prop->kind = PROP_LOCEXPR;
+- gdb_assert (prop->data.baton != NULL);
++ gdb_assert(prop->data.baton != NULL);
+ }
+ else if (attr_form_is_ref (attr))
+ {
+@@ -15213,8 +15299,28 @@
+ baton = XOBNEW (obstack, struct dwarf2_property_baton);
+ baton->referenced_type = die_type (target_die, target_cu);
+ baton->locexpr.per_cu = cu->per_cu;
+- baton->locexpr.size = DW_BLOCK (target_attr)->size;
+- baton->locexpr.data = DW_BLOCK (target_attr)->data;
++
++ if (additional_data != NULL && additional_data_size > 0)
++ {
++ gdb_byte *data;
++
++ data = (gdb_byte *) obstack_alloc (&cu->objfile->objfile_obstack,
++ DW_BLOCK (target_attr)->size + additional_data_size);
++ memcpy (data, DW_BLOCK (target_attr)->data,
++ DW_BLOCK (target_attr)->size);
++ memcpy (data + DW_BLOCK (target_attr)->size,
++ additional_data, additional_data_size);
++
++ baton->locexpr.data = data;
++ baton->locexpr.size = (DW_BLOCK (target_attr)->size
++ + additional_data_size);
++ }
++ else
++ {
++ baton->locexpr.data = DW_BLOCK (target_attr)->data;
++ baton->locexpr.size = DW_BLOCK (target_attr)->size;
++ }
++
+ prop->data.baton = baton;
+ prop->kind = PROP_LOCEXPR;
+ gdb_assert (prop->data.baton != NULL);
+@@ -15325,24 +15431,24 @@
+
+ attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
+ if (attr)
+- if (!attr_to_dynamic_prop (attr, die, cu, &stride))
++ if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0))
+ complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
+ "- DIE at 0x%x [in module %s]"),
+ to_underlying (die->sect_off), objfile_name (cu->objfile));
+
+ attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
+ if (attr)
+- attr_to_dynamic_prop (attr, die, cu, &low);
++ attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
+ else if (!low_default_is_valid)
+ complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
+ "- DIE at 0x%x [in module %s]"),
+ to_underlying (die->sect_off), objfile_name (cu->objfile));
+
+ attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
+- if (!attr_to_dynamic_prop (attr, die, cu, &high))
++ if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
+ {
+ attr = dwarf2_attr (die, DW_AT_count, cu);
+- if (attr_to_dynamic_prop (attr, die, cu, &high))
++ if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
+ {
+ /* If bounds are constant do the final calculation here. */
+ if (low.kind == PROP_CONST && high.kind == PROP_CONST)
+@@ -22967,7 +23073,7 @@
+ attr = dwarf2_attr (die, DW_AT_allocated, cu);
+ if (attr_form_is_block (attr))
+ {
+- if (attr_to_dynamic_prop (attr, die, cu, &prop))
++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
+ add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile);
+ }
+ else if (attr != NULL)
+@@ -22982,7 +23088,7 @@
+ attr = dwarf2_attr (die, DW_AT_associated, cu);
+ if (attr_form_is_block (attr))
+ {
+- if (attr_to_dynamic_prop (attr, die, cu, &prop))
++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
+ add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile);
+ }
+ else if (attr != NULL)
+@@ -22995,7 +23101,7 @@
+
+ /* 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))
++ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
+ add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile);
+
+ if (dwarf2_per_objfile->die_type_hash == NULL)
+Index: gdb-7.99.90.20170420/gdb/f-typeprint.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/f-typeprint.c 2017-04-20 22:27:26.288900835 +0200
++++ gdb-7.99.90.20170420/gdb/f-typeprint.c 2017-04-20 22:27:49.953050280 +0200
+@@ -37,7 +37,7 @@
+ #endif
+
+ static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
+- int, int, int);
++ int, int, int, int);
+
+ void f_type_print_varspec_prefix (struct type *, struct ui_file *,
+ int, int);
+@@ -53,18 +53,6 @@
+ {
+ enum type_code code;
+
+- if (type_not_associated (type))
+- {
+- val_print_not_associated (stream);
+- return;
+- }
+-
+- if (type_not_allocated (type))
+- {
+- val_print_not_allocated (stream);
+- return;
+- }
+-
+ f_type_print_base (type, stream, show, level);
+ code = TYPE_CODE (type);
+ if ((varstring != NULL && *varstring != '\0')
+@@ -89,7 +77,7 @@
+
+ demangled_args = (*varstring != '\0'
+ && varstring[strlen (varstring) - 1] == ')');
+- f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
++ f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0, 0);
+ }
+ }
+
+@@ -159,7 +147,7 @@
+ static void
+ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
+ int show, int passed_a_ptr, int demangled_args,
+- int arrayprint_recurse_level)
++ int arrayprint_recurse_level, int print_rank_only)
+ {
+ int upper_bound, lower_bound;
+
+@@ -183,34 +171,50 @@
+ fprintf_filtered (stream, "(");
+
+ if (type_not_associated (type))
+- val_print_not_associated (stream);
++ print_rank_only = 1;
+ else if (type_not_allocated (type))
+- val_print_not_allocated (stream);
++ print_rank_only = 1;
++ else if ((TYPE_ASSOCIATED_PROP (type)
++ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type)))
++ || (TYPE_ALLOCATED_PROP (type)
++ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type)))
++ || (TYPE_DATA_LOCATION (type)
++ && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_DATA_LOCATION (type))))
++ /* This case exist when we ptype a typename which has the
++ dynamic properties but cannot be resolved as there is
++ no object. */
++ print_rank_only = 1;
++
++ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
++ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
++ 0, 0, arrayprint_recurse_level,
++ print_rank_only);
++
++ if (print_rank_only == 1)
++ fprintf_filtered (stream, ":");
+ else
+- {
+- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
+- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+- 0, 0, arrayprint_recurse_level);
+-
+- lower_bound = f77_get_lowerbound (type);
+- if (lower_bound != 1) /* Not the default. */
+- fprintf_filtered (stream, "%d:", lower_bound);
+-
+- /* Make sure that, if we have an assumed size array, we
+- print out a warning and print the upperbound as '*'. */
+-
+- if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
+- fprintf_filtered (stream, "*");
+- else
+- {
+- upper_bound = f77_get_upperbound (type);
+- fprintf_filtered (stream, "%d", upper_bound);
+- }
+-
+- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
+- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+- 0, 0, arrayprint_recurse_level);
+- }
++ {
++ lower_bound = f77_get_lowerbound (type);
++ if (lower_bound != 1) /* Not the default. */
++ fprintf_filtered (stream, "%d:", lower_bound);
++
++ /* Make sure that, if we have an assumed size array, we
++ print out a warning and print the upperbound as '*'. */
++
++ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
++ fprintf_filtered (stream, "*");
++ else
++ {
++ upper_bound = f77_get_upperbound (type);
++ fprintf_filtered (stream, "%d", upper_bound);
++ }
++ }
++
++ if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
++ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
++ 0, 0, arrayprint_recurse_level,
++ print_rank_only);
++
+ if (arrayprint_recurse_level == 1)
+ fprintf_filtered (stream, ")");
+ else
+@@ -221,13 +225,14 @@
+ case TYPE_CODE_PTR:
+ case TYPE_CODE_REF:
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
+- arrayprint_recurse_level);
++ arrayprint_recurse_level, 0);
+ fprintf_filtered (stream, ")");
+ break;
+
+ case TYPE_CODE_FUNC:
+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+- passed_a_ptr, 0, arrayprint_recurse_level);
++ passed_a_ptr, 0, arrayprint_recurse_level,
++ 0);
+ if (passed_a_ptr)
+ fprintf_filtered (stream, ")");
+
+@@ -378,7 +383,7 @@
+ fputs_filtered (" :: ", stream);
+ fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
+ f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
+- stream, show - 1, 0, 0, 0);
++ stream, show - 1, 0, 0, 0, 0);
+ fputs_filtered ("\n", stream);
+ }
+ fprintfi_filtered (level, stream, "End Type ");
+Index: gdb-7.99.90.20170420/gdb/gdbtypes.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/gdbtypes.c 2017-04-20 22:27:47.093032219 +0200
++++ gdb-7.99.90.20170420/gdb/gdbtypes.c 2017-04-20 22:27:49.954050287 +0200
+@@ -1840,7 +1840,8 @@
+ type = check_typedef (type);
+
+ /* We only want to recognize references at the outermost level. */
+- if (top_level && TYPE_CODE (type) == TYPE_CODE_REF)
++ if (top_level &&
++ (TYPE_CODE (type) == TYPE_CODE_REF || TYPE_CODE (type) == TYPE_CODE_PTR))
+ type = check_typedef (TYPE_TARGET_TYPE (type));
+
+ /* Types that have a dynamic TYPE_DATA_LOCATION are considered
+@@ -1874,6 +1875,7 @@
+ }
+
+ case TYPE_CODE_ARRAY:
++ case TYPE_CODE_STRING:
+ {
+ gdb_assert (TYPE_NFIELDS (type) == 1);
+
+@@ -1986,7 +1988,8 @@
+ struct type *ary_dim;
+ struct dynamic_prop *prop;
+
+- gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
++ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
++ || TYPE_CODE (type) == TYPE_CODE_STRING);
+
+ type = copy_type (type);
+
+@@ -2011,13 +2014,17 @@
+
+ ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
+
+- if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
++ if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
++ || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
+ elt_type = resolve_dynamic_array (ary_dim, addr_stack);
+ else
+ elt_type = TYPE_TARGET_TYPE (type);
+
+- return create_array_type_with_stride (type, elt_type, range_type,
+- TYPE_FIELD_BITSIZE (type, 0));
++ if (TYPE_CODE (type) == TYPE_CODE_STRING)
++ return create_string_type (type, elt_type, range_type);
++ else
++ return create_array_type_with_stride (type, elt_type, range_type,
++ TYPE_FIELD_BITSIZE (type, 0));
+ }
+
+ /* Resolve dynamic bounds of members of the union TYPE to static
+@@ -2147,6 +2154,28 @@
+ 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))
++ {
++ TYPE_DYN_PROP_ADDR (prop) = value;
++ TYPE_DYN_PROP_KIND (prop) = PROP_CONST;
++ }
++
++ return type;
++}
++
+ /* Worker for resolved_dynamic_type. */
+
+ static struct type *
+@@ -2195,7 +2224,12 @@
+ break;
+ }
+
++ case TYPE_CODE_PTR:
++ resolved_type = resolve_dynamic_pointer (type, addr_stack);
++ break;
++
+ case TYPE_CODE_ARRAY:
++ case TYPE_CODE_STRING:
+ resolved_type = resolve_dynamic_array (type, addr_stack);
+ break;
+
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.cc
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.cp/vla-cxx.cc 2017-04-20 22:27:47.094032225 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.cc 2017-04-20 22:27:49.955050293 +0200
+@@ -15,6 +15,10 @@
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
++extern "C" {
++#include <stddef.h>
++}
++
+ struct container;
+
+ struct element
+@@ -40,11 +44,16 @@
+ 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];
+ }
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.cp/vla-cxx.exp 2017-04-20 22:27:47.094032225 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.cp/vla-cxx.exp 2017-04-20 22:27:49.955050293 +0200
+@@ -23,6 +23,12 @@
+ 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 @@
+ # 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\\}"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.exp 2017-04-20 22:27:49.955050293 +0200
+@@ -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 <http://www.gnu.org/licenses/>.
++
++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 \\(:,:\\)\\)\\) <not associated>\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re " = <not associated>\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 = <not associated> \\)\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 \\)\\) <not associated>\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" "= <not allocated>"
++
++
++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 \\)\\) <not associated>\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 <pointers\\+\\d+>" "Print program counter"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/pointers.f90 2017-04-20 22:27:49.955050293 +0200
+@@ -0,0 +1,109 @@
++! 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 <http://www.gnu.org/licenses/>.
++
++program pointers
++
++ type :: two
++ integer, allocatable :: ivla1 (:)
++ 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
++ 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
++ integer, pointer :: intp
++ integer, pointer, dimension (:,:) :: intap
++ integer, pointer, dimension (:) :: intvlap
++ real, pointer :: realp
++ type(two), pointer :: twop
++
++ nullify (logp)
++ nullify (comp)
++ nullify (charp)
++ 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
++ charp => charv
++ 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)
++ charv = "a"
++ chara = "abc"
++ 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))
++ allocate (twov%ivla2(2,2))
++ twov%ivla1(1) = 11
++ twov%ivla1(2) = 12
++ twov%ivla1(3) = 13
++ twov%ivla2(1,1) = 211
++ twov%ivla2(2,1) = 221
++ twov%ivla2(1,2) = 212
++ twov%ivla2(2,2) = 222
++
++ intv = intv + 1 ! After value assignment
++
++end program pointers
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/print_type.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/print_type.exp 2017-04-20 22:27:49.956050299 +0200
+@@ -0,0 +1,100 @@
++# 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 <http://www.gnu.org/licenses/>.
++
++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 "ptype logp" "type = PTR TO -> \\( $logical \\)" "ptype logp, not associated"
++gdb_test "ptype comp" "type = PTR TO -> \\( $complex \\)" "ptype comp, not associated"
++gdb_test "ptype charp" "type = PTR TO -> \\( character\\*1 \\)" "ptype charp, not associated"
++gdb_test "ptype charap" "type = PTR TO -> \\( character\\*3 \\)" "ptype charap, not associated"
++gdb_test "ptype intp" "type = PTR TO -> \\( $int \\)" "ptype intp, not associated"
++set test "ptype intap, not associated"
++gdb_test_multiple "ptype intap" $test {
++ -re "type = PTR TO -> \\( $int \\(:,:\\)\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = $int \\(:,:\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)" "ptype realp, not associated"
++gdb_test "ptype twop" \
++ [multi_line "type = PTR TO -> \\( Type two" \
++ " $int :: ivla1\\(:\\)" \
++ " $int :: ivla2\\(:,:\\)" \
++ "End Type two \\)"] \
++ "ptype twop, not associated"
++gdb_test "ptype two" \
++ [multi_line "type = Type two" \
++ " $int :: ivla1\\(:\\)" \
++ " $int :: ivla2\\(:,:\\)" \
++ "End Type two"]
++
++
++gdb_breakpoint [gdb_get_line_number "Before value assignment"]
++gdb_continue_to_breakpoint "Before value assignment"
++gdb_test "ptype twop" \
++ [multi_line "type = PTR TO -> \\( Type two" \
++ " $int :: ivla1\\(:\\)" \
++ " $int :: ivla2\\(:,:\\)" \
++ "End Type two \\)"]
++
++
++gdb_breakpoint [gdb_get_line_number "After value assignment"]
++gdb_continue_to_breakpoint "After value assignment"
++gdb_test "ptype logv" "type = $logical"
++gdb_test "ptype comv" "type = $complex"
++gdb_test "ptype charv" "type = character\\*1"
++gdb_test "ptype chara" "type = character\\*3"
++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 \\)"
++set test "ptype intap"
++gdb_test_multiple $test $test {
++ -re "type = $int \\(10,2\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++ -re "type = PTR TO -> \\( $int \\(10,2\\)\\)\r\n$gdb_prompt $" {
++ pass $test
++ }
++}
++gdb_test "ptype realp" "type = PTR TO -> \\( $real \\)"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:27:47.094032225 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-ptype.exp 2017-04-20 22:27:49.956050299 +0200
+@@ -32,9 +32,9 @@
+ # Check the ptype of various VLA states and pointer to VLA's.
+ gdb_breakpoint [gdb_get_line_number "vla1-init"]
+ gdb_continue_to_breakpoint "vla1-init"
+-gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not initialized"
+-gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not initialized"
+-gdb_test "ptype pvla" "type = <not associated>" "ptype pvla not initialized"
++gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not initialized"
++gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not initialized"
++gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla not initialized"
+ gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla1(3, 6, 9) not initialized"
+ gdb_test "ptype vla2(5, 45, 20)" \
+@@ -81,20 +81,20 @@
+
+ gdb_breakpoint [gdb_get_line_number "pvla-deassociated"]
+ gdb_continue_to_breakpoint "pvla-deassociated"
+-gdb_test "ptype pvla" "type = <not associated>" "ptype pvla deassociated"
++gdb_test "ptype pvla" "type = $real \\(:,:,:\\)" "ptype pvla deassociated"
+ gdb_test "ptype pvla(5, 45, 20)" \
+ "no such vector element \\\(vector not associated\\\)" \
+ "ptype pvla(5, 45, 20) not associated"
+
+ gdb_breakpoint [gdb_get_line_number "vla1-deallocated"]
+ gdb_continue_to_breakpoint "vla1-deallocated"
+-gdb_test "ptype vla1" "type = <not allocated>" "ptype vla1 not allocated"
++gdb_test "ptype vla1" "type = $real \\(:,:,:\\)" "ptype vla1 not allocated"
+ gdb_test "ptype vla1(3, 6, 9)" "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla1(3, 6, 9) not allocated"
+
+ gdb_breakpoint [gdb_get_line_number "vla2-deallocated"]
+ gdb_continue_to_breakpoint "vla2-deallocated"
+-gdb_test "ptype vla2" "type = <not allocated>" "ptype vla2 not allocated"
++gdb_test "ptype vla2" "type = $real \\(:,:,:\\)" "ptype vla2 not allocated"
+ gdb_test "ptype vla2(5, 45, 20)" \
+ "no such vector element \\\(vector not allocated\\\)" \
+ "ptype vla2(5, 45, 20) not allocated"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.exp 2017-04-20 22:27:49.956050299 +0200
+@@ -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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++# check that all fortran standard datatypes will be
++# handled correctly when using as VLA's
++
++if ![runto_main] {
++ 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
++ }
++}
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-strings.f90 2017-04-20 22:27:49.956050299 +0200
+@@ -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 <http://www.gnu.org/licenses/>.
++
++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
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-type.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-type.exp 2017-04-20 22:27:47.094032225 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-type.exp 2017-04-20 22:27:49.956050299 +0200
+@@ -132,7 +132,10 @@
+ "End Type one" ]
+
+ # Check allocation status of dynamic array and it's dynamic members
+-gdb_test "ptype fivedynarr" "type = <not allocated>"
++gdb_test "ptype fivedynarr" \
++ [multi_line "type = Type five" \
++ " Type one :: tone" \
++ "End Type five \\(:\\)" ]
+ gdb_test "next" ""
+ gdb_test "ptype fivedynarr(2)" \
+ [multi_line "type = Type five" \
+@@ -141,7 +144,7 @@
+ "ptype fivedynarr(2), tone is not allocated"
+ gdb_test "ptype fivedynarr(2)%tone" \
+ [multi_line "type = Type one" \
+- " $int :: ivla\\(<not allocated>\\)" \
++ " $int :: ivla\\(:,:,:\\)" \
+ "End Type one" ] \
+ "ptype fivedynarr(2)%tone, not allocated"
+
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-value.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.fortran/vla-value.exp 2017-04-20 22:27:47.095032231 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/vla-value.exp 2017-04-20 22:27:49.957050306 +0200
+@@ -14,6 +14,7 @@
+ # along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+ standard_testfile "vla.f90"
++load_lib "fortran.exp"
+
+ if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile} \
+ {debug f90 quiet}] } {
+@@ -25,12 +26,15 @@
+ return -1
+ }
+
++# Depending on the compiler being used, the type names can be printed differently.
++set real [fortran_real4]
++
+ # Try to access values in non allocated VLA
+ gdb_breakpoint [gdb_get_line_number "vla1-init"]
+ gdb_continue_to_breakpoint "vla1-init"
+ gdb_test "print vla1" " = <not allocated>" "print non-allocated vla1"
+ gdb_test "print &vla1" \
+- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not allocated>\\\)\\\)\\\) $hex" \
++ " = \\\(PTR TO -> \\\( $real \\\(:,:,:\\\)\\\)\\\) $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)"
+@@ -51,7 +55,7 @@
+ "step over value assignment of vla1"
+ }
+ gdb_test "print &vla1" \
+- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
++ " = \\\(PTR TO -> \\\( $real \\\(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)"
+@@ -71,7 +75,7 @@
+ # Try to access values in undefined pointer to VLA (dangling)
+ gdb_test "print pvla" " = <not associated>" "print undefined pvla"
+ gdb_test "print &pvla" \
+- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(<not associated>\\\)\\\)\\\) $hex" \
++ " = \\\(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)"
+@@ -80,7 +84,7 @@
+ gdb_breakpoint [gdb_get_line_number "pvla-associated"]
+ gdb_continue_to_breakpoint "pvla-associated"
+ gdb_test "print &pvla" \
+- " = \\\(PTR TO -> \\\( real\\\(kind=4\\\) \\\(10,10,10\\\)\\\)\\\) $hex" \
++ " = \\\(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)"
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-var-child-f.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.mi/mi-var-child-f.exp 2017-04-20 22:27:47.095032231 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-var-child-f.exp 2017-04-20 22:27:49.957050306 +0200
+@@ -17,6 +17,7 @@
+
+ load_lib mi-support.exp
+ set MIFLAGS "-i=mi"
++load_lib "fortran.exp"
+
+ if { [skip_fortran_tests] } { return -1 }
+
+@@ -40,10 +41,8 @@
+ mi_create_varobj "array" "array" "create local variable array"
+
+
+-# 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 "integer(kind=4)".
+-set int4 "(int4|integer\\(kind=4\\))"
++# Depending on the compiler being used, the type names can be printed differently.
++set int4 [fortran_int4]
+
+ set children [list [list "array.-1" "-1" 2 "$int4 \\(2\\)"] \
+ [list "array.0" "0" 2 "$int4 \\(2\\)"] \
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-vla-fortran.exp
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2017-04-20 22:27:47.095032231 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.mi/mi-vla-fortran.exp 2017-04-20 22:27:49.957050306 +0200
+@@ -17,7 +17,9 @@
+ # Array (VLA).
+
+ load_lib mi-support.exp
++load_lib fortran.exp
+ set MIFLAGS "-i=mi"
++load_lib "fortran.exp"
+
+ gdb_exit
+ if [mi_gdb_start] {
+@@ -32,6 +34,9 @@
+ return -1
+ }
+
++# Depending on the compiler being used, the type names can be printed differently.
++set real [fortran_real4]
++
+ mi_delete_breakpoints
+ mi_gdb_reinitialize_dir $srcdir/$subdir
+ mi_gdb_load ${binfile}
+@@ -46,10 +51,10 @@
+ mi_gdb_test "500-data-evaluate-expression vla1" \
+ "500\\^done,value=\"<not allocated>\"" "evaluate not allocated vla"
+
+-mi_create_varobj_checked vla1_not_allocated vla1 "<not allocated>" \
++mi_create_varobj_checked vla1_not_allocated vla1 "$real \\(:\\)" \
+ "create local variable vla1_not_allocated"
+ mi_gdb_test "501-var-info-type vla1_not_allocated" \
+- "501\\^done,type=\"<not allocated>\"" \
++ "501\\^done,type=\"$real \\(:\\)\"" \
+ "info type variable vla1_not_allocated"
+ mi_gdb_test "502-var-show-format vla1_not_allocated" \
+ "502\\^done,format=\"natural\"" \
+@@ -58,7 +63,7 @@
+ "503\\^done,value=\"\\\[0\\\]\"" \
+ "eval variable vla1_not_allocated"
+ mi_list_array_varobj_children_with_index "vla1_not_allocated" "0" "1" \
+- "real\\\(kind=4\\\)" "get children of vla1_not_allocated"
++ "$real" "get children of vla1_not_allocated"
+
+
+
+@@ -71,10 +76,10 @@
+ mi_gdb_test "510-data-evaluate-expression vla1" \
+ "510\\^done,value=\"\\(.*\\)\"" "evaluate allocated vla"
+
+-mi_create_varobj_checked vla1_allocated vla1 "real\\\(kind=4\\\) \\\(5\\\)" \
++mi_create_varobj_checked vla1_allocated vla1 "$real \\\(5\\\)" \
+ "create local variable vla1_allocated"
+ mi_gdb_test "511-var-info-type vla1_allocated" \
+- "511\\^done,type=\"real\\\(kind=4\\\) \\\(5\\\)\"" \
++ "511\\^done,type=\"$real \\\(5\\\)\"" \
+ "info type variable vla1_allocated"
+ mi_gdb_test "512-var-show-format vla1_allocated" \
+ "512\\^done,format=\"natural\"" \
+@@ -83,7 +88,7 @@
+ "513\\^done,value=\"\\\[5\\\]\"" \
+ "eval variable vla1_allocated"
+ mi_list_array_varobj_children_with_index "vla1_allocated" "5" "1" \
+- "real\\\(kind=4\\\)" "get children of vla1_allocated"
++ "$real" "get children of vla1_allocated"
+
+
+ set bp_lineno [gdb_get_line_number "vla1-filled"]
+@@ -136,10 +141,10 @@
+ -re "580\\^done,value=\"<not associated>\".*${mi_gdb_prompt}$" {
+ pass $test
+
+- mi_create_varobj_checked pvla2_not_associated pvla2 "<not associated>" \
++ mi_create_varobj_checked pvla2_not_associated pvla2 "$real \\(:,:\\)" \
+ "create local variable pvla2_not_associated"
+ mi_gdb_test "581-var-info-type pvla2_not_associated" \
+- "581\\^done,type=\"<not associated>\"" \
++ "581\\^done,type=\"$real \\(:,:\\)\"" \
+ "info type variable pvla2_not_associated"
+ mi_gdb_test "582-var-show-format pvla2_not_associated" \
+ "582\\^done,format=\"natural\"" \
+@@ -148,7 +153,7 @@
+ "583\\^done,value=\"\\\[0\\\]\"" \
+ "eval variable pvla2_not_associated"
+ mi_list_array_varobj_children_with_index "pvla2_not_associated" "0" "1" \
+- "real\\\(kind=4\\\)" "get children of pvla2_not_associated"
++ "$real" "get children of pvla2_not_associated"
+ }
+ -re "580\\^error,msg=\"value contents too large \\(\[0-9\]+ bytes\\).*${mi_gdb_prompt}$" {
+ # Undefined behaviour in gfortran.
+@@ -173,9 +178,9 @@
+ "evaluate associated vla"
+
+ mi_create_varobj_checked pvla2_associated pvla2 \
+- "real\\\(kind=4\\\) \\\(5,2\\\)" "create local variable pvla2_associated"
++ "$real \\\(5,2\\\)" "create local variable pvla2_associated"
+ mi_gdb_test "591-var-info-type pvla2_associated" \
+- "591\\^done,type=\"real\\\(kind=4\\\) \\\(5,2\\\)\"" \
++ "591\\^done,type=\"$real \\\(5,2\\\)\"" \
+ "info type variable pvla2_associated"
+ mi_gdb_test "592-var-show-format pvla2_associated" \
+ "592\\^done,format=\"natural\"" \
+Index: gdb-7.99.90.20170420/gdb/typeprint.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/typeprint.c 2017-04-20 22:27:47.095032231 +0200
++++ gdb-7.99.90.20170420/gdb/typeprint.c 2017-04-20 22:27:49.957050306 +0200
+@@ -474,6 +474,25 @@
+ 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) == 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),
++ NULL, addr);
++ }
++
+ LA_PRINT_TYPE (type, "", gdb_stdout, show, 0, &flags);
+ printf_filtered ("\n");
+
+Index: gdb-7.99.90.20170420/gdb/valops.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/valops.c 2017-04-20 22:27:47.096032238 +0200
++++ gdb-7.99.90.20170420/gdb/valops.c 2017-04-20 22:27:49.958050312 +0200
+@@ -1574,6 +1574,19 @@
+ if (TYPE_CODE (base_type) == 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), NULL, addr);
+
+ /* We may be pointing to something embedded in a larger object.
+ Get the real type of the enclosing object. */
+@@ -1589,8 +1602,7 @@
+ else
+ /* Retrieve the enclosing object pointed to. */
+ arg2 = value_at_lazy (enc_type,
+- (value_as_address (arg1)
+- - value_pointed_to_offset (arg1)));
++ (addr - value_pointed_to_offset (arg1)));
+
+ enc_type = value_type (arg2);
+ return readjust_indirect_value_type (arg2, enc_type, base_type, arg1);
+Index: gdb-7.99.90.20170420/gdb/valprint.c
+===================================================================
+--- gdb-7.99.90.20170420.orig/gdb/valprint.c 2017-04-20 22:25:38.224218378 +0200
++++ gdb-7.99.90.20170420/gdb/valprint.c 2017-04-20 22:27:49.959050318 +0200
+@@ -1166,12 +1166,6 @@
+ 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);
+++ /dev/null
---- ./gdb/value.c-orig 2015-02-11 15:17:58.413241779 +0100
-+++ ./gdb/value.c 2015-02-11 15:19:42.068716949 +0100
-@@ -3074,7 +3074,7 @@ value_primitive_field (struct value *arg
- }
-
- if (!TYPE_DATA_LOCATION (type)
-- || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
-+ || TYPE_DATA_LOCATION_KIND (type) != PROP_CONST)
- v->offset = (value_offset (arg1) + offset
- + value_embedded_offset (arg1));
- }
Thanks,
Jan
---FCuugMFkClbJLl1L
-Content-Type: text/plain; charset=us-ascii
-Content-Disposition: inline; filename="vlastringonly.patch"
-
-Index: gdb-7.9.50.20150520/gdb/gdbtypes.c
+Index: gdb-7.99.90.20170420/gdb/dwarf2loc.c
===================================================================
---- gdb-7.9.50.20150520.orig/gdb/gdbtypes.c 2015-05-31 16:14:04.164533833 +0200
-+++ gdb-7.9.50.20150520/gdb/gdbtypes.c 2015-05-31 16:14:05.844545344 +0200
-@@ -1851,6 +1851,7 @@ is_dynamic_type_internal (struct type *t
- }
+--- gdb-7.99.90.20170420.orig/gdb/dwarf2loc.c 2017-04-20 22:28:59.686490666 +0200
++++ gdb-7.99.90.20170420/gdb/dwarf2loc.c 2017-04-20 22:29:13.104575404 +0200
+@@ -42,6 +42,7 @@
+ #include <algorithm>
+ #include <vector>
+ #include <unordered_set>
++#include <functional>
+ #include "common/underlying.h"
- case TYPE_CODE_ARRAY:
-+ case TYPE_CODE_STRING:
- {
- gdb_assert (TYPE_NFIELDS (type) == 1);
+ extern int dwarf_always_disassemble;
+@@ -2366,6 +2367,20 @@
+ ctx.per_cu = per_cu;
+ ctx.obj_address = 0;
-@@ -2192,6 +2193,7 @@ resolve_dynamic_type_internal (struct ty
- }
-
- case TYPE_CODE_ARRAY:
-+ case TYPE_CODE_STRING:
- resolved_type = resolve_dynamic_array (type, addr_stack);
- break;
++frame_id old_frame_id (get_frame_id (deprecated_safe_get_selected_frame ()));
++class RestoreCall {
++private:
++ const std::function<void ()> func;
++public:
++ RestoreCall(std::function<void ()> 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;
-Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90
+ ctx.gdbarch = get_objfile_arch (objfile);
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90 2015-05-31 16:14:05.844545344 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/dynamic-other-frame-stub.f90 2017-04-20 22:29:00.673496899 +0200
@@ -0,0 +1,24 @@
+! Copyright 2010 Free Software Foundation, Inc.
+!
+ real :: dummy
+ dummy = 1
+end subroutine bar
-Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/dynamic-other-frame.exp
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/dynamic-other-frame.exp
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/dynamic-other-frame.exp 2015-05-31 16:14:05.845545351 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/dynamic-other-frame.exp 2017-04-20 22:29:00.673496899 +0200
@@ -0,0 +1,39 @@
+# Copyright 2010 Free Software Foundation, Inc.
+
+}
+
+gdb_test "bt" {foo \(string='hello'.*}
-Index: gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/dynamic-other-frame.f90
+Index: gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/dynamic-other-frame.f90
===================================================================
--- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.9.50.20150520/gdb/testsuite/gdb.fortran/dynamic-other-frame.f90 2015-05-31 16:14:05.845545351 +0200
++++ gdb-7.99.90.20170420/gdb/testsuite/gdb.fortran/dynamic-other-frame.f90 2017-04-20 22:29:00.673496899 +0200
@@ -0,0 +1,36 @@
+! Copyright 2010 Free Software Foundation, Inc.
+!
--- /dev/null
+Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp 2016-01-08 19:15:44.983637680 +0100
+@@ -0,0 +1,61 @@
++# Copyright 2014 Free Software Foundation, Inc.
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 3 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program. If not, see <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++# Check VLA passed to first Fortran function.
++gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]
++gdb_continue_to_breakpoint "func1-vla-passed"
++gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \
++ "print vla (func1)"
++gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \
++ "ptype vla (func1)"
++
++gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]
++gdb_continue_to_breakpoint "func1-vla-modified"
++gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"
++gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"
++
++# Check if the values are correct after returning from func1
++gdb_breakpoint [gdb_get_line_number "func1-returned"]
++gdb_continue_to_breakpoint "func1-returned"
++gdb_test "print ret" " = .TRUE." "print ret after func1 returned"
++
++# Check VLA passed to second Fortran function
++gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]
++gdb_continue_to_breakpoint "func2-vla-passed"
++gdb_test "print vla" \
++ " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \
++ "print vla (func2)"
++gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
++ "ptype vla (func2)"
++
++# Check if the returned VLA has the correct values and ptype.
++gdb_breakpoint [gdb_get_line_number "func2-returned"]
++gdb_continue_to_breakpoint "func2-returned"
++gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \
++ "print vla3 (after func2)"
++gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
++ "ptype vla3 (after func2)"
+Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90 2016-01-08 19:15:44.983637680 +0100
+@@ -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
+Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.exp
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.exp 2016-01-08 19:15:44.984637686 +0100
+@@ -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 <http://www.gnu.org/licenses/>.
++
++standard_testfile ".f90"
++
++if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
++ {debug f90 quiet}] } {
++ return -1
++}
++
++# check that all fortran standard datatypes will be
++# handled correctly when using as VLA's
++
++if ![runto MAIN__] then {
++ perror "couldn't run to breakpoint MAIN__"
++ continue
++}
++
++gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
++gdb_continue_to_breakpoint "var_char-allocated-1"
++gdb_test "print var_char" \
++ " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \
++ "print var_char after allocated first time"
++gdb_test "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"
+Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.f90
+===================================================================
+--- /dev/null 1970-01-01 00:00:00.000000000 +0000
++++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stringsold.f90 2016-01-08 19:15:44.984637686 +0100
+@@ -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
+++ /dev/null
-[PATCH 00/23] Fortran dynamic array support
-https://sourceware.org/ml/gdb-patches/2014-06/msg00108.html
-https://github.com/intel-gdb/vla/tree/vla-fortran
-
-GIT snapshot:
-commit 511bff520372ffc10fa2ff569c176bdf1e6e475d
-
-
-Index: gdb-7.10.50.20160106/gdb/c-valprint.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/c-valprint.c 2016-01-08 19:15:35.065582359 +0100
-+++ gdb-7.10.50.20160106/gdb/c-valprint.c 2016-01-08 19:15:44.974637630 +0100
-@@ -642,7 +642,16 @@
- {
- /* normal case */
- fprintf_filtered (stream, "(");
-- type_print (value_type (val), "", stream, -1);
-+ if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
-+ {
-+ struct value *v;
-+
-+ v = value_ind (val);
-+ v = value_addr (v);
-+ type_print (value_type (v), "", stream, -1);
-+ }
-+ else
-+ type_print (value_type (val), "", stream, -1);
- fprintf_filtered (stream, ") ");
- }
- }
-Index: gdb-7.10.50.20160106/gdb/dwarf2loc.h
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/dwarf2loc.h 2016-01-08 19:15:35.066582365 +0100
-+++ gdb-7.10.50.20160106/gdb/dwarf2loc.h 2016-01-08 19:15:44.974637630 +0100
-@@ -138,6 +138,11 @@
- struct property_addr_info *addr_stack,
- CORE_ADDR *value);
-
-+/* Checks if a dwarf location definition is valid.
-+ Returns 1 if valid; 0 otherwise. */
-+
-+extern int dwarf2_address_data_valid (const struct type *type);
-+
- /* A helper for the compiler interface that compiles a single dynamic
- property to C code.
-
-Index: gdb-7.10.50.20160106/gdb/dwarf2read.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/dwarf2read.c 2016-01-08 19:15:35.078582432 +0100
-+++ gdb-7.10.50.20160106/gdb/dwarf2read.c 2016-01-08 19:15:44.980637663 +0100
-@@ -1745,7 +1745,9 @@
-
- static int attr_to_dynamic_prop (const struct attribute *attr,
- struct die_info *die, struct dwarf2_cu *cu,
-- struct dynamic_prop *prop);
-+ struct dynamic_prop *prop,
-+ const gdb_byte *additional_data,
-+ int additional_data_size);
-
- /* memory allocation interface */
-
-@@ -11420,7 +11422,7 @@
- {
- newobj->static_link
- = XOBNEW (&objfile->objfile_obstack, struct dynamic_prop);
-- attr_to_dynamic_prop (attr, die, cu, newobj->static_link);
-+ attr_to_dynamic_prop (attr, die, cu, newobj->static_link, NULL, 0);
- }
-
- cu->list_in_scope = &local_symbols;
-@@ -14471,29 +14473,92 @@
- struct gdbarch *gdbarch = get_objfile_arch (objfile);
- struct type *type, *range_type, *index_type, *char_type;
- struct attribute *attr;
-- unsigned int length;
-+ unsigned int length = UINT_MAX;
-
-+ index_type = objfile_type (objfile)->builtin_int;
-+ range_type = create_static_range_type (NULL, index_type, 1, length);
-+
-+ /* If DW_AT_string_length is defined, the length is stored at some location
-+ * in memory. */
- attr = dwarf2_attr (die, DW_AT_string_length, cu);
- if (attr)
- {
-- length = DW_UNSND (attr);
-+ if (attr_form_is_block (attr))
-+ {
-+ struct attribute *byte_size, *bit_size;
-+ struct dynamic_prop high;
-+
-+ byte_size = dwarf2_attr (die, DW_AT_byte_size, cu);
-+ bit_size = dwarf2_attr (die, DW_AT_bit_size, cu);
-+
-+ /* DW_AT_byte_size should never occur together in combination with
-+ DW_AT_string_length. */
-+ if ((byte_size == NULL && bit_size != NULL) ||
-+ (byte_size != NULL && bit_size == NULL))
-+ complaint (&symfile_complaints, _("DW_AT_byte_size AND "
-+ "DW_AT_bit_size found together at the same time."));
-+
-+ /* If DW_AT_string_length AND DW_AT_byte_size exist together, it
-+ describes the number of bytes that should be read from the length
-+ memory location. */
-+ if (byte_size != NULL && bit_size == NULL)
-+ {
-+ /* Build new dwarf2_locexpr_baton structure with additions to the
-+ data attribute, to reflect DWARF specialities to get address
-+ sizes. */
-+ const gdb_byte append_ops[] = {
-+ /* DW_OP_deref_size: size of an address on the target machine
-+ (bytes), where the size will be specified by the next
-+ operand. */
-+ DW_OP_deref_size,
-+ /* Operand for DW_OP_deref_size. */
-+ DW_UNSND (byte_size) };
-+
-+ if (!attr_to_dynamic_prop (attr, die, cu, &high,
-+ append_ops, ARRAY_SIZE (append_ops)))
-+ complaint (&symfile_complaints,
-+ _("Could not parse DW_AT_byte_size"));
-+ }
-+ else if (bit_size != NULL && byte_size == NULL)
-+ complaint (&symfile_complaints, _("DW_AT_string_length AND "
-+ "DW_AT_bit_size found but not supported yet."));
-+ /* If DW_AT_string_length WITHOUT DW_AT_byte_size exist, the default
-+ is the address size of the target machine. */
-+ else
-+ {
-+ const gdb_byte append_ops[] = { DW_OP_deref };
-+
-+ if (!attr_to_dynamic_prop (attr, die, cu, &high, append_ops,
-+ ARRAY_SIZE (append_ops)))
-+ complaint (&symfile_complaints,
-+ _("Could not parse DW_AT_string_length"));
-+ }
-+
-+ TYPE_RANGE_DATA (range_type)->high = high;
-+ }
-+ else
-+ {
-+ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
-+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
-+ }
- }
- else
- {
-- /* Check for the DW_AT_byte_size attribute. */
-+ /* Check for the DW_AT_byte_size attribute, which represents the length
-+ in this case. */
- attr = dwarf2_attr (die, DW_AT_byte_size, cu);
- if (attr)
- {
-- length = DW_UNSND (attr);
-+ TYPE_HIGH_BOUND (range_type) = DW_UNSND (attr);
-+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
- }
- else
- {
-- length = 1;
-+ TYPE_HIGH_BOUND (range_type) = 1;
-+ TYPE_HIGH_BOUND_KIND (range_type) = PROP_CONST;
- }
- }
-
-- index_type = objfile_type (objfile)->builtin_int;
-- range_type = create_static_range_type (NULL, index_type, 1, length);
- char_type = language_string_char_type (cu->language_defn, gdbarch);
- type = create_string_type (NULL, char_type, range_type);
-
-@@ -14816,13 +14881,15 @@
- return set_die_type (die, type, cu);
- }
-
-+
- /* Parse dwarf attribute if it's a block, reference or constant and put the
- resulting value of the attribute into struct bound_prop.
- Returns 1 if ATTR could be resolved into PROP, 0 otherwise. */
-
- static int
- attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
-- struct dwarf2_cu *cu, struct dynamic_prop *prop)
-+ struct dwarf2_cu *cu, struct dynamic_prop *prop,
-+ const gdb_byte *additional_data, int additional_data_size)
- {
- struct dwarf2_property_baton *baton;
- struct obstack *obstack = &cu->objfile->objfile_obstack;
-@@ -14835,8 +14902,25 @@
- baton = XOBNEW (obstack, struct dwarf2_property_baton);
- baton->referenced_type = NULL;
- baton->locexpr.per_cu = cu->per_cu;
-- baton->locexpr.size = DW_BLOCK (attr)->size;
-- baton->locexpr.data = DW_BLOCK (attr)->data;
-+
-+ if (additional_data != NULL && additional_data_size > 0)
-+ {
-+ gdb_byte *data;
-+
-+ data = obstack_alloc (&cu->objfile->objfile_obstack,
-+ DW_BLOCK (attr)->size + additional_data_size);
-+ memcpy (data, DW_BLOCK (attr)->data, DW_BLOCK (attr)->size);
-+ memcpy (data + DW_BLOCK (attr)->size,
-+ additional_data, additional_data_size);
-+
-+ baton->locexpr.data = data;
-+ baton->locexpr.size = DW_BLOCK (attr)->size + additional_data_size;
-+ }
-+ else
-+ {
-+ baton->locexpr.data = DW_BLOCK (attr)->data;
-+ baton->locexpr.size = DW_BLOCK (attr)->size;
-+ }
- prop->data.baton = baton;
- prop->kind = PROP_LOCEXPR;
- gdb_assert (prop->data.baton != NULL);
-@@ -14872,8 +14956,28 @@
- baton = XOBNEW (obstack, struct dwarf2_property_baton);
- baton->referenced_type = die_type (target_die, target_cu);
- baton->locexpr.per_cu = cu->per_cu;
-- baton->locexpr.size = DW_BLOCK (target_attr)->size;
-- baton->locexpr.data = DW_BLOCK (target_attr)->data;
-+
-+ if (additional_data != NULL && additional_data_size > 0)
-+ {
-+ gdb_byte *data;
-+
-+ data = obstack_alloc (&cu->objfile->objfile_obstack,
-+ DW_BLOCK (target_attr)->size + additional_data_size);
-+ memcpy (data, DW_BLOCK (target_attr)->data,
-+ DW_BLOCK (target_attr)->size);
-+ memcpy (data + DW_BLOCK (target_attr)->size,
-+ additional_data, additional_data_size);
-+
-+ baton->locexpr.data = data;
-+ baton->locexpr.size = (DW_BLOCK (target_attr)->size
-+ + additional_data_size);
-+ }
-+ else
-+ {
-+ baton->locexpr.data = DW_BLOCK (target_attr)->data;
-+ baton->locexpr.size = DW_BLOCK (target_attr)->size;
-+ }
-+
- prop->data.baton = baton;
- prop->kind = PROP_LOCEXPR;
- gdb_assert (prop->data.baton != NULL);
-@@ -14927,7 +15031,7 @@
- struct type *base_type, *orig_base_type;
- struct type *range_type;
- struct attribute *attr;
-- struct dynamic_prop low, high;
-+ struct dynamic_prop low, high, stride;
- int low_default_is_valid;
- int high_bound_is_count = 0;
- const char *name;
-@@ -14947,7 +15051,9 @@
-
- low.kind = PROP_CONST;
- high.kind = PROP_CONST;
-+ stride.kind = PROP_CONST;
- high.data.const_val = 0;
-+ stride.data.const_val = 0;
-
- /* Set LOW_DEFAULT_IS_VALID if current language and DWARF version allow
- omitting DW_AT_lower_bound. */
-@@ -14980,19 +15086,26 @@
- break;
- }
-
-+ attr = dwarf2_attr (die, DW_AT_byte_stride, cu);
-+ if (attr)
-+ if (!attr_to_dynamic_prop (attr, die, cu, &stride, NULL, 0))
-+ complaint (&symfile_complaints, _("Missing DW_AT_byte_stride "
-+ "- DIE at 0x%x [in module %s]"),
-+ die->offset.sect_off, objfile_name (cu->objfile));
-+
- attr = dwarf2_attr (die, DW_AT_lower_bound, cu);
- if (attr)
-- attr_to_dynamic_prop (attr, die, cu, &low);
-+ attr_to_dynamic_prop (attr, die, cu, &low, NULL, 0);
- else if (!low_default_is_valid)
- complaint (&symfile_complaints, _("Missing DW_AT_lower_bound "
- "- DIE at 0x%x [in module %s]"),
- die->offset.sect_off, objfile_name (cu->objfile));
-
- attr = dwarf2_attr (die, DW_AT_upper_bound, cu);
-- if (!attr_to_dynamic_prop (attr, die, cu, &high))
-+ if (!attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
- {
- attr = dwarf2_attr (die, DW_AT_count, cu);
-- if (attr_to_dynamic_prop (attr, die, cu, &high))
-+ if (attr_to_dynamic_prop (attr, die, cu, &high, NULL, 0))
- {
- /* If bounds are constant do the final calculation here. */
- if (low.kind == PROP_CONST && high.kind == PROP_CONST)
-@@ -15056,7 +15169,7 @@
- && !TYPE_UNSIGNED (base_type) && (high.data.const_val & negative_mask))
- high.data.const_val |= negative_mask;
-
-- range_type = create_range_type (NULL, orig_base_type, &low, &high);
-+ range_type = create_range_type (NULL, orig_base_type, &low, &high, &stride);
-
- if (high_bound_is_count)
- TYPE_RANGE_DATA (range_type)->flag_upper_bound_is_count = 1;
-@@ -22360,7 +22473,7 @@
- attr = dwarf2_attr (die, DW_AT_allocated, cu);
- if (attr_form_is_block (attr))
- {
-- if (attr_to_dynamic_prop (attr, die, cu, &prop))
-+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
- add_dyn_prop (DYN_PROP_ALLOCATED, prop, type, objfile);
- }
- else if (attr != NULL)
-@@ -22375,7 +22488,7 @@
- attr = dwarf2_attr (die, DW_AT_associated, cu);
- if (attr_form_is_block (attr))
- {
-- if (attr_to_dynamic_prop (attr, die, cu, &prop))
-+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
- add_dyn_prop (DYN_PROP_ASSOCIATED, prop, type, objfile);
- }
- else if (attr != NULL)
-@@ -22388,7 +22501,7 @@
-
- /* 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))
-+ if (attr_to_dynamic_prop (attr, die, cu, &prop, NULL, 0))
- add_dyn_prop (DYN_PROP_DATA_LOCATION, prop, type, objfile);
-
- if (dwarf2_per_objfile->die_type_hash == NULL)
-Index: gdb-7.10.50.20160106/gdb/f-typeprint.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/f-typeprint.c 2016-01-08 19:15:35.080582443 +0100
-+++ gdb-7.10.50.20160106/gdb/f-typeprint.c 2016-01-08 19:15:44.980637663 +0100
-@@ -31,6 +31,7 @@
- #include "target.h"
- #include "f-lang.h"
- #include "typeprint.h"
-+#include "valprint.h"
-
- #if 0 /* Currently unused. */
- static void f_type_print_args (struct type *, struct ui_file *);
-@@ -64,6 +65,17 @@
- {
- val_print_not_allocated (stream);
- return;
-+ }
-+
-+ if (TYPE_NOT_ASSOCIATED (type))
-+ {
-+ val_print_not_associated (stream);
-+ return;
-+ }
-+ if (TYPE_NOT_ALLOCATED (type))
-+ {
-+ val_print_not_allocated (stream);
-+ return;
- }
-
- f_type_print_base (type, stream, show, level);
-Index: gdb-7.10.50.20160106/gdb/f-valprint.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/f-valprint.c 2016-01-08 19:15:35.081582448 +0100
-+++ gdb-7.10.50.20160106/gdb/f-valprint.c 2016-01-08 19:15:44.981637669 +0100
-@@ -36,8 +36,6 @@
-
- extern void _initialize_f_valprint (void);
- static void info_common_command (char *, int);
--static void f77_create_arrayprint_offset_tbl (struct type *,
-- struct ui_file *);
- static void f77_get_dynamic_length_of_aggregate (struct type *);
-
- int f77_array_offset_tbl[MAX_FORTRAN_DIMS + 1][2];
-@@ -45,15 +43,6 @@
- /* Array which holds offsets to be applied to get a row's elements
- for a given array. Array also holds the size of each subarray. */
-
--/* The following macro gives us the size of the nth dimension, Where
-- n is 1 based. */
--
--#define F77_DIM_SIZE(n) (f77_array_offset_tbl[n][1])
--
--/* The following gives us the offset for row n where n is 1-based. */
--
--#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
--
- int
- f77_get_lowerbound (struct type *type)
- {
-@@ -111,47 +100,6 @@
- * TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type)));
- }
-
--/* Function that sets up the array offset,size table for the array
-- type "type". */
--
--static void
--f77_create_arrayprint_offset_tbl (struct type *type, struct ui_file *stream)
--{
-- struct type *tmp_type;
-- int eltlen;
-- int ndimen = 1;
-- int upper, lower;
--
-- tmp_type = type;
--
-- while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
-- {
-- upper = f77_get_upperbound (tmp_type);
-- lower = f77_get_lowerbound (tmp_type);
--
-- F77_DIM_SIZE (ndimen) = upper - lower + 1;
--
-- tmp_type = TYPE_TARGET_TYPE (tmp_type);
-- ndimen++;
-- }
--
-- /* Now we multiply eltlen by all the offsets, so that later we
-- can print out array elements correctly. Up till now we
-- know an offset to apply to get the item but we also
-- have to know how much to add to get to the next item. */
--
-- ndimen--;
-- eltlen = TYPE_LENGTH (tmp_type);
-- F77_DIM_OFFSET (ndimen) = eltlen;
-- while (--ndimen > 0)
-- {
-- eltlen *= F77_DIM_SIZE (ndimen + 1);
-- F77_DIM_OFFSET (ndimen) = eltlen;
-- }
--}
--
--
--
- /* Actual function which prints out F77 arrays, Valaddr == address in
- the superior. Address == the address in the inferior. */
-
-@@ -164,41 +112,62 @@
- const struct value_print_options *options,
- int *elts)
- {
-+ struct type *range_type = TYPE_INDEX_TYPE (check_typedef (type));
-+ CORE_ADDR addr = address + embedded_offset;
-+ LONGEST lowerbound, upperbound;
- int i;
-
-+ get_discrete_bounds (range_type, &lowerbound, &upperbound);
-+
- if (nss != ndimensions)
- {
-- for (i = 0;
-- (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max);
-+ size_t dim_size;
-+ size_t offs = 0;
-+ LONGEST byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
-+
-+ if (byte_stride)
-+ dim_size = byte_stride;
-+ else
-+ dim_size = TYPE_LENGTH (TYPE_TARGET_TYPE (type));
-+
-+ for (i = lowerbound;
-+ (i < upperbound + 1 && (*elts) < options->print_max);
- i++)
- {
-+ struct value *subarray = value_from_contents_and_address
-+ (TYPE_TARGET_TYPE (type), value_contents_for_printing_const (val)
-+ + offs, addr + offs);
-+
- fprintf_filtered (stream, "( ");
-- f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
-- valaddr,
-- embedded_offset + i * F77_DIM_OFFSET (nss),
-- address,
-- stream, recurse, val, options, elts);
-+ f77_print_array_1 (nss + 1, ndimensions, value_type (subarray),
-+ value_contents_for_printing (subarray),
-+ value_embedded_offset (subarray),
-+ value_address (subarray),
-+ stream, recurse, subarray, options, elts);
-+ offs += dim_size;
- fprintf_filtered (stream, ") ");
- }
-- if (*elts >= options->print_max && i < F77_DIM_SIZE (nss))
-+ if (*elts >= options->print_max && i < upperbound)
- fprintf_filtered (stream, "...");
- }
- else
- {
-- for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max;
-+ for (i = lowerbound; i < upperbound + 1 && (*elts) < options->print_max;
- i++, (*elts)++)
- {
-- val_print (TYPE_TARGET_TYPE (type),
-- valaddr,
-- embedded_offset + i * F77_DIM_OFFSET (ndimensions),
-- address, stream, recurse,
-- val, options, current_language);
-+ struct value *elt = value_subscript ((struct value *)val, i);
-+
-+ val_print (value_type (elt),
-+ value_contents_for_printing (elt),
-+ value_embedded_offset (elt),
-+ value_address (elt), stream, recurse,
-+ elt, options, current_language);
-
-- if (i != (F77_DIM_SIZE (nss) - 1))
-+ if (i != upperbound)
- fprintf_filtered (stream, ", ");
-
- if ((*elts == options->print_max - 1)
-- && (i != (F77_DIM_SIZE (nss) - 1)))
-+ && (i != upperbound))
- fprintf_filtered (stream, "...");
- }
- }
-@@ -225,12 +194,6 @@
- Type node corrupt! F77 arrays cannot have %d subscripts (%d Max)"),
- ndimensions, MAX_FORTRAN_DIMS);
-
-- /* Since F77 arrays are stored column-major, we set up an
-- offset table to get at the various row's elements. The
-- offset table contains entries for both offset and subarray size. */
--
-- f77_create_arrayprint_offset_tbl (type, stream);
--
- f77_print_array_1 (1, ndimensions, type, valaddr, embedded_offset,
- address, stream, recurse, val, options, &elts);
- }
-@@ -375,12 +338,15 @@
- fprintf_filtered (stream, "( ");
- for (index = 0; index < TYPE_NFIELDS (type); index++)
- {
-- int offset = TYPE_FIELD_BITPOS (type, index) / 8;
-+ struct value *field = value_field
-+ ((struct value *)original_value, index);
-+
-+ val_print (value_type (field),
-+ value_contents_for_printing (field),
-+ value_embedded_offset (field),
-+ value_address (field), stream, recurse + 1,
-+ field, options, current_language);
-
-- val_print (TYPE_FIELD_TYPE (type, index), valaddr,
-- embedded_offset + offset,
-- address, stream, recurse + 1,
-- original_value, options, current_language);
- if (index != TYPE_NFIELDS (type) - 1)
- fputs_filtered (", ", stream);
- }
-Index: gdb-7.10.50.20160106/gdb/gdbtypes.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/gdbtypes.c 2016-01-08 19:15:35.083582459 +0100
-+++ gdb-7.10.50.20160106/gdb/gdbtypes.c 2016-01-08 19:15:44.982637674 +0100
-@@ -836,7 +836,8 @@
- struct type *
- create_range_type (struct type *result_type, struct type *index_type,
- const struct dynamic_prop *low_bound,
-- const struct dynamic_prop *high_bound)
-+ const struct dynamic_prop *high_bound,
-+ const struct dynamic_prop *stride)
- {
- if (result_type == NULL)
- result_type = alloc_type_copy (index_type);
-@@ -851,6 +852,7 @@
- TYPE_ZALLOC (result_type, sizeof (struct range_bounds));
- TYPE_RANGE_DATA (result_type)->low = *low_bound;
- TYPE_RANGE_DATA (result_type)->high = *high_bound;
-+ TYPE_RANGE_DATA (result_type)->stride = *stride;
-
- if (low_bound->kind == PROP_CONST && low_bound->data.const_val >= 0)
- TYPE_UNSIGNED (result_type) = 1;
-@@ -879,7 +881,7 @@
- create_static_range_type (struct type *result_type, struct type *index_type,
- LONGEST low_bound, LONGEST high_bound)
- {
-- struct dynamic_prop low, high;
-+ struct dynamic_prop low, high, stride;
-
- low.kind = PROP_CONST;
- low.data.const_val = low_bound;
-@@ -887,7 +889,11 @@
- high.kind = PROP_CONST;
- high.data.const_val = high_bound;
-
-- result_type = create_range_type (result_type, index_type, &low, &high);
-+ stride.kind = PROP_CONST;
-+ stride.data.const_val = 0;
-+
-+ result_type = create_range_type (result_type, index_type,
-+ &low, &high, &stride);
-
- return result_type;
- }
-@@ -1084,16 +1090,21 @@
- && (!type_not_associated (result_type)
- && !type_not_allocated (result_type)))
- {
-- LONGEST low_bound, high_bound;
-+ LONGEST low_bound, high_bound, byte_stride;
-
- if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
- low_bound = high_bound = 0;
- element_type = check_typedef (element_type);
-+
-+ byte_stride = abs (TYPE_BYTE_STRIDE (range_type));
-+
- /* Be careful when setting the array length. Ada arrays can be
- empty arrays with the high_bound being smaller than the low_bound.
- In such cases, the array length should be zero. */
- if (high_bound < low_bound)
- TYPE_LENGTH (result_type) = 0;
-+ else if (byte_stride > 0)
-+ TYPE_LENGTH (result_type) = byte_stride * (high_bound - low_bound + 1);
- else if (bit_stride > 0)
- TYPE_LENGTH (result_type) =
- (bit_stride * (high_bound - low_bound + 1) + 7) / 8;
-@@ -1804,12 +1815,31 @@
- static int
- is_dynamic_type_internal (struct type *type, int top_level)
- {
-+ int index;
-+
-+ if (!type)
-+ return 0;
-+
- type = check_typedef (type);
-
- /* We only want to recognize references at the outermost level. */
- if (top_level && TYPE_CODE (type) == TYPE_CODE_REF)
- type = check_typedef (TYPE_TARGET_TYPE (type));
-
-+ if (TYPE_ASSOCIATED_PROP (type))
-+ return 1;
-+
-+ if (TYPE_ALLOCATED_PROP (type))
-+ return 1;
-+
-+ /* Scan field types in the Fortran case for nested dynamic types.
-+ This will be done only for Fortran as in the C++ case an endless recursion
-+ can occur in the area of classes. */
-+ if (current_language->la_language == language_fortran)
-+ for (index = 0; index < TYPE_NFIELDS (type); index++)
-+ if (is_dynamic_type (TYPE_FIELD_TYPE (type, index)))
-+ return 1;
-+
- /* Types that have a dynamic TYPE_DATA_LOCATION are considered
- dynamic, even if the type itself is statically defined.
- From a user's point of view, this may appear counter-intuitive;
-@@ -1844,11 +1874,19 @@
- {
- gdb_assert (TYPE_NFIELDS (type) == 1);
-
-- /* The array is dynamic if either the bounds are dynamic,
-- or the elements it contains have a dynamic contents. */
-+ /* The array is dynamic if either
-+ - the bounds are dynamic,
-+ - the elements it contains have a dynamic contents
-+ - a data_locaton attribute was found. */
- if (is_dynamic_type_internal (TYPE_INDEX_TYPE (type), 0))
- return 1;
-- return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
-+ else if (TYPE_DATA_LOCATION (type) != NULL
-+ && (TYPE_DATA_LOCATION_KIND (type) == PROP_LOCEXPR
-+ || TYPE_DATA_LOCATION_KIND (type) == PROP_LOCLIST))
-+ return 1;
-+ else
-+ return is_dynamic_type_internal (TYPE_TARGET_TYPE (type), 0);
-+ break;
- }
-
- case TYPE_CODE_STRUCT:
-@@ -1861,6 +1899,18 @@
- && is_dynamic_type_internal (TYPE_FIELD_TYPE (type, i), 0))
- return 1;
- }
-+ case TYPE_CODE_PTR:
-+ {
-+ if (TYPE_TARGET_TYPE (type)
-+ && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_STRING
-+ || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY))
-+ return is_dynamic_type (check_typedef (TYPE_TARGET_TYPE (type)));
-+
-+ return 0;
-+ break;
-+ }
-+ default:
-+ return 0;
- break;
- }
-
-@@ -1890,7 +1940,8 @@
- struct type *static_range_type, *static_target_type;
- const struct dynamic_prop *prop;
- const struct dwarf2_locexpr_baton *baton;
-- struct dynamic_prop low_bound, high_bound;
-+ struct dynamic_prop low_bound, high_bound, stride;
-+ struct type *range_copy = copy_type (dyn_range_type);
-
- gdb_assert (TYPE_CODE (dyn_range_type) == TYPE_CODE_RANGE);
-
-@@ -1922,12 +1973,19 @@
- high_bound.data.const_val = 0;
- }
-
-+ prop = &TYPE_RANGE_DATA (dyn_range_type)->stride;
-+ if (dwarf2_evaluate_property (prop, NULL, addr_stack, &value))
-+ {
-+ stride.kind = PROP_CONST;
-+ stride.data.const_val = value;
-+ }
-+
- static_target_type
-- = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (dyn_range_type),
-+ = resolve_dynamic_type_internal (TYPE_TARGET_TYPE (range_copy),
- addr_stack, 0);
-- static_range_type = create_range_type (copy_type (dyn_range_type),
-+ static_range_type = create_range_type (range_copy,
- static_target_type,
-- &low_bound, &high_bound);
-+ &low_bound, &high_bound, &stride);
- TYPE_RANGE_DATA (static_range_type)->flag_bound_evaluated = 1;
- return static_range_type;
- }
-@@ -1946,7 +2004,8 @@
- struct type *ary_dim;
- struct dynamic_prop *prop;
-
-- gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY);
-+ gdb_assert (TYPE_CODE (type) == TYPE_CODE_ARRAY
-+ || TYPE_CODE (type) == TYPE_CODE_STRING);
-
- type = copy_type (type);
-
-@@ -1971,13 +2030,18 @@
-
- ary_dim = check_typedef (TYPE_TARGET_TYPE (elt_type));
-
-- if (ary_dim != NULL && TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY)
-+ if (ary_dim != NULL && (TYPE_CODE (ary_dim) == TYPE_CODE_ARRAY
-+ || TYPE_CODE (ary_dim) == TYPE_CODE_STRING))
- elt_type = resolve_dynamic_array (ary_dim, addr_stack);
- else
- elt_type = TYPE_TARGET_TYPE (type);
-
-- return create_array_type_with_stride (type, elt_type, range_type,
-- TYPE_FIELD_BITSIZE (type, 0));
-+ if (TYPE_CODE (type) == TYPE_CODE_STRING
-+ && TYPE_FIELD_BITSIZE (type, 0) == 0)
-+ return create_string_type (type, elt_type, range_type);
-+ else
-+ return create_array_type_with_stride (type, elt_type, range_type,
-+ TYPE_FIELD_BITSIZE (type, 0));
- }
-
- /* Resolve dynamic bounds of members of the union TYPE to static
-Index: gdb-7.10.50.20160106/gdb/gdbtypes.h
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/gdbtypes.h 2016-01-08 19:15:35.085582471 +0100
-+++ gdb-7.10.50.20160106/gdb/gdbtypes.h 2016-01-08 19:15:44.983637680 +0100
-@@ -577,6 +577,10 @@
-
- struct dynamic_prop high;
-
-+ /* * Stride of range. */
-+
-+ struct dynamic_prop stride;
-+
- /* True if HIGH range bound contains the number of elements in the
- subrange. This affects how the final hight bound is computed. */
-
-@@ -749,6 +753,18 @@
-
- /* * Contains all dynamic type properties. */
- struct dynamic_prop_list *dyn_prop_list;
-+
-+ /* Structure for DW_AT_allocated.
-+ The presence of this attribute indicates that the object of the type
-+ can be allocated/deallocated. The value can be a dwarf expression,
-+ reference, or a constant. */
-+ struct dynamic_prop *allocated;
-+
-+ /* Structure for DW_AT_associated.
-+ The presence of this attribute indicated that the object of the type
-+ can be associated. The value can be a dwarf expression,
-+ reference, or a constant. */
-+ struct dynamic_prop *associated;
- };
-
- /* * A ``struct type'' describes a particular instance of a type, with
-@@ -1255,6 +1271,15 @@
- TYPE_RANGE_DATA(range_type)->high.kind
- #define TYPE_LOW_BOUND_KIND(range_type) \
- TYPE_RANGE_DATA(range_type)->low.kind
-+#define TYPE_BYTE_STRIDE(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.data.const_val
-+#define TYPE_BYTE_STRIDE_BLOCK(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.data.locexpr
-+#define TYPE_BYTE_STRIDE_LOCLIST(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.data.loclist
-+#define TYPE_BYTE_STRIDE_KIND(range_type) \
-+ TYPE_RANGE_DATA(range_type)->stride.kind
-+
-
- /* Property accessors for the type data location. */
- #define TYPE_DATA_LOCATION(thistype) \
-@@ -1266,6 +1291,18 @@
- #define TYPE_DATA_LOCATION_KIND(thistype) \
- TYPE_DATA_LOCATION (thistype)->kind
-
-+/* Allocated status of type object. If set to non-zero it means the object
-+ is allocated. A zero value means it is not allocated. */
-+#define TYPE_NOT_ALLOCATED(t) (TYPE_ALLOCATED_PROP (t) \
-+ && TYPE_ALLOCATED_PROP (t)->kind == PROP_CONST \
-+ && !TYPE_ALLOCATED_PROP (t)->data.const_val)
-+
-+/* Associated status of type object. If set to non-zero it means the object
-+ is associated. A zero value means it is not associated. */
-+#define TYPE_NOT_ASSOCIATED(t) (TYPE_ASSOCIATED_PROP (t) \
-+ && TYPE_ASSOCIATED_PROP (t)->kind == PROP_CONST \
-+ && !TYPE_ASSOCIATED_PROP (t)->data.const_val)
-+
- /* Property accessors for the type allocated/associated. */
- #define TYPE_ALLOCATED_PROP(thistype) \
- get_dyn_prop (DYN_PROP_ALLOCATED, thistype)
-@@ -1289,6 +1326,9 @@
- TYPE_HIGH_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
- #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \
- TYPE_LOW_BOUND_UNDEFINED(TYPE_INDEX_TYPE(arraytype))
-+#define TYPE_ARRAY_STRIDE_IS_UNDEFINED(arraytype) \
-+ (TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) == 0)
-+
-
- #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \
- (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE((arraytype))))
-@@ -1775,6 +1815,7 @@
-
- extern struct type *create_range_type (struct type *, struct type *,
- const struct dynamic_prop *,
-+ const struct dynamic_prop *,
- const struct dynamic_prop *);
-
- extern struct type *create_array_type (struct type *, struct type *,
-Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.exp 2016-01-08 19:15:44.983637680 +0100
-@@ -0,0 +1,61 @@
-+# Copyright 2014 Free Software Foundation, Inc.
-+
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 3 of the License, or
-+# (at your option) any later version.
-+#
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+# GNU General Public License for more details.
-+#
-+# You should have received a copy of the GNU General Public License
-+# along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+standard_testfile ".f90"
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+if ![runto MAIN__] then {
-+ perror "couldn't run to breakpoint MAIN__"
-+ continue
-+}
-+
-+# Check VLA passed to first Fortran function.
-+gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]
-+gdb_continue_to_breakpoint "func1-vla-passed"
-+gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \
-+ "print vla (func1)"
-+gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10,10\\\)" \
-+ "ptype vla (func1)"
-+
-+gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]
-+gdb_continue_to_breakpoint "func1-vla-modified"
-+gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"
-+gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"
-+
-+# Check if the values are correct after returning from func1
-+gdb_breakpoint [gdb_get_line_number "func1-returned"]
-+gdb_continue_to_breakpoint "func1-returned"
-+gdb_test "print ret" " = .TRUE." "print ret after func1 returned"
-+
-+# Check VLA passed to second Fortran function
-+gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]
-+gdb_continue_to_breakpoint "func2-vla-passed"
-+gdb_test "print vla" \
-+ " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \
-+ "print vla (func2)"
-+gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
-+ "ptype vla (func2)"
-+
-+# Check if the returned VLA has the correct values and ptype.
-+gdb_breakpoint [gdb_get_line_number "func2-returned"]
-+gdb_continue_to_breakpoint "func2-returned"
-+gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \
-+ "print vla3 (after func2)"
-+gdb_test "ptype vla3" "type = integer\\\(kind=4\\\) \\\(10\\\)" \
-+ "ptype vla3 (after func2)"
-Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-func.f90 2016-01-08 19:15:44.983637680 +0100
-@@ -0,0 +1,71 @@
-+! Copyright 2014 Free Software Foundation, Inc.
-+!
-+! This program is free software; you can redistribute it and/or modify
-+! it under the terms of the GNU General Public License as published by
-+! the Free Software Foundation; either version 2 of the License, or
-+! (at your option) any later version.
-+!
-+! This program is distributed in the hope that it will be useful,
-+! but WITHOUT ANY WARRANTY; without even the implied warranty of
-+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+! GNU General Public License for more details.
-+!
-+! You should have received a copy of the GNU General Public License
-+! along with this program; if not, write to the Free Software
-+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-+
-+logical function func1 (vla)
-+ implicit none
-+ integer, allocatable :: vla (:, :)
-+ func1 = allocated(vla)
-+ vla(5,5) = 55 ! func1-vla-passed
-+ vla(7,7) = 77
-+ return ! func1-vla-modified
-+end function func1
-+
-+function func2(vla)
-+ implicit none
-+ integer :: vla (:)
-+ integer :: func2(size(vla))
-+ integer :: k
-+
-+ vla(1) = 1 ! func2-vla-passed
-+ vla(2) = 2
-+ vla(4) = 4
-+ vla(8) = 8
-+
-+ func2 = vla
-+end function func2
-+
-+program vla_func
-+ implicit none
-+ interface
-+ logical function func1 (vla)
-+ integer :: vla (:, :)
-+ end function
-+ end interface
-+ interface
-+ function func2 (vla)
-+ integer :: vla (:)
-+ integer func2(size(vla))
-+ end function
-+ end interface
-+
-+ logical :: ret
-+ integer, allocatable :: vla1 (:, :)
-+ integer, allocatable :: vla2 (:)
-+ integer, allocatable :: vla3 (:)
-+
-+ ret = .FALSE.
-+
-+ allocate (vla1 (10,10))
-+ vla1(:,:) = 22
-+
-+ allocate (vla2 (10))
-+ vla2(:) = 44
-+
-+ ret = func1(vla1)
-+ vla3 = func2(vla2) ! func1-returned
-+
-+ ret = .TRUE. ! func2-returned
-+end program vla_func
-Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.exp 2016-01-08 19:15:44.984637686 +0100
-@@ -0,0 +1,44 @@
-+# Copyright 2014 Free Software Foundation, Inc.
-+
-+# This program is free software; you can redistribute it and/or modify
-+# it under the terms of the GNU General Public License as published by
-+# the Free Software Foundation; either version 3 of the License, or
-+# (at your option) any later version.
-+#
-+# This program is distributed in the hope that it will be useful,
-+# but WITHOUT ANY WARRANTY; without even the implied warranty of
-+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+# GNU General Public License for more details.
-+#
-+# You should have received a copy of the GNU General Public License
-+# along with this program. If not, see <http://www.gnu.org/licenses/>.
-+
-+standard_testfile ".f90"
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+if ![runto MAIN__] then {
-+ perror "couldn't run to breakpoint MAIN__"
-+ continue
-+}
-+
-+gdb_breakpoint [gdb_get_line_number "re-reverse-elements"]
-+gdb_continue_to_breakpoint "re-reverse-elements"
-+gdb_test "print pvla" " = \\\(1, 2, 3, 4, 5, 6, 7, 8, 9, 10\\\)" \
-+ "print re-reverse-elements"
-+gdb_test "print pvla(1)" " = 1" "print first re-reverse-element"
-+gdb_test "print pvla(10)" " = 10" "print last re-reverse-element"
-+
-+gdb_breakpoint [gdb_get_line_number "odd-elements"]
-+gdb_continue_to_breakpoint "odd-elements"
-+gdb_test "print pvla" " = \\\(1, 3, 5, 7, 9\\\)" "print odd-elements"
-+gdb_test "print pvla(1)" " = 1" "print first odd-element"
-+gdb_test "print pvla(5)" " = 9" "print last odd-element"
-+
-+gdb_breakpoint [gdb_get_line_number "single-element"]
-+gdb_continue_to_breakpoint "single-element"
-+gdb_test "print pvla" " = \\\(5\\\)" "print single-element"
-+gdb_test "print pvla(1)" " = 5" "print one single-element"
-Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.f90
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-stride.f90 2016-01-08 19:15:44.984637686 +0100
-@@ -0,0 +1,30 @@
-+! Copyright 2014 Free Software Foundation, Inc.
-+!
-+! This program is free software; you can redistribute it and/or modify
-+! it under the terms of the GNU General Public License as published by
-+! the Free Software Foundation; either version 2 of the License, or
-+! (at your option) any later version.
-+!
-+! This program is distributed in the hope that it will be useful,
-+! but WITHOUT ANY WARRANTY; without even the implied warranty of
-+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+! GNU General Public License for more details.
-+!
-+! You should have received a copy of the GNU General Public License
-+! along with this program; if not, write to the Free Software
-+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-+
-+program vla_stride
-+ integer, target, allocatable :: vla (:)
-+ integer, pointer :: pvla (:)
-+
-+ allocate(vla(10))
-+ vla = (/ (I, I = 1,10) /)
-+
-+ pvla => vla(10:1:-1)
-+ pvla => pvla(10:1:-1)
-+ pvla => vla(1:10:2) ! re-reverse-elements
-+ pvla => vla(5:4:-2) ! odd-elements
-+
-+ pvla => null() ! single-element
-+end program vla_stride
-Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.exp
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.exp 2016-01-08 19:15:44.984637686 +0100
-@@ -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 <http://www.gnu.org/licenses/>.
-+
-+standard_testfile ".f90"
-+
-+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
-+ {debug f90 quiet}] } {
-+ return -1
-+}
-+
-+# check that all fortran standard datatypes will be
-+# handled correctly when using as VLA's
-+
-+if ![runto MAIN__] then {
-+ perror "couldn't run to breakpoint MAIN__"
-+ continue
-+}
-+
-+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]
-+gdb_continue_to_breakpoint "var_char-allocated-1"
-+gdb_test "print var_char" \
-+ " = \\(PTR TO -> \\( character\\*10 \\)\\) ${hex}" \
-+ "print var_char after allocated first time"
-+gdb_test "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"
-Index: gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.f90
-===================================================================
---- /dev/null 1970-01-01 00:00:00.000000000 +0000
-+++ gdb-7.10.50.20160106/gdb/testsuite/gdb.fortran/vla-strings.f90 2016-01-08 19:15:44.984637686 +0100
-@@ -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
-Index: gdb-7.10.50.20160106/gdb/typeprint.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/typeprint.c 2016-01-08 19:15:35.086582476 +0100
-+++ gdb-7.10.50.20160106/gdb/typeprint.c 2016-01-08 19:15:44.984637686 +0100
-@@ -460,6 +460,13 @@
-
- type = value_type (val);
-
-+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
-+ if (is_dynamic_type (TYPE_TARGET_TYPE (type)))
-+ {
-+ val = value_addr (value_ind (val));
-+ type = value_type (val);
-+ }
-+
- get_user_print_options (&opts);
- if (opts.objectprint)
- {
-Index: gdb-7.10.50.20160106/gdb/valarith.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/valarith.c 2016-01-08 19:15:35.087582482 +0100
-+++ gdb-7.10.50.20160106/gdb/valarith.c 2016-01-08 19:15:44.985637691 +0100
-@@ -193,9 +193,21 @@
- struct type *array_type = check_typedef (value_type (array));
- struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
- unsigned int elt_size = type_length_units (elt_type);
-- unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound);
-+ unsigned int elt_offs = longest_to_int (index - lowerbound);
-+ LONGEST elt_stride = TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (array_type));
- struct value *v;
-
-+ if (elt_stride > 0)
-+ elt_offs *= elt_stride;
-+ else if (elt_stride < 0)
-+ {
-+ int offs = (elt_offs + 1) * elt_stride;
-+
-+ elt_offs = TYPE_LENGTH (array_type) + offs;
-+ }
-+ else
-+ elt_offs *= elt_size;
-+
- if (index < lowerbound || (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
- && elt_offs >= type_length_units (array_type)))
- {
-Index: gdb-7.10.50.20160106/gdb/valprint.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/valprint.c 2016-01-08 19:15:35.088582487 +0100
-+++ gdb-7.10.50.20160106/gdb/valprint.c 2016-01-08 19:15:44.986637697 +0100
-@@ -316,6 +316,18 @@
- return 0;
- }
-
-+ if (TYPE_NOT_ASSOCIATED (type))
-+ {
-+ val_print_not_associated (stream);
-+ return 0;
-+ }
-+
-+ if (TYPE_NOT_ALLOCATED (type))
-+ {
-+ val_print_not_allocated (stream);
-+ return 0;
-+ }
-+
- if (TYPE_CODE (type) != TYPE_CODE_UNION
- && TYPE_CODE (type) != TYPE_CODE_STRUCT
- && TYPE_CODE (type) != TYPE_CODE_ARRAY)
-@@ -1025,12 +1037,16 @@
- value_check_printable (struct value *val, struct ui_file *stream,
- const struct value_print_options *options)
- {
-+ const struct type *type;
-+
- if (val == 0)
- {
- fprintf_filtered (stream, _("<address of value unknown>"));
- return 0;
- }
-
-+ type = value_type (val);
-+
- if (value_entirely_optimized_out (val))
- {
- if (options->summary && !val_print_scalar_type_p (value_type (val)))
-@@ -1066,6 +1082,18 @@
- {
- val_print_not_allocated (stream);
- return 0;
-+ }
-+
-+ if (TYPE_NOT_ASSOCIATED (type))
-+ {
-+ val_print_not_associated (stream);
-+ return 0;
-+ }
-+
-+ if (TYPE_NOT_ALLOCATED (type))
-+ {
-+ val_print_not_allocated (stream);
-+ return 0;
- }
-
- return 1;
-Index: gdb-7.10.50.20160106/gdb/valprint.h
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/valprint.h 2016-01-08 19:15:35.088582487 +0100
-+++ gdb-7.10.50.20160106/gdb/valprint.h 2016-01-08 19:15:44.986637697 +0100
-@@ -232,4 +232,8 @@
- struct format_data *fmtp);
- extern void print_value (struct value *val, const struct format_data *fmtp);
-
-+extern void val_print_not_allocated (struct ui_file *stream);
-+
-+extern void val_print_not_associated (struct ui_file *stream);
-+
- #endif
-Index: gdb-7.10.50.20160106/gdb/value.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/value.c 2016-01-08 19:15:35.090582499 +0100
-+++ gdb-7.10.50.20160106/gdb/value.c 2016-01-08 19:15:44.987637702 +0100
-@@ -40,6 +40,7 @@
- #include "tracepoint.h"
- #include "cp-abi.h"
- #include "user-regs.h"
-+#include "dwarf2loc.h"
-
- /* Prototypes for exported functions. */
-
-@@ -1788,6 +1789,25 @@
- if (funcs->copy_closure)
- component->location.computed.closure = funcs->copy_closure (whole);
- }
-+
-+ /* For dynamic types compute the address of the component value location in
-+ sub range types based on the location of the sub range type, if not being
-+ an internal GDB variable or parts of it. */
-+ if (VALUE_LVAL (component) != lval_internalvar
-+ && VALUE_LVAL (component) != lval_internalvar_component)
-+ {
-+ CORE_ADDR addr;
-+ struct type *type = value_type (whole);
-+
-+ addr = value_raw_address (component);
-+
-+ if (TYPE_DATA_LOCATION (type)
-+ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
-+ {
-+ addr = TYPE_DATA_LOCATION_ADDR (type);
-+ set_value_address (component, addr);
-+ }
-+ }
- }
-
- \f
-@@ -3095,13 +3115,22 @@
- v = allocate_value_lazy (type);
- else
- {
-- v = allocate_value (type);
-- value_contents_copy_raw (v, value_embedded_offset (v),
-- arg1, value_embedded_offset (arg1) + offset,
-- type_length_units (type));
-+ if (TYPE_DATA_LOCATION (type)
-+ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
-+ v = value_at_lazy (type, value_address (arg1) + offset);
-+ else
-+ {
-+ v = allocate_value (type);
-+ value_contents_copy_raw (v, value_embedded_offset (v),
-+ arg1, value_embedded_offset (arg1) + offset,
-+ type_length_units (type));
-+ }
- }
-- v->offset = (value_offset (arg1) + offset
-- + value_embedded_offset (arg1));
-+
-+ if (!TYPE_DATA_LOCATION (type)
-+ || !TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
-+ v->offset = (value_offset (arg1) + offset
-+ + value_embedded_offset (arg1));
- }
- set_value_component_location (v, arg1);
- VALUE_REGNUM (v) = VALUE_REGNUM (arg1);
-@@ -3689,7 +3718,8 @@
- struct value *original_value)
- {
- /* Re-adjust type. */
-- deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
-+ if (!is_dynamic_type (TYPE_TARGET_TYPE (original_type)))
-+ deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type));
-
- /* Add embedding info. */
- set_value_enclosing_type (value, enc_type);
-@@ -3706,6 +3736,12 @@
- struct value *retval;
- struct type *enc_type;
-
-+ if (current_language->la_language != language_fortran
-+ && TYPE_DATA_LOCATION (value_type_arg_tmp) != NULL
-+ && TYPE_DATA_LOCATION_KIND (value_type_arg_tmp) == PROP_CONST)
-+ arg = value_at_lazy (value_type_arg_tmp,
-+ TYPE_DATA_LOCATION_ADDR (value_type_arg_tmp));
-+
- retval = coerce_ref_if_computed (arg);
- if (retval)
- return retval;
-@@ -3834,8 +3870,14 @@
- }
- else if (VALUE_LVAL (val) == lval_memory)
- {
-- CORE_ADDR addr = value_address (val);
- struct type *type = check_typedef (value_enclosing_type (val));
-+ CORE_ADDR addr;
-+
-+ if (TYPE_DATA_LOCATION (type) != NULL
-+ && TYPE_DATA_LOCATION_KIND (type) == PROP_CONST)
-+ addr = TYPE_DATA_LOCATION_ADDR (type);
-+ else
-+ addr = value_address (val);
-
- if (TYPE_LENGTH (type))
- read_value_memory (val, 0, value_stack (val),
-Index: gdb-7.10.50.20160106/gdb/dwarf2loc.c
-===================================================================
---- gdb-7.10.50.20160106.orig/gdb/dwarf2loc.c 2016-01-08 19:15:35.091582504 +0100
-+++ gdb-7.10.50.20160106/gdb/dwarf2loc.c 2016-01-08 19:15:44.988637708 +0100
-@@ -2368,6 +2368,11 @@
- address = value_as_address (value_from_pointer (ptr_type, address));
-
- do_cleanups (value_chain);
-+
-+ /* Select right frame to correctly evaluate VLA's during a backtrace. */
-+ if (is_dynamic_type (type))
-+ select_frame (frame);
-+
- retval = value_at_lazy (type, address + byte_offset);
- if (in_stack_memory)
- set_value_stack (retval, 1);
-@@ -2660,6 +2665,19 @@
- data, data + size, per_cu);
- }
-
-+/* See dwarf2loc.h. */
-+
-+int
-+dwarf2_address_data_valid (const struct type *type)
-+{
-+ if (TYPE_NOT_ASSOCIATED (type))
-+ return 0;
-+
-+ if (TYPE_NOT_ALLOCATED (type))
-+ return 0;
-+
-+ return 1;
-+}
- \f
- /* Helper functions and baton for dwarf2_loc_desc_needs_frame. */
-
Summary(zh_TW.UTF-8): [.-A開發]C和.$)B其.-A他語.$)B言的調試器
%define snap 20120926
Name: gdb
-Version: 7.11.1
-Release: 3
+Version: 8.0
+Release: 1
License: GPL v3+
Group: Development/Debuggers
Source0: http://ftp.gnu.org/gnu/gdb/%{name}-%{version}.tar.xz
-# Source0-md5: 5aa71522e488e358243917967db87476
+# Source0-md5: c3d35cd949084be53b92cc1e03485f88
Source1: http://www.mif.pg.gda.pl/homepages/ankry/man-PLD/%{name}-non-english-man-pages.tar.bz2
# Source1-md5: 2e8a48939ae282c12bbacdd54e398247
Source3: %{name}-gstack.man
Patch103: gdb-6.6-buildid-locate-core-as-arg.patch
Patch104: gdb-6.6-buildid-locate-rpm-librpm-workaround.patch
Patch105: gdb-6.6-buildid-locate-misleading-warning-missing-debuginfo-rhbz981154.patch
+Patch106: gdb-6.6-buildid-locate-rpm-scl.patch
Patch110: gdb-6.3-gstack-20050411.patch
Patch111: gdb-gdb-add-index-script.patch
Patch112: gdb-archer-vla-tests.patch
-Patch113: gdb-vla-intel.patch
-Patch114: gdb-vla-intel-04of23-fix.patch
-Patch115: gdb-vla-intel-stringbt-fix.patch
-Patch116: gdb-vla-intel-logical-not.patch
+Patch113: gdb-vla-intel-fortran-strides.patch
+Patch114: gdb-vla-intel-stringbt-fix.patch
+Patch115: gdb-vla-intel-fortran-vla-strings.patch
+Patch116: gdb-vla-intel-tests.patch
Patch1000: %{name}-readline.patch
Patch1001: %{name}-info.patch
Patch1002: %{name}-passflags.patch
BuildRequires: bison
BuildRequires: babeltrace-devel
BuildRequires: expat-devel
-BuildRequires: flex
+BuildRequires: flex >= 2.6.4
BuildRequires: gettext-tools
%{?with_guile:BuildRequires: guile-devel >= 2.0}
BuildRequires: libselinux-devel
%prep
%setup -q
-%patch0 -p1
-%patch1 -p1
-
# Files have `# <number> <file>' statements breaking VPATH / find-debuginfo.sh .
rm -f gdb/ada-exp.c gdb/ada-lex.c gdb/c-exp.c gdb/cp-name-parser.c gdb/f-exp.c
rm -f gdb/jv-exp.c gdb/m2-exp.c gdb/objc-exp.c gdb/p-exp.c
%patch103 -p1
%patch104 -p1
%patch105 -p1
+%patch106 -p1
%patch110 -p1
%patch111 -p1
%patch112 -p1
projects / packages / gdb.git / commitdiff