Support DW_TAG_module as separate namespaces.
* dwarf2read.c (typename_concat): New parameter physname.
(read_module_type): New function and declaration.
(scan_partial_symbols): Scan also DW_TAG_module children.
(partial_die_parent_scope): Accept scope even from DW_TAG_module. Pass
to typename_concat backward compatible physname value 0.
(partial_die_full_name, read_namespace_type): Pass to typename_concat
backward compatible physname value 0.
(add_partial_module, read_module): Remove FIXME comment.
(process_die) <DW_TAG_module>: Set PROCESSING_HAS_NAMESPACE_INFO.
(die_needs_namespace) <DW_TAG_variable>: Allow returning true even for
DIEs under DW_TAG_module.
(dwarf2_compute_name): Move the ada block for DW_AT_linkage_name and
DW_AT_MIPS_linkage_name first, extend it for language_fortran
&& physname and return there instead of just setting NAME. Extend
the main block for language_fortran. Pass physname parameter to the
typename_concat call.
(read_import_statement, read_func_scope, get_scope_pc_bounds)
(load_partial_dies, determine_prefix): Support also DW_TAG_module.
(new_symbol): Fill in cplus_specific.demangled_name if it is still
missing from SYMBOL_SET_NAMES in the language_fortran case.
(new_symbol) <DW_TAG_variable>: Force LOC_UNRESOLVED for gfortran module
variables.
(read_type_die) <DW_TAG_module>: New.
(MAX_SEP_LEN): Increase to 7.
(typename_concat): New parameter physname. New variable lead. Support
also language_fortran.
* f-exp.y (yylex): Consider : also as a symbol name character class.
* f-lang.c: Include cp-support.h.
(f_word_break_characters, f_make_symbol_completion_list): New functions.
(f_language_defn): Use cp_lookup_symbol_nonlocal,
f_word_break_characters and f_make_symbol_completion_list.
* f-typeprint.c (f_type_print_base) <TYPE_CODE_MODULE>: New.
* gdbtypes.h (enum type_code) <TYPE_CODE_MODULE>: New.
* symtab.c (symbol_init_language_specific): Support language_fortran.
(symbol_find_demangled_name): New comment on language_fortran.
(symbol_natural_name, symbol_demangled_name): Use demangled_name even
for language_fortran.
(lookup_symbol_aux_local): Check imports also for language_fortran.
(default_make_symbol_completion_list): Rename to ...
(default_make_symbol_completion_list_break_on): ... this name. New
parameter break_on, use it.
(default_make_symbol_completion_list): New stub.
* symtab.h (default_make_symbol_completion_list_break_on): New
prototype.
gdb/testsuite/
Support DW_TAG_module as separate namespaces.
* gdb.fortran/library-module.exp, gdb.fortran/library-module-main.f90,
gdb.fortran/library-module-lib.f90: New.
* gdb.fortran/module.exp: Replace startup by a prepare_for_testing call.
(print i): Remove.
(continue to breakpoint: i-is-1, print var_i value 1)
(continue to breakpoint: i-is-2, print var_i value 2)
(continue to breakpoint: a-b-c-d, print var_a, print var_b, print var_c)
(print var_d, print var_i value 14, ptype modmany, complete `modm)
(complete `modmany, complete `modmany`, complete `modmany`var)
(show language, setting breakpoint at module): New tests.
* gdb.fortran/module.f90 (module mod): Remove.
(module mod1, module mod2, module modmany, subroutine sub1)
(subroutine sub2, program module): New.
+2010-06-02 Jan Kratochvil <jan.kratochvil@redhat.com>
+
+ Support DW_TAG_module as separate namespaces.
+ * dwarf2read.c (typename_concat): New parameter physname.
+ (read_module_type): New function and declaration.
+ (scan_partial_symbols): Scan also DW_TAG_module children.
+ (partial_die_parent_scope): Accept scope even from DW_TAG_module. Pass
+ to typename_concat backward compatible physname value 0.
+ (partial_die_full_name, read_namespace_type): Pass to typename_concat
+ backward compatible physname value 0.
+ (add_partial_module, read_module): Remove FIXME comment.
+ (process_die) <DW_TAG_module>: Set PROCESSING_HAS_NAMESPACE_INFO.
+ (die_needs_namespace) <DW_TAG_variable>: Allow returning true even for
+ DIEs under DW_TAG_module.
+ (dwarf2_compute_name): Move the ada block for DW_AT_linkage_name and
+ DW_AT_MIPS_linkage_name first, extend it for language_fortran
+ && physname and return there instead of just setting NAME. Extend
+ the main block for language_fortran. Pass physname parameter to the
+ typename_concat call.
+ (read_import_statement, read_func_scope, get_scope_pc_bounds)
+ (load_partial_dies, determine_prefix): Support also DW_TAG_module.
+ (new_symbol): Fill in cplus_specific.demangled_name if it is still
+ missing from SYMBOL_SET_NAMES in the language_fortran case.
+ (new_symbol) <DW_TAG_variable>: Force LOC_UNRESOLVED for gfortran module
+ variables.
+ (read_type_die) <DW_TAG_module>: New.
+ (MAX_SEP_LEN): Increase to 7.
+ (typename_concat): New parameter physname. New variable lead. Support
+ also language_fortran.
+ * f-exp.y (yylex): Consider : also as a symbol name character class.
+ * f-lang.c: Include cp-support.h.
+ (f_word_break_characters, f_make_symbol_completion_list): New functions.
+ (f_language_defn): Use cp_lookup_symbol_nonlocal,
+ f_word_break_characters and f_make_symbol_completion_list.
+ * f-typeprint.c (f_type_print_base) <TYPE_CODE_MODULE>: New.
+ * gdbtypes.h (enum type_code) <TYPE_CODE_MODULE>: New.
+ * symtab.c (symbol_init_language_specific): Support language_fortran.
+ (symbol_find_demangled_name): New comment on language_fortran.
+ (symbol_natural_name, symbol_demangled_name): Use demangled_name even
+ for language_fortran.
+ (lookup_symbol_aux_local): Check imports also for language_fortran.
+ (default_make_symbol_completion_list): Rename to ...
+ (default_make_symbol_completion_list_break_on): ... this name. New
+ parameter break_on, use it.
+ (default_make_symbol_completion_list): New stub.
+ * symtab.h (default_make_symbol_completion_list_break_on): New
+ prototype.
+
2010-06-02 Joel Brobecker <brobecker@adacore.com>
* remote.c (remote_get_noisy_reply): Remove trailing "\n" in call
static char *determine_prefix (struct die_info *die, struct dwarf2_cu *);
-static char *typename_concat (struct obstack *,
- const char *prefix,
- const char *suffix,
- struct dwarf2_cu *);
+static char *typename_concat (struct obstack *obs, const char *prefix,
+ const char *suffix, int physname,
+ struct dwarf2_cu *cu);
static void read_file_scope (struct die_info *, struct dwarf2_cu *);
static void read_import_statement (struct die_info *die, struct dwarf2_cu *);
+static struct type *read_module_type (struct die_info *die,
+ struct dwarf2_cu *cu);
+
static const char *namespace_name (struct die_info *die,
int *is_anonymous, struct dwarf2_cu *);
{
fixup_partial_die (pdi, cu);
- /* Anonymous namespaces have no name but have interesting
+ /* Anonymous namespaces or modules have no name but have interesting
children, so we need to look at them. Ditto for anonymous
enums. */
if (pdi->name != NULL || pdi->tag == DW_TAG_namespace
- || pdi->tag == DW_TAG_enumeration_type)
+ || pdi->tag == DW_TAG_module || pdi->tag == DW_TAG_enumeration_type)
{
switch (pdi->tag)
{
}
if (parent->tag == DW_TAG_namespace
+ || parent->tag == DW_TAG_module
|| parent->tag == DW_TAG_structure_type
|| parent->tag == DW_TAG_class_type
|| parent->tag == DW_TAG_interface_type
parent->scope = parent->name;
else
parent->scope = typename_concat (&cu->comp_unit_obstack, grandparent_scope,
- parent->name, cu);
+ parent->name, 0, cu);
}
else if (parent->tag == DW_TAG_enumerator)
/* Enumerators should not get the name of the enumeration as a prefix. */
if (parent_scope == NULL)
return NULL;
else
- return typename_concat (NULL, parent_scope, pdi->name, cu);
+ return typename_concat (NULL, parent_scope, pdi->name, 0, cu);
}
static void
add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc,
CORE_ADDR *highpc, int need_pc, struct dwarf2_cu *cu)
{
- /* Now scan partial symbols in that module.
-
- FIXME: Support the separate Fortran module namespaces. */
+ /* Now scan partial symbols in that module. */
if (pdi->has_children)
scan_partial_symbols (pdi->die_child, lowpc, highpc, need_pc, cu);
read_namespace (die, cu);
break;
case DW_TAG_module:
+ processing_has_namespace_info = 1;
read_module (die, cu);
break;
case DW_TAG_imported_declaration:
}
attr = dwarf2_attr (die, DW_AT_external, cu);
- if (attr == NULL && die->parent->tag != DW_TAG_namespace)
+ if (attr == NULL && die->parent->tag != DW_TAG_namespace
+ && die->parent->tag != DW_TAG_module)
return 0;
/* A variable in a lexical block of some kind does not need a
namespace, even though in C++ such variables may be external
if (name == NULL)
name = dwarf2_name (die, cu);
+ /* For Fortran GDB prefers DW_AT_*linkage_name if present but otherwise
+ compute it by typename_concat inside GDB. */
+ if (cu->language == language_ada
+ || (cu->language == language_fortran && physname))
+ {
+ /* For Ada unit, we prefer the linkage name over the name, as
+ the former contains the exported name, which the user expects
+ to be able to reference. Ideally, we want the user to be able
+ to reference this entity using either natural or linkage name,
+ but we haven't started looking at this enhancement yet. */
+ struct attribute *attr;
+
+ attr = dwarf2_attr (die, DW_AT_linkage_name, cu);
+ if (attr == NULL)
+ attr = dwarf2_attr (die, DW_AT_MIPS_linkage_name, cu);
+ if (attr && DW_STRING (attr))
+ return DW_STRING (attr);
+ }
+
/* These are the only languages we know how to qualify names in. */
if (name != NULL
- && (cu->language == language_cplus || cu->language == language_java))
+ && (cu->language == language_cplus || cu->language == language_java
+ || cu->language == language_fortran))
{
if (die_needs_namespace (die, cu))
{
buf = mem_fileopen ();
if (*prefix != '\0')
{
- char *prefixed_name = typename_concat (NULL, prefix, name, cu);
+ char *prefixed_name = typename_concat (NULL, prefix, name,
+ physname, cu);
fputs_unfiltered (prefixed_name, buf);
xfree (prefixed_name);
}
}
}
- else if (cu->language == language_ada)
- {
- /* For Ada unit, we prefer the linkage name over the name, as
- the former contains the exported name, which the user expects
- to be able to reference. Ideally, we want the user to be able
- to reference this entity using either natural or linkage name,
- but we haven't started looking at this enhancement yet. */
- struct attribute *attr;
-
- attr = dwarf2_attr (die, DW_AT_linkage_name, cu);
- if (attr == NULL)
- attr = dwarf2_attr (die, DW_AT_MIPS_linkage_name, cu);
- if (attr && DW_STRING (attr))
- name = DW_STRING (attr);
- }
return name;
}
to the name of the imported die. */
imported_name_prefix = determine_prefix (imported_die, imported_cu);
- if (imported_die->tag != DW_TAG_namespace)
+ if (imported_die->tag != DW_TAG_namespace
+ && imported_die->tag != DW_TAG_module)
{
imported_declaration = imported_name;
canonical_name = imported_name_prefix;
lowpc, highpc, objfile);
/* For C++, set the block's scope. */
- if (cu->language == language_cplus)
+ if (cu->language == language_cplus || cu->language == language_fortran)
cp_set_block_scope (new->name, block, &objfile->objfile_obstack,
determine_prefix (die, cu),
processing_has_namespace_info);
dwarf2_get_subprogram_pc_bounds (child, &best_low, &best_high, cu);
break;
case DW_TAG_namespace:
+ case DW_TAG_module:
/* FIXME: carlton/2004-01-16: Should we do this for
DW_TAG_class_type/DW_TAG_structure_type, too? I think
that current GCC's always emit the DIEs corresponding
previous_prefix = determine_prefix (die, cu);
if (previous_prefix[0] != '\0')
name = typename_concat (&objfile->objfile_obstack,
- previous_prefix, name, cu);
+ previous_prefix, name, 0, cu);
/* Create the type. */
type = init_type (TYPE_CODE_NAMESPACE, 0, 0, NULL,
}
}
+/* Read a Fortran module as type. This DIE can be only a declaration used for
+ imported module. Still we need that type as local Fortran "use ... only"
+ declaration imports depend on the created type in determine_prefix. */
+
+static struct type *
+read_module_type (struct die_info *die, struct dwarf2_cu *cu)
+{
+ struct objfile *objfile = cu->objfile;
+ char *module_name;
+ struct type *type;
+
+ module_name = dwarf2_name (die, cu);
+ if (!module_name)
+ complaint (&symfile_complaints, _("DW_TAG_module has no name, offset 0x%x"),
+ die->offset);
+ type = init_type (TYPE_CODE_MODULE, 0, 0, module_name, objfile);
+
+ /* determine_prefix uses TYPE_TAG_NAME. */
+ TYPE_TAG_NAME (type) = TYPE_NAME (type);
+
+ return set_die_type (die, type, cu);
+}
+
/* Read a Fortran module. */
static void
{
struct die_info *child_die = die->child;
- /* FIXME: Support the separate Fortran module namespaces. */
-
while (child_die && child_die->tag)
{
process_die (child_die, cu);
&& abbrev->tag != DW_TAG_lexical_block
&& abbrev->tag != DW_TAG_variable
&& abbrev->tag != DW_TAG_namespace
+ && abbrev->tag != DW_TAG_module
&& abbrev->tag != DW_TAG_member)
{
/* Otherwise we skip to the next sibling, if any. */
if (last_die->has_children
&& (load_all
|| last_die->tag == DW_TAG_namespace
+ || last_die->tag == DW_TAG_module
|| last_die->tag == DW_TAG_enumeration_type
|| (cu->language != language_c
&& (last_die->tag == DW_TAG_class_type
linkagename = dwarf2_physname (name, die, cu);
SYMBOL_SET_NAMES (sym, linkagename, strlen (linkagename), 0, objfile);
+ /* Fortran does not have mangling standard and the mangling does differ
+ between gfortran, iFort etc. */
+ if (cu->language == language_fortran
+ && sym->ginfo.language_specific.cplus_specific.demangled_name == NULL)
+ sym->ginfo.language_specific.cplus_specific.demangled_name
+ = (char *) dwarf2_full_name (name, die, cu);
+
/* Default assumptions.
Use the passed type or decode it from the die. */
SYMBOL_DOMAIN (sym) = VAR_DOMAIN;
{
struct pending **list_to_add;
+ /* Workaround gfortran PR debug/40040 - it uses
+ DW_AT_location for variables in -fPIC libraries which may
+ get overriden by other libraries/executable and get
+ a different address. Resolve it by the minimal symbol
+ which may come from inferior's executable using copy
+ relocation. Make this workaround only for gfortran as for
+ other compilers GDB cannot guess the minimal symbol
+ Fortran mangling kind. */
+ if (cu->language == language_fortran && die->parent
+ && die->parent->tag == DW_TAG_module
+ && cu->producer
+ && strncmp (cu->producer, "GNU Fortran ", 12) == 0)
+ SYMBOL_CLASS (sym) = LOC_UNRESOLVED;
+
/* A variable with DW_AT_external is never static,
but it may be block-scoped. */
list_to_add = (cu->list_in_scope == &file_symbols
case DW_TAG_namespace:
this_type = read_namespace_type (die, cu);
break;
+ case DW_TAG_module:
+ this_type = read_module_type (die, cu);
+ break;
default:
complaint (&symfile_complaints, _("unexpected tag in read_type_die: '%s'"),
dwarf_tag_name (die->tag));
struct dwarf2_cu *spec_cu;
struct type *parent_type;
- if (cu->language != language_cplus
- && cu->language != language_java)
+ if (cu->language != language_cplus && cu->language != language_java
+ && cu->language != language_fortran)
return "";
/* We have to be careful in the presence of DW_AT_specification.
case DW_TAG_interface_type:
case DW_TAG_structure_type:
case DW_TAG_union_type:
+ case DW_TAG_module:
parent_type = read_type_die (parent, cu);
if (TYPE_TAG_NAME (parent_type) != NULL)
return TYPE_TAG_NAME (parent_type);
perform an obconcat, otherwise allocate storage for the result. The CU argument
is used to determine the language and hence, the appropriate separator. */
-#define MAX_SEP_LEN 2 /* sizeof ("::") */
+#define MAX_SEP_LEN 7 /* strlen ("__") + strlen ("_MOD_") */
static char *
-typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
- struct dwarf2_cu *cu)
+typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
+ int physname, struct dwarf2_cu *cu)
{
+ const char *lead = "";
const char *sep;
if (suffix == NULL || suffix[0] == '\0' || prefix == NULL || prefix[0] == '\0')
sep = "";
else if (cu->language == language_java)
sep = ".";
+ else if (cu->language == language_fortran && physname)
+ {
+ /* This is gfortran specific mangling. Normally DW_AT_linkage_name or
+ DW_AT_MIPS_linkage_name is preferred and used instead. */
+
+ lead = "__";
+ sep = "_MOD_";
+ }
else
sep = "::";
{
char *retval = xmalloc (strlen (prefix) + MAX_SEP_LEN + strlen (suffix) + 1);
- strcpy (retval, prefix);
+ strcpy (retval, lead);
+ strcat (retval, prefix);
strcat (retval, sep);
strcat (retval, suffix);
return retval;
else
{
/* We have an obstack. */
- return obconcat (obs, prefix, sep, suffix, (char *) NULL);
+ return obconcat (obs, lead, prefix, sep, suffix, (char *) NULL);
}
}
return c;
}
- if (!(c == '_' || c == '$'
+ if (!(c == '_' || c == '$' || c ==':'
|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
/* We must have come across a bad character (e.g. ';'). */
error ("Invalid character '%c' in expression.", c);
namelen = 0;
for (c = tokstart[namelen];
- (c == '_' || c == '$' || (c >= '0' && c <= '9')
+ (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
c = tokstart[++namelen]);
#include "f-lang.h"
#include "valprint.h"
#include "value.h"
+#include "cp-support.h"
/* Following is dubious stuff that had been in the xcoff reader. */
lai->bool_type_default = builtin->builtin_logical_s2;
}
+/* Remove the modules separator :: from the default break list. */
+
+static char *
+f_word_break_characters (void)
+{
+ static char *retval;
+
+ if (!retval)
+ {
+ char *s;
+
+ retval = xstrdup (default_word_break_characters ());
+ s = strchr (retval, ':');
+ if (s)
+ {
+ char *last_char = &s[strlen (s) - 1];
+
+ *s = *last_char;
+ *last_char = 0;
+ }
+ }
+ return retval;
+}
+
+/* Consider the modules separator :: as a valid symbol name character class. */
+
+static char **
+f_make_symbol_completion_list (char *text, char *word)
+{
+ return default_make_symbol_completion_list_break_on (text, word, ":");
+}
+
/* This is declared in c-lang.h but it is silly to import that file for what
is already just a hack. */
extern int c_value_print (struct value *, struct ui_file *,
c_value_print, /* FIXME */
NULL, /* Language specific skip_trampoline */
NULL, /* name_of_this */
- basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
+ cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
basic_lookup_transparent_type,/* lookup_transparent_type */
NULL, /* Language specific symbol demangler */
NULL, /* Language specific class_name_from_physname */
f_op_print_tab, /* expression operators for printing */
0, /* arrays are first-class (not c-style) */
1, /* String lower bound */
- default_word_break_characters,
- default_make_symbol_completion_list,
+ f_word_break_characters,
+ f_make_symbol_completion_list,
f_language_arch_info,
default_print_array_index,
default_pass_by_reference,
fputs_filtered (TYPE_TAG_NAME (type), stream);
break;
+ case TYPE_CODE_MODULE:
+ fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
+ break;
+
default_case:
default:
/* Handle types not explicitly handled by the other cases,
TYPE_CODE_DECFLOAT, /* Decimal floating point. */
+ TYPE_CODE_MODULE, /* Fortran module. */
+
/* Internal function type. */
TYPE_CODE_INTERNAL_FUNCTION
};
if (gsymbol->language == language_cplus
|| gsymbol->language == language_d
|| gsymbol->language == language_java
- || gsymbol->language == language_objc)
+ || gsymbol->language == language_objc
+ || gsymbol->language == language_fortran)
{
gsymbol->language_specific.cplus_specific.demangled_name = NULL;
}
return demangled;
}
}
+ /* We could support `gsymbol->language == language_fortran' here to provide
+ module namespaces also for inferiors with only minimal symbol table (ELF
+ symbols). Just the mangling standard is not standardized across compilers
+ and there is no DW_AT_producer available for inferiors with only the ELF
+ symbols to check the mangling kind. */
return NULL;
}
case language_d:
case language_java:
case language_objc:
+ case language_fortran:
if (gsymbol->language_specific.cplus_specific.demangled_name != NULL)
return gsymbol->language_specific.cplus_specific.demangled_name;
break;
case language_d:
case language_java:
case language_objc:
+ case language_fortran:
if (gsymbol->language_specific.cplus_specific.demangled_name != NULL)
return gsymbol->language_specific.cplus_specific.demangled_name;
break;
if (sym != NULL)
return sym;
- if (language == language_cplus)
+ if (language == language_cplus || language == language_fortran)
{
sym = cp_lookup_symbol_imports (scope,
name,
}
char **
-default_make_symbol_completion_list (char *text, char *word)
+default_make_symbol_completion_list_break_on (char *text, char *word,
+ const char *break_on)
{
/* Problem: All of the symbols have to be copied because readline
frees them. I'm not going to worry about this; hopefully there
while (p > text)
{
if (isalnum (p[-1]) || p[-1] == '_' || p[-1] == '\0'
- || p[-1] == ':')
+ || p[-1] == ':' || strchr (break_on, p[-1]) != NULL)
--p;
else
break;
return (return_val);
}
+char **
+default_make_symbol_completion_list (char *text, char *word)
+{
+ return default_make_symbol_completion_list_break_on (text, word, "");
+}
+
/* Return a NULL terminated array of all symbols (regardless of class)
which begin by matching TEXT. If the answer is no symbols, then
the return value is an array which contains only a NULL pointer. */
extern void select_source_symtab (struct symtab *);
+extern char **default_make_symbol_completion_list_break_on
+ (char *text, char *word, const char *break_on);
extern char **default_make_symbol_completion_list (char *, char *);
extern char **make_symbol_completion_list (char *, char *);
extern char **make_symbol_completion_list_fn (struct cmd_list_element *,
+2010-06-02 Jan Kratochvil <jan.kratochvil@redhat.com>
+
+ Support DW_TAG_module as separate namespaces.
+ * gdb.fortran/library-module.exp, gdb.fortran/library-module-main.f90,
+ gdb.fortran/library-module-lib.f90: New.
+ * gdb.fortran/module.exp: Replace startup by a prepare_for_testing call.
+ (print i): Remove.
+ (continue to breakpoint: i-is-1, print var_i value 1)
+ (continue to breakpoint: i-is-2, print var_i value 2)
+ (continue to breakpoint: a-b-c-d, print var_a, print var_b, print var_c)
+ (print var_d, print var_i value 14, ptype modmany, complete `modm)
+ (complete `modmany, complete `modmany`, complete `modmany`var)
+ (show language, setting breakpoint at module): New tests.
+ * gdb.fortran/module.f90 (module mod): Remove.
+ (module mod1, module mod2, module modmany, subroutine sub1)
+ (subroutine sub2, program module): New.
+
2010-06-02 Jan Kratochvil <jan.kratochvil@redhat.com>
* gdb.cp/ref-types.exp (pass, pass, pass): Rename to ...
--- /dev/null
+! Copyright 2010 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+module lib
+ integer :: var_i = 1
+contains
+ subroutine lib_func
+ if (var_i .ne. 1) call abort
+ var_i = 2
+ var_i = var_i ! i-is-2-in-lib
+ end subroutine lib_func
+end module lib
+
+module libmany
+ integer :: var_j = 3
+ integer :: var_k = 4
+end module libmany
--- /dev/null
+! Copyright 2010 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+ use lib
+ use libmany, only: var_j
+ if (var_i .ne. 1) call abort
+ call lib_func
+ if (var_i .ne. 2) call abort
+ if (var_j .ne. 3) call abort
+ var_i = var_i ! i-is-2-in-main
+end
--- /dev/null
+# Copyright 2010 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+set testfile "library-module"
+set srcfile ${testfile}-main.f90
+set srclibfile ${testfile}-lib.f90
+set libfile ${testfile}-lib.so
+set binfile ${testfile}
+
+# Required for -fPIC by gdb_compile_shlib.
+if [get_compiler_info not-used] {
+ warning "Could not get compiler info"
+ return -1
+}
+
+if { [gdb_compile_shlib "${srcdir}/${subdir}/${srclibfile}" $objdir/$subdir/$libfile {debug f77}] != "" } {
+ untested "Couldn't compile ${srclibfile}"
+ return -1
+}
+
+# prepare_for_testing cannot be used as linking with $libfile cannot be passed
+# just for the linking phase (and not the source compilation phase). And any
+# warnings on ignored $libfile abort the process.
+
+if { [gdb_compile [list $srcdir/$subdir/$srcfile $objdir/$subdir/$libfile] $objdir/$subdir/$binfile executable {debug f77}] != "" } {
+ untested "Couldn't compile ${srcfile}"
+ return -1
+}
+
+clean_restart $binfile
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint $srclibfile:[gdb_get_line_number "i-is-2-in-lib" $srclibfile]
+gdb_continue_to_breakpoint "i-is-2-in-lib" ".*i-is-2-in-lib.*"
+gdb_test "print var_i" " = 2" "print var_i in lib"
+
+gdb_breakpoint $srcfile:[gdb_get_line_number "i-is-2-in-main" $srcfile]
+gdb_continue_to_breakpoint "i-is-2-in-main" ".*i-is-2-in-main.*"
+gdb_test "print var_i" " = 2" "print var_i in main"
+
+gdb_test "print var_j" " = 3"
+gdb_test "print var_k" "No symbol \"var_k\" in current context\\."
set testfile "module"
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}"
+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f77}] } {
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_test "print i" " = 42"
+# Do not use simple single-letter names as GDB would pick up for expectedly
+# nonexisting symbols some static variables from system libraries debuginfos.
+
+gdb_breakpoint [gdb_get_line_number "i-is-1"]
+gdb_continue_to_breakpoint "i-is-1" ".*i-is-1.*"
+gdb_test "print var_i" " = 1" "print var_i value 1"
+
+gdb_breakpoint [gdb_get_line_number "i-is-2"]
+gdb_continue_to_breakpoint "i-is-2" ".*i-is-2.*"
+gdb_test "print var_i" " = 2" "print var_i value 2"
+
+gdb_breakpoint [gdb_get_line_number "a-b-c-d"]
+gdb_continue_to_breakpoint "a-b-c-d" ".*a-b-c-d.*"
+gdb_test "print var_a" "No symbol \"var_a\" in current context\\."
+gdb_test "print var_b" " = 11"
+gdb_test "print var_c" "No symbol \"var_c\" in current context\\."
+gdb_test "print var_d" " = 12"
+gdb_test "print var_i" " = 14" "print var_i value 14"
+
+gdb_test "ptype modmany" {No symbol "modmany" in current context.}
+
+proc complete {expr list} {
+ set cmd "complete p $expr"
+ set expect [join [concat [list $cmd] $list] "\r\np "]
+ gdb_test $cmd $expect "complete $expr"
+}
+set modmany_list {modmany::var_a modmany::var_b modmany::var_c modmany::var_i}
+complete "modm" $modmany_list
+complete "modmany" $modmany_list
+complete "modmany::" $modmany_list
+complete "modmany::var" $modmany_list
+
+# Breakpoint would work in language "c".
+gdb_test "show language" {The current source language is "(auto; currently )?fortran".}
+
+# gcc-4.4.2: The main program is always MAIN__ in .symtab so "runto" above
+# works. But DWARF DW_TAG_subprogram contains the name specified by
+# the "program" Fortran statement.
+if [gdb_breakpoint "module"] {
+ pass "setting breakpoint at module"
+}
! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>.
-module mod
- integer :: i = 42
-end module mod
+module mod1
+ integer :: var_i = 1
+end module mod1
- use mod
- print *, i
+module mod2
+ integer :: var_i = 2
+end module mod2
+
+module modmany
+ integer :: var_a = 10, var_b = 11, var_c = 12, var_i = 14
+end module modmany
+
+ subroutine sub1
+ use mod1
+ if (var_i .ne. 1) call abort
+ var_i = var_i ! i-is-1
+ end
+
+ subroutine sub2
+ use mod2
+ if (var_i .ne. 2) call abort
+ var_i = var_i ! i-is-2
+ end
+
+ program module
+
+ use modmany, only: var_b, var_d => var_c, var_i
+
+ call sub1
+ call sub2
+
+ if (var_b .ne. 11) call abort
+ if (var_d .ne. 12) call abort
+ if (var_i .ne. 14) call abort
+ var_b = var_b ! a-b-c-d
end
projects / binutils-gdb.git / commitdiff