From 5c94ba08eef53f6ec593b6d44732930d1e61033f Mon Sep 17 00:00:00 2001 From: Jan Kratochvil Date: Nov 03 2008 03:34:39 +0000 Subject: - Fix the variable-length-arrays support (BZ 468266, feature BZ 377541). - Fix the debuginfo-install suggestions for missing base packages (BZ 467901), also update the rpm/yum code to no longer require _RPM_4_4_COMPAT. --- diff --git a/gdb-6.6-buildid-locate.patch b/gdb-6.6-buildid-locate.patch index f79804f..5486277 100644 --- a/gdb-6.6-buildid-locate.patch +++ b/gdb-6.6-buildid-locate.patch @@ -786,7 +786,7 @@ if (retval != NULL && !build_id_verify (retval, build_id)) { -@@ -1314,9 +1714,437 @@ build_id_to_debug_filename (struct build +@@ -1314,9 +1714,424 @@ build_id_to_debug_filename (struct build retval = NULL; } @@ -852,104 +852,91 @@ + for (;;) + { + Header h; -+ char *s, *srcrpm, *verrel, *debuginfo; -+ union -+ { -+ void *voidp; -+ char *s; -+ } -+ sourcerpm, arch; -+ char **slot; ++ char *debuginfo, **slot, *s, *s2; ++ errmsg_t err; ++ size_t srcrpmlen = sizeof (".src.rpm") - 1; ++ size_t debuginfolen = sizeof ("-debuginfo") - 1; + rpmdbMatchIterator mi_debuginfo; + + h = rpmdbNextIterator (mi); + if (h == NULL) + break; + -+ if (!headerGetEntry (h, RPMTAG_SOURCERPM, NULL, &sourcerpm.voidp, -+ NULL)) ++ /* Verify the debuginfo file is not already installed. */ ++ ++ debuginfo = headerFormat (h, "%{sourcerpm}-debuginfo.%{arch}", &err); ++ if (!debuginfo) + { -+ warning (_("Error querying the rpm file `%s' %s"), filename, -+ "RPMTAG_SOURCERPM"); ++ warning (_("Error querying the rpm file `%s': %s"), filename, ++ err); + continue; + } -+ srcrpm = sourcerpm.s + strlen (sourcerpm.s) - (sizeof ".src.rpm" - 1); -+ if (srcrpm < sourcerpm.s || strcmp (srcrpm, ".src.rpm") != 0) ++ /* s = `.src.rpm-debuginfo.%{arch}' */ ++ s = strrchr (debuginfo, '-') - srcrpmlen; ++ s2 = NULL; ++ if (s > debuginfo && memcmp (s, ".src.rpm", srcrpmlen) == 0) + { -+error_parsing_sourcerpm: -+ warning (_("Error parsing %%{sourcerpm} of the rpm file `%s': %s"), -+ filename, sourcerpm.s); -+ continue; ++ /* s2 = `-%{release}.src.rpm-debuginfo.%{arch}' */ ++ s2 = memrchr (debuginfo, '-', s - debuginfo); + } -+ s = srcrpm; -+ -+ /* Skip the release. */ -+ -+ while (s > sourcerpm.s && s[-1] != '-') -+ s--; -+ if (s == sourcerpm.s) -+ goto error_parsing_sourcerpm; -+ s--; -+ -+ /* Skip the version. */ -+ -+ while (s > sourcerpm.s && s[-1] != '-') -+ s--; -+ if (s == sourcerpm.s) -+ goto error_parsing_sourcerpm; -+ s--; -+ verrel = s; -+ -+ if (!headerGetEntry (h, RPMTAG_ARCH, NULL, &arch.voidp, NULL)) ++ if (s2) ++ { ++ /* s2 = `-%{version}-%{release}.src.rpm-debuginfo.%{arch}' */ ++ s2 = memrchr (debuginfo, '-', s2 - debuginfo); ++ } ++ if (!s2) + { -+ warning (_("Error querying the rpm file `%s' %s"), filename, -+ "RPMTAG_ARCH"); ++ warning (_("Error querying the rpm file `%s': %s"), filename, ++ debuginfo); ++ xfree (debuginfo); + continue; + } -+ -+ /* The allocated memory gets utilized below for MISSING_RPM_HASH. */ -+ -+ debuginfo = xmalloc (strlen (sourcerpm.s) + strlen (arch.s) + 32); -+ -+ /* Verify the debuginfo file is not already installed. */ -+ -+ sprintf (debuginfo, "%.*s-debuginfo%.*s.%s", -+ (int) (verrel - sourcerpm.s), sourcerpm.s, -+ (int) (srcrpm - verrel), verrel, arch.s); ++ /* s = `.src.rpm-debuginfo.%{arch}' */ ++ /* s2 = `-%{version}-%{release}.src.rpm-debuginfo.%{arch}' */ ++ memmove (s2 + debuginfolen, s2, s - s2); ++ memcpy (s2, "-debuginfo", debuginfolen); ++ /* s = `XXXX.%{arch}' */ ++ /* strlen ("XXXX") == srcrpmlen + debuginfolen */ ++ /* s2 = `-debuginfo-%{version}-%{release}XX.%{arch}' */ ++ /* strlen ("XX") == srcrpmlen */ ++ memmove (s + debuginfolen, s + srcrpmlen + debuginfolen, ++ strlen (s + srcrpmlen + debuginfolen) + 1); ++ /* s = `-debuginfo-%{version}-%{release}.%{arch}' */ ++ ++ /* RPMDBI_PACKAGES requires keylen == sizeof (int). */ ++ /* RPMDBI_LABEL is an interface for NVR-based dbiFindByLabel(). */ + mi_debuginfo = rpmtsInitIterator (ts, RPMDBI_LABEL, debuginfo, 0); -+ if (mi_debuginfo != NULL) ++ xfree (debuginfo); ++ if (mi_debuginfo) + { -+ Header h_debuginfo; -+ -+ h_debuginfo = rpmdbNextIterator (mi_debuginfo); + rpmdbFreeIterator (mi_debuginfo); -+ if (h_debuginfo != NULL) -+ { -+ xfree (debuginfo); -+ -+ /* We ignore any != 0 for possibly already enlisted rpms as -+ it should not hurt much. */ ++ count = 0; ++ break; ++ } + -+ count = 0; -+ break; -+ } ++ /* The allocated memory gets utilized below for MISSING_RPM_HASH. */ ++ debuginfo = headerFormat (h, ++ "%{name}-%{version}-%{release}.%{arch}", ++ &err); ++ if (!debuginfo) ++ { ++ warning (_("Error querying the rpm file `%s': %s"), filename, ++ err); ++ continue; + } + -+ /* Base package name for `debuginfo-install'. We do not use `yum' -+ as its command -+ yum --enablerepo='*-debuginfo' install BASE-debuginfo.ARCH ++ /* Base package name for `debuginfo-install'. We do not use the ++ `yum' command directly as the line ++ yum --enablerepo='*-debuginfo' install NAME-debuginfo.ARCH + would be more complicated than just: -+ debuginfo-install BASE.ARCH -+ We do not need to supply the version-release as -+ `debuginfo-install' always installs only the debuginfo matching -+ the currently installed rpm. Still we must supply `.%{arch}' as -+ we may have multilib (multiple arch-differing rpm packages) -+ installed. ++ debuginfo-install NAME-VERSION-RELEASE.ARCH ++ Do not supply the rpm base name (derived from .src.rpm name) as ++ debuginfo-install is unable to install the debuginfo package if ++ the base name PKG binary rpm is not installed while for example ++ PKG-libs would be installed (RH Bug 467901). + FUTURE: After multiple debuginfo versions simultaneously installed -+ get supported we may need to supply the version-release here. */ -+ -+ sprintf (debuginfo, "%.*s.%s", (int) (verrel - sourcerpm.s), -+ sourcerpm.s, arch.s); ++ get supported the support for the VERSION-RELEASE tags handling ++ may need an update. */ + + if (missing_rpm_hash == NULL) + { diff --git a/gdb-6.8-bz377541-fortran-dynamic-arrays.patch b/gdb-6.8-bz377541-fortran-dynamic-arrays.patch deleted file mode 100644 index b140703..0000000 --- a/gdb-6.8-bz377541-fortran-dynamic-arrays.patch +++ /dev/null @@ -1,2552 +0,0 @@ -The last version posted upstream: - -0: http://sources.redhat.com/ml/gdb-patches/2007-11/msg00438.html -1: http://sources.redhat.com/ml/gdb-patches/2007-11/msg00439.html -2: http://sources.redhat.com/ml/gdb-patches/2007-11/msg00440.html -3: http://sources.redhat.com/ml/gdb-patches/2007-11/msg00441.html -4: http://sources.redhat.com/ml/gdb-patches/2007-11/msg00442.html -5: http://sources.redhat.com/ml/gdb-patches/2007-11/msg00443.html -6: http://sources.redhat.com/ml/gdb-patches/2007-11/msg00444.html - -2008-02-24 Jan Kratochvil - - Port to GDB-6.8pre. - -2008-08-23 Jan Kratochvil - - Include dynamic strings support. - -diff -up -ruNp gdb-6.8-0/gdb/Makefile.in gdb-6.8-1/gdb/Makefile.in ---- gdb-6.8-0/gdb/Makefile.in 2008-08-23 22:29:57.000000000 +0200 -+++ gdb-6.8-1/gdb/Makefile.in 2008-08-23 22:31:08.000000000 +0200 -@@ -758,6 +758,7 @@ disasm_h = disasm.h - doublest_h = doublest.h $(floatformat_h) - dummy_frame_h = dummy-frame.h - dfp_h = dfp.h -+dwarf2block_h = dwarf2block.h - dwarf2expr_h = dwarf2expr.h - dwarf2_frame_h = dwarf2-frame.h - dwarf2loc_h = dwarf2loc.h -@@ -1051,7 +1052,7 @@ COMMON_OBS = $(DEPFILES) $(CONFIG_OBS) $ - exec.o bcache.o objfiles.o observer.o minsyms.o maint.o demangle.o \ - dbxread.o coffread.o coff-pe-read.o \ - dwarf2read.o mipsread.o stabsread.o corefile.o \ -- dwarf2expr.o dwarf2loc.o dwarf2-frame.o \ -+ dwarf2block.o dwarf2expr.o dwarf2loc.o dwarf2-frame.o \ - ada-lang.o c-lang.o f-lang.o objc-lang.o \ - ui-out.o cli-out.o \ - varobj.o vec.o wrapper.o \ -@@ -2086,6 +2087,9 @@ dummy-frame.o: dummy-frame.c $(defs_h) $ - $(command_h) $(gdbcmd_h) $(gdb_string_h) - dfp.o: dfp.c $(defs_h) $(expression_h) $(gdbtypes_h) $(value_h) $(dfp_h) \ - $(decimal128_h) $(decimal64_h) $(decimal32_h) -+dwarf2block.o: dwarf2block.c $(dwarf2block_h) $(defs_h) $(gdbcore_h) \ -+ $(dwarf2expr_h) $(exceptions_h) $(frame_h) $(regcache_h) $(value_h) \ -+ $(block_h) $(gdb_assert.h) $(dwarf2loc.h) - dwarf2expr.o: dwarf2expr.c $(defs_h) $(symtab_h) $(gdbtypes_h) $(value_h) \ - $(gdbcore_h) $(elf_dwarf2_h) $(dwarf2expr_h) - dwarf2-frame.o: dwarf2-frame.c $(defs_h) $(dwarf2expr_h) $(elf_dwarf2_h) \ -@@ -2096,13 +2100,14 @@ dwarf2-frame.o: dwarf2-frame.c $(defs_h) - dwarf2loc.o: dwarf2loc.c $(defs_h) $(ui_out_h) $(value_h) $(frame_h) \ - $(gdbcore_h) $(target_h) $(inferior_h) $(ax_h) $(ax_gdb_h) \ - $(regcache_h) $(objfiles_h) $(exceptions_h) $(elf_dwarf2_h) \ -- $(dwarf2expr_h) $(dwarf2loc_h) $(gdb_string_h) $(gdb_assert_h) -+ $(dwarf2expr_h) $(dwarf2loc_h) $(gdb_string_h) $(gdb_assert_h) \ -+ $(dwarf2block_h) - dwarf2read.o: dwarf2read.c $(defs_h) $(bfd_h) $(symtab_h) $(gdbtypes_h) \ - $(objfiles_h) $(elf_dwarf2_h) $(buildsym_h) $(demangle_h) \ - $(expression_h) $(filenames_h) $(macrotab_h) $(language_h) \ - $(complaints_h) $(bcache_h) $(dwarf2expr_h) $(dwarf2loc_h) \ - $(cp_support_h) $(hashtab_h) $(command_h) $(gdbcmd_h) \ -- $(gdb_string_h) $(gdb_assert_h) -+ $(gdb_string_h) $(gdb_assert_h) $(dwarf2block_h) $(f_lang_h) - elfread.o: elfread.c $(defs_h) $(bfd_h) $(gdb_string_h) $(elf_bfd_h) \ - $(elf_mips_h) $(symtab_h) $(symfile_h) $(objfiles_h) $(buildsym_h) \ - $(stabsread_h) $(gdb_stabs_h) $(complaints_h) $(demangle_h) \ -@@ -2138,10 +2143,10 @@ f-exp.o: f-exp.c $(defs_h) $(gdb_string_ - findvar.o: findvar.c $(defs_h) $(symtab_h) $(gdbtypes_h) $(frame_h) \ - $(value_h) $(gdbcore_h) $(inferior_h) $(target_h) $(gdb_string_h) \ - $(gdb_assert_h) $(floatformat_h) $(symfile_h) $(regcache_h) \ -- $(user_regs_h) $(block_h) -+ $(user_regs_h) $(block_h) $(dwarf2block_h) - f-lang.o: f-lang.c $(defs_h) $(gdb_string_h) $(symtab_h) $(gdbtypes_h) \ - $(expression_h) $(parser_defs_h) $(language_h) $(f_lang_h) \ -- $(valprint_h) $(value_h) -+ $(valprint_h) $(value_h) $(dwarf2block_h) - fork-child.o: fork-child.c $(defs_h) $(gdb_string_h) $(frame_h) \ - $(inferior_h) $(target_h) $(gdb_wait_h) $(gdb_vfork_h) $(gdbcore_h) \ - $(terminal_h) $(gdbthread_h) $(command_h) $(solib_h) -@@ -2166,7 +2171,7 @@ frv-tdep.o: frv-tdep.c $(defs_h) $(gdb_s - $(frv_tdep_h) - f-typeprint.o: f-typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) $(symtab_h) \ - $(gdbtypes_h) $(expression_h) $(value_h) $(gdbcore_h) $(target_h) \ -- $(f_lang_h) $(gdb_string_h) -+ $(f_lang_h) $(gdb_string_h) $(dwarf2block_h) - f-valprint.o: f-valprint.c $(defs_h) $(gdb_string_h) $(symtab_h) \ - $(gdbtypes_h) $(expression_h) $(value_h) $(valprint_h) $(language_h) \ - $(f_lang_h) $(frame_h) $(gdbcore_h) $(command_h) $(block_h) -@@ -2181,7 +2186,8 @@ gdb-events.o: gdb-events.c $(defs_h) $(g - gdbtypes.o: gdbtypes.c $(defs_h) $(gdb_string_h) $(bfd_h) $(symtab_h) \ - $(symfile_h) $(objfiles_h) $(gdbtypes_h) $(expression_h) \ - $(language_h) $(target_h) $(value_h) $(demangle_h) $(complaints_h) \ -- $(gdbcmd_h) $(wrapper_h) $(cp_abi_h) $(gdb_assert_h) $(hashtab_h) -+ $(gdbcmd_h) $(wrapper_h) $(cp_abi_h) $(gdb_assert_h) $(hashtab_h) \ -+ $(dwarf2block_h) - glibc-tdep.o: glibc-tdep.c $(defs_h) $(frame_h) $(symtab_h) $(symfile_h) \ - $(objfiles_h) $(glibc_tdep_h) - gnu-nat.o: gnu-nat.c $(gdb_string_h) $(defs_h) $(inferior_h) $(symtab_h) \ -@@ -2939,7 +2945,7 @@ tramp-frame.o: tramp-frame.c $(defs_h) $ - typeprint.o: typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) $(symtab_h) \ - $(gdbtypes_h) $(expression_h) $(value_h) $(gdbcore_h) $(command_h) \ - $(gdbcmd_h) $(target_h) $(language_h) $(cp_abi_h) $(typeprint_h) \ -- $(gdb_string_h) -+ $(gdb_string_h) $(dwarf2block_h) - ui-file.o: ui-file.c $(defs_h) $(ui_file_h) $(gdb_string_h) - ui-out.o: ui-out.c $(defs_h) $(gdb_string_h) $(expression_h) $(language_h) \ - $(ui_out_h) $(gdb_assert_h) -diff -up -ruNp gdb-6.8-0/gdb/ada-lang.c gdb-6.8-1/gdb/ada-lang.c ---- gdb-6.8-0/gdb/ada-lang.c 2008-08-23 22:29:57.000000000 +0200 -+++ gdb-6.8-1/gdb/ada-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -11009,6 +11009,7 @@ const struct language_defn ada_language_ - ada_language_arch_info, - ada_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/c-lang.c gdb-6.8-1/gdb/c-lang.c ---- gdb-6.8-0/gdb/c-lang.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/c-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -427,6 +427,7 @@ const struct language_defn c_language_de - c_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -@@ -540,6 +541,7 @@ const struct language_defn cplus_languag - cplus_language_arch_info, - default_print_array_index, - cp_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -@@ -575,6 +577,7 @@ const struct language_defn asm_language_ - c_language_arch_info, /* FIXME: la_language_arch_info. */ - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -@@ -615,6 +618,7 @@ const struct language_defn minimal_langu - c_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/dwarf2block.c gdb-6.8-1/gdb/dwarf2block.c ---- gdb-6.8-0/gdb/dwarf2block.c 1970-01-01 01:00:00.000000000 +0100 -+++ gdb-6.8-1/gdb/dwarf2block.c 2008-08-23 22:31:08.000000000 +0200 -@@ -0,0 +1,216 @@ -+/* DWARF DW_FORM_block* expression evaluation. -+ -+ Copyright (C) 2007 Free Software Foundation, Inc. -+ -+ This file is part of GDB. -+ -+ This program is free software; you can redistribute it and/or modify -+ it under the terms of the GNU General Public License as published by -+ the Free Software Foundation; either version 3 of the License, or -+ (at your option) any later version. -+ -+ This program is distributed in the hope that it will be useful, -+ but WITHOUT ANY WARRANTY; without even the implied warranty of -+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+ GNU General Public License for more details. -+ -+ You should have received a copy of the GNU General Public License -+ along with this program. If not, see . */ -+ -+#include "defs.h" -+#include "dwarf2block.h" -+#include "gdbcore.h" -+#include "dwarf2expr.h" -+#include "exceptions.h" -+#include "frame.h" -+#include "regcache.h" -+#include "value.h" -+#include "block.h" -+#include "gdb_assert.h" -+#include "dwarf2loc.h" -+ -+/* This is the baton used when performing dwarf2 DW_BLOCK evaluation. */ -+struct dwarf_block_baton -+{ -+ CORE_ADDR address; -+}; -+ -+/* Read memory at ADDR (length LEN) into BUF. */ -+ -+static void -+dwarf_block_read_mem (void *baton, gdb_byte *buf, CORE_ADDR addr, size_t len) -+{ -+ read_memory (addr, buf, len); -+} -+ -+static CORE_ADDR -+dwarf_block_object_address (void *baton) -+{ -+ struct dwarf_block_baton *debaton = baton; -+ -+ /* The message is suppressed in DWARF_BLOCK_EXEC. */ -+ if (debaton->address == 0) -+ error (_("Cannot resolve DW_OP_push_object_address for a missing object")); -+ -+ return debaton->address; -+} -+ -+/* A copy from dwarf2-frame.c:read_reg() but without one unwind. */ -+ -+static CORE_ADDR -+dwarf_block_read_reg (void *baton, int reg) -+{ -+ struct frame_info *frame = get_selected_frame -+ (_("Unsupported operation for DW_FORM_block: read_reg")); -+ struct gdbarch *gdbarch = get_frame_arch (frame); -+ int regnum; -+ gdb_byte *buf; -+ -+ regnum = gdbarch_dwarf2_reg_to_regnum (gdbarch, reg); -+ -+ buf = alloca (register_size (gdbarch, regnum)); -+ get_frame_register (frame, regnum, buf); -+ -+ /* Convert the register to an integer. This returns a LONGEST -+ rather than a CORE_ADDR, but unpack_pointer does the same thing -+ under the covers, and this makes more sense for non-pointer -+ registers. Maybe read_reg and the associated interfaces should -+ deal with "struct value" instead of CORE_ADDR. */ -+ return unpack_long (register_type (gdbarch, regnum), buf); -+} -+ -+/* A copy from dwarf2loc.c:dwarf_expr_frame_base(). */ -+ -+static void -+dwarf_block_get_frame_base (void *baton, gdb_byte **start, size_t *length) -+{ -+ struct frame_info *frame = get_selected_frame -+ (_("Unsupported operation for DW_FORM_block: read_reg")); -+ /* FIXME: cagney/2003-03-26: This code should be using -+ get_frame_base_address(), and then implement a dwarf2 specific -+ this_base method. */ -+ struct symbol *framefunc; -+ -+ /* Use block_linkage_function, which returns a real (not inlined) -+ function, instead of get_frame_function, which may return an -+ inlined function. */ -+ framefunc = block_linkage_function (get_frame_block (frame, NULL)); -+ -+ /* If we found a frame-relative symbol then it was certainly within -+ some function associated with a frame. If we can't find the frame, -+ something has gone wrong. */ -+ gdb_assert (framefunc != NULL); -+ -+ if (SYMBOL_LOCATION_BATON (framefunc) == NULL) -+ *start = NULL; -+ else if (SYMBOL_OPS (framefunc) == &dwarf2_loclist_funcs) -+ { -+ struct dwarf2_loclist_baton *symbaton; -+ -+ symbaton = SYMBOL_LOCATION_BATON (framefunc); -+ *start = find_location_expression (symbaton, length, -+ get_frame_address_in_block (frame)); -+ } -+ else -+ { -+ struct dwarf2_locexpr_baton *symbaton; -+ -+ symbaton = SYMBOL_LOCATION_BATON (framefunc); -+ *length = symbaton->size; -+ *start = symbaton->data; -+ } -+ -+ if (*start == NULL) -+ error (_("%s: Could not find the frame base for \"%s\"."), -+ "dwarf_block_get_frame_base", SYMBOL_NATURAL_NAME (framefunc)); -+} -+ -+static CORE_ADDR -+dwarf_block_get_tls_address (void *baton, CORE_ADDR offset) -+{ -+ error (_("Unsupported operation for DW_FORM_block*: %s"), "get_tls_address"); -+ return 0; -+} -+ -+static CORE_ADDR dwarf_block_exec_core (struct dwarf_block *dwarf_block, -+ CORE_ADDR address) -+{ -+ struct dwarf_expr_context *ctx; -+ struct dwarf_block_baton baton; -+ struct cleanup *back_to; -+ CORE_ADDR retval; -+ -+ back_to = make_cleanup (null_cleanup, 0); -+ -+ baton.address = address; -+ -+ ctx = new_dwarf_expr_context (); -+ back_to = make_cleanup ((make_cleanup_ftype *) free_dwarf_expr_context, ctx); -+ ctx->baton = &baton; -+ ctx->read_mem = dwarf_block_read_mem; -+ ctx->get_object_address = dwarf_block_object_address; -+ ctx->read_reg = dwarf_block_read_reg; -+ ctx->get_frame_base = dwarf_block_get_frame_base; -+ ctx->get_tls_address = dwarf_block_get_tls_address; -+ -+ dwarf_expr_eval (ctx, dwarf_block->data, dwarf_block->size); -+ -+ if (ctx->num_pieces > 0) -+ error (_("DW_OP_piece is an unsupported result for DW_FORM_block*")); -+ if (ctx->in_reg) -+ error (_("DW_OP_reg* is an unsupported result for DW_FORM_block*")); -+ -+ retval = dwarf_expr_fetch (ctx, 0); -+ -+ do_cleanups (back_to); -+ -+ return retval; -+} -+ -+static CORE_ADDR object_address; -+ -+static void -+object_address_cleanup (void *prev_save_voidp) -+{ -+ CORE_ADDR *prev_save = prev_save_voidp; -+ -+ object_address = *prev_save; -+ xfree (prev_save); -+} -+ -+void -+object_address_set (CORE_ADDR address) -+{ -+ CORE_ADDR *prev_save; -+ -+ prev_save = xmalloc (sizeof *prev_save); -+ *prev_save = object_address; -+ make_cleanup (object_address_cleanup, prev_save); -+ -+ object_address = address; -+} -+ -+CORE_ADDR -+object_address_get (void) -+{ -+ return object_address; -+} -+ -+CORE_ADDR dwarf_block_exec (struct dwarf_block *dwarf_block) -+{ -+ volatile struct gdb_exception e; -+ volatile CORE_ADDR retval = 0; -+ -+ TRY_CATCH (e, RETURN_MASK_ERROR) -+ { -+ retval = dwarf_block_exec_core (dwarf_block, object_address); -+ } -+ /* CATCH_ERRORS would print the possible error message of -+ DWARF_BLOCK_OBJECT_ADDRESS. Sometimes it is valid as CHECK_TYPEDEF is -+ a very common call even if we still do not know any variable instance of -+ that type. We cannot fill in the right TYPE_LENGTH at that time. */ -+ if (e.reason < 0) -+ return 0; -+ -+ return retval; -+} -diff -up -ruNp gdb-6.8-0/gdb/dwarf2block.h gdb-6.8-1/gdb/dwarf2block.h ---- gdb-6.8-0/gdb/dwarf2block.h 1970-01-01 01:00:00.000000000 +0100 -+++ gdb-6.8-1/gdb/dwarf2block.h 2008-08-23 22:30:33.000000000 +0200 -@@ -0,0 +1,36 @@ -+/* DWARF DW_FORM_block* expression evaluation. -+ -+ Copyright (C) 2007 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 . */ -+ -+#if !defined (DWARF2BLOCK_H) -+#define DWARF2BLOCK_H 1 -+ -+/* Blocks are a bunch of untyped bytes. */ -+struct dwarf_block -+ { -+ unsigned int size; -+ gdb_byte *data; -+ }; -+ -+extern CORE_ADDR dwarf_block_exec (struct dwarf_block *dwarf_block); -+ -+extern void object_address_set (CORE_ADDR address); -+ -+extern CORE_ADDR object_address_get (void); -+ -+#endif /* !defined(DWARF2BLOCK_H) */ -diff -up -ruNp gdb-6.8-0/gdb/dwarf2expr.c gdb-6.8-1/gdb/dwarf2expr.c ---- gdb-6.8-0/gdb/dwarf2expr.c 2008-08-23 22:29:56.000000000 +0200 -+++ gdb-6.8-1/gdb/dwarf2expr.c 2008-08-23 22:30:33.000000000 +0200 -@@ -750,6 +750,13 @@ execute_stack_op (struct dwarf_expr_cont - ctx->initialized = 0; - goto no_push; - -+ case DW_OP_push_object_address: -+ if (ctx->get_object_address == NULL) -+ error (_("DWARF-2 expression error: DW_OP_push_object_address must " -+ "have a value to push.")); -+ result = (ctx->get_object_address) (ctx->baton); -+ break; -+ - default: - error (_("Unhandled dwarf expression opcode 0x%x"), op); - } -diff -up -ruNp gdb-6.8-0/gdb/dwarf2expr.h gdb-6.8-1/gdb/dwarf2expr.h ---- gdb-6.8-0/gdb/dwarf2expr.h 2008-01-01 23:53:09.000000000 +0100 -+++ gdb-6.8-1/gdb/dwarf2expr.h 2008-08-23 22:30:33.000000000 +0200 -@@ -61,10 +61,10 @@ struct dwarf_expr_context - The result must be live until the current expression evaluation - is complete. */ - unsigned char *(*get_subr) (void *baton, off_t offset, size_t *length); -+#endif - - /* Return the `object address' for DW_OP_push_object_address. */ - CORE_ADDR (*get_object_address) (void *baton); --#endif - - /* The current depth of dwarf expression recursion, via DW_OP_call*, - DW_OP_fbreg, DW_OP_push_object_address, etc., and the maximum -diff -up -ruNp gdb-6.8-0/gdb/dwarf2loc.c gdb-6.8-1/gdb/dwarf2loc.c ---- gdb-6.8-0/gdb/dwarf2loc.c 2008-01-01 23:53:09.000000000 +0100 -+++ gdb-6.8-1/gdb/dwarf2loc.c 2008-08-23 22:31:08.000000000 +0200 -@@ -35,6 +35,7 @@ - #include "elf/dwarf2.h" - #include "dwarf2expr.h" - #include "dwarf2loc.h" -+#include "dwarf2block.h" - - #include "gdb_string.h" - #include "gdb_assert.h" -@@ -47,7 +48,7 @@ - For now, only return the first matching location expression; there - can be more than one in the list. */ - --static gdb_byte * -+gdb_byte * - find_location_expression (struct dwarf2_loclist_baton *baton, - size_t *locexpr_length, CORE_ADDR pc) - { -@@ -252,6 +253,9 @@ dwarf2_evaluate_loc_desc (struct symbol - { - CORE_ADDR address = dwarf_expr_fetch (ctx, 0); - -+ /* ADDR is set here for ALLOCATE_VALUE's CHECK_TYPEDEF for -+ DW_OP_push_object_address. */ -+ object_address_set (address); - retval = allocate_value (SYMBOL_TYPE (var)); - VALUE_LVAL (retval) = lval_memory; - set_value_lazy (retval, 1); -diff -up -ruNp gdb-6.8-0/gdb/dwarf2loc.h gdb-6.8-1/gdb/dwarf2loc.h ---- gdb-6.8-0/gdb/dwarf2loc.h 2008-01-01 23:53:09.000000000 +0100 -+++ gdb-6.8-1/gdb/dwarf2loc.h 2008-08-23 22:31:08.000000000 +0200 -@@ -66,4 +66,8 @@ struct dwarf2_loclist_baton - extern const struct symbol_ops dwarf2_locexpr_funcs; - extern const struct symbol_ops dwarf2_loclist_funcs; - -+extern gdb_byte *find_location_expression (struct dwarf2_loclist_baton *baton, -+ size_t *locexpr_length, -+ CORE_ADDR pc); -+ - #endif /* dwarf2loc.h */ -diff -up -ruNp gdb-6.8-0/gdb/dwarf2read.c gdb-6.8-1/gdb/dwarf2read.c ---- gdb-6.8-0/gdb/dwarf2read.c 2008-08-23 22:29:57.000000000 +0200 -+++ gdb-6.8-1/gdb/dwarf2read.c 2008-08-23 22:31:08.000000000 +0200 -@@ -46,6 +46,8 @@ - #include "top.h" - #include "command.h" - #include "gdbcmd.h" -+#include "dwarf2block.h" -+#include "f-lang.h" - - #include - #include "gdb_string.h" -@@ -563,13 +565,6 @@ struct function_range - #define DW_SND(attr) ((attr)->u.snd) - #define DW_ADDR(attr) ((attr)->u.addr) - --/* Blocks are a bunch of untyped bytes. */ --struct dwarf_block -- { -- unsigned int size; -- gdb_byte *data; -- }; -- - #ifndef ATTR_ALLOC_CHUNK - #define ATTR_ALLOC_CHUNK 4 - #endif -@@ -1004,7 +999,14 @@ static void store_in_ref_table (unsigned - static unsigned int dwarf2_get_ref_die_offset (struct attribute *, - struct dwarf2_cu *); - --static int dwarf2_get_attr_constant_value (struct attribute *, int); -+enum dwarf2_get_attr_constant_value -+ { -+ dwarf2_attr_unknown, -+ dwarf2_attr_const, -+ dwarf2_attr_block -+ }; -+static enum dwarf2_get_attr_constant_value dwarf2_get_attr_constant_value -+ (struct attribute *attr, int *val_return); - - static struct die_info *follow_die_ref (struct die_info *, - struct attribute *, -@@ -4383,6 +4385,56 @@ process_enumeration_scope (struct die_in - new_symbol (die, die->type, cu); - } - -+static void -+fortran_array_update (struct fortran_array_type **fortran_array_pointer, -+ struct die_info *die, struct dwarf2_cu *cu, -+ int read_data_location, struct type *memory_owner) -+{ -+ struct fortran_array_type *p; -+ struct fortran_array_type fortran_array_local; -+ /* Used only for checking if FORTRAN_ARRAY is non-zero. */ -+ static struct fortran_array_type fortran_array_zero; -+ struct attribute *attr; -+ -+ /* Prepare FORTRAN_ARRAY_POINTER. It needs to be present in all the subarray -+ types and in all the range types at least for -+ TYPE_VERIFY_VALID_ARRAY_OBJECT. */ -+ -+ if (*fortran_array_pointer != NULL) -+ p = *fortran_array_pointer; -+ else -+ { -+ memset (&fortran_array_local, 0, sizeof fortran_array_local); -+ p = &fortran_array_local; -+ } -+ -+ if (read_data_location) -+ { -+ attr = dwarf2_attr (die, DW_AT_data_location, cu); -+ if (attr) -+ p->data_location = DW_BLOCK (attr); -+ } -+ -+ attr = dwarf2_attr (die, DW_AT_allocated, cu); -+ if (attr) -+ p->allocated = DW_BLOCK (attr); -+ -+ attr = dwarf2_attr (die, DW_AT_associated, cu); -+ if (attr) -+ p->associated = DW_BLOCK (attr); -+ -+ if (p != &fortran_array_local) -+ {} -+ else if (memcmp (p, &fortran_array_zero, sizeof *p) == 0) -+ *fortran_array_pointer = NULL; -+ else -+ { -+ *fortran_array_pointer = TYPE_ALLOC (memory_owner, -+ sizeof **fortran_array_pointer); -+ **fortran_array_pointer = fortran_array_local; -+ } -+} -+ - /* Extract all information from a DW_TAG_array_type DIE and put it in - the DIE's type field. For now, this only handles one dimensional - arrays. */ -@@ -4399,6 +4451,7 @@ read_array_type (struct die_info *die, s - int ndim = 0; - struct cleanup *back_to; - char *name; -+ struct fortran_array_type *fortran_array; - - /* Return if we've already decoded this type. */ - if (die->type) -@@ -4408,6 +4461,13 @@ read_array_type (struct die_info *die, s - - element_type = die_type (die, cu); - -+ /* Prepare FORTRAN_ARRAY_POINTER. It needs to be present in all the subarray -+ types and in all the range types at least for -+ TYPE_VERIFY_VALID_ARRAY_OBJECT. */ -+ -+ fortran_array = NULL; -+ fortran_array_update (&fortran_array, die, cu, 1, element_type); -+ - /* Irix 6.2 native cc creates array types without children for - arrays with unspecified length. */ - if (die->child == NULL) -@@ -4416,6 +4476,9 @@ read_array_type (struct die_info *die, s - range_type = create_range_type (NULL, index_type, 0, -1); - set_die_type (die, create_array_type (NULL, element_type, range_type), - cu); -+ -+ TYPE_FORTRAN_ARRAY (range_type) = fortran_array; -+ TYPE_FORTRAN_ARRAY (die->type) = fortran_array; - return; - } - -@@ -4452,14 +4515,31 @@ read_array_type (struct die_info *die, s - - if (read_array_order (die, cu) == DW_ORD_col_major) - { -- int i = 0; -- while (i < ndim) -- type = create_array_type (NULL, type, range_types[i++]); -+ int i; -+ for (i = 0; i < ndim; i++) -+ { -+ type = create_array_type (NULL, type, range_types[i]); -+ TYPE_FORTRAN_ARRAY (range_types[i]) = fortran_array; -+ TYPE_FORTRAN_ARRAY (type) = fortran_array; -+ TYPE_ARRAY_UPPER_BOUND_TYPE (type) = -+ TYPE_ARRAY_UPPER_BOUND_TYPE (range_types[i]); -+ TYPE_ARRAY_LOWER_BOUND_TYPE (type) = -+ TYPE_ARRAY_LOWER_BOUND_TYPE (range_types[i]); -+ } - } - else - { -- while (ndim-- > 0) -- type = create_array_type (NULL, type, range_types[ndim]); -+ int i; -+ for (i = ndim - 1; i >= 0; i--) -+ { -+ type = create_array_type (NULL, type, range_types[i]); -+ TYPE_FORTRAN_ARRAY (range_types[i]) = fortran_array; -+ TYPE_FORTRAN_ARRAY (type) = fortran_array; -+ TYPE_ARRAY_UPPER_BOUND_TYPE (type) = -+ TYPE_ARRAY_UPPER_BOUND_TYPE (range_types[i]); -+ TYPE_ARRAY_LOWER_BOUND_TYPE (type) = -+ TYPE_ARRAY_LOWER_BOUND_TYPE (range_types[i]); -+ } - } - - /* Understand Dwarf2 support for vector types (like they occur on -@@ -4679,13 +4759,25 @@ read_tag_pointer_type (struct die_info * - struct attribute *attr_byte_size; - struct attribute *attr_address_class; - int byte_size, addr_class; -+ struct type *target_type; - - if (die->type) - { - return; - } - -- type = lookup_pointer_type (die_type (die, cu)); -+ target_type = die_type (die, cu); -+ -+ /* Intel Fortran Compiler 10.1.008 puts DW_AT_associated into -+ DW_TAG_pointer_type pointing to its target DW_TAG_array_type. -+ GDB supports DW_AT_associated and DW_AT_allocated only for the -+ DW_TAG_array_type tags. */ -+ if (TYPE_CODE (target_type) == TYPE_CODE_ARRAY -+ && TYPE_FORTRAN_ARRAY (target_type) != NULL) -+ fortran_array_update (&TYPE_FORTRAN_ARRAY (target_type), die, cu, 0, -+ target_type); -+ -+ type = lookup_pointer_type (target_type); - - attr_byte_size = dwarf2_attr (die, DW_AT_byte_size, cu); - if (attr_byte_size) -@@ -4822,34 +4914,94 @@ read_tag_string_type (struct die_info *d - struct objfile *objfile = cu->objfile; - struct type *type, *range_type, *index_type, *char_type; - struct attribute *attr; -- unsigned int length; -+ union -+ { -+ unsigned u; -+ int i; -+ } length; - - if (die->type) - { - return; - } - -+ index_type = builtin_type_int32; -+ range_type = create_range_type_nfields (NULL, index_type, 2); -+ TYPE_FLAGS (range_type) |= TYPE_FLAG_UNSIGNED; -+ -+ /* C/C++ should probably have the low bound 0 but C/C++ does not use -+ DW_TAG_string_type. */ -+ TYPE_LOW_BOUND_RAW (range_type) = 1; -+ - attr = dwarf2_attr (die, DW_AT_string_length, cu); -- if (attr) -+ switch (dwarf2_get_attr_constant_value (attr, &length.i)) - { -- length = DW_UNSND (attr); -- } -- else -- { -- /* check for the DW_AT_byte_size attribute */ -+ case dwarf2_attr_const: -+ /* We currently do not support a constant address where the location -+ should be read from - DWARF2_ATTR_BLOCK is expected instead. */ -+ /* PASSTHRU */ -+ case dwarf2_attr_unknown: - attr = dwarf2_attr (die, DW_AT_byte_size, cu); -- if (attr) -- { -- length = DW_UNSND (attr); -- } -- else -- { -- length = 1; -- } -+ switch (dwarf2_get_attr_constant_value (attr, &length.i)) -+ { -+ case dwarf2_attr_unknown: -+ length.u = 1; -+ /* PASSTHRU */ -+ case dwarf2_attr_const: -+ TYPE_HIGH_BOUND_RAW (range_type) = length.u; -+ break; -+ case dwarf2_attr_block: -+ TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, 1) -+ |= TYPE_BOUND_IS_DWARF_BLOCK_MASK; -+ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = DW_BLOCK (attr); -+ break; -+ } -+ break; -+ case dwarf2_attr_block: -+ /* Security check for a size overflow. */ -+ if (DW_BLOCK (attr)->size + 2 < DW_BLOCK (attr)->size) -+ { -+ TYPE_HIGH_BOUND_RAW (range_type) = 1; -+ break; -+ } -+ /* Extend the DWARF block by a new DW_OP_deref/DW_OP_deref_size -+ instruction as DW_AT_string_length specifies the length location, not -+ its value. */ -+ { -+ struct dwarf_block *length_block = dwarf_alloc_block (cu); -+ struct attribute *size_attr; -+ -+ length_block->data = obstack_alloc (&cu->comp_unit_obstack, -+ DW_BLOCK (attr)->size + 2); -+ memcpy (length_block->data, DW_BLOCK (attr)->data, -+ DW_BLOCK (attr)->size); -+ -+ size_attr = dwarf2_attr (die, DW_AT_byte_size, cu); -+ if (size_attr) -+ { -+ length_block->size = DW_BLOCK (attr)->size + 2; -+ length_block->data[DW_BLOCK (attr)->size] = DW_OP_deref_size; -+ length_block->data[DW_BLOCK (attr)->size + 1] -+ = DW_UNSND (size_attr); -+ if (length_block->data[DW_BLOCK (attr)->size + 1] -+ != DW_UNSND (size_attr)) -+ complaint (&symfile_complaints, -+ _("DW_AT_string_length's DW_AT_byte_size integer " -+ "exceeds the byte size storage")); -+ } -+ else -+ { -+ length_block->size = DW_BLOCK (attr)->size + 1; -+ length_block->data[DW_BLOCK (attr)->size] = DW_OP_deref; -+ } -+ -+ TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, 1) -+ |= TYPE_BOUND_IS_DWARF_BLOCK_MASK; -+ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = length_block; -+ } -+ break; - } - -- index_type = builtin_type_int32; -- range_type = create_range_type (NULL, index_type, 1, length); - type = create_string_type (NULL, range_type); - - set_die_type (die, type, cu); -@@ -5048,9 +5200,9 @@ read_subrange_type (struct die_info *die - { - struct type *base_type; - struct type *range_type; -- struct attribute *attr; -- int low = 0; -- int high = -1; -+ struct attribute *attr, *byte_stride_attr; -+ int low, high, byte_stride_int; -+ enum dwarf2_get_attr_constant_value high_type, byte_stride_type; - char *name; - - /* If we have already decoded this die, then nothing more to do. */ -@@ -5067,42 +5219,99 @@ read_subrange_type (struct die_info *die - 0, NULL, cu->objfile); - } - -- if (cu->language == language_fortran) -- { -- /* FORTRAN implies a lower bound of 1, if not given. */ -- low = 1; -- } -+ /* DW_AT_bit_stride is unsupported as if it would be non-constant we would -+ have to wrap it by the division by 8 or provide another value type etc. */ -+ byte_stride_attr = dwarf2_attr (die, DW_AT_byte_stride, cu); -+ byte_stride_type = dwarf2_get_attr_constant_value (byte_stride_attr, -+ &byte_stride_int); -+ -+ range_type = create_range_type_nfields -+ (NULL, base_type, byte_stride_type == dwarf2_attr_unknown ? 2 : 3); - -- /* FIXME: For variable sized arrays either of these could be -- a variable rather than a constant value. We'll allow it, -- but we don't know how to handle it. */ - attr = dwarf2_attr (die, DW_AT_lower_bound, cu); -- if (attr) -- low = dwarf2_get_attr_constant_value (attr, 0); -+ switch (dwarf2_get_attr_constant_value (attr, &low)) -+ { -+ case dwarf2_attr_unknown: -+ if (cu->language == language_fortran) -+ { -+ /* FORTRAN implies a lower bound of 1, if not given. */ -+ low = 1; -+ } -+ else -+ { -+ /* According to DWARF3 we should assume the value 0 only for -+ LANGUAGE_C and LANGUAGE_CPLUS. */ -+ low = 0; -+ } -+ /* PASSTHRU */ -+ case dwarf2_attr_const: -+ TYPE_LOW_BOUND_RAW (range_type) = low; -+ if (low >= 0) -+ TYPE_FLAGS (range_type) |= TYPE_FLAG_UNSIGNED; -+ break; -+ case dwarf2_attr_block: -+ TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, 0) -+ |= TYPE_BOUND_IS_DWARF_BLOCK_MASK; -+ TYPE_FIELD_DWARF_BLOCK (range_type, 0) = DW_BLOCK (attr); -+ /* For auto-detection of possibly missing DW_AT_upper_bound. */ -+ low = 0; -+ break; -+ } - - attr = dwarf2_attr (die, DW_AT_upper_bound, cu); -- if (attr) -- { -- if (attr->form == DW_FORM_block1) -- { -- /* GCC encodes arrays with unspecified or dynamic length -- with a DW_FORM_block1 attribute. -- FIXME: GDB does not yet know how to handle dynamic -- arrays properly, treat them as arrays with unspecified -- length for now. -- -- FIXME: jimb/2003-09-22: GDB does not really know -- how to handle arrays of unspecified length -- either; we just represent them as zero-length -- arrays. Choose an appropriate upper bound given -- the lower bound we've computed above. */ -- high = low - 1; -- } -- else -- high = dwarf2_get_attr_constant_value (attr, 1); -+ high_type = dwarf2_get_attr_constant_value (attr, &high); -+ if (high_type == dwarf2_attr_unknown) -+ { -+ int count; -+ -+ attr = dwarf2_attr (die, DW_AT_count, cu); -+ high_type = dwarf2_get_attr_constant_value (attr, &count); -+ switch (high_type) -+ { -+ case dwarf2_attr_unknown: -+ break; -+ case dwarf2_attr_const: -+ /* We do not handle LOW being set as DW_BLOCK here. */ -+ high = low + count - 1; -+ /* PASSTHRU */ -+ case dwarf2_attr_block: -+ TYPE_HIGH_BOUND_IS_COUNT_VAR (range_type) -+ |= TYPE_HIGH_BOUND_IS_COUNT_MASK; -+ break; -+ } -+ } -+ switch (high_type) -+ { -+ case dwarf2_attr_unknown: -+ /* It needs to get propagated to he array type owning us. */ -+ TYPE_ARRAY_UPPER_BOUND_TYPE (range_type) = BOUND_CANNOT_BE_DETERMINED; -+ high = low - 1; -+ /* PASSTHRU */ -+ case dwarf2_attr_const: -+ TYPE_HIGH_BOUND_RAW (range_type) = high; -+ break; -+ case dwarf2_attr_block: -+ TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, 1) -+ |= TYPE_BOUND_IS_DWARF_BLOCK_MASK; -+ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = DW_BLOCK (attr); -+ break; - } - -- range_type = create_range_type (NULL, base_type, low, high); -+ switch (byte_stride_type) -+ { -+ case dwarf2_attr_unknown: -+ break; -+ case dwarf2_attr_const: -+ if (byte_stride_int == 0) -+ warning (_("Found DW_AT_byte_stride with unsupported value 0")); -+ TYPE_HIGH_BOUND_RAW (range_type) = byte_stride_int; -+ break; -+ case dwarf2_attr_block: -+ TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, 2) -+ |= TYPE_BOUND_IS_DWARF_BLOCK_MASK; -+ TYPE_FIELD_DWARF_BLOCK (range_type, 2) = DW_BLOCK (byte_stride_attr); -+ break; -+ } - - name = dwarf2_name (die, cu); - if (name) -@@ -9061,26 +9270,35 @@ dwarf2_get_ref_die_offset (struct attrib - return result; - } - --/* Return the constant value held by the given attribute. Return -1 -- if the value held by the attribute is not constant. */ -+/* *VAL_RETURN is filled only for DWARF2_ATTR_CONST. */ - --static int --dwarf2_get_attr_constant_value (struct attribute *attr, int default_value) -+static enum dwarf2_get_attr_constant_value -+dwarf2_get_attr_constant_value (struct attribute *attr, int *val_return) - { -+ if (attr == NULL) -+ return dwarf2_attr_unknown; - if (attr->form == DW_FORM_sdata) -- return DW_SND (attr); -- else if (attr->form == DW_FORM_udata -- || attr->form == DW_FORM_data1 -- || attr->form == DW_FORM_data2 -- || attr->form == DW_FORM_data4 -- || attr->form == DW_FORM_data8) -- return DW_UNSND (attr); -- else - { -- complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"), -- dwarf_form_name (attr->form)); -- return default_value; -+ *val_return = DW_SND (attr); -+ return dwarf2_attr_const; - } -+ if (attr->form == DW_FORM_udata -+ || attr->form == DW_FORM_data1 -+ || attr->form == DW_FORM_data2 -+ || attr->form == DW_FORM_data4 -+ || attr->form == DW_FORM_data8) -+ { -+ *val_return = DW_UNSND (attr); -+ return dwarf2_attr_const; -+ } -+ if (attr->form == DW_FORM_block -+ || attr->form == DW_FORM_block1 -+ || attr->form == DW_FORM_block2 -+ || attr->form == DW_FORM_block4) -+ return dwarf2_attr_block; -+ complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"), -+ dwarf_form_name (attr->form)); -+ return dwarf2_attr_unknown; - } - - static struct die_info * -diff -up -ruNp gdb-6.8-0/gdb/eval.c gdb-6.8-1/gdb/eval.c ---- gdb-6.8-0/gdb/eval.c 2008-02-04 01:23:04.000000000 +0100 -+++ gdb-6.8-1/gdb/eval.c 2008-08-23 22:30:33.000000000 +0200 -@@ -1643,9 +1643,12 @@ evaluate_subexp_standard (struct type *e - { - int subscript_array[MAX_FORTRAN_DIMS]; - int array_size_array[MAX_FORTRAN_DIMS]; -+ int byte_stride_array[MAX_FORTRAN_DIMS]; - int ndimensions = 1, i; - struct type *tmp_type; - int offset_item; /* The array offset where the item lives */ -+ CORE_ADDR offset_byte; /* byte_stride based offset */ -+ unsigned element_size; - - if (nargs > MAX_FORTRAN_DIMS) - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); -@@ -1682,6 +1685,9 @@ evaluate_subexp_standard (struct type *e - if (retcode == BOUND_FETCH_ERROR) - error (_("Cannot obtain dynamic lower bound")); - -+ byte_stride_array[nargs - i - 1] = -+ TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type); -+ - array_size_array[nargs - i - 1] = upper - lower + 1; - - /* Zero-normalize subscripts so that offsetting will work. */ -@@ -1702,11 +1708,22 @@ evaluate_subexp_standard (struct type *e - - /* Now let us calculate the offset for this item */ - -- offset_item = subscript_array[ndimensions - 1]; -+ offset_item = 0; -+ offset_byte = 0; -+ -+ for (i = ndimensions - 1; i >= 0; --i) -+ { -+ offset_item *= array_size_array[i]; -+ if (byte_stride_array[i] == 0) -+ offset_item += subscript_array[i]; -+ else -+ offset_byte += subscript_array[i] * byte_stride_array[i]; -+ } - -- for (i = ndimensions - 1; i > 0; --i) -- offset_item = -- array_size_array[i - 1] * offset_item + subscript_array[i - 1]; -+ element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tmp_type)); -+ if (offset_byte % element_size != 0) -+ warning (_("Fortran array stride not divisible by the element size")); -+ offset_item += offset_byte / element_size; - - /* Construct a value node with the value of the offset */ - -diff -up -ruNp gdb-6.8-0/gdb/f-lang.c gdb-6.8-1/gdb/f-lang.c ---- gdb-6.8-0/gdb/f-lang.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/f-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -31,6 +31,7 @@ - #include "f-lang.h" - #include "valprint.h" - #include "value.h" -+#include "dwarf2block.h" - - - /* Following is dubious stuff that had been in the xcoff reader. */ -@@ -222,6 +223,29 @@ f_printstr (struct ui_file *stream, cons - if (force_ellipses || i < length) - fputs_filtered ("...", stream); - } -+ -+static int -+f_value_address_get (struct type *type, CORE_ADDR *address_return) -+{ -+ if (f_type_object_valid_query (type) != NULL) -+ { -+ /* Do not try to evaluate DW_AT_data_location as it may even crash -+ (it would just return the value zero in the gfortran case). */ -+ return 0; -+ } -+ -+ /* Accelerated codepath. */ -+ if (address_return == NULL) -+ return 1; -+ -+ if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_FORTRAN_ARRAY (type) != NULL) -+ { -+ if (TYPE_FORTRAN_ARRAY_DATA_LOCATION (type) != NULL) -+ *address_return = dwarf_block_exec (TYPE_FORTRAN_ARRAY_DATA_LOCATION (type)); -+ } -+ -+ return 1; -+} - - - /* Table of operators and their precedences for printing expressions. */ -@@ -337,6 +361,7 @@ const struct language_defn f_language_de - f_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ f_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/f-lang.h gdb-6.8-1/gdb/f-lang.h ---- gdb-6.8-0/gdb/f-lang.h 2008-01-01 23:53:09.000000000 +0100 -+++ gdb-6.8-1/gdb/f-lang.h 2008-08-23 22:30:33.000000000 +0200 -@@ -28,6 +28,11 @@ extern void f_error (char *); /* Defined - extern void f_print_type (struct type *, char *, struct ui_file *, int, - int); - -+extern const char *f_type_object_valid_query (struct type *type); -+extern const char *f_type_object_valid_to_stream (struct type *type, -+ struct ui_file *stream); -+extern void f_type_object_valid_error (struct type *type); -+ - extern int f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR, - struct ui_file *, int, int, int, - enum val_prettyprint); -@@ -47,6 +52,32 @@ enum f90_range_type - NONE_BOUND_DEFAULT /* "(low:high)" */ - }; - -+/* GNU Fortran specific - for TYPE_FORTRAN_ARRAY. -+ All the DWARF_BLOCK fields are passed for execution to DWARF_BLOCK_EXEC. */ -+ -+struct fortran_array_type -+{ -+ /* For DW_AT_data_location. This entry is more appropriate for generic -+ MAIN_TYPE but we save the MAIN_TYPE size as it is in practice not present -+ for the other types. */ -+ struct dwarf_block *data_location; -+ -+ /* For DW_AT_allocated. */ -+ struct dwarf_block *allocated; -+ -+ /* For DW_AT_associated. */ -+ struct dwarf_block *associated; -+}; -+ -+/* Be sure to check `TYPE_CODE (thistype) == TYPE_CODE_ARRAY -+ && TYPE_FORTRAN_ARRAY (thistype) != NULL'. */ -+#define TYPE_FORTRAN_ARRAY_DATA_LOCATION(thistype) \ -+ TYPE_FORTRAN_ARRAY (thistype)->data_location -+#define TYPE_FORTRAN_ARRAY_ALLOCATED(thistype) \ -+ TYPE_FORTRAN_ARRAY (thistype)->allocated -+#define TYPE_FORTRAN_ARRAY_ASSOCIATED(thistype) \ -+ TYPE_FORTRAN_ARRAY (thistype)->associated -+ - struct common_entry - { - struct symbol *symbol; /* The symbol node corresponding -diff -up -ruNp gdb-6.8-0/gdb/f-typeprint.c gdb-6.8-1/gdb/f-typeprint.c ---- gdb-6.8-0/gdb/f-typeprint.c 2008-01-01 23:53:09.000000000 +0100 -+++ gdb-6.8-1/gdb/f-typeprint.c 2008-08-23 22:30:33.000000000 +0200 -@@ -31,6 +31,7 @@ - #include "gdbcore.h" - #include "target.h" - #include "f-lang.h" -+#include "dwarf2block.h" - - #include "gdb_string.h" - #include -@@ -39,7 +40,7 @@ - static void f_type_print_args (struct type *, struct ui_file *); - #endif - --static void f_type_print_varspec_suffix (struct type *, struct ui_file *, -+static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int, - int, int, int); - - void f_type_print_varspec_prefix (struct type *, struct ui_file *, -@@ -48,6 +49,50 @@ void f_type_print_varspec_prefix (struct - void f_type_print_base (struct type *, struct ui_file *, int, int); - - -+const char * -+f_type_object_valid_query (struct type *type) -+{ -+ if (TYPE_CODE (type) == TYPE_CODE_ARRAY && TYPE_FORTRAN_ARRAY (type) != NULL) -+ { -+ /* DW_AT_associated has a preference over DW_AT_allocated. */ -+ if (TYPE_FORTRAN_ARRAY_ASSOCIATED (type) != NULL -+ && !dwarf_block_exec (TYPE_FORTRAN_ARRAY_ASSOCIATED (type))) -+ return N_("the array is not associated"); -+ -+ if (TYPE_FORTRAN_ARRAY_ALLOCATED (type) != NULL -+ && !dwarf_block_exec (TYPE_FORTRAN_ARRAY_ALLOCATED (type))) -+ return N_("the array is not allocated"); -+ } -+ return NULL; -+} -+ -+const char * -+f_type_object_valid_to_stream (struct type *type, struct ui_file *stream) -+{ -+ const char *msg; -+ -+ msg = f_type_object_valid_query (type); -+ if (msg != NULL) -+ { -+ /* Assuming the content printed to STREAM should not be localized. */ -+ fprintf_filtered (stream, "<%s>", msg); -+ } -+ -+ return msg; -+} -+ -+void -+f_type_object_valid_error (struct type *type) -+{ -+ const char *msg; -+ -+ msg = f_type_object_valid_query (type); -+ if (msg != NULL) -+ { -+ error (_("Unable to access the object because %s."), _(msg)); -+ } -+} -+ - /* LEVEL is the depth to indent lines by. */ - - void -@@ -57,6 +102,9 @@ f_print_type (struct type *type, char *v - enum type_code code; - int demangled_args; - -+ if (f_type_object_valid_to_stream (type, stream) != NULL) -+ return; -+ - f_type_print_base (type, stream, show, level); - code = TYPE_CODE (type); - if ((varstring != NULL && *varstring != '\0') -@@ -78,7 +126,7 @@ f_print_type (struct type *type, char *v - so don't print an additional pair of ()'s */ - - demangled_args = varstring[strlen (varstring) - 1] == ')'; -- f_type_print_varspec_suffix (type, stream, show, 0, demangled_args); -+ f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0); - } - - /* Print any asterisks or open-parentheses needed before the -@@ -147,12 +195,14 @@ f_type_print_varspec_prefix (struct type - - static void - f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, -- int show, int passed_a_ptr, int demangled_args) -+ int show, int passed_a_ptr, int demangled_args, -+ int arrayprint_recurse_level) - { - int upper_bound, lower_bound; - int lower_bound_was_default = 0; -- static int arrayprint_recurse_level = 0; - int retcode; -+ /* No static variables (such as ARRAYPRINT_RECURSE_LEVEL) permitted as ERROR -+ may occur during the evaluation of DWARF_BLOCK values. */ - - if (type == 0) - return; -@@ -171,7 +221,8 @@ f_type_print_varspec_suffix (struct type - fprintf_filtered (stream, "("); - - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) -- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); -+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, -+ arrayprint_recurse_level); - - retcode = f77_get_dynamic_lowerbound (type, &lower_bound); - -@@ -205,7 +256,8 @@ f_type_print_varspec_suffix (struct type - } - - if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) -- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); -+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, -+ arrayprint_recurse_level); - if (arrayprint_recurse_level == 1) - fprintf_filtered (stream, ")"); - else -@@ -215,13 +267,14 @@ f_type_print_varspec_suffix (struct type - - case TYPE_CODE_PTR: - case TYPE_CODE_REF: -- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0); -+ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0, -+ arrayprint_recurse_level); - fprintf_filtered (stream, ")"); - break; - - case TYPE_CODE_FUNC: - f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, -- passed_a_ptr, 0); -+ passed_a_ptr, 0, arrayprint_recurse_level); - if (passed_a_ptr) - fprintf_filtered (stream, ")"); - -diff -up -ruNp gdb-6.8-0/gdb/f-valprint.c gdb-6.8-1/gdb/f-valprint.c ---- gdb-6.8-0/gdb/f-valprint.c 2008-01-11 14:34:14.000000000 +0100 -+++ gdb-6.8-1/gdb/f-valprint.c 2008-08-23 22:30:33.000000000 +0200 -@@ -54,11 +54,11 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM - /* 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]) -+#define F77_DIM_COUNT(n) (f77_array_offset_tbl[n][1]) - --/* The following gives us the offset for row n where n is 1-based. */ -+/* The following gives us the element size for row n where n is 1-based. */ - --#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0]) -+#define F77_DIM_BYTE_STRIDE(n) (f77_array_offset_tbl[n][0]) - - int - f77_get_dynamic_lowerbound (struct type *type, int *lower_bound) -@@ -67,6 +67,8 @@ f77_get_dynamic_lowerbound (struct type - CORE_ADDR current_frame_addr; - CORE_ADDR ptr_to_lower_bound; - -+ f_type_object_valid_error (type); -+ - switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type)) - { - case BOUND_BY_VALUE_ON_STACK: -@@ -128,6 +130,8 @@ f77_get_dynamic_upperbound (struct type - CORE_ADDR current_frame_addr = 0; - CORE_ADDR ptr_to_upper_bound; - -+ f_type_object_valid_error (type); -+ - switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type)) - { - case BOUND_BY_VALUE_ON_STACK: -@@ -250,24 +254,29 @@ f77_create_arrayprint_offset_tbl (struct - if (retcode == BOUND_FETCH_ERROR) - error (_("Cannot obtain dynamic lower bound")); - -- F77_DIM_SIZE (ndimen) = upper - lower + 1; -+ F77_DIM_COUNT (ndimen) = upper - lower + 1; -+ -+ F77_DIM_BYTE_STRIDE (ndimen) = -+ TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type); - - tmp_type = TYPE_TARGET_TYPE (tmp_type); - ndimen++; - } - -- /* Now we multiply eltlen by all the offsets, so that later we -+ /* Now we multiply eltlen by all the BYTE_STRIDEs, 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 -+ know an eltlen 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; -+ if (F77_DIM_BYTE_STRIDE (ndimen) == 0) -+ F77_DIM_BYTE_STRIDE (ndimen) = eltlen; - while (--ndimen > 0) - { -- eltlen *= F77_DIM_SIZE (ndimen + 1); -- F77_DIM_OFFSET (ndimen) = eltlen; -+ eltlen *= F77_DIM_COUNT (ndimen + 1); -+ if (F77_DIM_BYTE_STRIDE (ndimen) == 0) -+ F77_DIM_BYTE_STRIDE (ndimen) = eltlen; - } - } - -@@ -287,33 +296,33 @@ f77_print_array_1 (int nss, int ndimensi - - if (nss != ndimensions) - { -- for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++) -+ for (i = 0; (i < F77_DIM_COUNT (nss) && (*elts) < print_max); i++) - { - fprintf_filtered (stream, "( "); - f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type), -- valaddr + i * F77_DIM_OFFSET (nss), -- address + i * F77_DIM_OFFSET (nss), -+ valaddr + i * F77_DIM_BYTE_STRIDE (nss), -+ address + i * F77_DIM_BYTE_STRIDE (nss), - stream, format, deref_ref, recurse, pretty, elts); - fprintf_filtered (stream, ") "); - } -- if (*elts >= print_max && i < F77_DIM_SIZE (nss)) -+ if (*elts >= print_max && i < F77_DIM_COUNT (nss)) - fprintf_filtered (stream, "..."); - } - else - { -- for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max; -+ for (i = 0; i < F77_DIM_COUNT (nss) && (*elts) < print_max; - i++, (*elts)++) - { - val_print (TYPE_TARGET_TYPE (type), -- valaddr + i * F77_DIM_OFFSET (ndimensions), -+ valaddr + i * F77_DIM_BYTE_STRIDE (ndimensions), - 0, -- address + i * F77_DIM_OFFSET (ndimensions), -+ address + i * F77_DIM_BYTE_STRIDE (ndimensions), - stream, format, deref_ref, recurse, pretty); - -- if (i != (F77_DIM_SIZE (nss) - 1)) -+ if (i != (F77_DIM_COUNT (nss) - 1)) - fprintf_filtered (stream, ", "); - -- if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1))) -+ if ((*elts == print_max - 1) && (i != (F77_DIM_COUNT (nss) - 1))) - fprintf_filtered (stream, "..."); - } - } -@@ -372,6 +381,9 @@ f_val_print (struct type *type, const gd - CORE_ADDR addr; - int index; - -+ if (f_type_object_valid_to_stream (type, stream) != NULL) -+ return 0; -+ - CHECK_TYPEDEF (type); - switch (TYPE_CODE (type)) - { -diff -up -ruNp gdb-6.8-0/gdb/findvar.c gdb-6.8-1/gdb/findvar.c ---- gdb-6.8-0/gdb/findvar.c 2008-01-01 23:53:09.000000000 +0100 -+++ gdb-6.8-1/gdb/findvar.c 2008-08-23 22:30:33.000000000 +0200 -@@ -34,6 +34,7 @@ - #include "regcache.h" - #include "user-regs.h" - #include "block.h" -+#include "dwarf2block.h" - - /* Basic byte-swapping routines. GDB has needed these for a long time... - All extract a target-format integer at ADDR which is LEN bytes long. */ -@@ -370,24 +371,8 @@ symbol_read_needs_frame (struct symbol * - struct value * - read_var_value (struct symbol *var, struct frame_info *frame) - { -- struct value *v; - struct type *type = SYMBOL_TYPE (var); - CORE_ADDR addr; -- int len; -- -- if (SYMBOL_CLASS (var) == LOC_COMPUTED -- || SYMBOL_CLASS (var) == LOC_COMPUTED_ARG -- || SYMBOL_CLASS (var) == LOC_REGISTER -- || SYMBOL_CLASS (var) == LOC_REGPARM) -- /* These cases do not use V. */ -- v = NULL; -- else -- { -- v = allocate_value (type); -- VALUE_LVAL (v) = lval_memory; /* The most likely possibility. */ -- } -- -- len = TYPE_LENGTH (type); - - /* FIXME drow/2003-09-06: this call to the selected frame should be - pushed upwards to the callers. */ -@@ -397,31 +382,39 @@ read_var_value (struct symbol *var, stru - switch (SYMBOL_CLASS (var)) - { - case LOC_CONST: -- /* Put the constant back in target format. */ -- store_signed_integer (value_contents_raw (v), len, -- (LONGEST) SYMBOL_VALUE (var)); -- VALUE_LVAL (v) = not_lval; -- return v; -+ { -+ /* Put the constant back in target format. */ -+ struct value *v = allocate_value (type); -+ VALUE_LVAL (v) = not_lval; -+ store_signed_integer (value_contents_raw (v), TYPE_LENGTH (type), -+ (LONGEST) SYMBOL_VALUE (var)); -+ return v; -+ } - - case LOC_LABEL: -- /* Put the constant back in target format. */ -- if (overlay_debugging) -- { -- CORE_ADDR addr -- = symbol_overlayed_address (SYMBOL_VALUE_ADDRESS (var), -- SYMBOL_BFD_SECTION (var)); -- store_typed_address (value_contents_raw (v), type, addr); -- } -- else -- store_typed_address (value_contents_raw (v), type, -- SYMBOL_VALUE_ADDRESS (var)); -- VALUE_LVAL (v) = not_lval; -- return v; -+ { -+ /* Put the constant back in target format. */ -+ struct value *v = allocate_value (type); -+ VALUE_LVAL (v) = not_lval; -+ if (overlay_debugging) -+ { -+ CORE_ADDR addr -+ = symbol_overlayed_address (SYMBOL_VALUE_ADDRESS (var), -+ SYMBOL_BFD_SECTION (var)); -+ store_typed_address (value_contents_raw (v), type, addr); -+ } -+ else -+ store_typed_address (value_contents_raw (v), type, -+ SYMBOL_VALUE_ADDRESS (var)); -+ return v; -+ } - - case LOC_CONST_BYTES: - { -- memcpy (value_contents_raw (v), SYMBOL_VALUE_BYTES (var), len); -+ struct value *v = allocate_value (type); - VALUE_LVAL (v) = not_lval; -+ memcpy (value_contents_raw (v), SYMBOL_VALUE_BYTES (var), -+ TYPE_LENGTH (type)); - return v; - } - -@@ -503,12 +496,23 @@ addresses have not been bound by the dyn - break; - - case LOC_BLOCK: -- if (overlay_debugging) -- VALUE_ADDRESS (v) = symbol_overlayed_address -- (BLOCK_START (SYMBOL_BLOCK_VALUE (var)), SYMBOL_BFD_SECTION (var)); -- else -- VALUE_ADDRESS (v) = BLOCK_START (SYMBOL_BLOCK_VALUE (var)); -- return v; -+ { -+ CORE_ADDR addr; -+ struct value *v; -+ -+ if (overlay_debugging) -+ addr = symbol_overlayed_address -+ (BLOCK_START (SYMBOL_BLOCK_VALUE (var)), SYMBOL_BFD_SECTION (var)); -+ else -+ addr = BLOCK_START (SYMBOL_BLOCK_VALUE (var)); -+ /* ADDR is set here for ALLOCATE_VALUE's CHECK_TYPEDEF for -+ DW_OP_push_object_address. */ -+ object_address_set (addr); -+ v = allocate_value (type); -+ VALUE_ADDRESS (v) = addr; -+ VALUE_LVAL (v) = lval_memory; -+ return v; -+ } - - case LOC_REGISTER: - case LOC_REGPARM: -@@ -532,7 +536,6 @@ addresses have not been bound by the dyn - error (_("Value of register variable not available.")); - - addr = value_as_address (regval); -- VALUE_LVAL (v) = lval_memory; - } - else - { -@@ -572,18 +575,33 @@ addresses have not been bound by the dyn - break; - - case LOC_OPTIMIZED_OUT: -- VALUE_LVAL (v) = not_lval; -- set_value_optimized_out (v, 1); -- return v; -+ { -+ struct value *v = allocate_value (type); -+ -+ VALUE_LVAL (v) = not_lval; -+ set_value_optimized_out (v, 1); -+ return v; -+ } - - default: - error (_("Cannot look up value of a botched symbol.")); - break; - } - -- VALUE_ADDRESS (v) = addr; -- set_value_lazy (v, 1); -- return v; -+ { -+ struct value *v; -+ -+ /* ADDR is set here for ALLOCATE_VALUE's CHECK_TYPEDEF for -+ DW_OP_push_object_address. */ -+ object_address_set (addr); -+ v = allocate_value (type); -+ VALUE_ADDRESS (v) = addr; -+ VALUE_LVAL (v) = lval_memory; -+ -+ set_value_lazy (v, 1); -+ -+ return v; -+ } - } - - /* Install default attributes for register values. */ -diff -up -ruNp gdb-6.8-0/gdb/gdbtypes.c gdb-6.8-1/gdb/gdbtypes.c ---- gdb-6.8-0/gdb/gdbtypes.c 2008-08-23 22:29:56.000000000 +0200 -+++ gdb-6.8-1/gdb/gdbtypes.c 2008-08-23 22:31:08.000000000 +0200 -@@ -38,6 +38,7 @@ - #include "cp-abi.h" - #include "gdb_assert.h" - #include "hashtab.h" -+#include "dwarf2block.h" - - /* These variables point to the objects - representing the predefined C data types. */ -@@ -682,16 +683,21 @@ allocate_stub_method (struct type *type) - RESULT_TYPE, or creating a new type, inheriting the objfile from - INDEX_TYPE. - -- Indices will be of type INDEX_TYPE, and will range from LOW_BOUND -- to HIGH_BOUND, inclusive. -+ Indices will be of type INDEX_TYPE. NFIELDS should be 2 for standard -+ arrays, 3 for a custom TYPE_BYTE_STRIDE. Use CREATE_RANGE_TYPE for common -+ constant LOW_BOUND/HIGH_BOUND ranges. -+ -+ You must set TYPE_FLAG_UNSIGNED yourself as being done in CREATE_RANGE_TYPE. - - FIXME: Maybe we should check the TYPE_CODE of RESULT_TYPE to make - sure it is TYPE_CODE_UNDEF before we bash it into a range type? */ - - struct type * --create_range_type (struct type *result_type, struct type *index_type, -- int low_bound, int high_bound) -+create_range_type_nfields (struct type *result_type, struct type *index_type, -+ int nfields) - { -+ int fieldno; -+ - if (result_type == NULL) - { - result_type = alloc_type (TYPE_OBJFILE (index_type)); -@@ -702,17 +708,33 @@ create_range_type (struct type *result_t - TYPE_FLAGS (result_type) |= TYPE_FLAG_TARGET_STUB; - else - TYPE_LENGTH (result_type) = TYPE_LENGTH (check_typedef (index_type)); -- TYPE_NFIELDS (result_type) = 2; -+ TYPE_NFIELDS (result_type) = nfields; - TYPE_FIELDS (result_type) = (struct field *) -- TYPE_ALLOC (result_type, 2 * sizeof (struct field)); -- memset (TYPE_FIELDS (result_type), 0, 2 * sizeof (struct field)); -- TYPE_FIELD_BITPOS (result_type, 0) = low_bound; -- TYPE_FIELD_BITPOS (result_type, 1) = high_bound; -+ TYPE_ALLOC (result_type, -+ TYPE_NFIELDS (result_type) * sizeof (struct field)); -+ memset (TYPE_FIELDS (result_type), 0, -+ TYPE_NFIELDS (result_type) * sizeof (struct field)); -+ -+ return (result_type); -+} -+ -+/* Simplified CREATE_RANGE_TYPE_NFIELDS for constant ranges from LOW_BOUND to -+ HIGH_BOUND, inclusive. TYPE_BYTE_STRIDE is always set to zero (default -+ native target type length). */ -+ -+struct type * -+create_range_type (struct type *result_type, struct type *index_type, -+ int low_bound, int high_bound) -+{ -+ result_type = create_range_type_nfields (result_type, index_type, 2); -+ -+ TYPE_LOW_BOUND_RAW (result_type) = low_bound; -+ TYPE_HIGH_BOUND_RAW (result_type) = high_bound; - - if (low_bound >= 0) - TYPE_FLAGS (result_type) |= TYPE_FLAG_UNSIGNED; - -- return (result_type); -+ return result_type; - } - - /* Set *LOWP and *HIGHP to the lower and upper bounds of discrete type -@@ -800,25 +822,23 @@ create_array_type (struct type *result_t - struct type *element_type, - struct type *range_type) - { -- LONGEST low_bound, high_bound; -- - if (result_type == NULL) - { - result_type = alloc_type (TYPE_OBJFILE (range_type)); - } - TYPE_CODE (result_type) = TYPE_CODE_ARRAY; - TYPE_TARGET_TYPE (result_type) = element_type; -- if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) -- low_bound = high_bound = 0; - CHECK_TYPEDEF (element_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) -+ /* Dynamically sized arrays cannot be computed now as we may have forward -+ DWARF references here. */ -+ if ((TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, 0) -+ & TYPE_BOUND_IS_DWARF_BLOCK_MASK) != 0 -+ && (TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, 1) -+ & TYPE_BOUND_IS_DWARF_BLOCK_MASK) != 0) - TYPE_LENGTH (result_type) = 0; - else -- TYPE_LENGTH (result_type) = -- TYPE_LENGTH (element_type) * (high_bound - low_bound + 1); -+ TYPE_LENGTH (result_type) = TYPE_LENGTH (element_type) -+ * TYPE_COUNT_BOUND (range_type); - TYPE_NFIELDS (result_type) = 1; - TYPE_FIELDS (result_type) = - (struct field *) TYPE_ALLOC (result_type, sizeof (struct field)); -@@ -1377,6 +1397,117 @@ stub_noname_complaint (void) - complaint (&symfile_complaints, _("stub type has NULL name")); - } - -+CORE_ADDR range_type_any_field_internal (struct type *range_type, int fieldno) -+{ -+ if ((TYPE_BOUND_IS_DWARF_BLOCK_VAR (range_type, fieldno) -+ & TYPE_BOUND_IS_DWARF_BLOCK_MASK) != 0) -+ return dwarf_block_exec (TYPE_FIELD_DWARF_BLOCK (range_type, fieldno)); -+ else -+ return TYPE_FIELD_BITPOS (range_type, (fieldno)); -+} -+ -+int -+range_type_high_bound_internal (struct type *range_type) -+{ -+ int raw_value = range_type_any_field_internal (range_type, 1); -+ -+ if ((TYPE_HIGH_BOUND_IS_COUNT_VAR (range_type) -+ & TYPE_HIGH_BOUND_IS_COUNT_MASK) == 0) -+ { -+ /* DW_AT_upper_bound value. */ -+ return raw_value; -+ } -+ else -+ { -+ /* DW_AT_count value. */ -+ return TYPE_LOW_BOUND (range_type) + raw_value - 1; -+ } -+} -+ -+int -+range_type_count_bound_internal (struct type *range_type) -+{ -+ int raw_value = range_type_any_field_internal (range_type, 1); -+ if ((TYPE_HIGH_BOUND_IS_COUNT_VAR (range_type) -+ & TYPE_HIGH_BOUND_IS_COUNT_MASK) != 0) -+ { -+ /* DW_AT_count value. */ -+ return raw_value; -+ } -+ else -+ { -+ /* DW_AT_upper_bound value. */ -+ /* Be careful when getting 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 (raw_value < TYPE_LOW_BOUND (range_type)) -+ return 0; -+ return 1 + raw_value - TYPE_LOW_BOUND (range_type); -+ } -+} -+ -+CORE_ADDR range_type_byte_stride_internal (struct type *range_type, -+ struct type *element_type) -+{ -+ if (TYPE_NFIELDS (range_type) >= 3) -+ return range_type_any_field_internal (range_type, 2); -+ else if (element_type == NULL) -+ return 0; -+ else -+ return TYPE_LENGTH (check_typedef (element_type)); -+} -+ -+/* Calculate the memory length of array TYPE. -+ -+ TARGET_TYPE should be set to `check_typedef (TYPE_TARGET_TYPE (type))' as -+ a performance hint. Feel free to pass NULL. Set FULL_SPAN to return the -+ size incl. the possibly incomplete last element - it may differ from the -+ cleared FULL_SPAN return value for larger TYPE_BYTE_STRIDE values. */ -+ -+static CORE_ADDR -+type_length_get (struct type *type, struct type *target_type, int full_span) -+{ -+ struct type *range_type; -+ int count; -+ CORE_ADDR byte_stride = 0; /* `= 0' for a false GCC warning. */ -+ CORE_ADDR element_size; -+ -+ if (TYPE_CODE (type) != TYPE_CODE_ARRAY -+ && TYPE_CODE (type) != TYPE_CODE_STRING) -+ return TYPE_LENGTH (type); -+ -+ /* Avoid executing TYPE_COUNT_BOUND for invalid (unallocated/unassociated) -+ Fortran arrays. The allocated data will never be used so they can be -+ zero-length. */ -+ if (!LA_VALUE_ADDRESS_GET (type, NULL)) -+ return 0; -+ -+ range_type = TYPE_INDEX_TYPE (type); -+ count = TYPE_COUNT_BOUND (range_type); -+ if (count < 0) -+ warning (_("Object count %d < 0"), count); -+ if (count <= 0) -+ return 0; -+ if (full_span || count > 1) -+ { -+ /* We do not use TYPE_ARRAY_BYTE_STRIDE_VALUE (type) here as we want to -+ force FULL_SPAN to 1. */ -+ byte_stride = TYPE_BYTE_STRIDE (range_type); -+ if (byte_stride == 0) -+ { -+ if (target_type == NULL) -+ target_type = check_typedef (TYPE_TARGET_TYPE (type)); -+ byte_stride = type_length_get (target_type, NULL, 1); -+ } -+ } -+ if (full_span) -+ return count * byte_stride; -+ if (target_type == NULL) -+ target_type = check_typedef (TYPE_TARGET_TYPE (type)); -+ element_size = type_length_get (target_type, NULL, 1); -+ return (count - 1) * byte_stride + element_size; -+} -+ - /* Added by Bryan Boreham, Kewill, Sun Sep 17 18:07:17 1989. - - If this is a stubbed struct (i.e. declared as struct foo *), see if -@@ -1514,25 +1645,15 @@ check_typedef (struct type *type) - { - /* Empty. */ - } -- else if (TYPE_CODE (type) == TYPE_CODE_ARRAY -+ else if ((TYPE_CODE (type) == TYPE_CODE_ARRAY -+ || TYPE_CODE (type) == TYPE_CODE_STRING) - && TYPE_NFIELDS (type) == 1 - && (TYPE_CODE (range_type = TYPE_FIELD_TYPE (type, 0)) - == TYPE_CODE_RANGE)) - { - /* Now recompute the length of the array type, based on its -- number of elements and the target type's length. -- Watch out for Ada null Ada arrays where the high bound -- is smaller than the low bound. */ -- const int low_bound = TYPE_FIELD_BITPOS (range_type, 0); -- const int high_bound = TYPE_FIELD_BITPOS (range_type, 1); -- int nb_elements; -- -- if (high_bound < low_bound) -- nb_elements = 0; -- else -- nb_elements = high_bound - low_bound + 1; -- -- TYPE_LENGTH (type) = nb_elements * TYPE_LENGTH (target_type); -+ number of elements and the target type's length. */ -+ TYPE_LENGTH (type) = type_length_get (type, target_type, 0); - TYPE_FLAGS (type) &= ~TYPE_FLAG_TARGET_STUB; - } - else if (TYPE_CODE (type) == TYPE_CODE_RANGE) -diff -up -ruNp gdb-6.8-0/gdb/gdbtypes.h gdb-6.8-1/gdb/gdbtypes.h ---- gdb-6.8-0/gdb/gdbtypes.h 2008-08-23 22:29:56.000000000 +0200 -+++ gdb-6.8-1/gdb/gdbtypes.h 2008-08-23 22:31:08.000000000 +0200 -@@ -417,6 +417,9 @@ struct main_type - - CORE_ADDR physaddr; - char *physname; -+ -+ /* For dynamically-sized arrays. Passed to DWARF_BLOCK_EXEC. */ -+ struct dwarf_block *dwarf_block; - } - loc; - -@@ -427,7 +430,11 @@ struct main_type - - /* This flag is zero for non-static fields, 1 for fields whose location - is specified by the label loc.physname, and 2 for fields whose location -- is specified by loc.physaddr. */ -+ is specified by loc.physaddr. -+ For range bounds bit 0 cleared is for loc.bitpos and bit 0 set is for -+ loc.dwarf_block (TYPE_BOUND_IS_DWARF_BLOCK_MASK). -+ For range bounds bit 1 cleared is for DW_AT_upper_bound and bit 1 set is -+ for DW_AT_count (TYPE_HIGH_BOUND_IS_COUNT_MASK). */ - - unsigned int static_kind : 2; - -@@ -481,6 +488,10 @@ struct main_type - targets and the second is for little endian targets. */ - - const struct floatformat **floatformat; -+ -+ /* FORTRAN_ARRAY is for TYPE_CODE_ARRAY. */ -+ -+ struct fortran_array_type *fortran_array; - } type_specific; - }; - -@@ -766,9 +777,9 @@ extern void allocate_cplus_struct_type ( - #define TYPE_POINTER_TYPE(thistype) (thistype)->pointer_type - #define TYPE_REFERENCE_TYPE(thistype) (thistype)->reference_type - #define TYPE_CHAIN(thistype) (thistype)->chain --/* Note that if thistype is a TYPEDEF type, you have to call check_typedef. -- But check_typedef does set the TYPE_LENGTH of the TYPEDEF type, -- so you only have to call check_typedef once. Since allocate_value -+/* Note that if thistype is a TYPEDEF or ARRAY type, you have to call -+ check_typedef. But check_typedef does set the TYPE_LENGTH of the TYPEDEF -+ type, so you only have to call check_typedef once. Since allocate_value - calls check_typedef, TYPE_LENGTH (VALUE_TYPE (X)) is safe. */ - #define TYPE_LENGTH(thistype) (thistype)->length - #define TYPE_OBJFILE(thistype) TYPE_MAIN_TYPE(thistype)->objfile -@@ -782,8 +793,25 @@ extern void allocate_cplus_struct_type ( - #define TYPE_INSTANTIATIONS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->instantiations - - #define TYPE_INDEX_TYPE(type) TYPE_FIELD_TYPE (type, 0) --#define TYPE_LOW_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 0) --#define TYPE_HIGH_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 1) -+#define TYPE_LOW_BOUND_RAW(range_type) TYPE_FIELD_BITPOS (range_type, 0) -+#define TYPE_HIGH_BOUND_RAW(range_type) TYPE_FIELD_BITPOS (range_type, 1) -+/* `TYPE_NFIELDS (range_type) >= 3' check is required before accessing it: */ -+#define TYPE_BYTE_STRIDE_RAW(range_type) TYPE_FIELD_BITPOS (range_type, 2) -+#define TYPE_LOW_BOUND(range_type) \ -+ ((int) range_type_any_field_internal ((range_type), 0)) -+#define TYPE_HIGH_BOUND(range_type) \ -+ range_type_high_bound_internal ((range_type)) -+#define TYPE_COUNT_BOUND(range_type) \ -+ range_type_count_bound_internal ((range_type)) -+#define TYPE_BYTE_STRIDE(type) \ -+ range_type_byte_stride_internal ((type), NULL) -+ -+#define TYPE_BOUND_IS_DWARF_BLOCK_MASK 1 -+#define TYPE_BOUND_IS_DWARF_BLOCK_VAR(range_type, fieldno) \ -+ TYPE_FIELD_STATIC_KIND (range_type, fieldno) -+#define TYPE_HIGH_BOUND_IS_COUNT_MASK 2 -+#define TYPE_HIGH_BOUND_IS_COUNT_VAR(range_type) \ -+ TYPE_FIELD_STATIC_KIND (range_type, 1) - - /* Moto-specific stuff for FORTRAN arrays */ - -@@ -792,11 +820,14 @@ extern void allocate_cplus_struct_type ( - #define TYPE_ARRAY_LOWER_BOUND_TYPE(thistype) \ - TYPE_MAIN_TYPE(thistype)->lower_bound_type - --#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ -- (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),1)) -- - #define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \ -- (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),0)) -+ (TYPE_LOW_BOUND(TYPE_INDEX_TYPE(arraytype))) -+#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ -+ (TYPE_HIGH_BOUND(TYPE_INDEX_TYPE(arraytype))) -+/* ELEMENT_TYPE-enhanced TYPE_BYTE_STRIDE(TYPE_INDEX_TYPE(arraytype)) */ -+#define TYPE_ARRAY_BYTE_STRIDE_VALUE(arraytype) \ -+ range_type_byte_stride_internal (TYPE_INDEX_TYPE (arraytype), \ -+ TYPE_TARGET_TYPE (arraytype)) - - /* C++ */ - -@@ -812,6 +843,7 @@ extern void allocate_cplus_struct_type ( - #define TYPE_TYPE_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific - #define TYPE_CPLUS_SPECIFIC(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.cplus_stuff - #define TYPE_FLOATFORMAT(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.floatformat -+#define TYPE_FORTRAN_ARRAY(thistype) TYPE_MAIN_TYPE(thistype)->type_specific.fortran_array - #define TYPE_BASECLASS(thistype,index) TYPE_MAIN_TYPE(thistype)->fields[index].type - #define TYPE_N_BASECLASSES(thistype) TYPE_CPLUS_SPECIFIC(thistype)->n_baseclasses - #define TYPE_BASECLASS_NAME(thistype,index) TYPE_MAIN_TYPE(thistype)->fields[index].name -@@ -826,6 +858,7 @@ extern void allocate_cplus_struct_type ( - #define FIELD_TYPE(thisfld) ((thisfld).type) - #define FIELD_NAME(thisfld) ((thisfld).name) - #define FIELD_BITPOS(thisfld) ((thisfld).loc.bitpos) -+#define FIELD_DWARF_BLOCK(thisfld) ((thisfld).loc.dwarf_block) - #define FIELD_ARTIFICIAL(thisfld) ((thisfld).artificial) - #define FIELD_BITSIZE(thisfld) ((thisfld).bitsize) - #define FIELD_STATIC_KIND(thisfld) ((thisfld).static_kind) -@@ -839,6 +872,7 @@ extern void allocate_cplus_struct_type ( - #define TYPE_FIELD_TYPE(thistype, n) FIELD_TYPE(TYPE_FIELD(thistype, n)) - #define TYPE_FIELD_NAME(thistype, n) FIELD_NAME(TYPE_FIELD(thistype, n)) - #define TYPE_FIELD_BITPOS(thistype, n) FIELD_BITPOS(TYPE_FIELD(thistype,n)) -+#define TYPE_FIELD_DWARF_BLOCK(thistype, n) FIELD_DWARF_BLOCK(TYPE_FIELD(thistype,n)) - #define TYPE_FIELD_ARTIFICIAL(thistype, n) FIELD_ARTIFICIAL(TYPE_FIELD(thistype,n)) - #define TYPE_FIELD_BITSIZE(thistype, n) FIELD_BITSIZE(TYPE_FIELD(thistype,n)) - #define TYPE_FIELD_PACKED(thistype, n) (FIELD_BITSIZE(TYPE_FIELD(thistype,n))!=0) -@@ -1251,12 +1285,26 @@ extern struct type *make_function_type ( - - extern struct type *lookup_function_type (struct type *); - -+extern struct type *create_range_type_nfields (struct type *result_type, -+ struct type *index_type, -+ int nfields); -+ - extern struct type *create_range_type (struct type *, struct type *, int, - int); - - extern struct type *create_array_type (struct type *, struct type *, - struct type *); - -+extern CORE_ADDR range_type_any_field_internal (struct type *range_type, -+ int fieldno); -+ -+extern int range_type_high_bound_internal (struct type *range_type); -+ -+extern int range_type_count_bound_internal (struct type *range_type); -+ -+extern CORE_ADDR range_type_byte_stride_internal (struct type *range_type, -+ struct type *element_type); -+ - extern struct type *create_string_type (struct type *, struct type *); - - extern struct type *create_set_type (struct type *, struct type *); -diff -up -ruNp gdb-6.8-0/gdb/jv-lang.c gdb-6.8-1/gdb/jv-lang.c ---- gdb-6.8-0/gdb/jv-lang.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/jv-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -1083,6 +1083,7 @@ const struct language_defn java_language - c_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/language.c gdb-6.8-1/gdb/language.c ---- gdb-6.8-0/gdb/language.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/language.c 2008-08-23 22:30:33.000000000 +0200 -@@ -1087,6 +1087,15 @@ default_print_array_index (struct value - fprintf_filtered (stream, "] = "); - } - -+/* No *ADDRESS_RETURN change is needed as we do not support DW_AT_data_location -+ * for general types. */ -+ -+int -+default_value_address_get (struct type *type, CORE_ADDR *address_return) -+{ -+ return 1; -+} -+ - /* Define the language that is no language. */ - - static int -@@ -1205,6 +1214,7 @@ const struct language_defn unknown_langu - unknown_language_arch_info, /* la_language_arch_info. */ - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -@@ -1241,6 +1251,7 @@ const struct language_defn auto_language - unknown_language_arch_info, /* la_language_arch_info. */ - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -@@ -1276,6 +1287,7 @@ const struct language_defn local_languag - unknown_language_arch_info, /* la_language_arch_info. */ - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/language.h gdb-6.8-1/gdb/language.h ---- gdb-6.8-0/gdb/language.h 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/language.h 2008-08-23 22:30:33.000000000 +0200 -@@ -268,6 +268,13 @@ struct language_defn - reference at the language level. */ - int (*la_pass_by_reference) (struct type *type); - -+ /* Return the data address (DW_AT_data_location) of TYPE into -+ *ADDRESS_RETURN. Return non-zero if the variable/data is valid. -+ You should set *ADDRESS_RETURN as VALUE_ADDRESS (VAL) as if no -+ DW_AT_data_location is present for TYPE *ADDRESS_RETURN is left -+ unchanged. ADDRESS_RETURN may be NULL. */ -+ int (*la_value_address_get) (struct type *type, CORE_ADDR *address_return); -+ - /* Add fields above this point, so the magic number is always last. */ - /* Magic number for compat checking */ - -@@ -363,6 +370,9 @@ extern enum language set_language (enum - #define LA_PRINT_ARRAY_INDEX(index_value, stream, format, pretty) \ - (current_language->la_print_array_index(index_value, stream, format, pretty)) - -+#define LA_VALUE_ADDRESS_GET(type, address_return) \ -+ (current_language->la_value_address_get(type, address_return)) -+ - /* Test a character to decide whether it can be printed in literal form - or needs to be printed in another representation. For example, - in C the literal form of the character with octal value 141 is 'a' -@@ -470,4 +480,7 @@ int language_pass_by_reference (struct t - independent of this. */ - int default_pass_by_reference (struct type *type); - -+extern int default_value_address_get (struct type *type, -+ CORE_ADDR *address_return); -+ - #endif /* defined (LANGUAGE_H) */ -diff -up -ruNp gdb-6.8-0/gdb/m2-lang.c gdb-6.8-1/gdb/m2-lang.c ---- gdb-6.8-0/gdb/m2-lang.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/m2-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -388,6 +388,7 @@ const struct language_defn m2_language_d - m2_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/objc-lang.c gdb-6.8-1/gdb/objc-lang.c ---- gdb-6.8-0/gdb/objc-lang.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/objc-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -522,6 +522,7 @@ const struct language_defn objc_language - c_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/p-lang.c gdb-6.8-1/gdb/p-lang.c ---- gdb-6.8-0/gdb/p-lang.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/p-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -427,6 +427,7 @@ const struct language_defn pascal_langua - pascal_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/printcmd.c gdb-6.8-1/gdb/printcmd.c ---- gdb-6.8-0/gdb/printcmd.c 2008-08-23 22:29:55.000000000 +0200 -+++ gdb-6.8-1/gdb/printcmd.c 2008-08-23 22:30:33.000000000 +0200 -@@ -888,6 +888,11 @@ print_command_1 (char *exp, int inspect, - else - val = access_value_history (0); - -+ /* Do not try to OBJECT_ADDRESS_SET here anything. We are interested in the -+ source variable base addresses as found by READ_VAR_VALUE. The value here -+ can be already a calculated expression address inappropriate for -+ DW_OP_push_object_address. */ -+ - if (voidprint || (val && value_type (val) && - TYPE_CODE (value_type (val)) != TYPE_CODE_VOID)) - { -diff -up -ruNp gdb-6.8-0/gdb/scm-lang.c gdb-6.8-1/gdb/scm-lang.c ---- gdb-6.8-0/gdb/scm-lang.c 2008-02-05 23:17:40.000000000 +0100 -+++ gdb-6.8-1/gdb/scm-lang.c 2008-08-23 22:30:33.000000000 +0200 -@@ -266,6 +266,7 @@ const struct language_defn scm_language_ - c_language_arch_info, - default_print_array_index, - default_pass_by_reference, -+ default_value_address_get, /* Retrieve the real data value */ - LANG_MAGIC - }; - -diff -up -ruNp gdb-6.8-0/gdb/testsuite/gdb.fortran/dynamic.exp gdb-6.8-1/gdb/testsuite/gdb.fortran/dynamic.exp ---- gdb-6.8-0/gdb/testsuite/gdb.fortran/dynamic.exp 1970-01-01 01:00:00.000000000 +0100 -+++ gdb-6.8-1/gdb/testsuite/gdb.fortran/dynamic.exp 2008-08-23 22:31:08.000000000 +0200 -@@ -0,0 +1,141 @@ -+# Copyright 2007 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 2 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program; if not, write to the Free Software -+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -+ -+# This file was written by Jan Kratochvil . -+ -+# This file is part of the gdb testsuite. It contains tests for dynamically -+# allocated Fortran arrays. -+# It depends on the GCC dynamic Fortran arrays DWARF support: -+# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=22244 -+ -+set testfile "dynamic" -+set srcfile ${testfile}.f90 -+set binfile ${objdir}/${subdir}/${testfile} -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } { -+ untested "Couldn't compile ${srcfile}" -+ return -1 -+} -+ -+gdb_exit -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfile} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_breakpoint [gdb_get_line_number "varx-init"] -+gdb_continue_to_breakpoint "varx-init" -+gdb_test "p varx" "\\$\[0-9\]* = " -+gdb_test "ptype varx" "type = " -+gdb_test "p varx(1,5,17)" "Unable to access the object because the array is not allocated\\." -+gdb_test "p varx(1,5,17)=1" "Unable to access the object because the array is not allocated\\." -+gdb_test "ptype varx(1,5,17)" "Unable to access the object because the array is not allocated\\." -+ -+gdb_breakpoint [gdb_get_line_number "varx-allocated"] -+gdb_continue_to_breakpoint "varx-allocated" -+# $1 = (( ( 0, 0, 0, 0, 0, 0) ( 0, 0, 0, 0, 0, 0) --- , 0) ) ( ( 0, 0, ...) ...) ...) -+gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" -+# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1. -+gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" -+ -+gdb_breakpoint [gdb_get_line_number "varx-filled"] -+gdb_continue_to_breakpoint "varx-filled" -+gdb_test "p varx(2, 5, 17)" "\\$\[0-9\]* = 6" -+gdb_test "p varx(1, 5, 17)" "\\$\[0-9\]* = 7" -+gdb_test "p varx(2, 6, 18)" "\\$\[0-9\]* = 8" -+gdb_test "p varx(6, 15, 28)" "\\$\[0-9\]* = 9" -+# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type. -+gdb_test "p varv" "\\$\[0-9\]* = (|.*Unable to access the object because the array is not associated.)" -+gdb_test "ptype varv" "type = (|.*Unable to access the object because the array is not associated.)" -+ -+gdb_breakpoint [gdb_get_line_number "varv-associated"] -+gdb_continue_to_breakpoint "varv-associated" -+gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 6" -+gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 6" -+# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1. -+gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" -+gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" -+# Intel Fortran Compiler 10.1.008 uses the pointer type. -+gdb_test "ptype varv" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)\\)?" -+ -+gdb_breakpoint [gdb_get_line_number "varv-filled"] -+gdb_continue_to_breakpoint "varv-filled" -+gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 10" -+gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 10" -+ -+gdb_breakpoint [gdb_get_line_number "varv-deassociated"] -+gdb_continue_to_breakpoint "varv-deassociated" -+# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type. -+gdb_test "p varv" "\\$\[0-9\]* = (|.*Unable to access the object because the array is not associated.)" -+gdb_test "ptype varv" "type = (|.*Unable to access the object because the array is not associated.)" -+gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." -+gdb_test "p varv(1,5,17)" "Unable to access the object because the array is not associated\\." -+gdb_test "ptype varv(1,5,17)" "Unable to access the object because the array is not associated\\." -+ -+gdb_breakpoint [gdb_get_line_number "varx-deallocated"] -+gdb_continue_to_breakpoint "varx-deallocated" -+gdb_test "p varx" "\\$\[0-9\]* = " -+gdb_test "ptype varx" "type = " -+gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." -+gdb_test "p varx(1,5,17)" "Unable to access the object because the array is not allocated\\." -+gdb_test "ptype varx(1,5,17)" "Unable to access the object because the array is not allocated\\." -+ -+gdb_breakpoint [gdb_get_line_number "vary-passed"] -+gdb_continue_to_breakpoint "vary-passed" -+# $1 = (( ( 1, 1, 1, 1, 1, 1) ( 1, 1, 1, 1, 1, 1) --- , 1) ) ( ( 1, 1, ...) ...) ...) -+gdb_test "p vary" "\\$\[0-9\]* = \\(\[()1, .\]*\\)" -+ -+gdb_breakpoint [gdb_get_line_number "vary-filled"] -+gdb_continue_to_breakpoint "vary-filled" -+gdb_test "ptype vary" "type = real(\\(kind=4\\)|\\*4) \\(10,10\\)" -+gdb_test "p vary(1, 1)" "\\$\[0-9\]* = 8" -+gdb_test "p vary(2, 2)" "\\$\[0-9\]* = 9" -+gdb_test "p vary(1, 3)" "\\$\[0-9\]* = 10" -+# $1 = (( ( 3, 3, 3, 3, 3, 3) ( 3, 3, 3, 3, 3, 3) --- , 3) ) ( ( 3, 3, ...) ...) ...) -+gdb_test "p varw" "\\$\[0-9\]* = \\(\[()3, .\]*\\)" -+ -+gdb_breakpoint [gdb_get_line_number "varw-almostfilled"] -+gdb_continue_to_breakpoint "varw-almostfilled" -+gdb_test "ptype varw" "type = real(\\(kind=4\\)|\\*4) \\(5,4,3\\)" -+gdb_test "p varw(3,1,1)=1" "\\$\[0-9\]* = 1" -+# $1 = (( ( 6, 5, 1, 5, 5, 5) ( 5, 5, 5, 5, 5, 5) --- , 5) ) ( ( 5, 5, ...) ...) ...) -+gdb_test "p varw" "\\$\[0-9\]* = \\( *\\( *\\( *6, *5, *1,\[()5, .\]*\\)" -+# "up" works with GCC but other Fortran compilers may copy the values into the -+# outer function only on the exit of the inner function. -+gdb_test "finish" ".*call bar \\(y, x\\)" -+gdb_test "p z(2,4,5)" "\\$\[0-9\]* = 3" -+gdb_test "p z(2,4,6)" "\\$\[0-9\]* = 6" -+gdb_test "p z(2,4,7)" "\\$\[0-9\]* = 5" -+gdb_test "p z(4,4,6)" "\\$\[0-9\]* = 1" -+ -+gdb_breakpoint [gdb_get_line_number "varz-almostfilled"] -+gdb_continue_to_breakpoint "varz-almostfilled" -+# GCC uses the pointer type here, Intel Fortran Compiler 10.1.008 does not. -+gdb_test "ptype varz" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" -+# Intel Fortran Compiler 10.1.008 has a bug here - (2:11,7:7) -+# as it produces DW_AT_lower_bound == DW_AT_upper_bound == 7. -+gdb_test "ptype vart" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(2:11,7:\\*\\)\\)?" -+gdb_test "p varz(3)" "\\$\[0-9\]* = 4" -+# maps to foo::vary(1,1) -+gdb_test "p vart(2,7)" "\\$\[0-9\]* = 8" -+# maps to foo::vary(2,2) -+gdb_test "p vart(3,8)" "\\$\[0-9\]* = 9" -+# maps to foo::vary(1,3) -+gdb_test "p vart(2,9)" "\\$\[0-9\]* = 10" -diff -up -ruNp gdb-6.8-0/gdb/testsuite/gdb.fortran/dynamic.f90 gdb-6.8-1/gdb/testsuite/gdb.fortran/dynamic.f90 ---- gdb-6.8-0/gdb/testsuite/gdb.fortran/dynamic.f90 1970-01-01 01:00:00.000000000 +0100 -+++ gdb-6.8-1/gdb/testsuite/gdb.fortran/dynamic.f90 2008-08-23 22:30:33.000000000 +0200 -@@ -0,0 +1,97 @@ -+! Copyright 2007 Free Software Foundation, Inc. -+! -+! This program is free software; you can redistribute it and/or modify -+! it under the terms of the GNU General Public License as published by -+! the Free Software Foundation; either version 2 of the License, or -+! (at your option) any later version. -+! -+! This program is distributed in the hope that it will be useful, -+! but WITHOUT ANY WARRANTY; without even the implied warranty of -+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+! GNU General Public License for more details. -+! -+! You should have received a copy of the GNU General Public License -+! along with this program; if not, write to the Free Software -+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -+! -+! Ihis file is the Fortran source file for dynamic.exp. -+! Original file written by Jakub Jelinek . -+! Modified for the GDB testcase by Jan Kratochvil . -+ -+subroutine baz -+ real, target, allocatable :: varx (:, :, :) -+ real, pointer :: varv (:, :, :) -+ real, target :: varu (1, 2, 3) -+ logical :: l -+ allocate (varx (1:6, 5:15, 17:28)) ! varx-init -+ l = allocated (varx) -+ varx(:, :, :) = 6 ! varx-allocated -+ varx(1, 5, 17) = 7 -+ varx(2, 6, 18) = 8 -+ varx(6, 15, 28) = 9 -+ varv => varx ! varx-filled -+ l = associated (varv) -+ varv(3, 7, 19) = 10 ! varv-associated -+ varv => null () ! varv-filled -+ l = associated (varv) -+ deallocate (varx) ! varv-deassociated -+ l = allocated (varx) -+ varu(:, :, :) = 10 ! varx-deallocated -+ allocate (varv (1:6, 5:15, 17:28)) -+ l = associated (varv) -+ varv(:, :, :) = 6 -+ varv(1, 5, 17) = 7 -+ varv(2, 6, 18) = 8 -+ varv(6, 15, 28) = 9 -+ deallocate (varv) -+ l = associated (varv) -+ varv => varu -+ varv(1, 1, 1) = 6 -+ varv(1, 2, 3) = 7 -+ l = associated (varv) -+end subroutine baz -+subroutine foo (vary, varw) -+ real :: vary (:, :) -+ real :: varw (:, :, :) -+ vary(:, :) = 4 ! vary-passed -+ vary(1, 1) = 8 -+ vary(2, 2) = 9 -+ vary(1, 3) = 10 -+ varw(:, :, :) = 5 ! vary-filled -+ varw(1, 1, 1) = 6 -+ varw(2, 2, 2) = 7 ! varw-almostfilled -+end subroutine foo -+subroutine bar (varz, vart) -+ real :: varz (*) -+ real :: vart (2:11, 7:*) -+ varz(1:3) = 4 -+ varz(2) = 5 ! varz-almostfilled -+end subroutine bar -+program test -+ interface -+ subroutine foo (vary, varw) -+ real :: vary (:, :) -+ real :: varw (:, :, :) -+ end subroutine -+ end interface -+ interface -+ subroutine bar (varz, vart) -+ real :: varz (*) -+ real :: vart (2:11, 7:*) -+ end subroutine -+ end interface -+ real :: x (10, 10), y (5), z(8, 8, 8) -+ x(:,:) = 1 -+ y(:) = 2 -+ z(:,:,:) = 3 -+ call baz -+ call foo (x, z(2:6, 4:7, 6:8)) -+ call bar (y, x) -+ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort -+ if (x (1, 3) .ne. 10) call abort -+ if (z (2, 4, 6) .ne. 6 .or. z (3, 5, 7) .ne. 7 .or. z (2, 4, 7) .ne. 5) call abort -+ if (any (y .ne. (/4, 5, 4, 2, 2/))) call abort -+ call foo (transpose (x), z) -+ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort -+ if (x (3, 1) .ne. 10) call abort -+end -diff -up -ruNp gdb-6.8-0/gdb/testsuite/gdb.fortran/string.exp gdb-6.8-1/gdb/testsuite/gdb.fortran/string.exp ---- gdb-6.8-0/gdb/testsuite/gdb.fortran/string.exp 1970-01-01 01:00:00.000000000 +0100 -+++ gdb-6.8-1/gdb/testsuite/gdb.fortran/string.exp 2008-08-23 22:31:08.000000000 +0200 -@@ -0,0 +1,59 @@ -+# Copyright 2008 Free Software Foundation, Inc. -+ -+# This program is free software; you can redistribute it and/or modify -+# it under the terms of the GNU General Public License as published by -+# the Free Software Foundation; either version 2 of the License, or -+# (at your option) any later version. -+# -+# This program is distributed in the hope that it will be useful, -+# but WITHOUT ANY WARRANTY; without even the implied warranty of -+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+# GNU General Public License for more details. -+# -+# You should have received a copy of the GNU General Public License -+# along with this program; if not, write to the Free Software -+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -+ -+# This file was written by Jan Kratochvil . -+ -+# This file is part of the gdb testsuite. It contains tests for Fortran -+# strings with dynamic length. -+ -+set testfile "string" -+set srcfile ${testfile}.f90 -+set binfile ${objdir}/${subdir}/${testfile} -+ -+if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } { -+ untested "Couldn't compile ${srcfile}" -+ return -1 -+} -+ -+gdb_exit -+gdb_start -+gdb_reinitialize_dir $srcdir/$subdir -+gdb_load ${binfile} -+ -+if ![runto MAIN__] then { -+ perror "couldn't run to breakpoint MAIN__" -+ continue -+} -+ -+gdb_breakpoint [gdb_get_line_number "var-init"] -+gdb_continue_to_breakpoint "var-init" -+gdb_test "ptype c" "type = character(\\(kind=1\\)|\\*1)" -+gdb_test "ptype d" "type = character(\\(kind=8\\)|\\*8)" -+gdb_test "ptype e" "type = REF TO -> \\( character(\\(kind=4\\)|\\*4) \\)" -+gdb_test "ptype f" "type = PTR TO -> \\( character(\\(kind=4\\)|\\*4) \\(7,8:10\\)\\)" -+gdb_test "ptype *e" "type = character(\\(kind=4\\)|\\*4)" -+gdb_test "ptype *f" "type = character(\\(kind=4\\)|\\*4) \\(7,8:10\\)" -+gdb_test "p c" "\\$\[0-9\]* = 'c'" -+gdb_test "p d" "\\$\[0-9\]* = 'd '" -+gdb_test "p e" "\\$\[0-9\]* = \\(REF TO -> \\( character(\\(kind=4\\)|\\*4) \\)\\) @0x\[0-9a-f\]+: 'g '" -+gdb_test "p f" "\\$\[0-9\]* = \\(PTR TO -> \\( character(\\(kind=4\\)|\\*4) \\(7,8:10\\)\\)\\) 0x\[0-9a-f\]+" -+gdb_test "p *e" "Attempt to take contents of a non-pointer value." -+gdb_test "p *f" "\\$\[0-9\]* = \\(\\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\)" -+ -+gdb_breakpoint [gdb_get_line_number "var-finish"] -+gdb_continue_to_breakpoint "var-finish" -+gdb_test "p e" "\\$\[0-9\]* = \\(REF TO -> \\( character(\\(kind=4\\)|\\*4) \\)\\) @0x\[0-9a-f\]+: 'e '" "p e re-set" -+gdb_test "p *f" "\\$\[0-9\]* = \\(\\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f2 ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\)" "p *f re-set" -diff -up -ruNp gdb-6.8-0/gdb/testsuite/gdb.fortran/string.f90 gdb-6.8-1/gdb/testsuite/gdb.fortran/string.f90 ---- gdb-6.8-0/gdb/testsuite/gdb.fortran/string.f90 1970-01-01 01:00:00.000000000 +0100 -+++ gdb-6.8-1/gdb/testsuite/gdb.fortran/string.f90 2008-08-23 22:31:08.000000000 +0200 -@@ -0,0 +1,37 @@ -+! Copyright 2008 Free Software Foundation, Inc. -+! -+! This program is free software; you can redistribute it and/or modify -+! it under the terms of the GNU General Public License as published by -+! the Free Software Foundation; either version 2 of the License, or -+! (at your option) any later version. -+! -+! This program is distributed in the hope that it will be useful, -+! but WITHOUT ANY WARRANTY; without even the implied warranty of -+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -+! GNU General Public License for more details. -+! -+! You should have received a copy of the GNU General Public License -+! along with this program; if not, write to the Free Software -+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -+! -+! Ihis file is the Fortran source file for dynamic.exp. -+! Original file written by Jakub Jelinek . -+! Modified for the GDB testcase by Jan Kratochvil . -+ -+subroutine foo (e, f) -+ character (len=1) :: c -+ character (len=8) :: d -+ character (len=*) :: e -+ character (len=*) :: f (1:7, 8:10) -+ c = 'c' -+ d = 'd' -+ e = 'e' ! var-init -+ f = 'f' -+ f(1,9) = 'f2' -+ c = 'c' ! var-finish -+end subroutine foo -+ character (len=4) :: g, h (1:7, 8:10) -+ g = 'g' -+ h = 'h' -+ call foo (g, h) -+end -diff -up -ruNp gdb-6.8-0/gdb/typeprint.c gdb-6.8-1/gdb/typeprint.c ---- gdb-6.8-0/gdb/typeprint.c 2008-02-03 02:02:47.000000000 +0100 -+++ gdb-6.8-1/gdb/typeprint.c 2008-08-23 22:30:33.000000000 +0200 -@@ -33,6 +33,7 @@ - #include "cp-abi.h" - #include "typeprint.h" - #include "gdb_string.h" -+#include "dwarf2block.h" - #include - - /* For real-type printing in whatis_exp() */ -@@ -130,6 +131,7 @@ whatis_exp (char *exp, int show) - val = access_value_history (0); - - type = value_type (val); -+ object_address_set (VALUE_ADDRESS (val)); - - if (objectprint) - { -diff -up -ruNp gdb-6.8-0/gdb/valops.c gdb-6.8-1/gdb/valops.c ---- gdb-6.8-0/gdb/valops.c 2008-08-23 22:29:56.000000000 +0200 -+++ gdb-6.8-1/gdb/valops.c 2008-08-23 22:30:33.000000000 +0200 -@@ -571,12 +571,21 @@ value_at_lazy (struct type *type, CORE_A - int - value_fetch_lazy (struct value *val) - { -- CORE_ADDR addr = VALUE_ADDRESS (val) + value_offset (val); -- int length = TYPE_LENGTH (value_enclosing_type (val)); -+ CORE_ADDR addr; -+ int length; - -- struct type *type = value_type (val); -- if (length) -- read_memory (addr, value_contents_all_raw (val), length); -+ addr = VALUE_ADDRESS (val); -+ if (LA_VALUE_ADDRESS_GET (value_type (val), &addr)) -+ { -+ struct type *type = value_enclosing_type (val); -+ int length = TYPE_LENGTH (check_typedef (type)); -+ -+ if (length) -+ { -+ addr += value_offset (val); -+ read_memory (addr, value_contents_all_raw (val), length); -+ } -+ } - - set_value_lazy (val, 0); - return 0; -@@ -880,12 +889,17 @@ struct value * - value_coerce_array (struct value *arg1) - { - struct type *type = check_typedef (value_type (arg1)); -+ CORE_ADDR address; - - if (VALUE_LVAL (arg1) != lval_memory) - error (_("Attempt to take address of value not located in memory.")); - -+ address = VALUE_ADDRESS (arg1); -+ if (!LA_VALUE_ADDRESS_GET (type, &address)) -+ error (_("Attempt to take address of non-valid value.")); -+ - return value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)), -- (VALUE_ADDRESS (arg1) + value_offset (arg1))); -+ address + value_offset (arg1)); - } - - /* Given a value which is a function, return a value which is a pointer diff --git a/gdb-6.8-bz377541-vla-bound-undefined.patch b/gdb-6.8-bz377541-vla-bound-undefined.patch new file mode 100644 index 0000000..3e521a8 --- /dev/null +++ b/gdb-6.8-bz377541-vla-bound-undefined.patch @@ -0,0 +1,545 @@ +http://sourceware.org/ml/gdb-cvs/2008-10/msg00019.html + +gdb/ +2008-10-02 Jan Kratochvil + + Replace TYPE_ARRAY_{UPPER,LOWER}_BOUND_TYPE by a bit if {un,}defined. + * c-typeprint.c (c_type_print_varspec_suffix), m2-typeprint.c + (m2_array), p-typeprint.c (pascal_type_print_varspec_prefix), + valops.c (value_cast), varobj.c (c_number_of_children): Replace + TYPE_ARRAY_UPPER_BOUND_TYPE compared to BOUND_CANNOT_BE_DETERMINED by + TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED. + * parse.c (follow_types): Use TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED. + * f-valprint.c (f77_get_dynamic_upperbound): Replace with ... + (f77_get_upperbound): ... this function handling now only + TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED. + (f77_get_dynamic_lowerbound): Replace with ... + (f77_get_lowerbound): ... this function handling now only + TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED. + (f77_get_dynamic_length_of_aggregate, f77_create_arrayprint_offset_tbl): + Update their callers. + * eval.c (evaluate_subexp_standard): Update their callers. + * f-lang.h (f77_get_dynamic_upperbound, f77_get_upperbound) + (f77_get_dynamic_lowerbound, f77_get_lowerbound): Update their + prototypes. + (BOUND_FETCH_OK, BOUND_FETCH_ERROR): Remove. + * f-typeprint.c (f_type_print_varspec_suffix, f_type_print_base): Remove + the lower_bound_was_default variable. Update the + f77_get_dynamic_upperbound, f77_get_upperbound and + TYPE_ARRAY_UPPER_BOUND_TYPE calls. + * gdbtypes.c (print_bound_type): Remove the function. + (recursive_dump_type): Remove its calls printing UPPER_BOUND_TYPE and + LOWER_BOUND_TYPE. + * gdbtypes.h (enum array_bound_type): Remove. + (struct main_type): Remove the fields upper_bound_type and + lower_bound_type. Comment the new overload of the field artificial. + (TYPE_ARRAY_UPPER_BOUND_TYPE): Replace by ... + (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED): ... this macro. + (TYPE_ARRAY_LOWER_BOUND_TYPE): Replace by ... + (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED): ... this macro. + +gdb/testsuite/ +2008-10-02 Jan Kratochvil + + * gdb.base/maint.exp (maint print type): Remove printing + UPPER_BOUND_TYPE and LOWER_BOUND_TYPE. + +[ Ported to gdb-6.8fedora. ] + +--- ./gdb/c-typeprint.c 2008-01-01 23:53:09.000000000 +0100 ++++ ./gdb/c-typeprint.c 2008-10-29 10:55:07.000000000 +0100 +@@ -542,7 +542,7 @@ c_type_print_varspec_suffix (struct type + + fprintf_filtered (stream, "["); + if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 +- && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED) ++ && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "%d", + (TYPE_LENGTH (type) + / TYPE_LENGTH (TYPE_TARGET_TYPE (type)))); +--- ./gdb/eval.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/eval.c 2008-10-29 10:55:07.000000000 +0100 +@@ -1674,13 +1674,8 @@ evaluate_subexp_standard (struct type *e + /* Internal type of array is arranged right to left */ + for (i = 0; i < nargs; i++) + { +- retcode = f77_get_dynamic_upperbound (tmp_type, &upper); +- if (retcode == BOUND_FETCH_ERROR) +- error (_("Cannot obtain dynamic upper bound")); +- +- retcode = f77_get_dynamic_lowerbound (tmp_type, &lower); +- if (retcode == BOUND_FETCH_ERROR) +- error (_("Cannot obtain dynamic lower bound")); ++ upper = f77_get_upperbound (tmp_type); ++ lower = f77_get_lowerbound (tmp_type); + + array_size_array[nargs - i - 1] = upper - lower + 1; + +--- ./gdb/f-lang.h 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/f-lang.h 2008-10-29 10:55:07.000000000 +0100 +@@ -83,9 +83,6 @@ extern SAVED_F77_COMMON_PTR find_common_ + #define BLANK_COMMON_NAME_MF77 "__BLNK__" /* MF77 assigned */ + #define BLANK_COMMON_NAME_LOCAL "__BLANK" /* Local GDB */ + +-#define BOUND_FETCH_OK 1 +-#define BOUND_FETCH_ERROR -999 +- + /* When reasonable array bounds cannot be fetched, such as when + you ask to 'mt print symbols' and there is no stack frame and + therefore no way of knowing the bounds of stack-based arrays, +@@ -97,9 +94,9 @@ extern SAVED_F77_COMMON_PTR find_common_ + extern char *real_main_name; /* Name of main function */ + extern int real_main_c_value; /* C_value field of main function */ + +-extern int f77_get_dynamic_upperbound (struct type *, int *); ++extern int f77_get_upperbound (struct type *); + +-extern int f77_get_dynamic_lowerbound (struct type *, int *); ++extern int f77_get_lowerbound (struct type *); + + extern void f77_get_dynamic_array_length (struct type *); + +--- ./gdb/f-typeprint.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/f-typeprint.c 2008-10-29 10:55:07.000000000 +0100 +@@ -150,7 +150,6 @@ f_type_print_varspec_suffix (struct type + int show, int passed_a_ptr, int demangled_args) + { + int upper_bound, lower_bound; +- int lower_bound_was_default = 0; + static int arrayprint_recurse_level = 0; + int retcode; + +@@ -173,35 +172,19 @@ f_type_print_varspec_suffix (struct type + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); + +- retcode = f77_get_dynamic_lowerbound (type, &lower_bound); +- +- lower_bound_was_default = 0; +- +- if (retcode == BOUND_FETCH_ERROR) +- fprintf_filtered (stream, "???"); +- else if (lower_bound == 1) /* The default */ +- lower_bound_was_default = 1; +- else +- fprintf_filtered (stream, "%d", lower_bound); +- +- if (lower_bound_was_default) +- lower_bound_was_default = 0; +- else +- fprintf_filtered (stream, ":"); ++ 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_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) ++ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "*"); + else + { +- retcode = f77_get_dynamic_upperbound (type, &upper_bound); +- +- if (retcode == BOUND_FETCH_ERROR) +- fprintf_filtered (stream, "???"); +- else +- fprintf_filtered (stream, "%d", upper_bound); ++ upper_bound = f77_get_upperbound (type); ++ fprintf_filtered (stream, "%d", upper_bound); + } + + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) +@@ -351,16 +334,12 @@ f_type_print_base (struct type *type, st + case TYPE_CODE_STRING: + /* Strings may have dynamic upperbounds (lengths) like arrays. */ + +- if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) ++ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintfi_filtered (level, stream, "character*(*)"); + else + { +- retcode = f77_get_dynamic_upperbound (type, &upper_bound); +- +- if (retcode == BOUND_FETCH_ERROR) +- fprintf_filtered (stream, "character*???"); +- else +- fprintf_filtered (stream, "character*%d", upper_bound); ++ upper_bound = f77_get_upperbound (type); ++ fprintf_filtered (stream, "character*%d", upper_bound); + } + break; + +--- ./gdb/f-valprint.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/f-valprint.c 2008-10-29 20:48:30.000000000 +0100 +@@ -61,130 +61,28 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM + #define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0]) + + int +-f77_get_dynamic_lowerbound (struct type *type, int *lower_bound) ++f77_get_lowerbound (struct type *type) + { +- struct frame_info *frame; +- CORE_ADDR current_frame_addr; +- CORE_ADDR ptr_to_lower_bound; +- +- switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type)) +- { +- case BOUND_BY_VALUE_ON_STACK: +- frame = deprecated_safe_get_selected_frame (); +- current_frame_addr = get_frame_base (frame); +- if (current_frame_addr > 0) +- { +- *lower_bound = +- read_memory_integer (current_frame_addr + +- TYPE_ARRAY_LOWER_BOUND_VALUE (type), +- 4); +- } +- else +- { +- *lower_bound = DEFAULT_LOWER_BOUND; +- return BOUND_FETCH_ERROR; +- } +- break; +- +- case BOUND_SIMPLE: +- *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type); +- break; +- +- case BOUND_CANNOT_BE_DETERMINED: +- error (_("Lower bound may not be '*' in F77")); +- break; +- +- case BOUND_BY_REF_ON_STACK: +- frame = deprecated_safe_get_selected_frame (); +- current_frame_addr = get_frame_base (frame); +- if (current_frame_addr > 0) +- { +- ptr_to_lower_bound = +- read_memory_typed_address (current_frame_addr + +- TYPE_ARRAY_LOWER_BOUND_VALUE (type), +- builtin_type_void_data_ptr); +- *lower_bound = read_memory_integer (ptr_to_lower_bound, 4); +- } +- else +- { +- *lower_bound = DEFAULT_LOWER_BOUND; +- return BOUND_FETCH_ERROR; +- } +- break; ++ if (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED (type)) ++ error (_("Lower bound may not be '*' in F77")); + +- case BOUND_BY_REF_IN_REG: +- case BOUND_BY_VALUE_IN_REG: +- default: +- error (_("??? unhandled dynamic array bound type ???")); +- break; +- } +- return BOUND_FETCH_OK; ++ return TYPE_ARRAY_LOWER_BOUND_VALUE (type); + } + + int +-f77_get_dynamic_upperbound (struct type *type, int *upper_bound) ++f77_get_upperbound (struct type *type) + { +- struct frame_info *frame; +- CORE_ADDR current_frame_addr = 0; +- CORE_ADDR ptr_to_upper_bound; +- +- switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type)) +- { +- case BOUND_BY_VALUE_ON_STACK: +- frame = deprecated_safe_get_selected_frame (); +- current_frame_addr = get_frame_base (frame); +- if (current_frame_addr > 0) +- { +- *upper_bound = +- read_memory_integer (current_frame_addr + +- TYPE_ARRAY_UPPER_BOUND_VALUE (type), +- 4); +- } +- else +- { +- *upper_bound = DEFAULT_UPPER_BOUND; +- return BOUND_FETCH_ERROR; +- } +- break; +- +- case BOUND_SIMPLE: +- *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type); +- break; +- +- case BOUND_CANNOT_BE_DETERMINED: +- /* we have an assumed size array on our hands. Assume that +- upper_bound == lower_bound so that we show at least +- 1 element.If the user wants to see more elements, let +- him manually ask for 'em and we'll subscript the +- array and show him */ +- f77_get_dynamic_lowerbound (type, upper_bound); +- break; +- +- case BOUND_BY_REF_ON_STACK: +- frame = deprecated_safe_get_selected_frame (); +- current_frame_addr = get_frame_base (frame); +- if (current_frame_addr > 0) +- { +- ptr_to_upper_bound = +- read_memory_typed_address (current_frame_addr + +- TYPE_ARRAY_UPPER_BOUND_VALUE (type), +- builtin_type_void_data_ptr); +- *upper_bound = read_memory_integer (ptr_to_upper_bound, 4); +- } +- else +- { +- *upper_bound = DEFAULT_UPPER_BOUND; +- return BOUND_FETCH_ERROR; +- } +- break; ++ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) ++ { ++ /* We have an assumed size array on our hands. Assume that ++ upper_bound == lower_bound so that we show at least 1 element. ++ If the user wants to see more elements, let him manually ask for 'em ++ and we'll subscript the array and show him. */ + +- case BOUND_BY_REF_IN_REG: +- case BOUND_BY_VALUE_IN_REG: +- default: +- error (_("??? unhandled dynamic array bound type ???")); +- break; ++ return f77_get_lowerbound (type); + } +- return BOUND_FETCH_OK; ++ ++ return TYPE_ARRAY_UPPER_BOUND_VALUE (type); + } + + /* Obtain F77 adjustable array dimensions */ +@@ -210,13 +108,8 @@ f77_get_dynamic_length_of_aggregate (str + f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type)); + + /* Recursion ends here, start setting up lengths. */ +- retcode = f77_get_dynamic_lowerbound (type, &lower_bound); +- if (retcode == BOUND_FETCH_ERROR) +- error (_("Cannot obtain valid array lower bound")); +- +- retcode = f77_get_dynamic_upperbound (type, &upper_bound); +- if (retcode == BOUND_FETCH_ERROR) +- error (_("Cannot obtain valid array upper bound")); ++ lower_bound = f77_get_lowerbound (type); ++ upper_bound = f77_get_upperbound (type); + + /* Patch in a valid length value. */ + +@@ -239,16 +132,8 @@ f77_create_arrayprint_offset_tbl (struct + + while ((TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)) + { +- if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED) +- fprintf_filtered (stream, " "); +- +- retcode = f77_get_dynamic_upperbound (tmp_type, &upper); +- if (retcode == BOUND_FETCH_ERROR) +- error (_("Cannot obtain dynamic upper bound")); +- +- retcode = f77_get_dynamic_lowerbound (tmp_type, &lower); +- if (retcode == BOUND_FETCH_ERROR) +- error (_("Cannot obtain dynamic lower bound")); ++ upper = f77_get_upperbound (tmp_type); ++ lower = f77_get_lowerbound (tmp_type); + + F77_DIM_SIZE (ndimen) = upper - lower + 1; + +--- ./gdb/gdbtypes.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/gdbtypes.c 2008-10-29 10:55:07.000000000 +0100 +@@ -2529,35 +2529,6 @@ print_cplus_stuff (struct type *type, in + } + } + +-static void +-print_bound_type (int bt) +-{ +- switch (bt) +- { +- case BOUND_CANNOT_BE_DETERMINED: +- printf_filtered ("(BOUND_CANNOT_BE_DETERMINED)"); +- break; +- case BOUND_BY_REF_ON_STACK: +- printf_filtered ("(BOUND_BY_REF_ON_STACK)"); +- break; +- case BOUND_BY_VALUE_ON_STACK: +- printf_filtered ("(BOUND_BY_VALUE_ON_STACK)"); +- break; +- case BOUND_BY_REF_IN_REG: +- printf_filtered ("(BOUND_BY_REF_IN_REG)"); +- break; +- case BOUND_BY_VALUE_IN_REG: +- printf_filtered ("(BOUND_BY_VALUE_IN_REG)"); +- break; +- case BOUND_SIMPLE: +- printf_filtered ("(BOUND_SIMPLE)"); +- break; +- default: +- printf_filtered (_("(unknown bound type)")); +- break; +- } +-} +- + static struct obstack dont_print_type_obstack; + + void +@@ -2692,14 +2663,6 @@ recursive_dump_type (struct type *type, + } + puts_filtered ("\n"); + printfi_filtered (spaces, "length %d\n", TYPE_LENGTH (type)); +- printfi_filtered (spaces, "upper_bound_type 0x%x ", +- TYPE_ARRAY_UPPER_BOUND_TYPE (type)); +- print_bound_type (TYPE_ARRAY_UPPER_BOUND_TYPE (type)); +- puts_filtered ("\n"); +- printfi_filtered (spaces, "lower_bound_type 0x%x ", +- TYPE_ARRAY_LOWER_BOUND_TYPE (type)); +- print_bound_type (TYPE_ARRAY_LOWER_BOUND_TYPE (type)); +- puts_filtered ("\n"); + printfi_filtered (spaces, "objfile "); + gdb_print_host_address (TYPE_OBJFILE (type), gdb_stdout); + printf_filtered ("\n"); +@@ -2942,10 +2942,6 @@ copy_type_recursive (struct objfile *obj + + /* Copy the common fields of types. */ + TYPE_CODE (new_type) = TYPE_CODE (type); +- TYPE_ARRAY_UPPER_BOUND_TYPE (new_type) = +- TYPE_ARRAY_UPPER_BOUND_TYPE (type); +- TYPE_ARRAY_LOWER_BOUND_TYPE (new_type) = +- TYPE_ARRAY_LOWER_BOUND_TYPE (type); + if (TYPE_NAME (type)) + TYPE_NAME (new_type) = xstrdup (TYPE_NAME (type)); + if (TYPE_TAG_NAME (type)) +--- ./gdb/gdbtypes.h 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/gdbtypes.h 2008-10-29 10:56:05.000000000 +0100 +@@ -310,17 +310,6 @@ enum type_code + #define TYPE_FLAG_NOTTEXT (1 << 17) + #define TYPE_NOTTEXT(t) (TYPE_FLAGS (t) & TYPE_FLAG_NOTTEXT) + +-/* Array bound type. */ +-enum array_bound_type +-{ +- BOUND_SIMPLE = 0, +- BOUND_BY_VALUE_IN_REG, +- BOUND_BY_REF_IN_REG, +- BOUND_BY_VALUE_ON_STACK, +- BOUND_BY_REF_ON_STACK, +- BOUND_CANNOT_BE_DETERMINED +-}; +- + /* This structure is space-critical. + Its layout has been tweaked to reduce the space used. */ + +@@ -330,12 +319,6 @@ struct main_type + + ENUM_BITFIELD(type_code) code : 8; + +- /* Array bounds. These fields appear at this location because +- they pack nicely here. */ +- +- ENUM_BITFIELD(array_bound_type) upper_bound_type : 4; +- ENUM_BITFIELD(array_bound_type) lower_bound_type : 4; +- + /* Name of this type, or NULL if none. + + This is used for printing only, except by poorly designed C++ code. +@@ -437,7 +420,8 @@ struct main_type + + /* For a function or member type, this is 1 if the argument is marked + artificial. Artificial arguments should not be shown to the +- user. */ ++ user. For TYPE_CODE_RANGE it is set if the specific bound is not ++ defined. */ + unsigned int artificial : 1; + + /* This flag is zero for non-static fields, 1 for fields whose location +@@ -802,10 +786,10 @@ extern void allocate_cplus_struct_type ( + + /* Moto-specific stuff for FORTRAN arrays */ + +-#define TYPE_ARRAY_UPPER_BOUND_TYPE(thistype) \ +- TYPE_MAIN_TYPE(thistype)->upper_bound_type +-#define TYPE_ARRAY_LOWER_BOUND_TYPE(thistype) \ +- TYPE_MAIN_TYPE(thistype)->lower_bound_type ++#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \ ++ (TYPE_FIELD_ARTIFICIAL((TYPE_FIELD_TYPE((arraytype),0)),1)) ++#define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ ++ (TYPE_FIELD_ARTIFICIAL((TYPE_FIELD_TYPE((arraytype),0)),0)) + + #define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ + (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),1)) +--- ./gdb/m2-typeprint.c 2008-01-01 23:53:11.000000000 +0100 ++++ ./gdb/m2-typeprint.c 2008-10-29 10:55:12.000000000 +0100 +@@ -202,7 +202,7 @@ static void m2_array (struct type *type, + { + fprintf_filtered (stream, "ARRAY ["); + if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 +- && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED) ++ && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + { + if (TYPE_INDEX_TYPE (type) != 0) + { +--- ./gdb/p-typeprint.c 2008-01-01 23:53:12.000000000 +0100 ++++ ./gdb/p-typeprint.c 2008-10-29 10:55:12.000000000 +0100 +@@ -251,7 +251,7 @@ pascal_type_print_varspec_prefix (struct + fprintf_filtered (stream, "("); + fprintf_filtered (stream, "array "); + if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 +- && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED) ++ && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "[%d..%d] ", + TYPE_ARRAY_LOWER_BOUND_VALUE (type), + TYPE_ARRAY_UPPER_BOUND_VALUE (type) +--- ./gdb/parse.c 2008-10-29 10:47:18.000000000 +0100 ++++ ./gdb/parse.c 2008-10-29 10:55:12.000000000 +0100 +@@ -1175,8 +1175,7 @@ follow_types (struct type *follow_type) + create_array_type ((struct type *) NULL, + follow_type, range_type); + if (array_size < 0) +- TYPE_ARRAY_UPPER_BOUND_TYPE (follow_type) +- = BOUND_CANNOT_BE_DETERMINED; ++ TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (follow_type) = 1; + break; + case tp_function: + /* FIXME-type-allocation: need a way to free this type when we are +--- ./gdb/testsuite/gdb.base/maint.exp 2008-01-28 19:06:59.000000000 +0100 ++++ ./gdb/testsuite/gdb.base/maint.exp 2008-10-29 20:50:33.000000000 +0100 +@@ -404,7 +404,7 @@ gdb_expect { + + send_gdb "maint print type argc\n" + gdb_expect { +- -re "type node $hex\r\nname .int. \\($hex\\)\r\ntagname .. \\($hex\\)\r\ncode $hex \\(TYPE_CODE_INT\\)\r\nlength \[24\]\r\nupper_bound_type $hex \\(BOUND_SIMPLE\\)\r\nlower_bound_type $hex \\(BOUND_SIMPLE\\)\r\nobjfile $hex\r\ntarget_type $hex\r\npointer_type $hex\r\nreference_type $hex\r\ntype_chain $hex\r\ninstance_flags $hex\r\nflags $hex\r\nnfields 0 $hex\r\nvptr_basetype $hex\r\nvptr_fieldno -1\r\ntype_specific $hex\r\n$gdb_prompt $"\ ++ -re "type node $hex\r\nname .int. \\($hex\\)\r\ntagname .. \\($hex\\)\r\ncode $hex \\(TYPE_CODE_INT\\)\r\nlength \[24\]\r\nobjfile $hex\r\ntarget_type $hex\r\npointer_type $hex\r\nreference_type $hex\r\ntype_chain $hex\r\ninstance_flags $hex\r\nflags $hex\r\nnfields 0 $hex\r\nvptr_basetype $hex\r\nvptr_fieldno -1\r\ntype_specific $hex\r\n$gdb_prompt $"\ + { pass "maint print type" } + -re ".*$gdb_prompt $" { fail "maint print type" } + timeout { fail "(timeout) maint print type" } +--- ./gdb/valops.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/valops.c 2008-10-29 10:55:12.000000000 +0100 +@@ -291,8 +291,7 @@ value_cast (struct type *type, struct va + { + struct type *element_type = TYPE_TARGET_TYPE (type); + unsigned element_length = TYPE_LENGTH (check_typedef (element_type)); +- if (element_length > 0 +- && TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED) ++ if (element_length > 0 && TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + { + struct type *range_type = TYPE_INDEX_TYPE (type); + int val_length = TYPE_LENGTH (type2); +--- ./gdb/varobj.c 2008-10-29 10:47:21.000000000 +0100 ++++ ./gdb/varobj.c 2008-10-29 10:55:12.000000000 +0100 +@@ -1988,7 +1988,7 @@ c_number_of_children (struct varobj *var + { + case TYPE_CODE_ARRAY: + if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (target) > 0 +- && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED) ++ && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + children = TYPE_LENGTH (type) / TYPE_LENGTH (target); + else + /* If we don't know how many elements there are, don't display diff --git a/gdb-6.8-bz377541-vla-loc-kind.patch b/gdb-6.8-bz377541-vla-loc-kind.patch new file mode 100644 index 0000000..357b08e --- /dev/null +++ b/gdb-6.8-bz377541-vla-loc-kind.patch @@ -0,0 +1,579 @@ +http://sourceware.org/ml/gdb-cvs/2008-10/msg00099.html + +2008-10-08 Jan Kratochvil + + Convert static_kind into loc_kind enum. + * gdbtypes.h (enum field_loc_kind): New. + (union field_location): New field dwarf_block. + (struct field): Rename static_kind as loc_kind. + (FIELD_STATIC_KIND): Rename to ... + (FIELD_LOC_KIND): ... here. + (TYPE_FIELD_STATIC_KIND): Rename to ... + (TYPE_FIELD_LOC_KIND): ... here and use there now new FIELD_LOC_KIND. + (TYPE_FIELD_STATIC_HAS_ADDR): Remove. + (TYPE_FIELD_STATIC): Remove. + (TYPE_FIELD_BITPOS): Reformat. + (SET_FIELD_BITPOS): New. + (FIELD_PHYSADDR): Rename to ... + (FIELD_STATIC_PHYSADDR): ... here. + (TYPE_FIELD_STATIC_PHYSADDR): Follow the FIELD_PHYSADDR rename. + (SET_FIELD_PHYSADDR): Use new FIELD_LOC_KIND. + (FIELD_PHYSNAME): Rename to ... + (FIELD_STATIC_PHYSNAME): ... here. + (TYPE_FIELD_STATIC_PHYSNAME): Follow the FIELD_PHYSNAME rename. + (SET_FIELD_PHYSNAME): Use new FIELD_LOC_KIND. + (FIELD_DWARF_BLOCK, TYPE_FIELD_DWARF_BLOCK, SET_FIELD_DWARF_BLOCK): New. + (field_is_static): New declaration. + * gdbtypes.c (field_is_static): New function. + (copy_type_recursive): Update throughout. + * amd64-tdep.c, c-typeprint.c, coffread.c, cp-valprint.c, dwarf2read.c, + eval.c, jv-typeprint.c, jv-valprint.c, mdebugread.c, p-typeprint.c, + p-valprint.c, valops.c, value.c, varobj.c: Update throughout. + +[ Ported to gdb-6.8fedora. ] + +--- ./gdb/amd64-tdep.c 2008-10-29 10:47:21.000000000 +0100 ++++ ./gdb/amd64-tdep.c 2008-10-29 20:56:57.000000000 +0100 +@@ -317,7 +317,7 @@ amd64_classify_aggregate (struct type *t + enum amd64_reg_class subclass[2]; + + /* Ignore static fields. */ +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + continue; + + gdb_assert (pos == 0 || pos == 1); +--- ./gdb/c-typeprint.c 2008-10-29 10:55:07.000000000 +0100 ++++ ./gdb/c-typeprint.c 2008-10-29 20:56:57.000000000 +0100 +@@ -872,14 +872,12 @@ c_type_print_base (struct type *type, st + } + + print_spaces_filtered (level + 4, stream); +- if (TYPE_FIELD_STATIC (type, i)) +- { +- fprintf_filtered (stream, "static "); +- } ++ if (field_is_static (&TYPE_FIELD (type, i))) ++ fprintf_filtered (stream, "static "); + c_print_type (TYPE_FIELD_TYPE (type, i), + TYPE_FIELD_NAME (type, i), + stream, show - 1, level + 4); +- if (!TYPE_FIELD_STATIC (type, i) ++ if (!field_is_static (&TYPE_FIELD (type, i)) + && TYPE_FIELD_PACKED (type, i)) + { + /* It is a bitfield. This code does not attempt +--- ./gdb/coffread.c 2008-01-16 12:21:42.000000000 +0100 ++++ ./gdb/coffread.c 2008-10-29 20:58:56.000000000 +0100 +@@ -1946,9 +1946,8 @@ coff_read_struct_type (int index, int le + strlen (name), + ¤t_objfile->objfile_obstack); + FIELD_TYPE (list->field) = decode_type (ms, ms->c_type, &sub_aux); +- FIELD_BITPOS (list->field) = 8 * ms->c_value; ++ SET_FIELD_BITPOS (list->field, 8 * ms->c_value); + FIELD_BITSIZE (list->field) = 0; +- FIELD_STATIC_KIND (list->field) = 0; + nfields++; + break; + +@@ -1965,9 +1964,8 @@ coff_read_struct_type (int index, int le + strlen (name), + ¤t_objfile->objfile_obstack); + FIELD_TYPE (list->field) = decode_type (ms, ms->c_type, &sub_aux); +- FIELD_BITPOS (list->field) = ms->c_value; ++ SET_FIELD_BITPOS (list->field, ms->c_value); + FIELD_BITSIZE (list->field) = sub_aux.x_sym.x_misc.x_lnsz.x_size; +- FIELD_STATIC_KIND (list->field) = 0; + nfields++; + break; + +@@ -2083,11 +2081,10 @@ coff_read_enum_type (int index, int leng + struct symbol *xsym = syms->symbol[j]; + SYMBOL_TYPE (xsym) = type; + TYPE_FIELD_NAME (type, n) = DEPRECATED_SYMBOL_NAME (xsym); +- TYPE_FIELD_BITPOS (type, n) = SYMBOL_VALUE (xsym); ++ SET_FIELD_BITPOS (TYPE_FIELD (type, n), SYMBOL_VALUE (xsym)); + if (SYMBOL_VALUE (xsym) < 0) + unsigned_enum = 0; + TYPE_FIELD_BITSIZE (type, n) = 0; +- TYPE_FIELD_STATIC_KIND (type, n) = 0; + } + if (syms == osyms) + break; +--- ./gdb/cp-valprint.c 2008-01-01 23:53:09.000000000 +0100 ++++ ./gdb/cp-valprint.c 2008-10-29 20:56:57.000000000 +0100 +@@ -192,7 +192,8 @@ cp_print_value_fields (struct type *type + for (i = n_baseclasses; i < len; i++) + { + /* If requested, skip printing of static fields. */ +- if (!static_field_print && TYPE_FIELD_STATIC (type, i)) ++ if (!static_field_print ++ && field_is_static (&TYPE_FIELD (type, i))) + continue; + + if (fields_seen) +@@ -225,7 +226,7 @@ cp_print_value_fields (struct type *type + fputs_filtered ("\"( ptr \"", stream); + else + fputs_filtered ("\"( nodef \"", stream); +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + fputs_filtered ("static ", stream); + fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), + current_language->la_language, +@@ -240,7 +241,7 @@ cp_print_value_fields (struct type *type + { + annotate_field_begin (TYPE_FIELD_TYPE (type, i)); + +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + fputs_filtered ("static ", stream); + fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), + current_language->la_language, +@@ -252,7 +253,8 @@ cp_print_value_fields (struct type *type + annotate_field_value (); + } + +- if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i)) ++ if (!field_is_static (&TYPE_FIELD (type, i)) ++ && TYPE_FIELD_PACKED (type, i)) + { + struct value *v; + +@@ -277,7 +279,7 @@ cp_print_value_fields (struct type *type + { + fputs_filtered ("", stream); + } +- else if (TYPE_FIELD_STATIC (type, i)) ++ else if (field_is_static (&TYPE_FIELD (type, i))) + { + struct value *v = value_static_field (type, i); + if (v == NULL) +--- ./gdb/dwarf2read.c 2008-10-29 10:50:56.000000000 +0100 ++++ ./gdb/dwarf2read.c 2008-10-29 20:56:57.000000000 +0100 +@@ -3492,7 +3492,7 @@ dwarf2_add_field (struct field_info *fip + /* Get type of field. */ + fp->type = die_type (die, cu); + +- FIELD_STATIC_KIND (*fp) = 0; ++ SET_FIELD_BITPOS (*fp, 0); + + /* Get bit size of field (zero if none). */ + attr = dwarf2_attr (die, DW_AT_bit_size, cu); +@@ -3521,10 +3521,8 @@ dwarf2_add_field (struct field_info *fip + else + byte_offset = decode_locdesc (DW_BLOCK (attr), cu); + +- FIELD_BITPOS (*fp) = byte_offset * bits_per_byte; ++ SET_FIELD_BITPOS (*fp, byte_offset * bits_per_byte); + } +- else +- FIELD_BITPOS (*fp) = 0; + attr = dwarf2_attr (die, DW_AT_bit_offset, cu); + if (attr) + { +@@ -3617,10 +3615,9 @@ dwarf2_add_field (struct field_info *fip + /* C++ base class field. */ + attr = dwarf2_attr (die, DW_AT_data_member_location, cu); + if (attr) +- FIELD_BITPOS (*fp) = (decode_locdesc (DW_BLOCK (attr), cu) +- * bits_per_byte); ++ SET_FIELD_BITPOS (*fp, decode_locdesc (DW_BLOCK (attr), cu) ++ * bits_per_byte); + FIELD_BITSIZE (*fp) = 0; +- FIELD_STATIC_KIND (*fp) = 0; + FIELD_TYPE (*fp) = die_type (die, cu); + FIELD_NAME (*fp) = type_name_no_tag (fp->type); + fip->nbaseclasses++; +@@ -4379,9 +4376,8 @@ process_enumeration_scope (struct die_in + + FIELD_NAME (fields[num_fields]) = DEPRECATED_SYMBOL_NAME (sym); + FIELD_TYPE (fields[num_fields]) = NULL; +- FIELD_BITPOS (fields[num_fields]) = SYMBOL_VALUE (sym); ++ SET_FIELD_BITPOS (fields[num_fields], SYMBOL_VALUE (sym)); + FIELD_BITSIZE (fields[num_fields]) = 0; +- FIELD_STATIC_KIND (fields[num_fields]) = 0; + + num_fields++; + } +--- ./gdb/eval.c 2008-10-29 10:55:07.000000000 +0100 ++++ ./gdb/eval.c 2008-10-29 20:56:57.000000000 +0100 +@@ -288,7 +288,8 @@ evaluate_struct_tuple (struct value *str + fieldno++; + /* Skip static fields. */ + while (fieldno < TYPE_NFIELDS (struct_type) +- && TYPE_FIELD_STATIC_KIND (struct_type, fieldno)) ++ && field_is_static (&TYPE_FIELD (struct_type, ++ fieldno))) + fieldno++; + subfieldno = fieldno; + if (fieldno >= TYPE_NFIELDS (struct_type)) +--- ./gdb/gdbtypes.c 2008-10-29 10:55:07.000000000 +0100 ++++ ./gdb/gdbtypes.c 2008-10-29 20:56:57.000000000 +0100 +@@ -2407,6 +2407,20 @@ print_arg_types (struct field *args, int + } + } + ++int ++field_is_static (struct field *f) ++{ ++ /* "static" fields are the fields whose location is not relative ++ to the address of the enclosing struct. It would be nice to ++ have a dedicated flag that would be set for static fields when ++ the type is being created. But in practice, checking the field ++ loc_kind should give us an accurate answer (at least as long as ++ we assume that DWARF block locations are not going to be used ++ for static fields). FIXME? */ ++ return (FIELD_LOC_KIND (*f) == FIELD_LOC_KIND_PHYSNAME ++ || FIELD_LOC_KIND (*f) == FIELD_LOC_KIND_PHYSADDR); ++} ++ + static void + dump_fn_fieldlists (struct type *type, int spaces) + { +@@ -2939,18 +2953,25 @@ copy_type_recursive (struct objfile *obj + if (TYPE_FIELD_NAME (type, i)) + TYPE_FIELD_NAME (new_type, i) = + xstrdup (TYPE_FIELD_NAME (type, i)); +- if (TYPE_FIELD_STATIC_HAS_ADDR (type, i)) +- SET_FIELD_PHYSADDR (TYPE_FIELD (new_type, i), +- TYPE_FIELD_STATIC_PHYSADDR (type, i)); +- else if (TYPE_FIELD_STATIC (type, i)) +- SET_FIELD_PHYSNAME (TYPE_FIELD (new_type, i), +- xstrdup (TYPE_FIELD_STATIC_PHYSNAME (type, +- i))); +- else ++ switch (TYPE_FIELD_LOC_KIND (type, i)) + { +- TYPE_FIELD_BITPOS (new_type, i) = +- TYPE_FIELD_BITPOS (type, i); +- TYPE_FIELD_STATIC_KIND (new_type, i) = 0; ++ case FIELD_LOC_KIND_BITPOS: ++ SET_FIELD_BITPOS (TYPE_FIELD (new_type, i), ++ TYPE_FIELD_BITPOS (type, i)); ++ break; ++ case FIELD_LOC_KIND_PHYSADDR: ++ SET_FIELD_PHYSADDR (TYPE_FIELD (new_type, i), ++ TYPE_FIELD_STATIC_PHYSADDR (type, i)); ++ break; ++ case FIELD_LOC_KIND_PHYSNAME: ++ SET_FIELD_PHYSNAME (TYPE_FIELD (new_type, i), ++ xstrdup (TYPE_FIELD_STATIC_PHYSNAME (type, ++ i))); ++ break; ++ default: ++ internal_error (__FILE__, __LINE__, ++ _("Unexpected type field location kind: %d"), ++ TYPE_FIELD_LOC_KIND (type, i)); + } + } + } +--- ./gdb/gdbtypes.h 2008-10-29 10:56:05.000000000 +0100 ++++ ./gdb/gdbtypes.h 2008-10-29 20:56:57.000000000 +0100 +@@ -310,6 +310,16 @@ enum type_code + #define TYPE_FLAG_NOTTEXT (1 << 17) + #define TYPE_NOTTEXT(t) (TYPE_FLAGS (t) & TYPE_FLAG_NOTTEXT) + ++/* Determine which field of the union main_type.fields[x].loc is used. */ ++ ++enum field_loc_kind ++ { ++ FIELD_LOC_KIND_BITPOS, /* bitpos */ ++ FIELD_LOC_KIND_PHYSADDR, /* physaddr */ ++ FIELD_LOC_KIND_PHYSNAME, /* physname */ ++ FIELD_LOC_KIND_DWARF_BLOCK /* dwarf_block */ ++ }; ++ + /* This structure is space-critical. + Its layout has been tweaked to reduce the space used. */ + +@@ -415,6 +425,12 @@ struct main_type + + CORE_ADDR physaddr; + char *physname; ++ ++ /* The field location can be computed by evaluating the following DWARF ++ block. This can be used in Fortran variable-length arrays, for ++ instance. */ ++ ++ struct dwarf2_locexpr_baton *dwarf_block; + } + loc; + +@@ -424,11 +440,8 @@ struct main_type + defined. */ + unsigned int artificial : 1; + +- /* This flag is zero for non-static fields, 1 for fields whose location +- is specified by the label loc.physname, and 2 for fields whose location +- is specified by loc.physaddr. */ +- +- unsigned int static_kind : 2; ++ /* Discriminant for union field_location. */ ++ ENUM_BITFIELD(field_loc_kind) loc_kind : 2; + + /* Size of this field, in bits, or zero if not packed. + For an unpacked field, the field's type's length +@@ -824,20 +837,34 @@ extern void allocate_cplus_struct_type ( + + #define FIELD_TYPE(thisfld) ((thisfld).type) + #define FIELD_NAME(thisfld) ((thisfld).name) ++#define FIELD_LOC_KIND(thisfld) ((thisfld).loc_kind) + #define FIELD_BITPOS(thisfld) ((thisfld).loc.bitpos) ++#define FIELD_STATIC_PHYSNAME(thisfld) ((thisfld).loc.physname) ++#define FIELD_STATIC_PHYSADDR(thisfld) ((thisfld).loc.physaddr) ++#define FIELD_DWARF_BLOCK(thisfld) ((thisfld).loc.dwarf_block) ++#define SET_FIELD_BITPOS(thisfld, bitpos) \ ++ (FIELD_LOC_KIND (thisfld) = FIELD_LOC_KIND_BITPOS, \ ++ FIELD_BITPOS (thisfld) = (bitpos)) ++#define SET_FIELD_PHYSNAME(thisfld, name) \ ++ (FIELD_LOC_KIND (thisfld) = FIELD_LOC_KIND_PHYSNAME, \ ++ FIELD_STATIC_PHYSNAME (thisfld) = (name)) ++#define SET_FIELD_PHYSADDR(thisfld, addr) \ ++ (FIELD_LOC_KIND (thisfld) = FIELD_LOC_KIND_PHYSADDR, \ ++ FIELD_STATIC_PHYSADDR (thisfld) = (addr)) ++#define SET_FIELD_DWARF_BLOCK(thisfld, addr) \ ++ (FIELD_LOC_KIND (thisfld) = FIELD_LOC_KIND_DWARF_BLOCK, \ ++ FIELD_DWARF_BLOCK (thisfld) = (addr)) + #define FIELD_ARTIFICIAL(thisfld) ((thisfld).artificial) + #define FIELD_BITSIZE(thisfld) ((thisfld).bitsize) +-#define FIELD_STATIC_KIND(thisfld) ((thisfld).static_kind) +-#define FIELD_PHYSNAME(thisfld) ((thisfld).loc.physname) +-#define FIELD_PHYSADDR(thisfld) ((thisfld).loc.physaddr) +-#define SET_FIELD_PHYSNAME(thisfld, name) \ +- ((thisfld).static_kind = 1, FIELD_PHYSNAME(thisfld) = (name)) +-#define SET_FIELD_PHYSADDR(thisfld, name) \ +- ((thisfld).static_kind = 2, FIELD_PHYSADDR(thisfld) = (name)) ++ + #define TYPE_FIELD(thistype, n) TYPE_MAIN_TYPE(thistype)->fields[n] + #define TYPE_FIELD_TYPE(thistype, n) FIELD_TYPE(TYPE_FIELD(thistype, n)) + #define TYPE_FIELD_NAME(thistype, n) FIELD_NAME(TYPE_FIELD(thistype, n)) +-#define TYPE_FIELD_BITPOS(thistype, n) FIELD_BITPOS(TYPE_FIELD(thistype,n)) ++#define TYPE_FIELD_LOC_KIND(thistype, n) FIELD_LOC_KIND (TYPE_FIELD (thistype, n)) ++#define TYPE_FIELD_BITPOS(thistype, n) FIELD_BITPOS (TYPE_FIELD (thistype, n)) ++#define TYPE_FIELD_STATIC_PHYSNAME(thistype, n) FIELD_STATIC_PHYSNAME (TYPE_FIELD (thistype, n)) ++#define TYPE_FIELD_STATIC_PHYSADDR(thistype, n) FIELD_STATIC_PHYSADDR (TYPE_FIELD (thistype, n)) ++#define TYPE_FIELD_DWARF_BLOCK(thistype, n) FIELD_DWARF_BLOCK (TYPE_FIELD (thistype, n)) + #define TYPE_FIELD_ARTIFICIAL(thistype, n) FIELD_ARTIFICIAL(TYPE_FIELD(thistype,n)) + #define TYPE_FIELD_BITSIZE(thistype, n) FIELD_BITSIZE(TYPE_FIELD(thistype,n)) + #define TYPE_FIELD_PACKED(thistype, n) (FIELD_BITSIZE(TYPE_FIELD(thistype,n))!=0) +@@ -873,12 +900,6 @@ extern void allocate_cplus_struct_type ( + (TYPE_CPLUS_SPECIFIC(thistype)->virtual_field_bits == NULL ? 0 \ + : B_TST(TYPE_CPLUS_SPECIFIC(thistype)->virtual_field_bits, (n))) + +-#define TYPE_FIELD_STATIC(thistype, n) (TYPE_MAIN_TYPE (thistype)->fields[n].static_kind != 0) +-#define TYPE_FIELD_STATIC_KIND(thistype, n) TYPE_MAIN_TYPE (thistype)->fields[n].static_kind +-#define TYPE_FIELD_STATIC_HAS_ADDR(thistype, n) (TYPE_MAIN_TYPE (thistype)->fields[n].static_kind == 2) +-#define TYPE_FIELD_STATIC_PHYSNAME(thistype, n) FIELD_PHYSNAME(TYPE_FIELD(thistype, n)) +-#define TYPE_FIELD_STATIC_PHYSADDR(thistype, n) FIELD_PHYSADDR(TYPE_FIELD(thistype, n)) +- + #define TYPE_FN_FIELDLISTS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->fn_fieldlists + #define TYPE_FN_FIELDLIST(thistype, n) TYPE_CPLUS_SPECIFIC(thistype)->fn_fieldlists[n] + #define TYPE_FN_FIELDLIST1(thistype, n) TYPE_CPLUS_SPECIFIC(thistype)->fn_fieldlists[n].fn_fields +@@ -1331,6 +1352,8 @@ extern int rank_one_type (struct type *, + + extern void recursive_dump_type (struct type *, int); + ++extern int field_is_static (struct field *); ++ + /* printcmd.c */ + + extern void print_scalar_formatted (const void *, struct type *, int, int, +--- ./gdb/jv-typeprint.c 2008-01-01 23:53:11.000000000 +0100 ++++ ./gdb/jv-typeprint.c 2008-10-29 20:56:57.000000000 +0100 +@@ -185,7 +185,7 @@ java_type_print_base (struct type *type, + fprintf_filtered (stream, "public "); + } + +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + fprintf_filtered (stream, "static "); + + java_print_type (TYPE_FIELD_TYPE (type, i), +--- ./gdb/jv-valprint.c 2008-01-01 23:53:11.000000000 +0100 ++++ ./gdb/jv-valprint.c 2008-10-29 20:56:57.000000000 +0100 +@@ -302,7 +302,7 @@ java_print_value_fields (struct type *ty + for (i = n_baseclasses; i < len; i++) + { + /* If requested, skip printing of static fields. */ +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + { + char *name = TYPE_FIELD_NAME (type, i); + if (!static_field_print) +@@ -340,7 +340,7 @@ java_print_value_fields (struct type *ty + fputs_filtered ("\"( ptr \"", stream); + else + fputs_filtered ("\"( nodef \"", stream); +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + fputs_filtered ("static ", stream); + fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), + language_cplus, +@@ -355,7 +355,7 @@ java_print_value_fields (struct type *ty + { + annotate_field_begin (TYPE_FIELD_TYPE (type, i)); + +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + fputs_filtered ("static ", stream); + fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), + language_cplus, +@@ -365,7 +365,8 @@ java_print_value_fields (struct type *ty + annotate_field_value (); + } + +- if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i)) ++ if (!field_is_static (&TYPE_FIELD (type, i)) ++ && TYPE_FIELD_PACKED (type, i)) + { + struct value *v; + +@@ -389,7 +390,7 @@ java_print_value_fields (struct type *ty + { + fputs_filtered ("", stream); + } +- else if (TYPE_FIELD_STATIC (type, i)) ++ else if (field_is_static (&TYPE_FIELD (type, i))) + { + struct value *v = value_static_field (type, i); + if (v == NULL) +--- ./gdb/mdebugread.c 2008-01-01 23:53:12.000000000 +0100 ++++ ./gdb/mdebugread.c 2008-10-29 20:56:57.000000000 +0100 +@@ -1053,11 +1053,10 @@ parse_symbol (SYMR *sh, union aux_ext *a + if (tsym.st != stMember) + break; + +- FIELD_BITPOS (*f) = tsym.value; ++ SET_FIELD_BITPOS (*f, tsym.value); + FIELD_TYPE (*f) = t; + FIELD_NAME (*f) = debug_info->ss + cur_fdr->issBase + tsym.iss; + FIELD_BITSIZE (*f) = 0; +- FIELD_STATIC_KIND (*f) = 0; + + enum_sym = ((struct symbol *) + obstack_alloc (¤t_objfile->objfile_obstack, +@@ -1247,11 +1246,10 @@ parse_symbol (SYMR *sh, union aux_ext *a + case stMember: /* member of struct or union */ + f = &TYPE_FIELDS (top_stack->cur_type)[top_stack->cur_field++]; + FIELD_NAME (*f) = name; +- FIELD_BITPOS (*f) = sh->value; ++ SET_FIELD_BITPOS (*f, sh->value); + bitsize = 0; + FIELD_TYPE (*f) = parse_type (cur_fd, ax, sh->index, &bitsize, bigend, name); + FIELD_BITSIZE (*f) = bitsize; +- FIELD_STATIC_KIND (*f) = 0; + break; + + case stIndirect: /* forward declaration on Irix5 */ +--- ./gdb/p-typeprint.c 2008-10-29 10:55:12.000000000 +0100 ++++ ./gdb/p-typeprint.c 2008-10-29 20:56:57.000000000 +0100 +@@ -575,14 +575,12 @@ pascal_type_print_base (struct type *typ + } + + print_spaces_filtered (level + 4, stream); +- if (TYPE_FIELD_STATIC (type, i)) +- { +- fprintf_filtered (stream, "static "); +- } ++ if (field_is_static (&TYPE_FIELD (type, i))) ++ fprintf_filtered (stream, "static "); + pascal_print_type (TYPE_FIELD_TYPE (type, i), + TYPE_FIELD_NAME (type, i), + stream, show - 1, level + 4); +- if (!TYPE_FIELD_STATIC (type, i) ++ if (!field_is_static (&TYPE_FIELD (type, i)) + && TYPE_FIELD_PACKED (type, i)) + { + /* It is a bitfield. This code does not attempt +--- ./gdb/p-valprint.c 2008-01-01 23:53:12.000000000 +0100 ++++ ./gdb/p-valprint.c 2008-10-29 20:56:57.000000000 +0100 +@@ -671,7 +671,8 @@ pascal_object_print_value_fields (struct + for (i = n_baseclasses; i < len; i++) + { + /* If requested, skip printing of static fields. */ +- if (!pascal_static_field_print && TYPE_FIELD_STATIC (type, i)) ++ if (!pascal_static_field_print ++ && field_is_static (&TYPE_FIELD (type, i))) + continue; + if (fields_seen) + fprintf_filtered (stream, ", "); +@@ -703,7 +704,7 @@ pascal_object_print_value_fields (struct + fputs_filtered ("\"( ptr \"", stream); + else + fputs_filtered ("\"( nodef \"", stream); +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + fputs_filtered ("static ", stream); + fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), + language_cplus, +@@ -718,7 +719,7 @@ pascal_object_print_value_fields (struct + { + annotate_field_begin (TYPE_FIELD_TYPE (type, i)); + +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + fputs_filtered ("static ", stream); + fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i), + language_cplus, +@@ -728,7 +729,8 @@ pascal_object_print_value_fields (struct + annotate_field_value (); + } + +- if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i)) ++ if (!field_is_static (&TYPE_FIELD (type, i)) ++ && TYPE_FIELD_PACKED (type, i)) + { + struct value *v; + +@@ -752,7 +754,7 @@ pascal_object_print_value_fields (struct + { + fputs_filtered ("", stream); + } +- else if (TYPE_FIELD_STATIC (type, i)) ++ else if (field_is_static (&TYPE_FIELD (type, i))) + { + /* struct value *v = value_static_field (type, i); v4.17 specific */ + struct value *v; +--- ./gdb/valops.c 2008-10-29 10:55:12.000000000 +0100 ++++ ./gdb/valops.c 2008-10-29 20:56:57.000000000 +0100 +@@ -1269,7 +1269,7 @@ search_struct_field (char *name, struct + if (t_field_name && (strcmp_iw (t_field_name, name) == 0)) + { + struct value *v; +- if (TYPE_FIELD_STATIC (type, i)) ++ if (field_is_static (&TYPE_FIELD (type, i))) + { + v = value_static_field (type, i); + if (v == 0) +@@ -2382,7 +2382,7 @@ value_struct_elt_for_reference (struct t + + if (t_field_name && strcmp (t_field_name, name) == 0) + { +- if (TYPE_FIELD_STATIC (t, i)) ++ if (field_is_static (&TYPE_FIELD (t, i))) + { + v = value_static_field (t, i); + if (v == NULL) +--- ./gdb/value.c 2008-10-29 10:47:18.000000000 +0100 ++++ ./gdb/value.c 2008-10-29 20:56:57.000000000 +0100 +@@ -1261,7 +1261,7 @@ value_static_field (struct type *type, i + { + struct value *retval; + +- if (TYPE_FIELD_STATIC_HAS_ADDR (type, fieldno)) ++ if (TYPE_FIELD_LOC_KIND (type, fieldno) == FIELD_LOC_KIND_PHYSADDR) + { + retval = value_at (TYPE_FIELD_TYPE (type, fieldno), + TYPE_FIELD_STATIC_PHYSADDR (type, fieldno)); +--- ./gdb/varobj.c 2008-10-29 10:55:12.000000000 +0100 ++++ ./gdb/varobj.c 2008-10-29 20:56:57.000000000 +0100 +@@ -2050,7 +2050,7 @@ value_struct_element_index (struct value + + TRY_CATCH (e, RETURN_MASK_ERROR) + { +- if (TYPE_FIELD_STATIC (type, type_index)) ++ if (field_is_static (&TYPE_FIELD (type, type_index))) + result = value_static_field (type, type_index); + else + result = value_primitive_field (value, 0, type_index, type); diff --git a/gdb-6.8-bz377541-vla.patch b/gdb-6.8-bz377541-vla.patch new file mode 100644 index 0000000..d921aa2 --- /dev/null +++ b/gdb-6.8-bz377541-vla.patch @@ -0,0 +1,2727 @@ +Based on: +http://people.redhat.com/jkratoch/vla/ +fortran-dynamic-arrays-HEAD-i.patch + +--- ./gdb/c-typeprint.c 2008-10-29 20:56:57.000000000 +0100 ++++ ./gdb/c-typeprint.c 2008-10-29 21:32:13.000000000 +0100 +@@ -541,7 +541,12 @@ c_type_print_varspec_suffix (struct type + fprintf_filtered (stream, ")"); + + fprintf_filtered (stream, "["); +- if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 ++ if (TYPE_ARRAY_BOUND_IS_DWARF_BLOCK (type, 1)) ++ { ++ /* No _() - printed sources should not be locale dependent. */ ++ fprintf_filtered (stream, "variable"); ++ } ++ else if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 + && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + fprintf_filtered (stream, "%d", + (TYPE_LENGTH (type) +--- ./gdb/dwarf2expr.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/dwarf2expr.c 2008-10-29 21:32:13.000000000 +0100 +@@ -750,6 +750,13 @@ execute_stack_op (struct dwarf_expr_cont + ctx->initialized = 0; + goto no_push; + ++ case DW_OP_push_object_address: ++ if (ctx->get_object_address == NULL) ++ error (_("DWARF-2 expression error: DW_OP_push_object_address must " ++ "have a value to push.")); ++ result = (ctx->get_object_address) (ctx->baton); ++ break; ++ + default: + error (_("Unhandled dwarf expression opcode 0x%x"), op); + } +--- ./gdb/dwarf2expr.h 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/dwarf2expr.h 2008-10-29 21:32:13.000000000 +0100 +@@ -61,10 +61,10 @@ struct dwarf_expr_context + The result must be live until the current expression evaluation + is complete. */ + unsigned char *(*get_subr) (void *baton, off_t offset, size_t *length); ++#endif + + /* Return the `object address' for DW_OP_push_object_address. */ + CORE_ADDR (*get_object_address) (void *baton); +-#endif + + /* The current depth of dwarf expression recursion, via DW_OP_call*, + DW_OP_fbreg, DW_OP_push_object_address, etc., and the maximum +--- ./gdb/dwarf2loc.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/dwarf2loc.c 2008-11-01 20:31:51.000000000 +0100 +@@ -106,6 +106,9 @@ struct dwarf_expr_baton + { + struct frame_info *frame; + struct objfile *objfile; ++ /* From DW_TAG_variable's DW_AT_location (not DW_TAG_type's ++ DW_AT_data_location) for DW_OP_push_object_address. */ ++ CORE_ADDR object_address; + }; + + /* Helper functions for dwarf2_evaluate_loc_desc. */ +@@ -189,6 +192,105 @@ dwarf_expr_tls_address (void *baton, COR + return target_translate_tls_address (debaton->objfile, offset); + } + ++static CORE_ADDR ++dwarf_expr_object_address (void *baton) ++{ ++ struct dwarf_expr_baton *debaton = baton; ++ ++ /* The message is suppressed in DWARF_BLOCK_EXEC. */ ++ if (debaton->object_address == 0) ++ error (_("Cannot resolve DW_OP_push_object_address for a missing object")); ++ ++ return debaton->object_address; ++} ++ ++/* Address of the variable we are currently referring to. It is set from ++ DW_TAG_variable's DW_AT_location (not DW_TAG_type's DW_AT_data_location) for ++ DW_OP_push_object_address. */ ++ ++static CORE_ADDR object_address; ++ ++/* Callers use object_address_set while their callers use the result set so we ++ cannot run the cleanup at the local block of our direct caller. Still we ++ should reset OBJECT_ADDRESS at least for the next GDB command. */ ++ ++static void ++object_address_cleanup (void *prev_save_voidp) ++{ ++ CORE_ADDR *prev_save = prev_save_voidp; ++ ++ object_address = *prev_save; ++ xfree (prev_save); ++} ++ ++/* It would be useful to sanity check ADDRESS - such as for some objects with ++ unset VALUE_ADDRESS - but some valid addresses may be zero (such as first ++ objects in relocatable .o files). */ ++ ++void ++object_address_set (CORE_ADDR address) ++{ ++ CORE_ADDR *prev_save; ++ ++ prev_save = xmalloc (sizeof *prev_save); ++ *prev_save = object_address; ++ make_cleanup (object_address_cleanup, prev_save); ++ ++ object_address = address; ++} ++ ++/* Evaluate DWARF expression at DATA ... DATA + SIZE with its result readable ++ by dwarf_expr_fetch (RETVAL, 0). FRAME parameter can be NULL to call ++ get_selected_frame to find it. */ ++ ++struct dwarf_expr_context * ++dwarf_expr_prep_ctx (struct frame_info *frame, gdb_byte *data, ++ unsigned short size, struct objfile *objfile) ++{ ++ struct dwarf_expr_context *ctx; ++ struct dwarf_expr_baton baton; ++ ++ if (!frame) ++ frame = get_selected_frame (NULL); ++ ++ baton.frame = frame; ++ baton.objfile = objfile; ++ baton.object_address = object_address; ++ ++ ctx = new_dwarf_expr_context (); ++ ctx->baton = &baton; ++ ctx->read_reg = dwarf_expr_read_reg; ++ ctx->read_mem = dwarf_expr_read_mem; ++ ctx->get_frame_base = dwarf_expr_frame_base; ++ ctx->get_tls_address = dwarf_expr_tls_address; ++ ctx->get_object_address = dwarf_expr_object_address; ++ ++ dwarf_expr_eval (ctx, data, size); ++ ++ return ctx; ++} ++ ++/* Evaluate DWARF expression at DLBATON expecting it produces exactly one ++ CORE_ADDR result on the DWARF stack stack. */ ++ ++CORE_ADDR ++dwarf_locexpr_baton_eval (struct dwarf2_locexpr_baton *dlbaton) ++{ ++ struct dwarf_expr_context *ctx; ++ CORE_ADDR retval; ++ ++ ctx = dwarf_expr_prep_ctx (NULL, dlbaton->data, dlbaton->size, ++ dlbaton->objfile); ++ if (ctx->num_pieces > 0) ++ error (_("DW_OP_*piece is unsupported for DW_FORM_block")); ++ else if (ctx->in_reg) ++ error (_("Register result is unsupported for DW_FORM_block")); ++ ++ retval = dwarf_expr_fetch (ctx, 0); ++ ++ return retval; ++} ++ + /* Evaluate a location description, starting at DATA and with length + SIZE, to find the current location of variable VAR in the context + of FRAME. */ +@@ -199,7 +301,6 @@ dwarf2_evaluate_loc_desc (struct symbol + { + struct gdbarch *arch = get_frame_arch (frame); + struct value *retval; +- struct dwarf_expr_baton baton; + struct dwarf_expr_context *ctx; + + if (size == 0) +@@ -210,17 +311,8 @@ dwarf2_evaluate_loc_desc (struct symbol + return retval; + } + +- baton.frame = frame; +- baton.objfile = objfile; +- +- ctx = new_dwarf_expr_context (); +- ctx->baton = &baton; +- ctx->read_reg = dwarf_expr_read_reg; +- ctx->read_mem = dwarf_expr_read_mem; +- ctx->get_frame_base = dwarf_expr_frame_base; +- ctx->get_tls_address = dwarf_expr_tls_address; ++ ctx = dwarf_expr_prep_ctx (frame, data, size, objfile); + +- dwarf_expr_eval (ctx, data, size); + if (ctx->num_pieces > 0) + { + int i; +@@ -258,6 +351,10 @@ dwarf2_evaluate_loc_desc (struct symbol + { + CORE_ADDR address = dwarf_expr_fetch (ctx, 0); + ++ /* object_address_set called here is required in ALLOCATE_VALUE's ++ CHECK_TYPEDEF for the object's possible DW_OP_push_object_address. */ ++ object_address_set (address); ++ + retval = allocate_value (SYMBOL_TYPE (var)); + VALUE_LVAL (retval) = lval_memory; + set_value_lazy (retval, 1); +--- ./gdb/dwarf2loc.h 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/dwarf2loc.h 2008-11-01 20:16:31.000000000 +0100 +@@ -66,4 +66,13 @@ struct dwarf2_loclist_baton + extern const struct symbol_ops dwarf2_locexpr_funcs; + extern const struct symbol_ops dwarf2_loclist_funcs; + ++extern void object_address_set (CORE_ADDR address); ++ ++extern struct dwarf_expr_context *dwarf_expr_prep_ctx ++ (struct frame_info *frame, gdb_byte *data, unsigned short size, ++ struct objfile *objfile); ++ ++extern CORE_ADDR dwarf_locexpr_baton_eval ++ (struct dwarf2_locexpr_baton *dlbaton); ++ + #endif /* dwarf2loc.h */ +--- ./gdb/dwarf2read.c 2008-10-29 20:56:57.000000000 +0100 ++++ ./gdb/dwarf2read.c 2008-11-01 20:30:52.000000000 +0100 +@@ -1005,7 +1005,14 @@ static void store_in_ref_table (unsigned + static unsigned int dwarf2_get_ref_die_offset (struct attribute *, + struct dwarf2_cu *); + +-static int dwarf2_get_attr_constant_value (struct attribute *, int); ++enum dwarf2_get_attr_constant_value ++ { ++ dwarf2_attr_unknown, ++ dwarf2_attr_const, ++ dwarf2_attr_block ++ }; ++static enum dwarf2_get_attr_constant_value dwarf2_get_attr_constant_value ++ (struct attribute *attr, int *val_return); + + static struct die_info *follow_die_ref (struct die_info *, + struct attribute *, +@@ -1060,6 +1067,9 @@ static void age_cached_comp_units (void) + + static void free_one_cached_comp_unit (void *); + ++static void fetch_die_type_attrs (struct die_info *die, struct type *type, ++ struct dwarf2_cu *cu); ++ + static void set_die_type (struct die_info *, struct type *, + struct dwarf2_cu *); + +@@ -1083,6 +1093,9 @@ static void dwarf2_clear_marks (struct d + static void read_set_type (struct die_info *, struct dwarf2_cu *); + + ++static struct dwarf2_locexpr_baton *dwarf2_attr_to_locexpr_baton ++ (struct attribute *attr, struct dwarf2_cu *cu); ++ + /* Try to locate the sections we need for DWARF 2 debugging + information and return true if we have enough to do something. */ + +@@ -4402,6 +4415,26 @@ process_enumeration_scope (struct die_in + new_symbol (die, die->type, cu); + } + ++/* Create a new array dimension referencing its target type TYPE. ++ ++ Multidimensional arrays are internally represented as a stack of ++ singledimensional arrays being referenced by their TYPE_TARGET_TYPE. */ ++ ++static struct type * ++create_single_array_dimension (struct type *type, struct type *range_type, ++ struct die_info *die, struct dwarf2_cu *cu) ++{ ++ type = create_array_type (NULL, type, range_type); ++ ++ /* These generic type attributes need to be fetched by ++ evaluate_subexp_standard 's call of ++ value_subscripted_rvalue only for the innermost array type. */ ++ ++ fetch_die_type_attrs (die, type, cu); ++ ++ return type; ++} ++ + /* Extract all information from a DW_TAG_array_type DIE and put it in + the DIE's type field. For now, this only handles one dimensional + arrays. */ +@@ -4415,7 +4448,7 @@ read_array_type (struct die_info *die, s + struct type *element_type, *range_type, *index_type; + struct type **range_types = NULL; + struct attribute *attr; +- int ndim = 0; ++ int ndim = 0, i; + struct cleanup *back_to; + char *name; + +@@ -4470,16 +4503,11 @@ read_array_type (struct die_info *die, s + type = element_type; + + if (read_array_order (die, cu) == DW_ORD_col_major) +- { +- int i = 0; +- while (i < ndim) +- type = create_array_type (NULL, type, range_types[i++]); +- } +- else +- { +- while (ndim-- > 0) +- type = create_array_type (NULL, type, range_types[ndim]); +- } ++ for (i = 0; i < ndim; i++) ++ type = create_single_array_dimension (type, range_types[i], die, cu); ++ else /* (read_array_order (die, cu) == DW_ORD_row_major) */ ++ for (i = ndim - 1; i >= 0; i--) ++ type = create_single_array_dimension (type, range_types[i], die, cu); + + /* Understand Dwarf2 support for vector types (like they occur on + the PowerPC w/ AltiVec). Gcc just adds another attribute to the +@@ -4841,34 +4869,98 @@ read_tag_string_type (struct die_info *d + struct objfile *objfile = cu->objfile; + struct type *type, *range_type, *index_type, *char_type; + struct attribute *attr; +- unsigned int length; ++ int length; + + if (die->type) + { + return; + } + ++ index_type = builtin_type_int32; ++ range_type = create_range_type_nfields (NULL, index_type, 2); ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_UNSIGNED; ++ ++ /* C/C++ should probably have the low bound 0 but C/C++ does not use ++ DW_TAG_string_type. */ ++ TYPE_LOW_BOUND (range_type) = 1; ++ + attr = dwarf2_attr (die, DW_AT_string_length, cu); +- if (attr) +- { +- length = DW_UNSND (attr); +- } +- else ++ switch (dwarf2_get_attr_constant_value (attr, &length)) + { +- /* check for the DW_AT_byte_size attribute */ ++ case dwarf2_attr_const: ++ /* We currently do not support a constant address where the location ++ should be read from - DWARF2_ATTR_BLOCK is expected instead. See ++ DWARF for the DW_AT_STRING_LENGTH vs. DW_AT_BYTE_SIZE difference. */ ++ /* PASSTHRU */ ++ case dwarf2_attr_unknown: + attr = dwarf2_attr (die, DW_AT_byte_size, cu); +- if (attr) +- { +- length = DW_UNSND (attr); +- } +- else +- { +- length = 1; +- } ++ switch (dwarf2_get_attr_constant_value (attr, &length)) ++ { ++ case dwarf2_attr_unknown: ++ length = 1; ++ /* PASSTHRU */ ++ case dwarf2_attr_const: ++ TYPE_HIGH_BOUND (range_type) = length; ++ break; ++ case dwarf2_attr_block: ++ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 1); ++ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = ++ dwarf2_attr_to_locexpr_baton (attr, cu); ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC; ++ break; ++ } ++ break; ++ case dwarf2_attr_block: ++ /* Security check for a size overflow. */ ++ if (DW_BLOCK (attr)->size + 2 < DW_BLOCK (attr)->size) ++ { ++ TYPE_HIGH_BOUND (range_type) = 1; ++ break; ++ } ++ /* Extend the DWARF block by a new DW_OP_deref/DW_OP_deref_size ++ instruction as DW_AT_string_length specifies the length location, not ++ its value. */ ++ { ++ struct dwarf2_locexpr_baton *length_baton; ++ struct attribute *size_attr; ++ ++ length_baton = obstack_alloc (&cu->comp_unit_obstack, ++ sizeof (*length_baton)); ++ length_baton->objfile = cu->objfile; ++ length_baton->data = obstack_alloc (&cu->comp_unit_obstack, ++ DW_BLOCK (attr)->size + 2); ++ memcpy (length_baton->data, DW_BLOCK (attr)->data, ++ DW_BLOCK (attr)->size); ++ ++ /* DW_AT_BYTE_SIZE existing together with DW_AT_STRING_LENGTH specifies ++ the size of an integer to fetch. */ ++ ++ size_attr = dwarf2_attr (die, DW_AT_byte_size, cu); ++ if (size_attr) ++ { ++ length_baton->size = DW_BLOCK (attr)->size + 2; ++ length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref_size; ++ length_baton->data[DW_BLOCK (attr)->size + 1] ++ = DW_UNSND (size_attr); ++ if (length_baton->data[DW_BLOCK (attr)->size + 1] ++ != DW_UNSND (size_attr)) ++ complaint (&symfile_complaints, ++ _("DW_AT_string_length's DW_AT_byte_size integer " ++ "exceeds the byte size storage")); ++ } ++ else ++ { ++ length_baton->size = DW_BLOCK (attr)->size + 1; ++ length_baton->data[DW_BLOCK (attr)->size] = DW_OP_deref; ++ } ++ ++ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 1); ++ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = length_baton; ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC; ++ } ++ break; + } + +- index_type = builtin_type_int32; +- range_type = create_range_type (NULL, index_type, 1, length); + type = create_string_type (NULL, range_type); + + set_die_type (die, type, cu); +@@ -4961,7 +5053,6 @@ static void + read_typedef (struct die_info *die, struct dwarf2_cu *cu) + { + struct objfile *objfile = cu->objfile; +- struct attribute *attr; + char *name = NULL; + + if (!die->type) +@@ -5067,9 +5158,9 @@ read_subrange_type (struct die_info *die + { + struct type *base_type; + struct type *range_type; +- struct attribute *attr; +- int low = 0; +- int high = -1; ++ struct attribute *attr, *byte_stride_attr; ++ int low, high, byte_stride_int; ++ enum dwarf2_get_attr_constant_value high_type, byte_stride_type; + char *name; + + /* If we have already decoded this die, then nothing more to do. */ +@@ -5086,42 +5177,87 @@ read_subrange_type (struct die_info *die + 0, NULL, cu->objfile); + } + +- if (cu->language == language_fortran) +- { +- /* FORTRAN implies a lower bound of 1, if not given. */ +- low = 1; +- } ++ /* DW_AT_bit_stride is currently unsupported as we count in bytes. */ ++ byte_stride_attr = dwarf2_attr (die, DW_AT_byte_stride, cu); ++ byte_stride_type = dwarf2_get_attr_constant_value (byte_stride_attr, ++ &byte_stride_int); ++ ++ range_type = create_range_type_nfields ++ (NULL, base_type, byte_stride_type == dwarf2_attr_unknown ? 2 : 3); + +- /* FIXME: For variable sized arrays either of these could be +- a variable rather than a constant value. We'll allow it, +- but we don't know how to handle it. */ + attr = dwarf2_attr (die, DW_AT_lower_bound, cu); +- if (attr) +- low = dwarf2_get_attr_constant_value (attr, 0); ++ switch (dwarf2_get_attr_constant_value (attr, &low)) ++ { ++ case dwarf2_attr_unknown: ++ if (cu->language == language_fortran) ++ { ++ /* FORTRAN implies a lower bound of 1, if not given. */ ++ low = 1; ++ } ++ else ++ { ++ /* According to DWARF we should assume the value 0 only for ++ LANGUAGE_C and LANGUAGE_CPLUS. */ ++ low = 0; ++ } ++ /* PASSTHRU */ ++ case dwarf2_attr_const: ++ TYPE_LOW_BOUND (range_type) = low; ++ if (low >= 0) ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_UNSIGNED; ++ break; ++ case dwarf2_attr_block: ++ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 0); ++ TYPE_FIELD_DWARF_BLOCK (range_type, 0) = dwarf2_attr_to_locexpr_baton ++ (attr, cu); ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC; ++ /* For setting a default if DW_AT_UPPER_BOUND would be missing. */ ++ low = 0; ++ break; ++ } + + attr = dwarf2_attr (die, DW_AT_upper_bound, cu); +- if (attr) +- { +- if (attr->form == DW_FORM_block1) +- { +- /* GCC encodes arrays with unspecified or dynamic length +- with a DW_FORM_block1 attribute. +- FIXME: GDB does not yet know how to handle dynamic +- arrays properly, treat them as arrays with unspecified +- length for now. +- +- FIXME: jimb/2003-09-22: GDB does not really know +- how to handle arrays of unspecified length +- either; we just represent them as zero-length +- arrays. Choose an appropriate upper bound given +- the lower bound we've computed above. */ +- high = low - 1; +- } +- else +- high = dwarf2_get_attr_constant_value (attr, 1); ++ high_type = dwarf2_get_attr_constant_value (attr, &high); ++ if (high_type == dwarf2_attr_unknown) ++ { ++ attr = dwarf2_attr (die, DW_AT_count, cu); ++ high_type = dwarf2_get_attr_constant_value (attr, &high); ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT; ++ /* Pass it now as the regular DW_AT_upper_bound. */ ++ } ++ switch (high_type) ++ { ++ case dwarf2_attr_unknown: ++ TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (range_type) = 1; ++ high = low - 1; ++ /* PASSTHRU */ ++ case dwarf2_attr_const: ++ TYPE_HIGH_BOUND (range_type) = high; ++ break; ++ case dwarf2_attr_block: ++ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 1); ++ TYPE_FIELD_DWARF_BLOCK (range_type, 1) = dwarf2_attr_to_locexpr_baton ++ (attr, cu); ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC; ++ break; + } + +- range_type = create_range_type (NULL, base_type, low, high); ++ switch (byte_stride_type) ++ { ++ case dwarf2_attr_unknown: ++ break; ++ case dwarf2_attr_const: ++ if (byte_stride_int == 0) ++ warning (_("Found DW_AT_byte_stride with unsupported value 0")); ++ SET_TYPE_BYTE_STRIDE (range_type, byte_stride_int); ++ break; ++ case dwarf2_attr_block: ++ TYPE_RANGE_BOUND_SET_DWARF_BLOCK (range_type, 2); ++ TYPE_FIELD_DWARF_BLOCK (range_type, 2) = dwarf2_attr_to_locexpr_baton ++ (byte_stride_attr, cu); ++ TYPE_FLAGS (range_type) |= TYPE_FLAG_DYNAMIC; ++ break; ++ } + + name = dwarf2_name (die, cu); + if (name) +@@ -7256,10 +7392,12 @@ var_decode_location (struct attribute *a + (i.e. when the value of a register or memory location is + referenced, or a thread-local block, etc.). Then again, it might + not be worthwhile. I'm assuming that it isn't unless performance +- or memory numbers show me otherwise. */ ++ or memory numbers show me otherwise. ++ ++ SYMBOL_CLASS may get overriden by dwarf2_symbol_mark_computed. */ + +- dwarf2_symbol_mark_computed (attr, sym, cu); + SYMBOL_CLASS (sym) = LOC_COMPUTED; ++ dwarf2_symbol_mark_computed (attr, sym, cu); + } + + /* Given a pointer to a DWARF information entry, figure out if we need +@@ -9120,26 +9258,35 @@ dwarf2_get_ref_die_offset (struct attrib + return result; + } + +-/* Return the constant value held by the given attribute. Return -1 +- if the value held by the attribute is not constant. */ ++/* (*val_return) is filled only if returning dwarf2_attr_const. */ + +-static int +-dwarf2_get_attr_constant_value (struct attribute *attr, int default_value) ++static enum dwarf2_get_attr_constant_value ++dwarf2_get_attr_constant_value (struct attribute *attr, int *val_return) + { ++ if (attr == NULL) ++ return dwarf2_attr_unknown; + if (attr->form == DW_FORM_sdata) +- return DW_SND (attr); +- else if (attr->form == DW_FORM_udata +- || attr->form == DW_FORM_data1 +- || attr->form == DW_FORM_data2 +- || attr->form == DW_FORM_data4 +- || attr->form == DW_FORM_data8) +- return DW_UNSND (attr); +- else + { +- complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"), +- dwarf_form_name (attr->form)); +- return default_value; ++ *val_return = DW_SND (attr); ++ return dwarf2_attr_const; + } ++ if (attr->form == DW_FORM_udata ++ || attr->form == DW_FORM_data1 ++ || attr->form == DW_FORM_data2 ++ || attr->form == DW_FORM_data4 ++ || attr->form == DW_FORM_data8) ++ { ++ *val_return = DW_UNSND (attr); ++ return dwarf2_attr_const; ++ } ++ if (attr->form == DW_FORM_block ++ || attr->form == DW_FORM_block1 ++ || attr->form == DW_FORM_block2 ++ || attr->form == DW_FORM_block4) ++ return dwarf2_attr_block; ++ complaint (&symfile_complaints, _("Attribute value is not a constant (%s)"), ++ dwarf_form_name (attr->form)); ++ return dwarf2_attr_unknown; + } + + static struct die_info * +@@ -9903,6 +10050,34 @@ attr_form_is_constant (struct attribute + } + } + ++/* Convert DW_BLOCK into struct dwarf2_locexpr_baton. ATTR must be a DW_BLOCK ++ attribute type. */ ++ ++static struct dwarf2_locexpr_baton * ++dwarf2_attr_to_locexpr_baton (struct attribute *attr, struct dwarf2_cu *cu) ++{ ++ struct dwarf2_locexpr_baton *baton; ++ ++ gdb_assert (attr_form_is_block (attr)); ++ ++ baton = obstack_alloc (&cu->objfile->objfile_obstack, sizeof (*baton)); ++ baton->objfile = cu->objfile; ++ gdb_assert (baton->objfile); ++ ++ /* Note that we're just copying the block's data pointer ++ here, not the actual data. We're still pointing into the ++ info_buffer for SYM's objfile; right now we never release ++ that buffer, but when we do clean up properly this may ++ need to change. */ ++ baton->size = DW_BLOCK (attr)->size; ++ baton->data = DW_BLOCK (attr)->data; ++ gdb_assert (baton->size == 0 || baton->data != NULL); ++ ++ return baton; ++} ++ ++/* SYM may get its SYMBOL_CLASS overriden on invalid ATTR content. */ ++ + static void + dwarf2_symbol_mark_computed (struct attribute *attr, struct symbol *sym, + struct dwarf2_cu *cu) +@@ -9938,34 +10113,18 @@ dwarf2_symbol_mark_computed (struct attr + SYMBOL_OPS (sym) = &dwarf2_loclist_funcs; + SYMBOL_LOCATION_BATON (sym) = baton; + } +- else ++ else if (attr_form_is_block (attr)) + { +- struct dwarf2_locexpr_baton *baton; +- +- baton = obstack_alloc (&cu->objfile->objfile_obstack, +- sizeof (struct dwarf2_locexpr_baton)); +- baton->objfile = objfile; +- +- if (attr_form_is_block (attr)) +- { +- /* Note that we're just copying the block's data pointer +- here, not the actual data. We're still pointing into the +- info_buffer for SYM's objfile; right now we never release +- that buffer, but when we do clean up properly this may +- need to change. */ +- baton->size = DW_BLOCK (attr)->size; +- baton->data = DW_BLOCK (attr)->data; +- } +- else +- { +- dwarf2_invalid_attrib_class_complaint ("location description", +- SYMBOL_NATURAL_NAME (sym)); +- baton->size = 0; +- baton->data = NULL; +- } +- + SYMBOL_OPS (sym) = &dwarf2_locexpr_funcs; +- SYMBOL_LOCATION_BATON (sym) = baton; ++ SYMBOL_LOCATION_BATON (sym) = dwarf2_attr_to_locexpr_baton (attr, cu); ++ } ++ else ++ { ++ dwarf2_invalid_attrib_class_complaint ("location description", ++ SYMBOL_NATURAL_NAME (sym)); ++ /* We have no valid SYMBOL_OPS. */ ++ if (attr->name == DW_AT_location) ++ SYMBOL_CLASS (sym) = LOC_OPTIMIZED_OUT; + } + } + +@@ -10205,6 +10363,27 @@ offset_and_type_eq (const void *item_lhs + return ofs_lhs->offset == ofs_rhs->offset; + } + ++/* Fill in generic attributes applicable for type DIEs. */ ++ ++static void ++fetch_die_type_attrs (struct die_info *die, struct type *type, ++ struct dwarf2_cu *cu) ++{ ++ struct attribute *attr; ++ ++ attr = dwarf2_attr (die, DW_AT_data_location, cu); ++ if (attr_form_is_block (attr)) ++ TYPE_DATA_LOCATION (type) = dwarf2_attr_to_locexpr_baton (attr, cu); ++ ++ attr = dwarf2_attr (die, DW_AT_allocated, cu); ++ if (attr_form_is_block (attr)) ++ TYPE_ALLOCATED (type) = dwarf2_attr_to_locexpr_baton (attr, cu); ++ ++ attr = dwarf2_attr (die, DW_AT_associated, cu); ++ if (attr_form_is_block (attr)) ++ TYPE_ASSOCIATED (type) = dwarf2_attr_to_locexpr_baton (attr, cu); ++} ++ + /* Set the type associated with DIE to TYPE. Save it in CU's hash + table if necessary. */ + +@@ -10215,6 +10394,8 @@ set_die_type (struct die_info *die, stru + + die->type = type; + ++ fetch_die_type_attrs (die, type, cu); ++ + if (cu->per_cu == NULL) + return; + +--- ./gdb/eval.c 2008-10-29 20:56:57.000000000 +0100 ++++ ./gdb/eval.c 2008-11-01 19:58:56.000000000 +0100 +@@ -38,6 +38,7 @@ + #include "ui-out.h" + #include "exceptions.h" + #include "regcache.h" ++#include "dwarf2loc.h" + + #include "gdb_assert.h" + +@@ -1644,9 +1645,12 @@ evaluate_subexp_standard (struct type *e + { + int subscript_array[MAX_FORTRAN_DIMS]; + int array_size_array[MAX_FORTRAN_DIMS]; ++ int byte_stride_array[MAX_FORTRAN_DIMS]; + int ndimensions = 1, i; + struct type *tmp_type; + int offset_item; /* The array offset where the item lives */ ++ CORE_ADDR offset_byte; /* byte_stride based offset */ ++ unsigned element_size; + + if (nargs > MAX_FORTRAN_DIMS) + error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); +@@ -1678,6 +1682,9 @@ evaluate_subexp_standard (struct type *e + upper = f77_get_upperbound (tmp_type); + lower = f77_get_lowerbound (tmp_type); + ++ byte_stride_array[nargs - i - 1] = ++ TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type); ++ + array_size_array[nargs - i - 1] = upper - lower + 1; + + /* Zero-normalize subscripts so that offsetting will work. */ +@@ -1698,15 +1705,20 @@ evaluate_subexp_standard (struct type *e + + /* Now let us calculate the offset for this item */ + +- offset_item = subscript_array[ndimensions - 1]; +- +- for (i = ndimensions - 1; i > 0; --i) +- offset_item = +- array_size_array[i - 1] * offset_item + subscript_array[i - 1]; ++ offset_item = 0; ++ offset_byte = 0; + +- /* Construct a value node with the value of the offset */ ++ for (i = ndimensions - 1; i >= 0; --i) ++ { ++ offset_item *= array_size_array[i]; ++ if (byte_stride_array[i] == 0) ++ offset_item += subscript_array[i]; ++ else ++ offset_byte += subscript_array[i] * byte_stride_array[i]; ++ } + +- arg2 = value_from_longest (builtin_type_f_integer, offset_item); ++ element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tmp_type)); ++ offset_byte += offset_item * element_size; + + /* Let us now play a dirty trick: we will take arg1 + which is a value node pointing to the topmost level +@@ -1716,7 +1728,7 @@ evaluate_subexp_standard (struct type *e + returns the correct type value */ + + deprecated_set_value_type (arg1, tmp_type); +- return value_ind (value_add (value_coerce_array (arg1), arg2)); ++ return value_subscripted_rvalue (arg1, offset_byte); + } + + case BINOP_LOGICAL_AND: +@@ -2300,9 +2312,12 @@ evaluate_subexp_for_sizeof (struct expre + + case OP_VAR_VALUE: + (*pos) += 4; +- type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol)); +- return +- value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type)); ++ /* We do not need to call read_var_value but the object evaluation may ++ need to have executed object_address_set which needs valid ++ SYMBOL_VALUE_ADDRESS of the symbol. Still VALUE returned by ++ read_var_value we left as lazy. */ ++ type = value_type (read_var_value (exp->elts[pc + 2].symbol, NULL)); ++ return value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type)); + + default: + val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS); +--- ./gdb/f-lang.h 2008-10-29 10:55:07.000000000 +0100 ++++ ./gdb/f-lang.h 2008-10-29 21:32:13.000000000 +0100 +@@ -28,6 +28,10 @@ extern void f_error (char *); /* Defined + extern void f_print_type (struct type *, char *, struct ui_file *, int, + int); + ++extern const char *f_object_address_data_valid_print_to_stream ++ (struct type *type, struct ui_file *stream); ++extern void f_object_address_data_valid_or_error (struct type *type); ++ + extern int f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR, + struct ui_file *, int, int, int, + enum val_prettyprint); +--- ./gdb/f-typeprint.c 2008-10-29 10:55:07.000000000 +0100 ++++ ./gdb/f-typeprint.c 2008-11-01 17:51:42.000000000 +0100 +@@ -31,7 +31,7 @@ + #include "gdbcore.h" + #include "target.h" + #include "f-lang.h" +- ++#include "dwarf2loc.h" + #include "gdb_string.h" + #include + +@@ -39,7 +39,7 @@ + static void f_type_print_args (struct type *, struct ui_file *); + #endif + +-static void f_type_print_varspec_suffix (struct type *, struct ui_file *, ++static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int, + int, int, int); + + void f_type_print_varspec_prefix (struct type *, struct ui_file *, +@@ -48,6 +48,34 @@ void f_type_print_varspec_prefix (struct + void f_type_print_base (struct type *, struct ui_file *, int, int); + + ++const char * ++f_object_address_data_valid_print_to_stream (struct type *type, ++ struct ui_file *stream) ++{ ++ const char *msg; ++ ++ msg = object_address_data_not_valid (type); ++ if (msg != NULL) ++ { ++ /* Assuming the content printed to STREAM should not be localized. */ ++ fprintf_filtered (stream, "<%s>", msg); ++ } ++ ++ return msg; ++} ++ ++void ++f_object_address_data_valid_or_error (struct type *type) ++{ ++ const char *msg; ++ ++ msg = object_address_data_not_valid (type); ++ if (msg != NULL) ++ { ++ error (_("Cannot access it because the %s."), _(msg)); ++ } ++} ++ + /* LEVEL is the depth to indent lines by. */ + + void +@@ -57,6 +85,9 @@ f_print_type (struct type *type, char *v + enum type_code code; + int demangled_args; + ++ if (f_object_address_data_valid_print_to_stream (type, stream) != NULL) ++ return; ++ + f_type_print_base (type, stream, show, level); + code = TYPE_CODE (type); + if ((varstring != NULL && *varstring != '\0') +@@ -78,7 +109,7 @@ f_print_type (struct type *type, char *v + so don't print an additional pair of ()'s */ + + demangled_args = varstring[strlen (varstring) - 1] == ')'; +- f_type_print_varspec_suffix (type, stream, show, 0, demangled_args); ++ f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0); + } + + /* Print any asterisks or open-parentheses needed before the +@@ -147,11 +178,13 @@ f_type_print_varspec_prefix (struct type + + static void + f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, +- int show, int passed_a_ptr, int demangled_args) ++ int show, int passed_a_ptr, int demangled_args, ++ int arrayprint_recurse_level) + { + int upper_bound, lower_bound; +- static int arrayprint_recurse_level = 0; + int retcode; ++ /* No static variables (such as ARRAYPRINT_RECURSE_LEVEL) permitted as ERROR ++ may occur during the evaluation of DWARF_BLOCK values. */ + + if (type == 0) + return; +@@ -161,6 +194,9 @@ f_type_print_varspec_suffix (struct type + + QUIT; + ++ if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF) ++ CHECK_TYPEDEF (type); ++ + switch (TYPE_CODE (type)) + { + case TYPE_CODE_ARRAY: +@@ -170,7 +206,8 @@ f_type_print_varspec_suffix (struct type + fprintf_filtered (stream, "("); + + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY) +- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); ++ 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. */ +@@ -188,7 +225,8 @@ f_type_print_varspec_suffix (struct type + } + + if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY) +- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0); ++ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0, ++ arrayprint_recurse_level); + if (arrayprint_recurse_level == 1) + fprintf_filtered (stream, ")"); + else +@@ -198,13 +236,14 @@ f_type_print_varspec_suffix (struct type + + case TYPE_CODE_PTR: + case TYPE_CODE_REF: +- f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0); ++ f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0, ++ arrayprint_recurse_level); + fprintf_filtered (stream, ")"); + break; + + case TYPE_CODE_FUNC: + f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, +- passed_a_ptr, 0); ++ passed_a_ptr, 0, arrayprint_recurse_level); + if (passed_a_ptr) + fprintf_filtered (stream, ")"); + +--- ./gdb/f-valprint.c 2008-10-29 20:48:30.000000000 +0100 ++++ ./gdb/f-valprint.c 2008-11-01 17:55:30.000000000 +0100 +@@ -54,15 +54,17 @@ int f77_array_offset_tbl[MAX_FORTRAN_DIM + /* 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]) ++#define F77_DIM_COUNT(n) (f77_array_offset_tbl[n][1]) + +-/* The following gives us the offset for row n where n is 1-based. */ ++/* The following gives us the element size for row n where n is 1-based. */ + +-#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0]) ++#define F77_DIM_BYTE_STRIDE(n) (f77_array_offset_tbl[n][0]) + + int + f77_get_lowerbound (struct type *type) + { ++ f_object_address_data_valid_or_error (type); ++ + if (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED (type)) + error (_("Lower bound may not be '*' in F77")); + +@@ -72,6 +74,8 @@ f77_get_lowerbound (struct type *type) + int + f77_get_upperbound (struct type *type) + { ++ f_object_address_data_valid_or_error (type); ++ + if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) + { + /* We have an assumed size array on our hands. Assume that +@@ -135,24 +139,29 @@ f77_create_arrayprint_offset_tbl (struct + upper = f77_get_upperbound (tmp_type); + lower = f77_get_lowerbound (tmp_type); + +- F77_DIM_SIZE (ndimen) = upper - lower + 1; ++ F77_DIM_COUNT (ndimen) = upper - lower + 1; ++ ++ F77_DIM_BYTE_STRIDE (ndimen) = ++ TYPE_ARRAY_BYTE_STRIDE_VALUE (tmp_type); + + tmp_type = TYPE_TARGET_TYPE (tmp_type); + ndimen++; + } + +- /* Now we multiply eltlen by all the offsets, so that later we ++ /* Now we multiply eltlen by all the BYTE_STRIDEs, 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 ++ know an eltlen 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; ++ if (F77_DIM_BYTE_STRIDE (ndimen) == 0) ++ F77_DIM_BYTE_STRIDE (ndimen) = eltlen; + while (--ndimen > 0) + { +- eltlen *= F77_DIM_SIZE (ndimen + 1); +- F77_DIM_OFFSET (ndimen) = eltlen; ++ eltlen *= F77_DIM_COUNT (ndimen + 1); ++ if (F77_DIM_BYTE_STRIDE (ndimen) == 0) ++ F77_DIM_BYTE_STRIDE (ndimen) = eltlen; + } + } + +@@ -172,33 +181,33 @@ f77_print_array_1 (int nss, int ndimensi + + if (nss != ndimensions) + { +- for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++) ++ for (i = 0; (i < F77_DIM_COUNT (nss) && (*elts) < print_max); i++) + { + fprintf_filtered (stream, "( "); + f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type), +- valaddr + i * F77_DIM_OFFSET (nss), +- address + i * F77_DIM_OFFSET (nss), ++ valaddr + i * F77_DIM_BYTE_STRIDE (nss), ++ address + i * F77_DIM_BYTE_STRIDE (nss), + stream, format, deref_ref, recurse, pretty, elts); + fprintf_filtered (stream, ") "); + } +- if (*elts >= print_max && i < F77_DIM_SIZE (nss)) ++ if (*elts >= print_max && i < F77_DIM_COUNT (nss)) + fprintf_filtered (stream, "..."); + } + else + { +- for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max; ++ for (i = 0; i < F77_DIM_COUNT (nss) && (*elts) < print_max; + i++, (*elts)++) + { + val_print (TYPE_TARGET_TYPE (type), +- valaddr + i * F77_DIM_OFFSET (ndimensions), ++ valaddr + i * F77_DIM_BYTE_STRIDE (ndimensions), + 0, +- address + i * F77_DIM_OFFSET (ndimensions), ++ address + i * F77_DIM_BYTE_STRIDE (ndimensions), + stream, format, deref_ref, recurse, pretty); + +- if (i != (F77_DIM_SIZE (nss) - 1)) ++ if (i != (F77_DIM_COUNT (nss) - 1)) + fprintf_filtered (stream, ", "); + +- if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1))) ++ if ((*elts == print_max - 1) && (i != (F77_DIM_COUNT (nss) - 1))) + fprintf_filtered (stream, "..."); + } + } +@@ -257,6 +266,9 @@ f_val_print (struct type *type, const gd + CORE_ADDR addr; + int index; + ++ if (f_object_address_data_valid_print_to_stream (type, stream) != NULL) ++ return 0; ++ + CHECK_TYPEDEF (type); + switch (TYPE_CODE (type)) + { +--- ./gdb/findvar.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/findvar.c 2008-11-01 20:13:39.000000000 +0100 +@@ -34,6 +34,7 @@ + #include "regcache.h" + #include "user-regs.h" + #include "block.h" ++#include "dwarf2loc.h" + + /* Basic byte-swapping routines. GDB has needed these for a long time... + All extract a target-format integer at ADDR which is LEN bytes long. */ +@@ -365,29 +366,16 @@ symbol_read_needs_frame (struct symbol * + and a stack frame id, read the value of the variable + and return a (pointer to a) struct value containing the value. + If the variable cannot be found, return a zero pointer. +- If FRAME is NULL, use the selected frame. */ ++ If FRAME is NULL, use the selected frame. ++ We have to first find the address of the variable before allocating struct ++ value to return as its size may depend on DW_OP_PUSH_OBJECT_ADDRESS possibly ++ used by its type. */ + + struct value * + read_var_value (struct symbol *var, struct frame_info *frame) + { +- struct value *v; + struct type *type = SYMBOL_TYPE (var); + CORE_ADDR addr; +- int len; +- +- if (SYMBOL_CLASS (var) == LOC_COMPUTED +- || SYMBOL_CLASS (var) == LOC_COMPUTED_ARG +- || SYMBOL_CLASS (var) == LOC_REGISTER +- || SYMBOL_CLASS (var) == LOC_REGPARM) +- /* These cases do not use V. */ +- v = NULL; +- else +- { +- v = allocate_value (type); +- VALUE_LVAL (v) = lval_memory; /* The most likely possibility. */ +- } +- +- len = TYPE_LENGTH (type); + + /* FIXME drow/2003-09-06: this call to the selected frame should be + pushed upwards to the callers. */ +@@ -397,31 +385,39 @@ read_var_value (struct symbol *var, stru + switch (SYMBOL_CLASS (var)) + { + case LOC_CONST: +- /* Put the constant back in target format. */ +- store_signed_integer (value_contents_raw (v), len, +- (LONGEST) SYMBOL_VALUE (var)); +- VALUE_LVAL (v) = not_lval; +- return v; ++ { ++ /* Put the constant back in target format. */ ++ struct value *v = allocate_value (type); ++ VALUE_LVAL (v) = not_lval; ++ store_signed_integer (value_contents_raw (v), TYPE_LENGTH (type), ++ (LONGEST) SYMBOL_VALUE (var)); ++ return v; ++ } + + case LOC_LABEL: +- /* Put the constant back in target format. */ +- if (overlay_debugging) +- { +- CORE_ADDR addr +- = symbol_overlayed_address (SYMBOL_VALUE_ADDRESS (var), +- SYMBOL_BFD_SECTION (var)); +- store_typed_address (value_contents_raw (v), type, addr); +- } +- else +- store_typed_address (value_contents_raw (v), type, +- SYMBOL_VALUE_ADDRESS (var)); +- VALUE_LVAL (v) = not_lval; +- return v; ++ { ++ /* Put the constant back in target format. */ ++ struct value *v = allocate_value (type); ++ VALUE_LVAL (v) = not_lval; ++ if (overlay_debugging) ++ { ++ CORE_ADDR addr ++ = symbol_overlayed_address (SYMBOL_VALUE_ADDRESS (var), ++ SYMBOL_BFD_SECTION (var)); ++ store_typed_address (value_contents_raw (v), type, addr); ++ } ++ else ++ store_typed_address (value_contents_raw (v), type, ++ SYMBOL_VALUE_ADDRESS (var)); ++ return v; ++ } + + case LOC_CONST_BYTES: + { +- memcpy (value_contents_raw (v), SYMBOL_VALUE_BYTES (var), len); ++ struct value *v = allocate_value (type); + VALUE_LVAL (v) = not_lval; ++ memcpy (value_contents_raw (v), SYMBOL_VALUE_BYTES (var), ++ TYPE_LENGTH (type)); + return v; + } + +@@ -503,12 +499,23 @@ addresses have not been bound by the dyn + break; + + case LOC_BLOCK: +- if (overlay_debugging) +- VALUE_ADDRESS (v) = symbol_overlayed_address +- (BLOCK_START (SYMBOL_BLOCK_VALUE (var)), SYMBOL_BFD_SECTION (var)); +- else +- VALUE_ADDRESS (v) = BLOCK_START (SYMBOL_BLOCK_VALUE (var)); +- return v; ++ { ++ CORE_ADDR addr; ++ struct value *v; ++ ++ if (overlay_debugging) ++ addr = symbol_overlayed_address ++ (BLOCK_START (SYMBOL_BLOCK_VALUE (var)), SYMBOL_BFD_SECTION (var)); ++ else ++ addr = BLOCK_START (SYMBOL_BLOCK_VALUE (var)); ++ /* ADDR is set here for ALLOCATE_VALUE's CHECK_TYPEDEF for ++ DW_OP_push_object_address. */ ++ object_address_set (addr); ++ v = allocate_value (type); ++ VALUE_ADDRESS (v) = addr; ++ VALUE_LVAL (v) = lval_memory; ++ return v; ++ } + + case LOC_REGISTER: + case LOC_REGPARM: +@@ -530,7 +537,6 @@ addresses have not been bound by the dyn + error (_("Value of register variable not available.")); + + addr = value_as_address (regval); +- VALUE_LVAL (v) = lval_memory; + } + else + { +@@ -570,18 +576,33 @@ addresses have not been bound by the dyn + break; + + case LOC_OPTIMIZED_OUT: +- VALUE_LVAL (v) = not_lval; +- set_value_optimized_out (v, 1); +- return v; ++ { ++ struct value *v = allocate_value (type); ++ ++ VALUE_LVAL (v) = not_lval; ++ set_value_optimized_out (v, 1); ++ return v; ++ } + + default: + error (_("Cannot look up value of a botched symbol.")); + break; + } + +- VALUE_ADDRESS (v) = addr; +- set_value_lazy (v, 1); +- return v; ++ { ++ struct value *v; ++ ++ /* ADDR is set here for ALLOCATE_VALUE's CHECK_TYPEDEF for ++ DW_OP_PUSH_OBJECT_ADDRESS. */ ++ object_address_set (addr); ++ v = allocate_value (type); ++ VALUE_ADDRESS (v) = addr; ++ VALUE_LVAL (v) = lval_memory; ++ ++ set_value_lazy (v, 1); ++ ++ return v; ++ } + } + + /* Install default attributes for register values. */ +@@ -618,10 +639,11 @@ struct value * + value_from_register (struct type *type, int regnum, struct frame_info *frame) + { + struct gdbarch *gdbarch = get_frame_arch (frame); +- struct type *type1 = check_typedef (type); + struct value *v; + +- if (gdbarch_convert_register_p (gdbarch, regnum, type1)) ++ type = check_typedef (type); ++ ++ if (gdbarch_convert_register_p (gdbarch, regnum, type)) + { + /* The ISA/ABI need to something weird when obtaining the + specified value from this register. It might need to +@@ -635,7 +657,7 @@ value_from_register (struct type *type, + VALUE_FRAME_ID (v) = get_frame_id (frame); + VALUE_REGNUM (v) = regnum; + gdbarch_register_to_value (gdbarch, +- frame, regnum, type1, value_contents_raw (v)); ++ frame, regnum, type, value_contents_raw (v)); + } + else + { +--- ./gdb/gdbtypes.c 2008-10-29 21:22:30.000000000 +0100 ++++ ./gdb/gdbtypes.c 2008-11-01 20:20:42.000000000 +0100 +@@ -38,6 +38,8 @@ + #include "cp-abi.h" + #include "gdb_assert.h" + #include "hashtab.h" ++#include "dwarf2expr.h" ++#include "dwarf2loc.h" + + /* These variables point to the objects + representing the predefined C data types. */ +@@ -471,11 +473,13 @@ make_qualified_type (struct type *type, + struct type *ntype; + + ntype = type; +- do { +- if (TYPE_INSTANCE_FLAGS (ntype) == new_flags) +- return ntype; +- ntype = TYPE_CHAIN (ntype); +- } while (ntype != type); ++ do ++ { ++ if (TYPE_INSTANCE_FLAGS (ntype) == new_flags) ++ return ntype; ++ ntype = TYPE_CHAIN (ntype); ++ } ++ while (ntype != type); + + /* Create a new type instance. */ + if (storage == NULL) +@@ -682,16 +686,21 @@ allocate_stub_method (struct type *type) + RESULT_TYPE, or creating a new type, inheriting the objfile from + INDEX_TYPE. + +- Indices will be of type INDEX_TYPE, and will range from LOW_BOUND +- to HIGH_BOUND, inclusive. ++ Indices will be of type INDEX_TYPE. NFIELDS should be 2 for standard ++ arrays, 3 for custom TYPE_BYTE_STRIDE. Use CREATE_RANGE_TYPE for common ++ constant TYPE_LOW_BOUND/TYPE_HIGH_BOUND ranges instead. ++ ++ You must to decide TYPE_UNSIGNED yourself as being done in CREATE_RANGE_TYPE. + + FIXME: Maybe we should check the TYPE_CODE of RESULT_TYPE to make + sure it is TYPE_CODE_UNDEF before we bash it into a range type? */ + + struct type * +-create_range_type (struct type *result_type, struct type *index_type, +- int low_bound, int high_bound) ++create_range_type_nfields (struct type *result_type, struct type *index_type, ++ int nfields) + { ++ int fieldno; ++ + if (result_type == NULL) + { + result_type = alloc_type (TYPE_OBJFILE (index_type)); +@@ -702,17 +711,33 @@ create_range_type (struct type *result_t + TYPE_FLAGS (result_type) |= TYPE_FLAG_TARGET_STUB; + else + TYPE_LENGTH (result_type) = TYPE_LENGTH (check_typedef (index_type)); +- TYPE_NFIELDS (result_type) = 2; ++ TYPE_NFIELDS (result_type) = nfields; + TYPE_FIELDS (result_type) = (struct field *) +- TYPE_ALLOC (result_type, 2 * sizeof (struct field)); +- memset (TYPE_FIELDS (result_type), 0, 2 * sizeof (struct field)); +- TYPE_FIELD_BITPOS (result_type, 0) = low_bound; +- TYPE_FIELD_BITPOS (result_type, 1) = high_bound; ++ TYPE_ALLOC (result_type, ++ TYPE_NFIELDS (result_type) * sizeof (struct field)); ++ memset (TYPE_FIELDS (result_type), 0, ++ TYPE_NFIELDS (result_type) * sizeof (struct field)); ++ ++ return (result_type); ++} ++ ++/* Simplified CREATE_RANGE_TYPE_NFIELDS for constant ranges from LOW_BOUND to ++ HIGH_BOUND, inclusive. TYPE_BYTE_STRIDE is always set to zero (default ++ native target type length). */ ++ ++struct type * ++create_range_type (struct type *result_type, struct type *index_type, ++ int low_bound, int high_bound) ++{ ++ result_type = create_range_type_nfields (result_type, index_type, 2); ++ ++ TYPE_LOW_BOUND (result_type) = low_bound; ++ TYPE_HIGH_BOUND (result_type) = high_bound; + + if (low_bound >= 0) + TYPE_FLAGS (result_type) |= TYPE_FLAG_UNSIGNED; + +- return (result_type); ++ return result_type; + } + + /* Set *LOWP and *HIGHP to the lower and upper bounds of discrete type +@@ -726,6 +751,9 @@ get_discrete_bounds (struct type *type, + switch (TYPE_CODE (type)) + { + case TYPE_CODE_RANGE: ++ if (TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (type) ++ || TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (type)) ++ return -1; + *lowp = TYPE_LOW_BOUND (type); + *highp = TYPE_HIGH_BOUND (type); + return 1; +@@ -808,17 +836,6 @@ create_array_type (struct type *result_t + } + TYPE_CODE (result_type) = TYPE_CODE_ARRAY; + TYPE_TARGET_TYPE (result_type) = element_type; +- if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) +- low_bound = high_bound = 0; +- CHECK_TYPEDEF (element_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 +- TYPE_LENGTH (result_type) = +- TYPE_LENGTH (element_type) * (high_bound - low_bound + 1); + TYPE_NFIELDS (result_type) = 1; + TYPE_FIELDS (result_type) = + (struct field *) TYPE_ALLOC (result_type, sizeof (struct field)); +@@ -826,9 +843,48 @@ create_array_type (struct type *result_t + TYPE_FIELD_TYPE (result_type, 0) = range_type; + TYPE_VPTR_FIELDNO (result_type) = -1; + +- /* TYPE_FLAG_TARGET_STUB will take care of zero length arrays */ ++ /* DWARF blocks may depend on runtime information like ++ DW_OP_PUSH_OBJECT_ADDRESS not being available during the ++ CREATE_ARRAY_TYPE time. */ ++ if (TYPE_RANGE_BOUND_IS_DWARF_BLOCK (range_type, 0) ++ || TYPE_RANGE_BOUND_IS_DWARF_BLOCK (range_type, 1) ++ || TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (range_type) ++ || TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (range_type) ++ || get_discrete_bounds (range_type, &low_bound, &high_bound) < 0) ++ { ++ low_bound = 0; ++ high_bound = -1; ++ } ++ ++ /* 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. TYPE_TARGET_STUB needs to ++ be checked as it may have dependencies on DWARF blocks depending on ++ runtime information not available during the CREATE_ARRAY_TYPE time. */ ++ if (high_bound < low_bound || TYPE_TARGET_STUB (element_type)) ++ TYPE_LENGTH (result_type) = 0; ++ else ++ { ++ CHECK_TYPEDEF (element_type); ++ TYPE_LENGTH (result_type) = ++ TYPE_LENGTH (element_type) * (high_bound - low_bound + 1); ++ } ++ ++ if (TYPE_DYNAMIC (range_type)) ++ TYPE_FLAGS (result_type) |= TYPE_FLAG_DYNAMIC; ++ ++ /* Multidimensional dynamic arrays need to have all the outer dimensions ++ dynamic to update the outer TYPE_TARGET_TYPE pointer with the new type ++ with statically evaluated dimensions. */ ++ if (TYPE_DYNAMIC (element_type)) ++ TYPE_FLAGS (result_type) |= TYPE_FLAG_DYNAMIC; ++ + if (TYPE_LENGTH (result_type) == 0) +- TYPE_FLAGS (result_type) |= TYPE_FLAG_TARGET_STUB; ++ { ++ /* The real size will be computed for specific instances by ++ CHECK_TYPEDEF. */ ++ TYPE_FLAGS (result_type) |= TYPE_FLAG_TARGET_STUB; ++ } + + return (result_type); + } +@@ -1377,6 +1433,65 @@ stub_noname_complaint (void) + complaint (&symfile_complaints, _("stub type has NULL name")); + } + ++/* Calculate the memory length of array TYPE. ++ ++ TARGET_TYPE should be set to `check_typedef (TYPE_TARGET_TYPE (type))' as ++ a performance hint. Feel free to pass NULL. Set FULL_SPAN to return the ++ size incl. the possible padding of the last element - it may differ from the ++ cleared FULL_SPAN return value (the expected SIZEOF) for non-zero ++ TYPE_BYTE_STRIDE values. */ ++ ++static CORE_ADDR ++type_length_get (struct type *type, struct type *target_type, int full_span) ++{ ++ struct type *range_type; ++ int count; ++ CORE_ADDR byte_stride = 0; /* `= 0' for a false GCC warning. */ ++ CORE_ADDR element_size; ++ ++ if (TYPE_CODE (type) != TYPE_CODE_ARRAY ++ && TYPE_CODE (type) != TYPE_CODE_STRING) ++ return TYPE_LENGTH (type); ++ ++ /* Avoid executing TYPE_HIGH_BOUND for invalid (unallocated/unassociated) ++ Fortran arrays. The allocated data will never be used so they can be ++ zero-length. */ ++ if (object_address_data_not_valid (type)) ++ return 0; ++ ++ range_type = TYPE_INDEX_TYPE (type); ++ if (TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (range_type) ++ || TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (range_type)) ++ return 0; ++ count = TYPE_HIGH_BOUND (range_type) - TYPE_LOW_BOUND (range_type) + 1; ++ /* It may happen for wrong DWARF annotations returning garbage data. */ ++ if (count < 0) ++ warning (_("Range for type %s has invalid bounds %d..%d"), ++ TYPE_NAME (type), TYPE_LOW_BOUND (range_type), ++ TYPE_HIGH_BOUND (range_type)); ++ /* The code below does not handle count == 0 right. */ ++ if (count <= 0) ++ return 0; ++ if (full_span || count > 1) ++ { ++ /* We do not use TYPE_ARRAY_BYTE_STRIDE_VALUE (type) here as we want to ++ force FULL_SPAN to 1. */ ++ byte_stride = TYPE_BYTE_STRIDE (range_type); ++ if (byte_stride == 0) ++ { ++ if (target_type == NULL) ++ target_type = check_typedef (TYPE_TARGET_TYPE (type)); ++ byte_stride = type_length_get (target_type, NULL, 1); ++ } ++ } ++ if (full_span) ++ return count * byte_stride; ++ if (target_type == NULL) ++ target_type = check_typedef (TYPE_TARGET_TYPE (type)); ++ element_size = type_length_get (target_type, NULL, 1); ++ return (count - 1) * byte_stride + element_size; ++} ++ + /* Added by Bryan Boreham, Kewill, Sun Sep 17 18:07:17 1989. + + If this is a stubbed struct (i.e. declared as struct foo *), see if +@@ -1393,7 +1508,8 @@ stub_noname_complaint (void) + /* Find the real type of TYPE. This function returns the real type, + after removing all layers of typedefs and completing opaque or stub + types. Completion changes the TYPE argument, but stripping of +- typedefs does not. */ ++ typedefs does not. Still original passed TYPE will have TYPE_LENGTH ++ updated. FIXME: Remove this dependency (only ada_to_fixed_type?). */ + + struct type * + check_typedef (struct type *type) +@@ -1505,34 +1621,85 @@ check_typedef (struct type *type) + } + } + +- if (TYPE_TARGET_STUB (type)) ++ if (TYPE_DYNAMIC (type) || (TYPE_CODE (type) == TYPE_CODE_RANGE ++ && TYPE_RANGE_HIGH_BOUND_IS_COUNT (type))) ++ { ++ struct type *ntype; ++ ++ /* make_cv_type does not copy the contents of TYPE_MAIN_TYPE while we are ++ changing fields in it below. Do a full TYPE_MAIN_TYPE copy. */ ++ ++ ntype = alloc_type (TYPE_OBJFILE (type)); ++ *TYPE_MAIN_TYPE (ntype) = *TYPE_MAIN_TYPE (type); ++ if (TYPE_NFIELDS (type)) ++ { ++ size_t size = sizeof (*TYPE_FIELDS (type)) * TYPE_NFIELDS (type); ++ ++ if (TYPE_OBJFILE (type)) ++ TYPE_FIELDS (ntype) = obstack_alloc ++ (&TYPE_OBJFILE (type)->objfile_obstack, size); ++ else ++ TYPE_FIELDS (ntype) = xzalloc (size); ++ memcpy (TYPE_FIELDS (ntype), TYPE_FIELDS (type), size); ++ } ++ TYPE_INSTANCE_FLAGS (ntype) = TYPE_INSTANCE_FLAGS (type); ++ type = ntype; ++ ++ if (TYPE_CODE (type) == TYPE_CODE_ARRAY ++ || TYPE_CODE (type) == TYPE_CODE_STRING) ++ { ++ struct type *range_type; ++ ++ gdb_assert (TYPE_NFIELDS (type) == 1); ++ range_type = TYPE_INDEX_TYPE (type); ++ gdb_assert (TYPE_CODE (range_type) == TYPE_CODE_RANGE); ++ TYPE_INDEX_TYPE (type) = check_typedef (range_type); ++ } ++ else if (TYPE_CODE (type) == TYPE_CODE_RANGE) ++ { ++ int fieldno; ++ ++ /* Evaluate the DWARF ranges and set them statically. */ ++ for (fieldno = 0; fieldno < TYPE_NFIELDS (type); fieldno++) ++ if (TYPE_RANGE_BOUND_IS_DWARF_BLOCK (type, fieldno)) ++ { ++ struct dwarf2_locexpr_baton *dlbaton; ++ CORE_ADDR val; ++ ++ dlbaton = TYPE_FIELD_DWARF_BLOCK (type, fieldno); ++ val = dwarf_locexpr_baton_eval (dlbaton); ++ TYPE_RANGE_BOUND_UNSET_DWARF_BLOCK (type, fieldno); ++ TYPE_FIELD_BITPOS (type, fieldno) = val; ++ } ++ ++ /* Convert TYPE_RANGE_HIGH_BOUND_IS_COUNT-modified TYPE_HIGH_BOUND ++ meanint the count (not the high bound) into a regular bound. */ ++ if (TYPE_RANGE_HIGH_BOUND_IS_COUNT (type)) ++ { ++ TYPE_FLAGS (type) &= ~TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT; ++ TYPE_HIGH_BOUND (type) = TYPE_LOW_BOUND (type) ++ + TYPE_HIGH_BOUND (type) - 1; ++ } ++ } ++ } ++ ++ if (!currently_reading_symtab ++ && (TYPE_TARGET_STUB (type) || TYPE_DYNAMIC (type))) + { +- struct type *range_type; + struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type)); + ++ if (TYPE_DYNAMIC (type)) ++ TYPE_TARGET_TYPE (type) = target_type; + if (TYPE_STUB (target_type) || TYPE_TARGET_STUB (target_type)) + { + /* Empty. */ + } + else if (TYPE_CODE (type) == TYPE_CODE_ARRAY +- && TYPE_NFIELDS (type) == 1 +- && (TYPE_CODE (range_type = TYPE_FIELD_TYPE (type, 0)) +- == TYPE_CODE_RANGE)) ++ || TYPE_CODE (type) == TYPE_CODE_STRING) + { + /* Now recompute the length of the array type, based on its +- number of elements and the target type's length. +- Watch out for Ada null Ada arrays where the high bound +- is smaller than the low bound. */ +- const int low_bound = TYPE_FIELD_BITPOS (range_type, 0); +- const int high_bound = TYPE_FIELD_BITPOS (range_type, 1); +- int nb_elements; +- +- if (high_bound < low_bound) +- nb_elements = 0; +- else +- nb_elements = high_bound - low_bound + 1; +- +- TYPE_LENGTH (type) = nb_elements * TYPE_LENGTH (target_type); ++ number of elements and the target type's length. */ ++ TYPE_LENGTH (type) = type_length_get (type, target_type, 0); + TYPE_FLAGS (type) &= ~TYPE_FLAG_TARGET_STUB; + } + else if (TYPE_CODE (type) == TYPE_CODE_RANGE) +@@ -1540,9 +1707,12 @@ check_typedef (struct type *type) + TYPE_LENGTH (type) = TYPE_LENGTH (target_type); + TYPE_FLAGS (type) &= ~TYPE_FLAG_TARGET_STUB; + } ++ TYPE_FLAGS (type) &= ~TYPE_FLAG_DYNAMIC; + } ++ + /* Cache TYPE_LENGTH for future use. */ + TYPE_LENGTH (orig_type) = TYPE_LENGTH (type); ++ + return type; + } + +--- ./gdb/gdbtypes.h 2008-10-29 20:56:57.000000000 +0100 ++++ ./gdb/gdbtypes.h 2008-11-02 11:01:18.000000000 +0100 +@@ -310,6 +310,16 @@ enum type_code + #define TYPE_FLAG_NOTTEXT (1 << 17) + #define TYPE_NOTTEXT(t) (TYPE_FLAGS (t) & TYPE_FLAG_NOTTEXT) + ++/* Type needs to be evaluated on each CHECK_TYPEDEF and its results must not be ++ sticky. Used for TYPE_RANGE_BOUND_IS_DWARF_BLOCK. */ ++ ++#define TYPE_FLAG_DYNAMIC (1 << 18) ++#define TYPE_DYNAMIC(t) (TYPE_FLAGS (t) & TYPE_FLAG_DYNAMIC) ++ ++/* Is HIGH_BOUND a low-bound relative count (1) or the high bound itself (0)? */ ++#define TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT (1 << 19) ++#define TYPE_RANGE_HIGH_BOUND_IS_COUNT(t) (TYPE_FLAGS (t) & TYPE_FLAG_RANGE_HIGH_BOUND_IS_COUNT) ++ + /* Determine which field of the union main_type.fields[x].loc is used. */ + + enum field_loc_kind +@@ -391,6 +401,15 @@ struct main_type + + short vptr_fieldno; + ++ /* For DW_AT_data_location. FIXME: Support also its constant form. */ ++ struct dwarf2_locexpr_baton *data_location; ++ ++ /* For DW_AT_allocated. FIXME: Support also its constant form. */ ++ struct dwarf2_locexpr_baton *allocated; ++ ++ /* For DW_AT_associated. FIXME: Support also its constant form. */ ++ struct dwarf2_locexpr_baton *associated; ++ + /* For structure and union types, a description of each field. + For set and pascal array types, there is one "field", + whose type is the domain type of the set or array. +@@ -778,9 +797,9 @@ extern void allocate_cplus_struct_type ( + #define TYPE_POINTER_TYPE(thistype) (thistype)->pointer_type + #define TYPE_REFERENCE_TYPE(thistype) (thistype)->reference_type + #define TYPE_CHAIN(thistype) (thistype)->chain +-/* Note that if thistype is a TYPEDEF type, you have to call check_typedef. +- But check_typedef does set the TYPE_LENGTH of the TYPEDEF type, +- so you only have to call check_typedef once. Since allocate_value ++/* Note that if thistype is a TYPEDEF, ARRAY or STRING type, you have to call ++ check_typedef. But check_typedef does set the TYPE_LENGTH of the TYPEDEF ++ type, so you only have to call check_typedef once. Since allocate_value + calls check_typedef, TYPE_LENGTH (VALUE_TYPE (X)) is safe. */ + #define TYPE_LENGTH(thistype) (thistype)->length + #define TYPE_OBJFILE(thistype) TYPE_MAIN_TYPE(thistype)->objfile +@@ -792,23 +811,49 @@ extern void allocate_cplus_struct_type ( + #define TYPE_FIELDS(thistype) TYPE_MAIN_TYPE(thistype)->fields + #define TYPE_TEMPLATE_ARGS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->template_args + #define TYPE_INSTANTIATIONS(thistype) TYPE_CPLUS_SPECIFIC(thistype)->instantiations ++#define TYPE_DATA_LOCATION(thistype) TYPE_MAIN_TYPE (thistype)->data_location ++#define TYPE_ALLOCATED(thistype) TYPE_MAIN_TYPE (thistype)->allocated ++#define TYPE_ASSOCIATED(thistype) TYPE_MAIN_TYPE (thistype)->associated + + #define TYPE_INDEX_TYPE(type) TYPE_FIELD_TYPE (type, 0) ++/* `TYPE_NFIELDS (range_type) >= 3' check is required before accessing it: */ ++#define SET_TYPE_BYTE_STRIDE(range_type, n) \ ++ (TYPE_FIELD_BITPOS (range_type, 2) = (n)) + #define TYPE_LOW_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 0) + #define TYPE_HIGH_BOUND(range_type) TYPE_FIELD_BITPOS (range_type, 1) ++#define TYPE_BYTE_STRIDE(range_type) \ ++ (TYPE_NFIELDS (range_type) < 3 ? 0 : TYPE_FIELD_BITPOS (range_type, 2)) + +-/* Moto-specific stuff for FORTRAN arrays */ +- +-#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \ +- (TYPE_FIELD_ARTIFICIAL((TYPE_FIELD_TYPE((arraytype),0)),1)) ++/* Whether we should use TYPE_FIELD_DWARF_BLOCK (and not TYPE_FIELD_BITPOS). */ ++#define TYPE_RANGE_BOUND_IS_DWARF_BLOCK(range_type, fieldno) \ ++ (TYPE_FIELD_LOC_KIND (range_type, fieldno) == FIELD_LOC_KIND_DWARF_BLOCK) ++#define TYPE_RANGE_BOUND_SET_DWARF_BLOCK(range_type, fieldno) \ ++ (TYPE_FIELD_LOC_KIND (range_type, fieldno) = FIELD_LOC_KIND_DWARF_BLOCK) ++#define TYPE_RANGE_BOUND_UNSET_DWARF_BLOCK(range_type, fieldno) \ ++ (TYPE_FIELD_LOC_KIND (range_type, fieldno) = FIELD_LOC_KIND_BITPOS) ++#define TYPE_ARRAY_BOUND_IS_DWARF_BLOCK(array_type, fieldno) \ ++ TYPE_RANGE_BOUND_IS_DWARF_BLOCK (TYPE_INDEX_TYPE (array_type), fieldno) ++ ++/* Unbound arrays, such as GCC array[]; at end of struct. */ ++#define TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED(rangetype) \ ++ TYPE_FIELD_ARTIFICIAL((rangetype),0) ++#define TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED(rangetype) \ ++ TYPE_FIELD_ARTIFICIAL((rangetype),1) + #define TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED(arraytype) \ +- (TYPE_FIELD_ARTIFICIAL((TYPE_FIELD_TYPE((arraytype),0)),0)) +- +-#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ +- (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),1)) ++ TYPE_RANGE_LOWER_BOUND_IS_UNDEFINED (TYPE_INDEX_TYPE (arraytype)) ++#define TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED(arraytype) \ ++ TYPE_RANGE_UPPER_BOUND_IS_UNDEFINED (TYPE_INDEX_TYPE (arraytype)) + + #define TYPE_ARRAY_LOWER_BOUND_VALUE(arraytype) \ +- (TYPE_FIELD_BITPOS((TYPE_FIELD_TYPE((arraytype),0)),0)) ++ TYPE_LOW_BOUND (TYPE_INDEX_TYPE (arraytype)) ++#define TYPE_ARRAY_UPPER_BOUND_VALUE(arraytype) \ ++ TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (arraytype)) ++/* TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (arraytype)) with a fallback to the ++ element size if no specific stride value is known. */ ++#define TYPE_ARRAY_BYTE_STRIDE_VALUE(arraytype) \ ++ (TYPE_NFIELDS (TYPE_INDEX_TYPE (arraytype)) < 2 \ ++ ? TYPE_LENGTH (TYPE_TARGET_TYPE (arraytype)) \ ++ : TYPE_BYTE_STRIDE (TYPE_INDEX_TYPE (arraytype))) + + /* C++ */ + +@@ -1271,12 +1316,26 @@ extern struct type *make_function_type ( + + extern struct type *lookup_function_type (struct type *); + ++extern struct type *create_range_type_nfields (struct type *result_type, ++ struct type *index_type, ++ int nfields); ++ + extern struct type *create_range_type (struct type *, struct type *, int, + int); + + extern struct type *create_array_type (struct type *, struct type *, + struct type *); + ++extern CORE_ADDR type_range_any_field_internal (struct type *range_type, ++ int fieldno); ++ ++extern int type_range_high_bound_internal (struct type *range_type); ++ ++extern int type_range_count_bound_internal (struct type *range_type); ++ ++extern CORE_ADDR type_range_byte_stride_internal (struct type *range_type, ++ struct type *element_type); ++ + extern struct type *create_string_type (struct type *, struct type *); + + extern struct type *create_set_type (struct type *, struct type *); +--- ./gdb/printcmd.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/printcmd.c 2008-10-29 21:32:14.000000000 +0100 +@@ -888,6 +888,11 @@ print_command_1 (char *exp, int inspect, + else + val = access_value_history (0); + ++ /* Do not try to OBJECT_ADDRESS_SET here anything. We are interested in the ++ source variable base addresses as found by READ_VAR_VALUE. The value here ++ can be already a calculated expression address inappropriate for ++ DW_OP_push_object_address. */ ++ + if (voidprint || (val && value_type (val) && + TYPE_CODE (value_type (val)) != TYPE_CODE_VOID)) + { +--- ./gdb/testsuite/gdb.base/vla-overflow.c 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.base/vla-overflow.c 2008-11-01 17:18:12.000000000 +0100 +@@ -0,0 +1,30 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2008 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++#include ++ ++int ++main (int argc, char **argv) ++{ ++ int array[argc]; ++ ++ array[0] = array[0]; ++ ++ abort (); ++ ++ return 0; ++} +--- ./gdb/testsuite/gdb.base/vla-overflow.exp 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.base/vla-overflow.exp 2008-11-01 17:42:32.000000000 +0100 +@@ -0,0 +1,108 @@ ++# Copyright 2008 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++# We could crash in: ++# #0 block_linkage_function (bl=0x0) at ../../gdb/block.c:69 ++# #1 in dwarf_block_get_frame_base (...) at ../../gdb/dwarf2block.c:97 ++# 97 framefunc = block_linkage_function (get_frame_block (frame, NULL)); ++# #2 in execute_stack_op (...) at ../../gdb/dwarf2expr.c:496 ++# #3 in dwarf_block_exec_core () at ../../gdb/dwarf2block.c:156 ++# #4 dwarf_block_exec (...) at ../../gdb/dwarf2block.c:206 ++# #5 in range_type_count_bound_internal (...) at ../../gdb/gdbtypes.c:1430 ++# #6 in create_array_type (...) at ../../gdb/gdbtypes.c:840 ++# ... ++# #21 in psymtab_to_symtab (...) at ../../gdb/symfile.c:292 ++# ... ++# #29 in backtrace_command_1 () at ../../gdb/stack.c:1273 ++ ++set testfile vla-overflow ++set shfile ${objdir}/${subdir}/${testfile}-gdb.sh ++set srcfile ${testfile}.c ++set binfile ${objdir}/${subdir}/${testfile} ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } { ++ untested "Couldn't compile test program" ++ return -1 ++} ++ ++set f [open "|getconf PAGESIZE" "r"] ++gets $f pagesize ++close $f ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++set pid_of_gdb [exp_pid -i [board_info host fileid]] ++ ++if { [runto_main] < 0 } { ++ untested vla-overflow ++ return -1 ++} ++ ++# Get the GDB memory size when we stay at main. ++ ++proc memory_v_pages_get {} { ++ global pid_of_gdb pagesize ++ set fd [open "/proc/$pid_of_gdb/statm"] ++ gets $fd line ++ close $fd ++ # number of pages of virtual memory ++ scan $line "%d" drs ++ return $drs ++} ++ ++set pages_found [memory_v_pages_get] ++ ++set mb_reserve 10 ++verbose -log "pages_found = $pages_found, mb_reserve = $mb_reserve" ++set kb_found [expr $pages_found * $pagesize / 1024] ++set kb_permit [expr $kb_found + 1 * 1024 + $mb_reserve * 1024] ++verbose -log "kb_found = $kb_found, kb_permit = $kb_permit" ++ ++# Create the ulimit wrapper. ++set f [open $shfile "w"] ++puts $f "#! /bin/sh" ++puts $f "ulimit -v $kb_permit" ++puts $f "exec $GDB \"\$@\"" ++close $f ++remote_exec host "chmod +x $shfile" ++ ++gdb_exit ++set GDBold $GDB ++set GDB "$shfile" ++gdb_start ++set GDB $GDBold ++ ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++set pid_of_gdb [exp_pid -i [board_info host fileid]] ++ ++# Check the size again after the second run. ++# We must not stop in main as it would cache `array' and never crash later. ++ ++gdb_run_cmd ++ ++verbose -log "kb_found before abort() = [expr [memory_v_pages_get] * $pagesize / 1024]" ++ ++gdb_test "" "Program received signal SIGABRT, Aborted..*" "Enter abort()" ++ ++verbose -log "kb_found in abort() = [expr [memory_v_pages_get] * $pagesize / 1024]" ++ ++# `abort' can get expressed as `*__GI_abort'. ++gdb_test "bt" "in \[^ \]*abort \\(.* in main \\(.*" "Backter after abort()" ++ ++verbose -log "kb_found in bt after abort() = [expr [memory_v_pages_get] * $pagesize / 1024]" +--- ./gdb/testsuite/gdb.base/vla.c 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.base/vla.c 2008-10-29 21:32:14.000000000 +0100 +@@ -0,0 +1,55 @@ ++/* This testcase is part of GDB, the GNU debugger. ++ ++ Copyright 2008 Free Software Foundation, Inc. ++ ++ This program is free software; you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see . */ ++ ++#include ++ ++void ++marker (void) ++{ ++} ++ ++void ++bar (char *a, char *b, char *c, int size) ++{ ++ memset (a, '1', size); ++ memset (b, '2', size); ++ memset (c, '3', 48); ++} ++ ++void ++foo (int size) ++{ ++ char temp1[size]; ++ char temp3[48]; ++ ++ temp1[size - 1] = '\0'; ++ { ++ char temp2[size]; ++ ++ bar (temp1, temp2, temp3, size); ++ ++ marker (); /* break-here */ ++ } ++} ++ ++int ++main (void) ++{ ++ foo (26); ++ foo (78); ++ return 0; ++} +--- ./gdb/testsuite/gdb.base/vla.exp 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.base/vla.exp 2008-10-29 21:32:14.000000000 +0100 +@@ -0,0 +1,62 @@ ++# Copyright 2008 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 3 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program. If not, see . ++ ++set testfile vla ++set srcfile ${testfile}.c ++set binfile ${objdir}/${subdir}/${testfile} ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } { ++ untested "Couldn't compile test program" ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++if ![runto_main] { ++ untested vla ++ return -1 ++} ++ ++gdb_breakpoint [gdb_get_line_number "break-here"] ++ ++gdb_continue_to_breakpoint "break-here" ++ ++gdb_test "whatis temp1" "type = char \\\[variable\\\]" "first: whatis temp1" ++gdb_test "whatis temp2" "type = char \\\[variable\\\]" "first: whatis temp2" ++gdb_test "whatis temp3" "type = char \\\[48\\\]" "first: whatis temp3" ++ ++gdb_test "ptype temp1" "type = char \\\[26\\\]" "first: ptype temp1" ++gdb_test "ptype temp2" "type = char \\\[26\\\]" "first: ptype temp2" ++gdb_test "ptype temp3" "type = char \\\[48\\\]" "first: ptype temp3" ++ ++gdb_test "p temp1" " = '1' " "first: print temp1" ++gdb_test "p temp2" " = '2' " "first: print temp2" ++gdb_test "p temp3" " = '3' " "first: print temp3" ++ ++gdb_continue_to_breakpoint "break-here" ++ ++gdb_test "whatis temp1" "type = char \\\[variable\\\]" "second: whatis temp1" ++gdb_test "whatis temp2" "type = char \\\[variable\\\]" "second: whatis temp2" ++gdb_test "whatis temp3" "type = char \\\[48\\\]" "second: whatis temp3" ++ ++gdb_test "ptype temp1" "type = char \\\[78\\\]" "second: ptype temp1" ++gdb_test "ptype temp2" "type = char \\\[78\\\]" "second: ptype temp2" ++gdb_test "ptype temp3" "type = char \\\[48\\\]" "second: ptype temp3" ++ ++gdb_test "p temp1" " = '1' " "second: print temp1" ++gdb_test "p temp2" " = '2' " "second: print temp2" ++gdb_test "p temp3" " = '3' " "second: print temp3" +--- ./gdb/testsuite/gdb.fortran/dynamic.exp 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/dynamic.exp 2008-10-29 21:32:14.000000000 +0100 +@@ -0,0 +1,141 @@ ++# Copyright 2007 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++# This file was written by Jan Kratochvil . ++ ++# This file is part of the gdb testsuite. It contains tests for dynamically ++# allocated Fortran arrays. ++# It depends on the GCC dynamic Fortran arrays DWARF support: ++# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=22244 ++ ++set testfile "dynamic" ++set srcfile ${testfile}.f90 ++set binfile ${objdir}/${subdir}/${testfile} ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } { ++ untested "Couldn't compile ${srcfile}" ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "varx-init"] ++gdb_continue_to_breakpoint "varx-init" ++gdb_test "p varx" "\\$\[0-9\]* = <(object|the array) is not allocated>" "p varx unallocated" ++gdb_test "ptype varx" "type = <(object|the array) is not allocated>" "ptype varx unallocated" ++gdb_test "p varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "p varx(1,5,17) unallocated" ++gdb_test "p varx(1,5,17)=1" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "p varx(1,5,17)=1 unallocated" ++gdb_test "ptype varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "ptype varx(1,5,17) unallocated" ++ ++gdb_breakpoint [gdb_get_line_number "varx-allocated"] ++gdb_continue_to_breakpoint "varx-allocated" ++# $1 = (( ( 0, 0, 0, 0, 0, 0) ( 0, 0, 0, 0, 0, 0) --- , 0) ) ( ( 0, 0, ...) ...) ...) ++gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx allocated" ++# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1. ++gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varx allocated" ++ ++gdb_breakpoint [gdb_get_line_number "varx-filled"] ++gdb_continue_to_breakpoint "varx-filled" ++gdb_test "p varx(2, 5, 17)" "\\$\[0-9\]* = 6" ++gdb_test "p varx(1, 5, 17)" "\\$\[0-9\]* = 7" ++gdb_test "p varx(2, 6, 18)" "\\$\[0-9\]* = 8" ++gdb_test "p varx(6, 15, 28)" "\\$\[0-9\]* = 9" ++# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type. ++gdb_test "p varv" "\\$\[0-9\]* = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "p varv unassociated" ++gdb_test "ptype varv" "type = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "ptype varv unassociated" ++ ++gdb_breakpoint [gdb_get_line_number "varv-associated"] ++gdb_continue_to_breakpoint "varv-associated" ++gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 6" "p varx(3, 7, 19) with varv associated" ++gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 6" "p varv(3, 7, 19) associated" ++# Intel Fortran Compiler 10.1.008 uses -1 there, GCC uses 1. ++gdb_test "p l" "\\$\[0-9\]* = (\\.TRUE\\.|4294967295)" "p l if varv associated" ++gdb_test "ptype varx" "type = real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)" "ptype varx with varv associated" ++# Intel Fortran Compiler 10.1.008 uses the pointer type. ++gdb_test "ptype varv" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(6,5:15,17:28\\)\\)?" "ptype varv associated" ++ ++gdb_breakpoint [gdb_get_line_number "varv-filled"] ++gdb_continue_to_breakpoint "varv-filled" ++gdb_test "p varx(3, 7, 19)" "\\$\[0-9\]* = 10" "p varx(3, 7, 19) with varv filled" ++gdb_test "p varv(3, 7, 19)" "\\$\[0-9\]* = 10" "p varv(3, 7, 19) filled" ++ ++gdb_breakpoint [gdb_get_line_number "varv-deassociated"] ++gdb_continue_to_breakpoint "varv-deassociated" ++# The latter one is for the Intel Fortran Compiler 10.1.008 pointer type. ++gdb_test "p varv" "\\$\[0-9\]* = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "p varv deassociated" ++gdb_test "ptype varv" "type = (<(object|the array) is not associated>|.*(Cannot access it|Unable to access the object) because the object is not associated.)" "ptype varv deassociated" ++gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varv deassociated" ++gdb_test "p varv(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not associated\\." ++gdb_test "ptype varv(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not associated\\." ++ ++gdb_breakpoint [gdb_get_line_number "varx-deallocated"] ++gdb_continue_to_breakpoint "varx-deallocated" ++gdb_test "p varx" "\\$\[0-9\]* = <(object|the array) is not allocated>" "p varx deallocated" ++gdb_test "ptype varx" "type = <(object|the array) is not allocated>" "ptype varx deallocated" ++gdb_test "p l" "\\$\[0-9\]* = \\.FALSE\\." "p l if varx deallocated" ++gdb_test "p varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "p varx(1,5,17) deallocated" ++gdb_test "ptype varx(1,5,17)" "(Cannot access it|Unable to access the object) because the (object|array) is not allocated\\." "ptype varx(1,5,17) deallocated" ++ ++gdb_breakpoint [gdb_get_line_number "vary-passed"] ++gdb_continue_to_breakpoint "vary-passed" ++# $1 = (( ( 1, 1, 1, 1, 1, 1) ( 1, 1, 1, 1, 1, 1) --- , 1) ) ( ( 1, 1, ...) ...) ...) ++gdb_test "p vary" "\\$\[0-9\]* = \\(\[()1, .\]*\\)" ++ ++gdb_breakpoint [gdb_get_line_number "vary-filled"] ++gdb_continue_to_breakpoint "vary-filled" ++gdb_test "ptype vary" "type = real(\\(kind=4\\)|\\*4) \\(10,10\\)" ++gdb_test "p vary(1, 1)" "\\$\[0-9\]* = 8" ++gdb_test "p vary(2, 2)" "\\$\[0-9\]* = 9" ++gdb_test "p vary(1, 3)" "\\$\[0-9\]* = 10" ++# $1 = (( ( 3, 3, 3, 3, 3, 3) ( 3, 3, 3, 3, 3, 3) --- , 3) ) ( ( 3, 3, ...) ...) ...) ++gdb_test "p varw" "\\$\[0-9\]* = \\(\[()3, .\]*\\)" ++ ++gdb_breakpoint [gdb_get_line_number "varw-almostfilled"] ++gdb_continue_to_breakpoint "varw-almostfilled" ++gdb_test "ptype varw" "type = real(\\(kind=4\\)|\\*4) \\(5,4,3\\)" ++gdb_test "p varw(3,1,1)=1" "\\$\[0-9\]* = 1" ++# $1 = (( ( 6, 5, 1, 5, 5, 5) ( 5, 5, 5, 5, 5, 5) --- , 5) ) ( ( 5, 5, ...) ...) ...) ++gdb_test "p varw" "\\$\[0-9\]* = \\( *\\( *\\( *6, *5, *1,\[()5, .\]*\\)" "p varw filled" ++# "up" works with GCC but other Fortran compilers may copy the values into the ++# outer function only on the exit of the inner function. ++gdb_test "finish" ".*call bar \\(y, x\\)" ++gdb_test "p z(2,4,5)" "\\$\[0-9\]* = 3" ++gdb_test "p z(2,4,6)" "\\$\[0-9\]* = 6" ++gdb_test "p z(2,4,7)" "\\$\[0-9\]* = 5" ++gdb_test "p z(4,4,6)" "\\$\[0-9\]* = 1" ++ ++gdb_breakpoint [gdb_get_line_number "varz-almostfilled"] ++gdb_continue_to_breakpoint "varz-almostfilled" ++# GCC uses the pointer type here, Intel Fortran Compiler 10.1.008 does not. ++gdb_test "ptype varz" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(\\*\\)\\)?" ++# Intel Fortran Compiler 10.1.008 has a bug here - (2:11,7:7) ++# as it produces DW_AT_lower_bound == DW_AT_upper_bound == 7. ++gdb_test "ptype vart" "type = (PTR TO -> \\( )?real(\\(kind=4\\)|\\*4) \\(2:11,7:\\*\\)\\)?" ++gdb_test "p varz(3)" "\\$\[0-9\]* = 4" ++# maps to foo::vary(1,1) ++gdb_test "p vart(2,7)" "\\$\[0-9\]* = 8" ++# maps to foo::vary(2,2) ++gdb_test "p vart(3,8)" "\\$\[0-9\]* = 9" ++# maps to foo::vary(1,3) ++gdb_test "p vart(2,9)" "\\$\[0-9\]* = 10" +--- ./gdb/testsuite/gdb.fortran/dynamic.f90 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/dynamic.f90 2008-10-29 21:32:14.000000000 +0100 +@@ -0,0 +1,97 @@ ++! Copyright 2007 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine baz ++ real, target, allocatable :: varx (:, :, :) ++ real, pointer :: varv (:, :, :) ++ real, target :: varu (1, 2, 3) ++ logical :: l ++ allocate (varx (1:6, 5:15, 17:28)) ! varx-init ++ l = allocated (varx) ++ varx(:, :, :) = 6 ! varx-allocated ++ varx(1, 5, 17) = 7 ++ varx(2, 6, 18) = 8 ++ varx(6, 15, 28) = 9 ++ varv => varx ! varx-filled ++ l = associated (varv) ++ varv(3, 7, 19) = 10 ! varv-associated ++ varv => null () ! varv-filled ++ l = associated (varv) ++ deallocate (varx) ! varv-deassociated ++ l = allocated (varx) ++ varu(:, :, :) = 10 ! varx-deallocated ++ allocate (varv (1:6, 5:15, 17:28)) ++ l = associated (varv) ++ varv(:, :, :) = 6 ++ varv(1, 5, 17) = 7 ++ varv(2, 6, 18) = 8 ++ varv(6, 15, 28) = 9 ++ deallocate (varv) ++ l = associated (varv) ++ varv => varu ++ varv(1, 1, 1) = 6 ++ varv(1, 2, 3) = 7 ++ l = associated (varv) ++end subroutine baz ++subroutine foo (vary, varw) ++ real :: vary (:, :) ++ real :: varw (:, :, :) ++ vary(:, :) = 4 ! vary-passed ++ vary(1, 1) = 8 ++ vary(2, 2) = 9 ++ vary(1, 3) = 10 ++ varw(:, :, :) = 5 ! vary-filled ++ varw(1, 1, 1) = 6 ++ varw(2, 2, 2) = 7 ! varw-almostfilled ++end subroutine foo ++subroutine bar (varz, vart) ++ real :: varz (*) ++ real :: vart (2:11, 7:*) ++ varz(1:3) = 4 ++ varz(2) = 5 ! varz-almostfilled ++end subroutine bar ++program test ++ interface ++ subroutine foo (vary, varw) ++ real :: vary (:, :) ++ real :: varw (:, :, :) ++ end subroutine ++ end interface ++ interface ++ subroutine bar (varz, vart) ++ real :: varz (*) ++ real :: vart (2:11, 7:*) ++ end subroutine ++ end interface ++ real :: x (10, 10), y (5), z(8, 8, 8) ++ x(:,:) = 1 ++ y(:) = 2 ++ z(:,:,:) = 3 ++ call baz ++ call foo (x, z(2:6, 4:7, 6:8)) ++ call bar (y, x) ++ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort ++ if (x (1, 3) .ne. 10) call abort ++ if (z (2, 4, 6) .ne. 6 .or. z (3, 5, 7) .ne. 7 .or. z (2, 4, 7) .ne. 5) call abort ++ if (any (y .ne. (/4, 5, 4, 2, 2/))) call abort ++ call foo (transpose (x), z) ++ if (x (1, 1) .ne. 8 .or. x (2, 2) .ne. 9 .or. x (1, 2) .ne. 4) call abort ++ if (x (3, 1) .ne. 10) call abort ++end +--- ./gdb/testsuite/gdb.fortran/string.exp 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/string.exp 2008-10-29 21:32:14.000000000 +0100 +@@ -0,0 +1,59 @@ ++# Copyright 2008 Free Software Foundation, Inc. ++ ++# This program is free software; you can redistribute it and/or modify ++# it under the terms of the GNU General Public License as published by ++# the Free Software Foundation; either version 2 of the License, or ++# (at your option) any later version. ++# ++# This program is distributed in the hope that it will be useful, ++# but WITHOUT ANY WARRANTY; without even the implied warranty of ++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++# GNU General Public License for more details. ++# ++# You should have received a copy of the GNU General Public License ++# along with this program; if not, write to the Free Software ++# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++ ++# This file was written by Jan Kratochvil . ++ ++# This file is part of the gdb testsuite. It contains tests for Fortran ++# strings with dynamic length. ++ ++set testfile "string" ++set srcfile ${testfile}.f90 ++set binfile ${objdir}/${subdir}/${testfile} ++ ++if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } { ++ untested "Couldn't compile ${srcfile}" ++ return -1 ++} ++ ++gdb_exit ++gdb_start ++gdb_reinitialize_dir $srcdir/$subdir ++gdb_load ${binfile} ++ ++if ![runto MAIN__] then { ++ perror "couldn't run to breakpoint MAIN__" ++ continue ++} ++ ++gdb_breakpoint [gdb_get_line_number "var-init"] ++gdb_continue_to_breakpoint "var-init" ++gdb_test "ptype c" "type = character(\\(kind=1\\)|\\*1)" ++gdb_test "ptype d" "type = character(\\(kind=8\\)|\\*8)" ++gdb_test "ptype e" "type = character(\\(kind=4\\)|\\*4)" ++gdb_test "ptype f" "type = character(\\(kind=4\\)|\\*4) \\(7,8:10\\)" ++gdb_test "ptype *e" "Attempt to take contents of a non-pointer value." ++gdb_test "ptype *f" "type = character(\\(kind=4\\)|\\*4) \\(7\\)" ++gdb_test "p c" "\\$\[0-9\]* = 'c'" ++gdb_test "p d" "\\$\[0-9\]* = 'd '" ++gdb_test "p e" "\\$\[0-9\]* = 'g '" ++gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\( 'h ', 'h ', 'h ', 'h ', 'h ', 'h ', 'h '\\) \\)" ++gdb_test "p *e" "Attempt to take contents of a non-pointer value." ++gdb_test "p *f" "Attempt to take contents of a non-pointer value." ++ ++gdb_breakpoint [gdb_get_line_number "var-finish"] ++gdb_continue_to_breakpoint "var-finish" ++gdb_test "p e" "\\$\[0-9\]* = 'e '" "p e re-set" ++gdb_test "p f" "\\$\[0-9\]* = \\(\\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f2 ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\( 'f ', 'f ', 'f ', 'f ', 'f ', 'f ', 'f '\\) \\)" "p *f re-set" +--- ./gdb/testsuite/gdb.fortran/string.f90 1970-01-01 01:00:00.000000000 +0100 ++++ ./gdb/testsuite/gdb.fortran/string.f90 2008-10-29 21:32:14.000000000 +0100 +@@ -0,0 +1,37 @@ ++! Copyright 2008 Free Software Foundation, Inc. ++! ++! This program is free software; you can redistribute it and/or modify ++! it under the terms of the GNU General Public License as published by ++! the Free Software Foundation; either version 2 of the License, or ++! (at your option) any later version. ++! ++! This program is distributed in the hope that it will be useful, ++! but WITHOUT ANY WARRANTY; without even the implied warranty of ++! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++! GNU General Public License for more details. ++! ++! You should have received a copy of the GNU General Public License ++! along with this program; if not, write to the Free Software ++! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++! ++! Ihis file is the Fortran source file for dynamic.exp. ++! Original file written by Jakub Jelinek . ++! Modified for the GDB testcase by Jan Kratochvil . ++ ++subroutine foo (e, f) ++ character (len=1) :: c ++ character (len=8) :: d ++ character (len=*) :: e ++ character (len=*) :: f (1:7, 8:10) ++ c = 'c' ++ d = 'd' ++ e = 'e' ! var-init ++ f = 'f' ++ f(1,9) = 'f2' ++ c = 'c' ! var-finish ++end subroutine foo ++ character (len=4) :: g, h (1:7, 8:10) ++ g = 'g' ++ h = 'h' ++ call foo (g, h) ++end +--- ./gdb/typeprint.c 2008-10-29 10:50:23.000000000 +0100 ++++ ./gdb/typeprint.c 2008-10-29 21:32:46.000000000 +0100 +@@ -33,6 +33,7 @@ + #include "cp-abi.h" + #include "typeprint.h" + #include "gdb_string.h" ++#include "dwarf2loc.h" + #include + + /* For real-type printing in whatis_exp() */ +@@ -102,6 +103,9 @@ void + type_print (struct type *type, char *varstring, struct ui_file *stream, + int show) + { ++ if (show >= 0) ++ type = check_typedef (type); ++ + LA_PRINT_TYPE (type, varstring, stream, show, 0); + } + +--- ./gdb/valarith.c 2008-02-04 01:23:04.000000000 +0100 ++++ ./gdb/valarith.c 2008-11-01 20:17:00.000000000 +0100 +@@ -39,7 +39,6 @@ + #define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2) + #endif + +-static struct value *value_subscripted_rvalue (struct value *, struct value *, int); + static struct type *unop_result_type (enum exp_opcode op, struct type *type1); + static struct type *binop_result_type (enum exp_opcode op, struct type *type1, + struct type *type2); +@@ -180,9 +179,9 @@ an integer nor a pointer of the same typ + struct value * + value_subscript (struct value *array, struct value *idx) + { +- struct value *bound; + int c_style = current_language->c_style_arrays; + struct type *tarray; ++ LONGEST index = value_as_long (idx); + + array = coerce_ref (array); + tarray = check_typedef (value_type (array)); +@@ -195,13 +194,26 @@ value_subscript (struct value *array, st + get_discrete_bounds (range_type, &lowerbound, &upperbound); + + if (VALUE_LVAL (array) != lval_memory) +- return value_subscripted_rvalue (array, idx, lowerbound); ++ { ++ if (index >= lowerbound && index <= upperbound) ++ { ++ CORE_ADDR element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tarray)); ++ CORE_ADDR offset = (index - lowerbound) * element_size; ++ ++ return value_subscripted_rvalue (array, offset); ++ } ++ error (_("array or string index out of range")); ++ } + + if (c_style == 0) + { +- LONGEST index = value_as_long (idx); + if (index >= lowerbound && index <= upperbound) +- return value_subscripted_rvalue (array, idx, lowerbound); ++ { ++ CORE_ADDR element_size = TYPE_LENGTH (TYPE_TARGET_TYPE (tarray)); ++ CORE_ADDR offset = (index - lowerbound) * element_size; ++ ++ return value_subscripted_rvalue (array, offset); ++ } + /* Emit warning unless we have an array of unknown size. + An array of unknown size has lowerbound 0 and upperbound -1. */ + if (upperbound > -1) +@@ -210,12 +222,7 @@ value_subscript (struct value *array, st + c_style = 1; + } + +- if (lowerbound != 0) +- { +- bound = value_from_longest (builtin_type_int, (LONGEST) lowerbound); +- idx = value_sub (idx, bound); +- } +- ++ index -= lowerbound; + array = value_coerce_array (array); + } + +@@ -248,43 +255,57 @@ value_subscript (struct value *array, st + } + + if (c_style) +- return value_ind (value_add (array, idx)); ++ { ++ struct value *idx; ++ ++ idx = value_from_longest (builtin_type_int32, index); ++ return value_ind (value_add (array, idx)); ++ } + else + error (_("not an array or string")); + } + +-/* Return the value of EXPR[IDX], expr an aggregate rvalue +- (eg, a vector register). This routine used to promote floats +- to doubles, but no longer does. */ ++/* Return the value of *((void *) ARRAY + ELEMENT), ARRAY an aggregate rvalue ++ (eg, a vector register). This routine used to promote floats to doubles, ++ but no longer does. OFFSET is zero-based with 0 for the lowermost existing ++ element, it must be expressed in bytes (therefore multiplied by ++ check_typedef (TYPE_TARGET_TYPE (array_type)). */ + +-static struct value * +-value_subscripted_rvalue (struct value *array, struct value *idx, int lowerbound) ++struct value * ++value_subscripted_rvalue (struct value *array, CORE_ADDR offset) + { + struct type *array_type = check_typedef (value_type (array)); + struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type)); +- unsigned int elt_size = TYPE_LENGTH (elt_type); +- LONGEST index = value_as_long (idx); +- unsigned int elt_offs = elt_size * longest_to_int (index - lowerbound); + struct value *v; + +- if (index < lowerbound || elt_offs >= TYPE_LENGTH (array_type)) +- error (_("no such vector element")); ++ /* Do not check TYPE_LENGTH (array_type) as we may have been given the ++ innermost dimension of a multi-dimensional Fortran array where its length ++ is shorter than the possibly accessed element offset. */ + + v = allocate_value (elt_type); + if (value_lazy (array)) + set_value_lazy (v, 1); + else +- memcpy (value_contents_writeable (v), +- value_contents (array) + elt_offs, elt_size); ++ { ++ unsigned int elt_size = TYPE_LENGTH (elt_type); ++ memcpy (value_contents_writeable (v), ++ value_contents (array) + offset, elt_size); ++ } + + if (VALUE_LVAL (array) == lval_internalvar) + VALUE_LVAL (v) = lval_internalvar_component; + else + VALUE_LVAL (v) = VALUE_LVAL (array); ++ + VALUE_ADDRESS (v) = VALUE_ADDRESS (array); ++ /* We need to already adjust the address according to the former type as ++ V will have a different type (ELT_TYPE) which may no longer contain the ++ adjustment code like TYPE_FORTRAN_ARRAY_DATA_LOCATION. */ ++ object_address_get_data (array_type, &VALUE_ADDRESS (v)); ++ + VALUE_REGNUM (v) = VALUE_REGNUM (array); + VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array); +- set_value_offset (v, value_offset (array) + elt_offs); ++ set_value_offset (v, value_offset (array) + offset); + return v; + } + +--- ./gdb/valops.c 2008-10-29 20:56:57.000000000 +0100 ++++ ./gdb/valops.c 2008-10-29 21:57:54.000000000 +0100 +@@ -37,6 +37,7 @@ + #include "dictionary.h" + #include "cp-support.h" + #include "dfp.h" ++#include "dwarf2loc.h" + + #include + #include "gdb_string.h" +@@ -504,6 +505,46 @@ value_one (struct type *type, enum lval_ + return val; + } + ++const char * ++object_address_data_not_valid (struct type *type) ++{ ++ /* DW_AT_associated has a preference over DW_AT_allocated. */ ++ if (TYPE_ASSOCIATED (type) != NULL ++ && 0 == dwarf_locexpr_baton_eval (TYPE_ASSOCIATED (type))) ++ return N_("object is not associated"); ++ ++ if (TYPE_ALLOCATED (type) != NULL ++ && 0 == dwarf_locexpr_baton_eval (TYPE_ALLOCATED (type))) ++ return N_("object is not allocated"); ++ ++ return NULL; ++} ++ ++/* Return non-zero if the variable is valid. If it is valid the function ++ may store the data address (DW_AT_DATA_LOCATION) of TYPE at *ADDRESS_RETURN. ++ You should set *ADDRESS_RETURN as VALUE_ADDRESS (VAL) before calling this ++ function as if no DW_AT_DATA_LOCATION is present for TYPE the address at ++ *ADDRESS_RETURN is left unchanged. ADDRESS_RETURN must not be NULL, use ++ object_address_data_not_valid () for just the data validity check. */ ++ ++int ++object_address_get_data (struct type *type, CORE_ADDR *address_return) ++{ ++ gdb_assert (address_return != NULL); ++ ++ if (object_address_data_not_valid (type) != NULL) ++ { ++ /* Do not try to evaluate DW_AT_data_location as it may even crash ++ (it would just return the value zero in the gfortran case). */ ++ return 0; ++ } ++ ++ if (TYPE_DATA_LOCATION (type) != NULL) ++ *address_return = dwarf_locexpr_baton_eval (TYPE_DATA_LOCATION (type)); ++ ++ return 1; ++} ++ + /* Return a value with type TYPE located at ADDR. + + Call value_at only if the data needs to be fetched immediately; +@@ -570,12 +611,21 @@ value_at_lazy (struct type *type, CORE_A + int + value_fetch_lazy (struct value *val) + { +- CORE_ADDR addr = VALUE_ADDRESS (val) + value_offset (val); +- int length = TYPE_LENGTH (value_enclosing_type (val)); ++ CORE_ADDR addr; ++ int length; + +- struct type *type = value_type (val); +- if (length) +- read_memory (addr, value_contents_all_raw (val), length); ++ addr = VALUE_ADDRESS (val); ++ if (object_address_get_data (value_type (val), &addr)) ++ { ++ struct type *type = value_enclosing_type (val); ++ int length = TYPE_LENGTH (check_typedef (type)); ++ ++ if (length) ++ { ++ addr += value_offset (val); ++ read_memory (addr, value_contents_all_raw (val), length); ++ } ++ } + + set_value_lazy (val, 0); + return 0; +@@ -887,12 +937,17 @@ struct value * + value_coerce_array (struct value *arg1) + { + struct type *type = check_typedef (value_type (arg1)); ++ CORE_ADDR address; + + if (VALUE_LVAL (arg1) != lval_memory) + error (_("Attempt to take address of value not located in memory.")); + ++ address = VALUE_ADDRESS (arg1); ++ if (!object_address_get_data (type, &address)) ++ error (_("Attempt to take address of non-valid value.")); ++ + return value_from_pointer (lookup_pointer_type (TYPE_TARGET_TYPE (type)), +- (VALUE_ADDRESS (arg1) + value_offset (arg1))); ++ address + value_offset (arg1)); + } + + /* Given a value which is a function, return a value which is a pointer +--- ./gdb/value.h 2008-02-04 01:23:04.000000000 +0100 ++++ ./gdb/value.h 2008-11-01 20:16:57.000000000 +0100 +@@ -284,6 +284,10 @@ extern struct value *value_from_decfloat + const gdb_byte *decbytes); + extern struct value *value_from_string (char *string); + ++extern const char *object_address_data_not_valid (struct type *type); ++extern int object_address_get_data (struct type *type, ++ CORE_ADDR *address_return); ++ + extern struct value *value_at (struct type *type, CORE_ADDR addr); + extern struct value *value_at_lazy (struct type *type, CORE_ADDR addr); + +@@ -554,4 +558,7 @@ extern struct value *value_allocate_spac + + extern struct value *value_of_local (const char *name, int complain); + ++extern struct value *value_subscripted_rvalue (struct value *array, ++ CORE_ADDR offset); ++ + #endif /* !defined (VALUE_H) */ diff --git a/gdb-6.8-inlining.patch b/gdb-6.8-inlining.patch index 70cd8c9..fd6d14a 100644 --- a/gdb-6.8-inlining.patch +++ b/gdb-6.8-inlining.patch @@ -24,50 +24,6 @@ Index: gdb-6.8/gdb/Makefile.in gnu-v2-abi.o gnu-v3-abi.o cp-abi.o cp-support.o \ cp-namespace.o \ reggroups.o regset.o \ -@@ -2106,13 +2108,13 @@ dwarf2loc.o: dwarf2loc.c $(defs_h) $(ui_ - $(gdbcore_h) $(target_h) $(inferior_h) $(ax_h) $(ax_gdb_h) \ - $(regcache_h) $(objfiles_h) $(exceptions_h) $(elf_dwarf2_h) \ - $(dwarf2expr_h) $(dwarf2loc_h) $(gdb_string_h) $(gdb_assert_h) \ -- $(dwarf2block_h) -+ $(dwarf2block_h) $(block_h) - dwarf2read.o: dwarf2read.c $(defs_h) $(bfd_h) $(symtab_h) $(gdbtypes_h) \ - $(objfiles_h) $(elf_dwarf2_h) $(buildsym_h) $(demangle_h) \ - $(expression_h) $(filenames_h) $(macrotab_h) $(language_h) \ - $(complaints_h) $(bcache_h) $(dwarf2expr_h) $(dwarf2loc_h) \ - $(cp_support_h) $(hashtab_h) $(command_h) $(gdbcmd_h) \ -- $(gdb_string_h) $(gdb_assert_h) $(dwarf2block_h) $(f_lang_h) -+ $(gdb_string_h) $(gdb_assert_h) $(dwarf2block_h) $(f_lang_h) $(block_h) - elfread.o: elfread.c $(defs_h) $(bfd_h) $(gdb_string_h) $(elf_bfd_h) \ - $(elf_mips_h) $(symtab_h) $(symfile_h) $(objfiles_h) $(buildsym_h) \ - $(stabsread_h) $(gdb_stabs_h) $(complaints_h) $(demangle_h) \ -@@ -2161,7 +2163,8 @@ frame.o: frame.c $(defs_h) $(frame_h) $( - $(regcache_h) $(gdb_assert_h) $(gdb_string_h) $(user_regs_h) \ - $(gdb_obstack_h) $(dummy_frame_h) $(sentinel_frame_h) $(gdbcore_h) \ - $(annotate_h) $(language_h) $(frame_unwind_h) $(frame_base_h) \ -- $(command_h) $(gdbcmd_h) $(observer_h) $(objfiles_h) $(exceptions_h) -+ $(command_h) $(gdbcmd_h) $(observer_h) $(objfiles_h) $(exceptions_h) \ -+ $(block_h) - frame-unwind.o: frame-unwind.c $(defs_h) $(frame_h) $(frame_unwind_h) \ - $(gdb_assert_h) $(dummy_frame_h) $(gdb_obstack_h) - frv-linux-tdep.o: frv-linux-tdep.c $(defs_h) $(gdbcore_h) $(target_h) \ -@@ -2335,7 +2338,7 @@ infcmd.o: infcmd.c $(defs_h) $(gdb_strin - $(objfiles_h) $(completer_h) $(ui_out_h) $(event_top_h) \ - $(parser_defs_h) $(regcache_h) $(reggroups_h) $(block_h) \ - $(solib_h) $(gdb_assert_h) $(observer_h) $(target_descriptions_h) \ -- $(user_regs_h) -+ $(user_regs_h) $(gdbthread_h) - inf-loop.o: inf-loop.c $(defs_h) $(inferior_h) $(target_h) $(event_loop_h) \ - $(event_top_h) $(inf_loop_h) $(remote_h) $(exceptions_h) - inflow.o: inflow.c $(defs_h) $(frame_h) $(inferior_h) $(command_h) \ -@@ -2353,6 +2356,8 @@ infrun.o: infrun.c $(defs_h) $(gdb_strin - inf-ttrace.o: inf-ttrace.c $(defs_h) $(command_h) $(gdbcore_h) \ - $(gdbthread_h) $(inferior_h) $(target_h) \ - $(gdb_assert_h) $(gdb_string_h) $(inf_child_h) $(inf_ttrace_h) -+inline-frame.o: inline-frame.c $(defs_h) $(frame_unwind_h) $(block_h) \ -+ $(symtab_h) $(addrmap_h) $(gdb_assert_h) - interps.o: interps.c $(defs_h) $(gdbcmd_h) $(ui_out_h) $(event_loop_h) \ - $(event_top_h) $(interps_h) $(completer_h) $(gdb_string_h) \ - $(gdb_events_h) $(gdb_assert_h) $(top_h) $(exceptions_h) Index: gdb-6.8/gdb/ada-lang.c =================================================================== --- gdb-6.8.orig/gdb/ada-lang.c 2008-07-14 10:28:30.000000000 +0200 @@ -694,10 +650,10 @@ Index: gdb-6.8/gdb/dwarf2read.c =================================================================== --- gdb-6.8.orig/gdb/dwarf2read.c 2008-07-14 10:28:30.000000000 +0200 +++ gdb-6.8/gdb/dwarf2read.c 2008-07-14 10:29:07.000000000 +0200 -@@ -48,6 +48,7 @@ +@@ -46,6 +46,7 @@ + #include "top.h" + #include "command.h" #include "gdbcmd.h" - #include "dwarf2block.h" - #include "f-lang.h" +#include "block.h" #include diff --git a/gdb.spec b/gdb.spec index bbfa607..a072d74 100644 --- a/gdb.spec +++ b/gdb.spec @@ -13,7 +13,7 @@ Version: 6.8 # The release always contains a leading reserved number, start it at 1. # `upstream' is not a part of `name' to stay fully rpm dependencies compatible for the testing. -Release: 24%{?_with_upstream:.upstream}%{?dist} +Release: 25%{?_with_upstream:.upstream}%{?dist} License: GPLv3+ Group: Development/Debuggers @@ -341,7 +341,10 @@ Patch301: gdb-6.6-buildid-readnever-silent.patch Patch304: gdb-6.7-kernel-headers-compat.patch # Fix/implement the Fortran dynamic arrays support (BZ 377541). -Patch305: gdb-6.8-bz377541-fortran-dynamic-arrays.patch +# Fix the variable-length-arrays support (BZ 468266, feature BZ 377541). +Patch339: gdb-6.8-bz377541-vla-bound-undefined.patch +Patch340: gdb-6.8-bz377541-vla-loc-kind.patch +Patch305: gdb-6.8-bz377541-vla.patch # Backport fix of a segfault + PIE regression since 6.7.1 on PIE executables. Patch306: gdb-6.8-watchpoint-inaccessible-memory.patch @@ -589,6 +592,8 @@ rm -f gdb/jv-exp.c gdb/m2-exp.c gdb/objc-exp.c gdb/p-exp.c %patch298 -p1 %patch301 -p1 %patch304 -p1 +%patch339 -p1 +%patch340 -p1 %patch305 -p1 %patch306 -p1 %patch309 -p1 @@ -654,9 +659,6 @@ test -z "$g77" || ln -s "$g77" ./g77 export CFLAGS="$RPM_OPT_FLAGS" -# FIXME: Temporary rpm compatibility cludge, port: gdb-6.6-buildid-locate.patch -CFLAGS="$CFLAGS -D_RPM_4_4_COMPAT -Wno-deprecated-declarations" - %if 0%{?_with_debug:1} # --enable-werror could conflict with `-Wall -O0' but this is no longer true # for recent GCCs. @@ -882,6 +884,11 @@ fi %endif %changelog +* Mon Nov 3 2008 Jan Kratochvil - 6.8-25 +- Fix the variable-length-arrays support (BZ 468266, feature BZ 377541). +- Fix the debuginfo-install suggestions for missing base packages (BZ 467901), + also update the rpm/yum code to no longer require _RPM_4_4_COMPAT. + * Tue Sep 2 2008 Jan Kratochvil - 6.8-24 - Fix PIE patch regression for loading binaries from valgrind (BZ 460319).