public inbox for gdb-patches@sourceware.org
 help / color / mirror / Atom feed
* [patch 3/3] Fortran modules namespaces
@ 2010-04-30 18:24 Jan Kratochvil
  2010-05-08  5:55 ` [patch 3/3] Fortran modules namespaces [rediff] Jan Kratochvil
  0 siblings, 1 reply; 6+ messages in thread
From: Jan Kratochvil @ 2010-04-30 18:24 UTC (permalink / raw)
  To: gdb-patches

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

^ permalink raw reply	[flat|nested] 6+ messages in thread

* [patch 3/3] Fortran modules namespaces [rediff]
  2010-04-30 18:24 [patch 3/3] Fortran modules namespaces Jan Kratochvil
@ 2010-05-08  5:55 ` Jan Kratochvil
  2010-06-01 22:01   ` Tom Tromey
  0 siblings, 1 reply; 6+ messages in thread
From: Jan Kratochvil @ 2010-05-08  5:55 UTC (permalink / raw)
  To: gdb-patches

Small update due to the checked-in `[patch 1/3] Make obconcat use stdarg'.
------------------------------------------------------------------------------
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,
@@ -260,6 +261,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
@@ -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 *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 *);
 
@@ -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 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 *);
 
@@ -2194,12 +2196,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)
 	    {
@@ -2312,6 +2314,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
@@ -2322,7 +2325,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.  */
@@ -2354,7 +2357,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
@@ -2540,9 +2543,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);
@@ -3201,6 +3202,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:
@@ -3255,7 +3257,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
@@ -3288,9 +3291,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))
 	{
@@ -3302,7 +3325,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);
 	    }
@@ -3351,21 +3375,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;
 }
@@ -3472,7 +3481,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;
@@ -3965,7 +3975,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);
@@ -4300,6 +4310,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
@@ -5615,7 +5626,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,
@@ -5667,6 +5678,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
@@ -5674,8 +5708,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);
@@ -6621,6 +6653,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.  */
@@ -6752,6 +6785,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
@@ -8471,6 +8505,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;
@@ -8572,6 +8613,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
@@ -9066,6 +9121,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));
@@ -9097,8 +9155,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.
@@ -9150,6 +9208,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);
@@ -9169,18 +9228,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 = "::";
 
@@ -9192,7 +9265,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;
@@ -9200,7 +9274,7 @@ typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
   else
     {
       /* We have an obstack.  */
-      return obconcat (obs, prefix, sep, suffix, (char *) NULL);
+      return obconcat (obs, lead, prefix, sep, suffix, (char *) 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. */
@@ -308,6 +309,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 *,
@@ -335,15 +368,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
@@ -370,6 +370,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,
@@ -3562,7 +3570,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
@@ -3625,7 +3634,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;
@@ -3751,6 +3760,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

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [patch 3/3] Fortran modules namespaces [rediff]
  2010-05-08  5:55 ` [patch 3/3] Fortran modules namespaces [rediff] Jan Kratochvil
@ 2010-06-01 22:01   ` Tom Tromey
  2010-06-02 21:16     ` Jan Kratochvil
  0 siblings, 1 reply; 6+ messages in thread
From: Tom Tromey @ 2010-06-01 22:01 UTC (permalink / raw)
  To: Jan Kratochvil; +Cc: gdb-patches

>>>>> "Jan" == Jan Kratochvil <jan.kratochvil@redhat.com> writes:

Jan> Small update due to the checked-in `[patch 1/3] Make obconcat use stdarg'.

Thanks.  I'm sorry about the long delay in reviewing this.

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

Yeah, and Pascal.

Jan> There has to be made a decision how to make fully-qualified reference of
Jan> symbols in modules.  Fortran language itself must always import any such
Jan> symbol into the local namespace.  C++ uses just "::" for such case.
Jan> iDB (Intel Debugger) uses character `
[...]
Jan> As GDB prints just "void" (or "VOID") on "$any$garbage" the
Jan> character $ is not usable and I have chosen '.  If there are no
Jan> concerns about some compatibility with iDB I would vote for "::".

I think that if there is no choice arising from the language (I don't
know Fortran) then it is up to you.

Jan> --- a/gdb/cp-namespace.c
Jan> +++ b/gdb/cp-namespace.c
Jan> @@ -32,6 +32,7 @@
Jan>  #include "command.h"
Jan>  #include "frame.h"
Jan>  #include "buildsym.h"
Jan> +#include "language.h"

Jan>  static struct symbol *lookup_namespace_scope (const char *name,
Jan>  					      const struct block *block,
Jan> @@ -260,6 +261,15 @@ cp_lookup_symbol_in_namespace (const char *namespace,
Jan>      {
Jan>        return lookup_symbol_file (name, block, domain, 0);
Jan>      }
Jan> +  else if (current_language->la_language == language_fortran)

I don't think we should introduce uses of current_language into this code.
It should probably just be an argument.

Tom

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [patch 3/3] Fortran modules namespaces [rediff]
  2010-06-01 22:01   ` Tom Tromey
@ 2010-06-02 21:16     ` Jan Kratochvil
  2010-06-02 22:03       ` Tom Tromey
  0 siblings, 1 reply; 6+ messages in thread
From: Jan Kratochvil @ 2010-06-02 21:16 UTC (permalink / raw)
  To: Tom Tromey; +Cc: gdb-patches

On Wed, 02 Jun 2010 00:01:26 +0200, Tom Tromey wrote:
> >>>>> "Jan" == Jan Kratochvil <jan.kratochvil@redhat.com> writes:
> Jan> There has to be made a decision how to make fully-qualified reference of
> Jan> symbols in modules.  Fortran language itself must always import any such
> Jan> symbol into the local namespace.  C++ uses just "::" for such case.
> Jan> iDB (Intel Debugger) uses character `
> 
> I think that if there is no choice arising from the language (I don't
> know Fortran) then it is up to you.

While I do not know Fortran well I checked as I could and IMO the Fortran
language really never uses any module separator.

Therefore I choose the :: separator now.

Just it currently does not behave exactly as in C++.  In C++ if you have
	NAMESPACE::var_i
	NAMESPACE::var_j
then
	p NAME<tab> completes to: p NAMESPACE
and
	p NAMESPACE:<tab> completes to: p NAMESPACE::var_
while now for Fortran
	MODULE::var_i
	MODULE::var_j
immediately
	p MOD<tab> completes to: p MODULE::var_

But I find it OK as for Fortran is not useful to reference MODULE itself.
While NAMESPACE is also not useful for C++ it needs to support referencing
CLASS.  I have some draft patch for f-exp.y supporting it more like C++ but
IMO the current way is OK.  Moreover the current way is easier to implement so
the C++ style completion could be even mostly an incremental addon patch.


> I don't think we should introduce uses of current_language into this code.
> It should probably just be an argument.

By using the :: separator it can now safely fallback to the C++ case and this
part of the patch is thus dropped.


Thanks,
Jan


gdb/
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.

gdb/testsuite/
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.

--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -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 *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 *);
 
@@ -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 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 *);
 
@@ -2200,12 +2202,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)
 	    {
@@ -2318,6 +2320,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
@@ -2328,7 +2331,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.  */
@@ -2360,7 +2363,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
@@ -2546,9 +2549,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);
@@ -3210,6 +3211,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:
@@ -3265,7 +3267,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
@@ -3298,9 +3301,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))
 	{
@@ -3312,7 +3335,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);
@@ -3363,21 +3387,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;
 }
@@ -3484,7 +3493,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;
@@ -3981,7 +3991,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);
@@ -4316,6 +4326,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
@@ -5642,7 +5653,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,
@@ -5695,6 +5706,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
@@ -5702,8 +5736,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);
@@ -6693,6 +6725,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.  */
@@ -6824,6 +6857,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
@@ -8545,6 +8579,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;
@@ -8648,6 +8689,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
@@ -9129,6 +9184,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));
@@ -9160,8 +9218,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.
@@ -9213,6 +9271,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);
@@ -9232,18 +9291,27 @@ 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 && 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 = "::";
 
@@ -9256,7 +9324,8 @@ typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
     {
       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;
@@ -9264,7 +9333,7 @@ typename_concat (struct obstack *obs, const char *prefix, const char *suffix,
   else
     {
       /* We have an obstack.  */
-      return obconcat (obs, prefix, sep, suffix, (char *) NULL);
+      return obconcat (obs, lead, prefix, sep, suffix, (char *) 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. */
@@ -308,6 +309,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 *,
@@ -335,15 +368,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
@@ -370,6 +370,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
@@ -351,7 +351,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;
     }
@@ -465,6 +466,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;
 }
 
@@ -645,6 +651,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;
@@ -671,6 +678,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;
@@ -1156,7 +1164,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,
@@ -3582,7 +3590,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
@@ -3645,7 +3654,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;
@@ -3771,6 +3780,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,54 @@
 
 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"
+}
--- 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

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [patch 3/3] Fortran modules namespaces [rediff]
  2010-06-02 21:16     ` Jan Kratochvil
@ 2010-06-02 22:03       ` Tom Tromey
  2010-06-02 22:44         ` Jan Kratochvil
  0 siblings, 1 reply; 6+ messages in thread
From: Tom Tromey @ 2010-06-02 22:03 UTC (permalink / raw)
  To: Jan Kratochvil; +Cc: gdb-patches

>>>>> "Jan" == Jan Kratochvil <jan.kratochvil@redhat.com> writes:

Jan> Therefore I choose the :: separator now.

Great.

Jan> while now for Fortran
Jan> 	MODULE::var_i
Jan> 	MODULE::var_j
Jan> immediately
Jan> 	p MOD<tab> completes to: p MODULE::var_

I think this approach is fine.

This patch is ok.  Thanks.

Tom

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [patch 3/3] Fortran modules namespaces [rediff]
  2010-06-02 22:03       ` Tom Tromey
@ 2010-06-02 22:44         ` Jan Kratochvil
  0 siblings, 0 replies; 6+ messages in thread
From: Jan Kratochvil @ 2010-06-02 22:44 UTC (permalink / raw)
  To: Tom Tromey; +Cc: gdb-patches

On Thu, 03 Jun 2010 00:02:45 +0200, Tom Tromey wrote:
> This patch is ok.  Thanks.

Checked-in; it needed a small rediff for my patch:
	[obv] typename_concat: char * -> const char *
	http://sourceware.org/ml/gdb-patches/2010-06/msg00053.html


Thanks,
Jan


http://sourceware.org/ml/gdb-cvs/2010-06/msg00027.html

--- src/gdb/ChangeLog	2010/06/02 22:21:52	1.11866
+++ src/gdb/ChangeLog	2010/06/02 22:41:55	1.11867
@@ -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>
 
 	* remote.c (remote_get_noisy_reply): Remove trailing "\n" in call
--- src/gdb/testsuite/ChangeLog	2010/06/02 22:24:15	1.2309
+++ src/gdb/testsuite/ChangeLog	2010/06/02 22:41:56	1.2310
@@ -1,5 +1,22 @@
 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 ...
 	(print value of rUC, print value of rI, print value of UI): ... here.
 	* gdb.cp/anon-union.exp (pass): Rename to ...
--- src/gdb/dwarf2read.c	2010/06/02 20:03:42	1.392
+++ src/gdb/dwarf2read.c	2010/06/02 22:41:55	1.393
@@ -905,10 +905,9 @@
 
 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 *);
 
@@ -955,6 +954,9 @@
 
 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 *);
 
@@ -2198,12 +2200,12 @@
     {
       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)
 	    {
@@ -2316,6 +2318,7 @@
     }
 
   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
@@ -2326,7 +2329,7 @@
 	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.  */
@@ -2358,7 +2361,7 @@
   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
@@ -2544,9 +2547,7 @@
 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);
@@ -3208,6 +3209,7 @@
       read_namespace (die, cu);
       break;
     case DW_TAG_module:
+      processing_has_namespace_info = 1;
       read_module (die, cu);
       break;
     case DW_TAG_imported_declaration:
@@ -3263,7 +3265,8 @@
 	}
 
       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
@@ -3296,9 +3299,29 @@
   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))
 	{
@@ -3310,7 +3333,8 @@
 	  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);
@@ -3361,21 +3385,6 @@
 	    }
 	}
     }
-  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;
 }
@@ -3482,7 +3491,8 @@
      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;
@@ -3979,7 +3989,7 @@
                         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);
@@ -4314,6 +4324,7 @@
             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
@@ -5640,7 +5651,7 @@
   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,
@@ -5693,6 +5704,29 @@
     }
 }
 
+/* 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
@@ -5700,8 +5734,6 @@
 {
   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);
@@ -6691,6 +6723,7 @@
 	  && 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.  */
@@ -6822,6 +6855,7 @@
       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
@@ -8543,6 +8577,13 @@
       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;
@@ -8646,6 +8687,20 @@
 		{
 		  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
@@ -9127,6 +9182,9 @@
     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));
@@ -9158,8 +9216,8 @@
   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.
@@ -9211,6 +9269,7 @@
       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);
@@ -9230,18 +9289,27 @@
    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 = "::";
 
@@ -9254,7 +9322,8 @@
     {
       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;
@@ -9262,7 +9331,7 @@
   else
     {
       /* We have an obstack.  */
-      return obconcat (obs, prefix, sep, suffix, (char *) NULL);
+      return obconcat (obs, lead, prefix, sep, suffix, (char *) NULL);
     }
 }
 
--- src/gdb/f-exp.y	2010/04/20 17:22:18	1.32
+++ src/gdb/f-exp.y	2010/06/02 22:41:55	1.33
@@ -1128,14 +1128,14 @@
       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]);
   
--- src/gdb/f-lang.c	2010/05/06 23:36:39	1.61
+++ src/gdb/f-lang.c	2010/06/02 22:41:55	1.62
@@ -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. */
@@ -308,6 +309,38 @@
   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 *,
@@ -335,15 +368,15 @@
   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,
--- src/gdb/f-typeprint.c	2010/05/07 00:28:32	1.30
+++ src/gdb/f-typeprint.c	2010/06/02 22:41:55	1.31
@@ -370,6 +370,10 @@
       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,
--- src/gdb/gdbtypes.h	2010/05/05 17:07:40	1.128
+++ src/gdb/gdbtypes.h	2010/06/02 22:41:55	1.129
@@ -136,6 +136,8 @@
 
     TYPE_CODE_DECFLOAT,		/* Decimal floating point.  */
 
+    TYPE_CODE_MODULE,		/* Fortran module.  */
+
     /* Internal function type.  */
     TYPE_CODE_INTERNAL_FUNCTION
   };
--- src/gdb/symtab.c	2010/05/16 23:49:58	1.237
+++ src/gdb/symtab.c	2010/06/02 22:41:55	1.238
@@ -351,7 +351,8 @@
   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;
     }
@@ -465,6 +466,11 @@
 	  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;
 }
 
@@ -645,6 +651,7 @@
     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;
@@ -671,6 +678,7 @@
     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;
@@ -1156,7 +1164,7 @@
       if (sym != NULL)
 	return sym;
 
-      if (language == language_cplus)
+      if (language == language_cplus || language == language_fortran)
         {
           sym = cp_lookup_symbol_imports (scope,
                                           name,
@@ -3582,7 +3590,8 @@
 }
 
 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
@@ -3645,7 +3654,7 @@
 	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;
@@ -3771,6 +3780,12 @@
   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.  */
--- src/gdb/symtab.h	2010/04/22 23:15:42	1.152
+++ src/gdb/symtab.h	2010/06/02 22:41:55	1.153
@@ -1116,6 +1116,8 @@
 
 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 *,
--- src/gdb/testsuite/gdb.fortran/library-module-lib.f90
+++ src/gdb/testsuite/gdb.fortran/library-module-lib.f90	2010-06-02 22:42:12.757644000 +0000
@@ -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
--- src/gdb/testsuite/gdb.fortran/library-module-main.f90
+++ src/gdb/testsuite/gdb.fortran/library-module-main.f90	2010-06-02 22:42:13.071128000 +0000
@@ -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
--- src/gdb/testsuite/gdb.fortran/library-module.exp
+++ src/gdb/testsuite/gdb.fortran/library-module.exp	2010-06-02 22:42:13.376698000 +0000
@@ -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\\."
--- src/gdb/testsuite/gdb.fortran/module.exp	2010/01/01 07:32:02	1.2
+++ src/gdb/testsuite/gdb.fortran/module.exp	2010/06/02 22:41:56	1.3
@@ -15,21 +15,54 @@
 
 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"
+}
--- src/gdb/testsuite/gdb.fortran/module.f90	2010/01/01 09:44:07	1.2
+++ src/gdb/testsuite/gdb.fortran/module.f90	2010/06/02 22:41:56	1.3
@@ -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

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2010-06-02 22:44 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-04-30 18:24 [patch 3/3] Fortran modules namespaces Jan Kratochvil
2010-05-08  5:55 ` [patch 3/3] Fortran modules namespaces [rediff] Jan Kratochvil
2010-06-01 22:01   ` Tom Tromey
2010-06-02 21:16     ` Jan Kratochvil
2010-06-02 22:03       ` Tom Tromey
2010-06-02 22:44         ` Jan Kratochvil

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).