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.
This commit is contained in:
Jan Kratochvil 2010-06-02 22:41:56 +00:00
parent 31e43e98bf
commit f55ee35cf1
14 changed files with 426 additions and 64 deletions

View File

@ -1,3 +1,51 @@
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> 2010-06-02 Joel Brobecker <brobecker@adacore.com>
* remote.c (remote_get_noisy_reply): Remove trailing "\n" in call * remote.c (remote_get_noisy_reply): Remove trailing "\n" in call

View File

@ -905,10 +905,9 @@ static struct type *read_type_die (struct die_info *, struct dwarf2_cu *);
static char *determine_prefix (struct die_info *die, struct dwarf2_cu *); static char *determine_prefix (struct die_info *die, struct dwarf2_cu *);
static char *typename_concat (struct obstack *, static char *typename_concat (struct obstack *obs, const char *prefix,
const char *prefix, const char *suffix, int physname,
const char *suffix, struct dwarf2_cu *cu);
struct dwarf2_cu *);
static void read_file_scope (struct die_info *, struct dwarf2_cu *); static void read_file_scope (struct die_info *, struct dwarf2_cu *);
@ -955,6 +954,9 @@ static void read_module (struct die_info *die, struct dwarf2_cu *cu);
static void read_import_statement (struct die_info *die, 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, static const char *namespace_name (struct die_info *die,
int *is_anonymous, struct dwarf2_cu *); int *is_anonymous, struct dwarf2_cu *);
@ -2198,12 +2200,12 @@ scan_partial_symbols (struct partial_die_info *first_die, CORE_ADDR *lowpc,
{ {
fixup_partial_die (pdi, 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 children, so we need to look at them. Ditto for anonymous
enums. */ enums. */
if (pdi->name != NULL || pdi->tag == DW_TAG_namespace 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) switch (pdi->tag)
{ {
@ -2316,6 +2318,7 @@ partial_die_parent_scope (struct partial_die_info *pdi,
} }
if (parent->tag == DW_TAG_namespace if (parent->tag == DW_TAG_namespace
|| parent->tag == DW_TAG_module
|| parent->tag == DW_TAG_structure_type || parent->tag == DW_TAG_structure_type
|| parent->tag == DW_TAG_class_type || parent->tag == DW_TAG_class_type
|| parent->tag == DW_TAG_interface_type || parent->tag == DW_TAG_interface_type
@ -2326,7 +2329,7 @@ partial_die_parent_scope (struct partial_die_info *pdi,
parent->scope = parent->name; parent->scope = parent->name;
else else
parent->scope = typename_concat (&cu->comp_unit_obstack, grandparent_scope, parent->scope = typename_concat (&cu->comp_unit_obstack, grandparent_scope,
parent->name, cu); parent->name, 0, cu);
} }
else if (parent->tag == DW_TAG_enumerator) else if (parent->tag == DW_TAG_enumerator)
/* Enumerators should not get the name of the enumeration as a prefix. */ /* Enumerators should not get the name of the enumeration as a prefix. */
@ -2358,7 +2361,7 @@ partial_die_full_name (struct partial_die_info *pdi,
if (parent_scope == NULL) if (parent_scope == NULL)
return NULL; return NULL;
else else
return typename_concat (NULL, parent_scope, pdi->name, cu); return typename_concat (NULL, parent_scope, pdi->name, 0, cu);
} }
static void static void
@ -2544,9 +2547,7 @@ static void
add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc, add_partial_module (struct partial_die_info *pdi, CORE_ADDR *lowpc,
CORE_ADDR *highpc, int need_pc, struct dwarf2_cu *cu) CORE_ADDR *highpc, int need_pc, struct dwarf2_cu *cu)
{ {
/* Now scan partial symbols in that module. /* Now scan partial symbols in that module. */
FIXME: Support the separate Fortran module namespaces. */
if (pdi->has_children) if (pdi->has_children)
scan_partial_symbols (pdi->die_child, lowpc, highpc, need_pc, cu); scan_partial_symbols (pdi->die_child, lowpc, highpc, need_pc, cu);
@ -3208,6 +3209,7 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
read_namespace (die, cu); read_namespace (die, cu);
break; break;
case DW_TAG_module: case DW_TAG_module:
processing_has_namespace_info = 1;
read_module (die, cu); read_module (die, cu);
break; break;
case DW_TAG_imported_declaration: case DW_TAG_imported_declaration:
@ -3263,7 +3265,8 @@ die_needs_namespace (struct die_info *die, struct dwarf2_cu *cu)
} }
attr = dwarf2_attr (die, DW_AT_external, cu); 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; return 0;
/* A variable in a lexical block of some kind does not need a /* A variable in a lexical block of some kind does not need a
namespace, even though in C++ such variables may be external namespace, even though in C++ such variables may be external
@ -3296,9 +3299,29 @@ dwarf2_compute_name (char *name, struct die_info *die, struct dwarf2_cu *cu,
if (name == NULL) if (name == NULL)
name = dwarf2_name (die, cu); 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. */ /* These are the only languages we know how to qualify names in. */
if (name != NULL 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)) if (die_needs_namespace (die, cu))
{ {
@ -3310,7 +3333,8 @@ dwarf2_compute_name (char *name, struct die_info *die, struct dwarf2_cu *cu,
buf = mem_fileopen (); buf = mem_fileopen ();
if (*prefix != '\0') 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); fputs_unfiltered (prefixed_name, buf);
xfree (prefixed_name); xfree (prefixed_name);
@ -3361,21 +3385,6 @@ dwarf2_compute_name (char *name, struct die_info *die, struct dwarf2_cu *cu,
} }
} }
} }
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; return name;
} }
@ -3482,7 +3491,8 @@ read_import_statement (struct die_info *die, struct dwarf2_cu *cu)
to the name of the imported die. */ to the name of the imported die. */
imported_name_prefix = determine_prefix (imported_die, imported_cu); 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; imported_declaration = imported_name;
canonical_name = imported_name_prefix; canonical_name = imported_name_prefix;
@ -3979,7 +3989,7 @@ read_func_scope (struct die_info *die, struct dwarf2_cu *cu)
lowpc, highpc, objfile); lowpc, highpc, objfile);
/* For C++, set the block's scope. */ /* 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, cp_set_block_scope (new->name, block, &objfile->objfile_obstack,
determine_prefix (die, cu), determine_prefix (die, cu),
processing_has_namespace_info); processing_has_namespace_info);
@ -4314,6 +4324,7 @@ get_scope_pc_bounds (struct die_info *die,
dwarf2_get_subprogram_pc_bounds (child, &best_low, &best_high, cu); dwarf2_get_subprogram_pc_bounds (child, &best_low, &best_high, cu);
break; break;
case DW_TAG_namespace: case DW_TAG_namespace:
case DW_TAG_module:
/* FIXME: carlton/2004-01-16: Should we do this for /* FIXME: carlton/2004-01-16: Should we do this for
DW_TAG_class_type/DW_TAG_structure_type, too? I think DW_TAG_class_type/DW_TAG_structure_type, too? I think
that current GCC's always emit the DIEs corresponding that current GCC's always emit the DIEs corresponding
@ -5640,7 +5651,7 @@ read_namespace_type (struct die_info *die, struct dwarf2_cu *cu)
previous_prefix = determine_prefix (die, cu); previous_prefix = determine_prefix (die, cu);
if (previous_prefix[0] != '\0') if (previous_prefix[0] != '\0')
name = typename_concat (&objfile->objfile_obstack, name = typename_concat (&objfile->objfile_obstack,
previous_prefix, name, cu); previous_prefix, name, 0, cu);
/* Create the type. */ /* Create the type. */
type = init_type (TYPE_CODE_NAMESPACE, 0, 0, NULL, type = init_type (TYPE_CODE_NAMESPACE, 0, 0, NULL,
@ -5693,6 +5704,29 @@ read_namespace (struct die_info *die, struct dwarf2_cu *cu)
} }
} }
/* 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. */ /* Read a Fortran module. */
static void static void
@ -5700,8 +5734,6 @@ read_module (struct die_info *die, struct dwarf2_cu *cu)
{ {
struct die_info *child_die = die->child; struct die_info *child_die = die->child;
/* FIXME: Support the separate Fortran module namespaces. */
while (child_die && child_die->tag) while (child_die && child_die->tag)
{ {
process_die (child_die, cu); process_die (child_die, cu);
@ -6691,6 +6723,7 @@ load_partial_dies (bfd *abfd, gdb_byte *buffer, gdb_byte *info_ptr,
&& abbrev->tag != DW_TAG_lexical_block && abbrev->tag != DW_TAG_lexical_block
&& abbrev->tag != DW_TAG_variable && abbrev->tag != DW_TAG_variable
&& abbrev->tag != DW_TAG_namespace && abbrev->tag != DW_TAG_namespace
&& abbrev->tag != DW_TAG_module
&& abbrev->tag != DW_TAG_member) && abbrev->tag != DW_TAG_member)
{ {
/* Otherwise we skip to the next sibling, if any. */ /* Otherwise we skip to the next sibling, if any. */
@ -6822,6 +6855,7 @@ load_partial_dies (bfd *abfd, gdb_byte *buffer, gdb_byte *info_ptr,
if (last_die->has_children if (last_die->has_children
&& (load_all && (load_all
|| last_die->tag == DW_TAG_namespace || last_die->tag == DW_TAG_namespace
|| last_die->tag == DW_TAG_module
|| last_die->tag == DW_TAG_enumeration_type || last_die->tag == DW_TAG_enumeration_type
|| (cu->language != language_c || (cu->language != language_c
&& (last_die->tag == DW_TAG_class_type && (last_die->tag == DW_TAG_class_type
@ -8543,6 +8577,13 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
linkagename = dwarf2_physname (name, die, cu); linkagename = dwarf2_physname (name, die, cu);
SYMBOL_SET_NAMES (sym, linkagename, strlen (linkagename), 0, objfile); 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. /* Default assumptions.
Use the passed type or decode it from the die. */ Use the passed type or decode it from the die. */
SYMBOL_DOMAIN (sym) = VAR_DOMAIN; SYMBOL_DOMAIN (sym) = VAR_DOMAIN;
@ -8646,6 +8687,20 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
{ {
struct pending **list_to_add; 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, /* A variable with DW_AT_external is never static,
but it may be block-scoped. */ but it may be block-scoped. */
list_to_add = (cu->list_in_scope == &file_symbols list_to_add = (cu->list_in_scope == &file_symbols
@ -9127,6 +9182,9 @@ read_type_die (struct die_info *die, struct dwarf2_cu *cu)
case DW_TAG_namespace: case DW_TAG_namespace:
this_type = read_namespace_type (die, cu); this_type = read_namespace_type (die, cu);
break; break;
case DW_TAG_module:
this_type = read_module_type (die, cu);
break;
default: default:
complaint (&symfile_complaints, _("unexpected tag in read_type_die: '%s'"), complaint (&symfile_complaints, _("unexpected tag in read_type_die: '%s'"),
dwarf_tag_name (die->tag)); dwarf_tag_name (die->tag));
@ -9158,8 +9216,8 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
struct dwarf2_cu *spec_cu; struct dwarf2_cu *spec_cu;
struct type *parent_type; struct type *parent_type;
if (cu->language != language_cplus if (cu->language != language_cplus && cu->language != language_java
&& cu->language != language_java) && cu->language != language_fortran)
return ""; return "";
/* We have to be careful in the presence of DW_AT_specification. /* We have to be careful in the presence of DW_AT_specification.
@ -9211,6 +9269,7 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
case DW_TAG_interface_type: case DW_TAG_interface_type:
case DW_TAG_structure_type: case DW_TAG_structure_type:
case DW_TAG_union_type: case DW_TAG_union_type:
case DW_TAG_module:
parent_type = read_type_die (parent, cu); parent_type = read_type_die (parent, cu);
if (TYPE_TAG_NAME (parent_type) != NULL) if (TYPE_TAG_NAME (parent_type) != NULL)
return TYPE_TAG_NAME (parent_type); return TYPE_TAG_NAME (parent_type);
@ -9230,18 +9289,27 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
perform an obconcat, otherwise allocate storage for the result. The CU argument perform an obconcat, otherwise allocate storage for the result. The CU argument
is used to determine the language and hence, the appropriate separator. */ 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 * static char *
typename_concat (struct obstack *obs, const char *prefix, const char *suffix, typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
struct dwarf2_cu *cu) int physname, struct dwarf2_cu *cu)
{ {
const char *lead = "";
const char *sep; const char *sep;
if (suffix == NULL || suffix[0] == '\0' || prefix == NULL || prefix[0] == '\0') if (suffix == NULL || suffix[0] == '\0' || prefix == NULL || prefix[0] == '\0')
sep = ""; sep = "";
else if (cu->language == language_java) else if (cu->language == language_java)
sep = "."; 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 else
sep = "::"; sep = "::";
@ -9254,7 +9322,8 @@ typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
{ {
char *retval = xmalloc (strlen (prefix) + MAX_SEP_LEN + strlen (suffix) + 1); 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, sep);
strcat (retval, suffix); strcat (retval, suffix);
return retval; return retval;
@ -9262,7 +9331,7 @@ typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
else else
{ {
/* We have an obstack. */ /* We have an obstack. */
return obconcat (obs, prefix, sep, suffix, (char *) NULL); return obconcat (obs, lead, prefix, sep, suffix, (char *) NULL);
} }
} }

View File

@ -1128,14 +1128,14 @@ yylex ()
return c; return c;
} }
if (!(c == '_' || c == '$' if (!(c == '_' || c == '$' || c ==':'
|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))) || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
/* We must have come across a bad character (e.g. ';'). */ /* We must have come across a bad character (e.g. ';'). */
error ("Invalid character '%c' in expression.", c); error ("Invalid character '%c' in expression.", c);
namelen = 0; namelen = 0;
for (c = tokstart[namelen]; 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 >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
c = tokstart[++namelen]); c = tokstart[++namelen]);

View File

@ -31,6 +31,7 @@
#include "f-lang.h" #include "f-lang.h"
#include "valprint.h" #include "valprint.h"
#include "value.h" #include "value.h"
#include "cp-support.h"
/* Following is dubious stuff that had been in the xcoff reader. */ /* Following is dubious stuff that had been in the xcoff reader. */
@ -308,6 +309,38 @@ f_language_arch_info (struct gdbarch *gdbarch,
lai->bool_type_default = builtin->builtin_logical_s2; 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 /* This is declared in c-lang.h but it is silly to import that file for what
is already just a hack. */ is already just a hack. */
extern int c_value_print (struct value *, struct ui_file *, extern int c_value_print (struct value *, struct ui_file *,
@ -335,15 +368,15 @@ const struct language_defn f_language_defn =
c_value_print, /* FIXME */ c_value_print, /* FIXME */
NULL, /* Language specific skip_trampoline */ NULL, /* Language specific skip_trampoline */
NULL, /* name_of_this */ 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 */ basic_lookup_transparent_type,/* lookup_transparent_type */
NULL, /* Language specific symbol demangler */ NULL, /* Language specific symbol demangler */
NULL, /* Language specific class_name_from_physname */ NULL, /* Language specific class_name_from_physname */
f_op_print_tab, /* expression operators for printing */ f_op_print_tab, /* expression operators for printing */
0, /* arrays are first-class (not c-style) */ 0, /* arrays are first-class (not c-style) */
1, /* String lower bound */ 1, /* String lower bound */
default_word_break_characters, f_word_break_characters,
default_make_symbol_completion_list, f_make_symbol_completion_list,
f_language_arch_info, f_language_arch_info,
default_print_array_index, default_print_array_index,
default_pass_by_reference, default_pass_by_reference,

View File

@ -370,6 +370,10 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
fputs_filtered (TYPE_TAG_NAME (type), stream); fputs_filtered (TYPE_TAG_NAME (type), stream);
break; break;
case TYPE_CODE_MODULE:
fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
break;
default_case: default_case:
default: default:
/* Handle types not explicitly handled by the other cases, /* Handle types not explicitly handled by the other cases,

View File

@ -136,6 +136,8 @@ enum type_code
TYPE_CODE_DECFLOAT, /* Decimal floating point. */ TYPE_CODE_DECFLOAT, /* Decimal floating point. */
TYPE_CODE_MODULE, /* Fortran module. */
/* Internal function type. */ /* Internal function type. */
TYPE_CODE_INTERNAL_FUNCTION TYPE_CODE_INTERNAL_FUNCTION
}; };

View File

@ -351,7 +351,8 @@ symbol_init_language_specific (struct general_symbol_info *gsymbol,
if (gsymbol->language == language_cplus if (gsymbol->language == language_cplus
|| gsymbol->language == language_d || gsymbol->language == language_d
|| gsymbol->language == language_java || gsymbol->language == language_java
|| gsymbol->language == language_objc) || gsymbol->language == language_objc
|| gsymbol->language == language_fortran)
{ {
gsymbol->language_specific.cplus_specific.demangled_name = NULL; gsymbol->language_specific.cplus_specific.demangled_name = NULL;
} }
@ -465,6 +466,11 @@ symbol_find_demangled_name (struct general_symbol_info *gsymbol,
return demangled; 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; return NULL;
} }
@ -645,6 +651,7 @@ symbol_natural_name (const struct general_symbol_info *gsymbol)
case language_d: case language_d:
case language_java: case language_java:
case language_objc: case language_objc:
case language_fortran:
if (gsymbol->language_specific.cplus_specific.demangled_name != NULL) if (gsymbol->language_specific.cplus_specific.demangled_name != NULL)
return gsymbol->language_specific.cplus_specific.demangled_name; return gsymbol->language_specific.cplus_specific.demangled_name;
break; break;
@ -671,6 +678,7 @@ symbol_demangled_name (const struct general_symbol_info *gsymbol)
case language_d: case language_d:
case language_java: case language_java:
case language_objc: case language_objc:
case language_fortran:
if (gsymbol->language_specific.cplus_specific.demangled_name != NULL) if (gsymbol->language_specific.cplus_specific.demangled_name != NULL)
return gsymbol->language_specific.cplus_specific.demangled_name; return gsymbol->language_specific.cplus_specific.demangled_name;
break; break;
@ -1156,7 +1164,7 @@ lookup_symbol_aux_local (const char *name, const struct block *block,
if (sym != NULL) if (sym != NULL)
return sym; return sym;
if (language == language_cplus) if (language == language_cplus || language == language_fortran)
{ {
sym = cp_lookup_symbol_imports (scope, sym = cp_lookup_symbol_imports (scope,
name, name,
@ -3582,7 +3590,8 @@ add_partial_symbol_name (const char *name, void *user_data)
} }
char ** 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 /* Problem: All of the symbols have to be copied because readline
frees them. I'm not going to worry about this; hopefully there frees them. I'm not going to worry about this; hopefully there
@ -3645,7 +3654,7 @@ default_make_symbol_completion_list (char *text, char *word)
while (p > text) while (p > text)
{ {
if (isalnum (p[-1]) || p[-1] == '_' || p[-1] == '\0' if (isalnum (p[-1]) || p[-1] == '_' || p[-1] == '\0'
|| p[-1] == ':') || p[-1] == ':' || strchr (break_on, p[-1]) != NULL)
--p; --p;
else else
break; break;
@ -3771,6 +3780,12 @@ default_make_symbol_completion_list (char *text, char *word)
return (return_val); 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) /* Return a NULL terminated array of all symbols (regardless of class)
which begin by matching TEXT. If the answer is no symbols, then which begin by matching TEXT. If the answer is no symbols, then
the return value is an array which contains only a NULL pointer. */ the return value is an array which contains only a NULL pointer. */

View File

@ -1116,6 +1116,8 @@ extern void forget_cached_source_info (void);
extern void select_source_symtab (struct symtab *); 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 **default_make_symbol_completion_list (char *, char *);
extern char **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 *, extern char **make_symbol_completion_list_fn (struct cmd_list_element *,

View File

@ -1,3 +1,20 @@
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> 2010-06-02 Jan Kratochvil <jan.kratochvil@redhat.com>
* gdb.cp/ref-types.exp (pass, pass, pass): Rename to ... * gdb.cp/ref-types.exp (pass, pass, pass): Rename to ...

View File

@ -0,0 +1,29 @@
! 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

View File

@ -0,0 +1,23 @@
! 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

View File

@ -0,0 +1,58 @@
# 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\\."

View File

@ -15,21 +15,54 @@
set testfile "module" set testfile "module"
set srcfile ${testfile}.f90 set srcfile ${testfile}.f90
set binfile ${objdir}/${subdir}/${testfile}
if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } { if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f77}] } {
untested "Couldn't compile ${srcfile}"
return -1 return -1
} }
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
gdb_load ${binfile}
if ![runto MAIN__] then { if ![runto MAIN__] then {
perror "couldn't run to breakpoint MAIN__" perror "couldn't run to breakpoint MAIN__"
continue 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"
}

View File

@ -13,10 +13,39 @@
! You should have received a copy of the GNU General Public License ! You should have received a copy of the GNU General Public License
! along with this program. If not, see <http://www.gnu.org/licenses/>. ! along with this program. If not, see <http://www.gnu.org/licenses/>.
module mod module mod1
integer :: i = 42 integer :: var_i = 1
end module mod end module mod1
use mod module mod2
print *, i 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 end