This is the mail archive of the gdb-patches@sourceware.org mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch 3/3] Fortran modules namespaces


Hi,

there was GDB PR fortran/9806 that FSF GDB started to recognize DW_AT_module.
But all the module variables had flat namespace completely violating any
Fortran language modules rules.

Patch implements DW_TAG_module like C++ DW_TAG_namespace on top of the
using-directive C++ patch and also on top of the physname patch.

While the patch has some parts a year old all the significant parts are now
unfortunately freshly replaced on top of using-directive + physname.

------------------------------------------------------------------------------

All the new tests PASS with:
gcc-gfortran-4.4.3-4.fc12.x86_64 (the only one used for the full regression run)
GNU Fortran (GCC) 4.4.5 20100430 (prerelease)
GNU Fortran (GCC) 4.5.1 20100430 (prerelease)
GNU Fortran (GCC) 4.6.0 20100430 (experimental)
Only the last one provides DW_AT_MIPS_linkage_name (GCC PR debug/40040).

------------------------------------------------------------------------------

With Portland Group Fortran this test fails:

pgilinux-104
    <70>   DW_AT_producer    : PGF90 10.4-0
Breakpoint 2, `lib`lib_func () at gdb.fortran/library-module-lib.f90:22
22              var_i = var_i                 ! i-is-2-in-lib
(gdb) print var_i
$1 = 1
(gdb) FAIL: gdb.fortran/library-module.exp: print var_i in lib

 <1><91>: Abbrev Number: 2 (DW_TAG_module)
    <92>   DW_AT_name        : lib
 <2><98>: Abbrev Number: 3 (DW_TAG_variable)
    <99>   DW_AT_name        : var_i
    <a3>   DW_AT_location    : 9 byte block: 3 c0 e 20 0 0 0 0 0        (DW_OP_addr: 200ec0)
 <2><ad>: Abbrev Number: 5 (DW_TAG_subprogram)
    <af>   DW_AT_name        : lib_func

 <1><92>: Abbrev Number: 2 (DW_TAG_subprogram)
    <94>   DW_AT_name        : MAIN
 <2><c7>: Abbrev Number: 4 (DW_TAG_variable)
    <c8>   DW_AT_name        : var_i
    <d6>   DW_AT_location    : 9 byte block: 3 10 2 62 0 0 0 0 0        (DW_OP_addr: 620210)

Relocation section '.rela.dyn' at offset 0x6038 contains 8 entries:
    Offset             Info             Type               Symbol's Value  Symbol's Name + Addend
0000000000620210  0000004a00000005 R_X86_64_COPY          0000000000620210 _lib_8_ + 0

This is just a bug of Portland Group Fortran, similar to the gcc one.  Library
should have only DW_AT_linkage_name (or DW_AT_MIPS_linkage_name) and it must
not have DW_AT_location itself.  This patch does not try to workaround this
Portland Group Fortran bug, it could be implemented similar to the existing
"Workaround gfortran PR debug/40040" and "typename_concat <physname>" code
there but I have not tried it.

(There are some minor general non-gfortran incompatibility of the
gdb/testsuite/gdb.fortran/ such as incompatible -B option to ../../g77 or
wrong expectation of the MAIN__ symbol.)

------------------------------------------------------------------------------

Intel Fortran Compiler (iFort) l_cprof_p_11.1.072_intel64.tgz works except of
those testcases referencing `modmany`... module.

    <66>   DW_AT_producer    : Intel(R) Fortran Compiler Fixes RangesRelative
 <1><234>: Abbrev Number: 6 (DW_TAG_module)
    <238>   DW_AT_name        : MODMANY

This case sensitivy problem is a bug of all of gdb, gfortran, PGF and iFort,
filed as GDB PR fortran/11560 and GCC PR debug/43950.

(There are some minor general non-gfortran incompatibility of the
gdb/testsuite/gdb.fortran/ such as wrong expectation of the MAIN__ symbol.)

------------------------------------------------------------------------------

There has to be made a decision how to make fully-qualified reference of
symbols in modules.  Fortran language itself must always import any such
symbol into the local namespace.  C++ uses just "::" for such case.
iDB (Intel Debugger) uses character `
	http://www.intel.com/software/products/compilers/flin/docs/for_ug1/ug1l_display_vars.htm
	(idb)    print ‘MODFILE‘J
while DIGITAL UNIX Ladebug was using character $
	http://www.helsinki.fi/atk/unix/dec_manuals/df90au52/dfum015.htm#sec_module_vars
	(ladebug) PRINT $MODFILE$J

As GDB prints just "void" (or "VOID") on "$any$garbage" the character $ is not
usable and I have chosen '.  If there are no concerns about some compatibility
with iDB I would vote for "::".

------------------------------------------------------------------------------

I have a small patch implementing the symbol_find_demangled_name part left
only as a comment here; see more the comment there.

"Workaround gfortran PR debug/40040" and "typename_concat <physname>" are
provided there as all GCCs 4.4.x and 4.5.0 (.x?) have this bug so I had to
workaround it anyway and I believe it is suitable even for FSF GDB.

No regressions on {x86_64,x86_64-m32,i686}-fedora12-linux-gnu for the whole
series.


Thanks,
Jan


gdb/
2010-04-30  Jan Kratochvil  <jan.kratochvil@redhat.com>

	Support DW_TAG_module as separate namespaces.
	* cp-namespace.c: Include language.h
	(cp_lookup_symbol_in_namespace) <language_fortran>: New.
	* 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 gfotran 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/
2010-04-30  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 `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.

--- a/gdb/cp-namespace.c
+++ b/gdb/cp-namespace.c
@@ -32,6 +32,7 @@
 #include "command.h"
 #include "frame.h"
 #include "buildsym.h"
+#include "language.h"
 
 static struct symbol *lookup_namespace_scope (const char *name,
 					      const struct block *block,
@@ -261,6 +262,15 @@ cp_lookup_symbol_in_namespace (const char *namespace,
     {
       return lookup_symbol_file (name, block, domain, 0);
     }
+  else if (current_language->la_language == language_fortran)
+    {
+      char *concatenated_name;
+      
+      concatenated_name = alloca (1 + strlen (namespace) + 1 + strlen (name)
+				  + 1);
+      sprintf (concatenated_name, "`%s`%s", namespace, name);
+      return lookup_symbol_file (concatenated_name, block, domain, 0);
+    }
   else
     {
       char *concatenated_name = alloca (strlen (namespace) + 2 +
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -908,10 +908,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 *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 *);
 
@@ -958,6 +957,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 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 *);
 
@@ -2204,12 +2206,12 @@ scan_partial_symbols (struct partial_die_info *first_die, CORE_ADDR *lowpc,
     {
       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)
 	    {
@@ -2322,6 +2324,7 @@ partial_die_parent_scope (struct partial_die_info *pdi,
     }
 
   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
@@ -2332,7 +2335,7 @@ partial_die_parent_scope (struct partial_die_info *pdi,
 	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.  */
@@ -2364,7 +2367,7 @@ partial_die_full_name (struct partial_die_info *pdi,
   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
@@ -2553,9 +2556,7 @@ 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);
@@ -3218,6 +3219,7 @@ process_die (struct die_info *die, struct dwarf2_cu *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:
@@ -3272,7 +3274,8 @@ die_needs_namespace (struct die_info *die, struct dwarf2_cu *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;
       /* A variable in a lexical block of some kind does not need a
 	 namespace, even though in C++ such variables may be external
@@ -3305,9 +3308,29 @@ dwarf2_compute_name (char *name, struct die_info *die, struct dwarf2_cu *cu,
   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))
 	{
@@ -3319,7 +3342,8 @@ dwarf2_compute_name (char *name, struct die_info *die, struct dwarf2_cu *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);
 	    }
@@ -3368,21 +3392,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;
 }
@@ -3489,7 +3498,8 @@ read_import_statement (struct die_info *die, struct dwarf2_cu *cu)
      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;
@@ -3984,7 +3994,7 @@ read_func_scope (struct die_info *die, struct dwarf2_cu *cu)
                         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);
@@ -4319,6 +4329,7 @@ get_scope_pc_bounds (struct die_info *die,
             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
@@ -5636,7 +5647,7 @@ read_namespace_type (struct die_info *die, struct dwarf2_cu *cu)
   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,
@@ -5688,6 +5699,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.  */
 
 static void
@@ -5695,8 +5729,6 @@ read_module (struct die_info *die, struct dwarf2_cu *cu)
 {
   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);
@@ -6644,6 +6676,7 @@ load_partial_dies (bfd *abfd, gdb_byte *buffer, gdb_byte *info_ptr,
 	  && 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.  */
@@ -6775,6 +6808,7 @@ load_partial_dies (bfd *abfd, gdb_byte *buffer, gdb_byte *info_ptr,
       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
@@ -8494,6 +8528,13 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
       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;
@@ -8595,6 +8636,20 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu)
 		{
 		  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
@@ -9089,6 +9144,9 @@ read_type_die (struct die_info *die, struct dwarf2_cu *cu)
     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));
@@ -9120,8 +9178,8 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
   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.
@@ -9173,6 +9231,7 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
       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);
@@ -9192,18 +9251,32 @@ determine_prefix (struct die_info *die, struct dwarf2_cu *cu)
    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)
 {
-  char *sep;
+  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)
+    {
+      /* This is gfortran specific mangling.  Normally DW_AT_linkage_name or
+	 DW_AT_MIPS_linkage_name is preferred and used instead.  */
+
+      if (physname)
+	{
+	  lead = "__";
+	  sep = "_MOD_";
+	}
+      else
+	lead = sep = "`";
+    }
   else
     sep = "::";
 
@@ -9215,7 +9288,8 @@ typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
   if (obs == NULL)
     {
       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;
@@ -9223,7 +9297,7 @@ typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
   else
     {
       /* We have an obstack.  */
-      return obconcat (obs, prefix, sep, suffix, NULL);
+      return obconcat (obs, lead, prefix, sep, suffix, NULL);
     }
 }
 
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -1128,14 +1128,14 @@ yylex ()
       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]);
   
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -31,6 +31,7 @@
 #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. */
@@ -309,6 +310,38 @@ f_language_arch_info (struct gdbarch *gdbarch,
   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 *,
@@ -336,15 +369,15 @@ const struct language_defn f_language_defn =
   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,
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -372,6 +372,10 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
       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,
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -136,6 +136,8 @@ enum type_code
 
     TYPE_CODE_DECFLOAT,		/* Decimal floating point.  */
 
+    TYPE_CODE_MODULE,		/* Fortran module.  */
+
     /* Internal function type.  */
     TYPE_CODE_INTERNAL_FUNCTION
   };
--- a/gdb/symtab.c
+++ b/gdb/symtab.c
@@ -349,7 +349,8 @@ symbol_init_language_specific (struct general_symbol_info *gsymbol,
   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;
     }
@@ -461,6 +462,11 @@ symbol_find_demangled_name (struct general_symbol_info *gsymbol,
 	  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;
 }
 
@@ -641,6 +647,7 @@ symbol_natural_name (const struct general_symbol_info *gsymbol)
     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;
@@ -667,6 +674,7 @@ symbol_demangled_name (const struct general_symbol_info *gsymbol)
     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;
@@ -1149,7 +1157,7 @@ lookup_symbol_aux_local (const char *name, const struct block *block,
       if (sym != NULL)
 	return sym;
 
-      if (language == language_cplus)
+      if (language == language_cplus || language == language_fortran)
         {
           sym = cp_lookup_symbol_imports (scope,
                                           name,
@@ -3568,7 +3576,8 @@ add_partial_symbol_name (const char *name, void *user_data)
 }
 
 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
@@ -3631,7 +3640,7 @@ default_make_symbol_completion_list (char *text, char *word)
 	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;
@@ -3757,6 +3766,12 @@ default_make_symbol_completion_list (char *text, char *word)
   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.  */
--- a/gdb/symtab.h
+++ b/gdb/symtab.h
@@ -1116,6 +1116,8 @@ extern void forget_cached_source_info (void);
 
 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 *,
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/library-module-lib.f90
@@ -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
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/library-module-main.f90
@@ -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
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/library-module.exp
@@ -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\\."
--- a/gdb/testsuite/gdb.fortran/module.exp
+++ b/gdb/testsuite/gdb.fortran/module.exp
@@ -15,21 +15,55 @@
 
 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"
+}
+complete "modm" ""
+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"
+}
--- a/gdb/testsuite/gdb.fortran/module.f90
+++ b/gdb/testsuite/gdb.fortran/module.f90
@@ -13,10 +13,39 @@
 ! 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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]