[patch 2/2] Fix not-only rename list for Fortran modules import

[Jan Kratochvil <jan dot kratochvil at redhat dot com>]

Hi,

with the Fortran modules support inclusion some time ago I forgot about one
case, bugreported by Tobias Burnus.

No regressions on {x86_64,x86_64-m32,i686}-fedora15-linux-gnu.


Thanks,
Jan


gdb/
2011-06-24  Jan Kratochvil  <jan.kratochvil@redhat.com>

	Fix not-only rename list for Fortran modules import.
	* cp-namespace.c (cp_scan_for_anonymous_namespaces): Adjust the
	cp_add_using_directive caller.
	(cp_add_using_directive): New parameter excludes, describe it.  New
	variables ix and param.  Compare if also excludes match.  Allocate NEW
	with variable size, initialize EXCLUDES there.
	(cp_lookup_symbol_imports): New variable excludep, test
	current->EXCLUDES with it.
	* cp-support.h: Include vec.h.
	(struct using_direct): New field excludes, describe it.
	(DEF_VEC_P (const_char_ptr)): New.
	(cp_add_using_directive): New parameter excludes.
	* defs.h (const_char_ptr): New typedef.
	* dwarf2read.c (read_import_statement): New variables child_die,
	excludes and cleanups, read in excludes.
	(read_namespace): Adjust the cp_add_using_directive caller.

gdb/testsuite/
2011-06-24  Jan Kratochvil  <jan.kratochvil@redhat.com>

	* gdb.fortran/module.exp (print var_x, print var_y, print var_z): New
	tests.
	* gdb.fortran/module.f90 (module moduse): New.
	(program module): use moduse, test var_x, var_y and var_z.

--- a/gdb/cp-namespace.c
+++ b/gdb/cp-namespace.c
@@ -95,7 +95,7 @@ cp_scan_for_anonymous_namespaces (const struct symbol *symbol)
 		 anonymous namespace.  So add symbols in it to the
 		 namespace given by the previous component if there is
 		 one, or to the global namespace if there isn't.  */
-	      cp_add_using_directive (dest, src, NULL, NULL,
+	      cp_add_using_directive (dest, src, NULL, NULL, NULL,
 	                              &SYMBOL_SYMTAB (symbol)->objfile->objfile_obstack);
 	    }
 	  /* The "+ 2" is for the "::".  */
@@ -116,19 +116,24 @@ cp_scan_for_anonymous_namespaces (const struct symbol *symbol)
    in the current scope.  If ALIAS is NULL then the namespace is known
    by its original name.  DECLARATION is the name if the imported
    varable if this is a declaration import (Eg. using A::x), otherwise
-   it is NULL.  The arguments are copied into newly allocated memory
-   so they can be temporaries.  */
+   it is NULL.  EXCLUDES is a list of names not to import from an imported
+   module or NULL.  The arguments are copied into newly allocated memory so
+   they can be temporaries.  For EXCLUDES the VEC pointers are copied but the
+   pointed to characters are not copied.  */
 
 void
 cp_add_using_directive (const char *dest,
 			const char *src,
 			const char *alias,
 			const char *declaration,
+			VEC (const_char_ptr) *excludes,
                         struct obstack *obstack)
 {
   struct using_direct *current;
   struct using_direct *new;
-  
+  int ix;
+  const char *param;
+
   /* Has it already been added?  */
 
   for (current = using_directives; current != NULL; current = current->next)
@@ -148,11 +153,23 @@ cp_add_using_directive (const char *dest,
 	      && strcmp (declaration, current->declaration) != 0))
 	continue;
 
+      /* Compare the contents of EXCLUDES.  */
+      for (ix = 0; VEC_iterate (const_char_ptr, excludes, ix, param); ix++)
+	if (current->excludes[ix] == NULL
+	    || strcmp (param, current->excludes[ix]) != 0)
+	  break;
+      if (ix < VEC_length (const_char_ptr, excludes)
+	  || current->excludes[ix] != NULL)
+	continue;
+
       /* Parameters exactly match CURRENT.  */
       return;
     }
 
-  new = OBSTACK_ZALLOC (obstack, struct using_direct);
+  new = obstack_alloc (obstack, (sizeof (*new)
+				 + (VEC_length (const_char_ptr, excludes)
+				    * sizeof (*new->excludes))));
+  memset (new, 0, sizeof (*new));
 
   new->import_src = obsavestring (src, strlen (src), obstack);
   new->import_dest = obsavestring (dest, strlen (dest), obstack);
@@ -164,6 +181,10 @@ cp_add_using_directive (const char *dest,
     new->declaration = obsavestring (declaration, strlen (declaration),
                                      obstack);
 
+  for (ix = 0; VEC_iterate (const_char_ptr, excludes, ix, param); ix++)
+    new->excludes[ix] = param;
+  new->excludes[ix] = NULL;
+
   new->next = using_directives;
   using_directives = new;
 }
@@ -332,6 +353,8 @@ cp_lookup_symbol_imports (const char *scope,
        current != NULL;
        current = current->next)
     {
+      const char **excludep;
+
       len = strlen (current->import_dest);
       directive_match = (search_parents
                          ? (strncmp (scope, current->import_dest,
@@ -377,6 +400,16 @@ cp_lookup_symbol_imports (const char *scope,
             continue;
           }
 
+	/* Do not follow CURRENT if NAME matches its EXCLUDES.  */
+	for (excludep = current->excludes; *excludep; excludep++)
+	  if (strcmp (name, *excludep) == 0)
+	    break;
+	if (*excludep)
+	  {
+	    discard_cleanups (searched_cleanup);
+	    continue;
+	  }
+
 	if (current->alias != NULL
 	    && strcmp (name, current->alias) == 0)
 	  /* If the import is creating an alias and the alias matches
--- a/gdb/cp-support.h
+++ b/gdb/cp-support.h
@@ -27,6 +27,8 @@
 
 #include "symtab.h"
 
+#include "vec.h"
+
 /* Opaque declarations.  */
 
 struct symbol;
@@ -60,6 +62,7 @@ struct demangle_component;
    import_dest = local scope of the import statement even such as ""
    alias = NULL
    declaration = NULL
+   excludes = NULL
 
    C++:      using A::x;
    Fortran:  use A, only: x
@@ -67,14 +70,32 @@ struct demangle_component;
    import_dest = local scope of the import statement even such as ""
    alias = NULL
    declaration = "x"
+   excludes = NULL
    The declaration will get imported as import_dest::x.
 
+   C++ has no way to import all names except those listed ones.
+   Fortran:  use A, localname => x
+   import_src = "A"
+   import_dest = local scope of the import statement even such as ""
+   alias = "localname"
+   declaration = "x"
+   excludes = NULL
+   +
+   import_src = "A"
+   import_dest = local scope of the import statement even such as ""
+   alias = NULL
+   declaration = NULL
+   excludes = ["x"]
+   All the entries of A get imported except of "x".  "x" gets imported as
+   "localname".  "x" is not defined as a local name by this statement.
+
    C++:      namespace LOCALNS = A;
    Fortran has no way to address non-local namespace/module.
    import_src = "A"
    import_dest = local scope of the import statement even such as ""
    alias = "LOCALNS"
    declaration = NULL
+   excludes = NULL
    The namespace will get imported as the import_dest::LOCALNS
    namespace.
 
@@ -85,6 +106,7 @@ struct demangle_component;
    import_dest = local scope of the import statement even such as ""
    alias = "localname"
    declaration = "x"
+   excludes = NULL
    The declaration will get imported as localname or
    `import_dest`localname.  */
 
@@ -101,6 +123,10 @@ struct using_direct
   /* Used during import search to temporarily mark this node as
      searched.  */
   int searched;
+
+  /* USING_DIRECT has variable allocation size according to the number of
+     EXCLUDES entries, the last entry is NULL.  */
+  const char *excludes[1];
 };
 
 
@@ -136,10 +162,13 @@ extern int cp_validate_operator (const char *input);
 
 extern int cp_is_anonymous (const char *namespace);
 
+DEF_VEC_P (const_char_ptr);
+
 extern void cp_add_using_directive (const char *dest,
                                     const char *src,
                                     const char *alias,
 				    const char *declaration,
+				    VEC (const_char_ptr) *excludes,
                                     struct obstack *obstack);
 
 extern void cp_initialize_namespace (void);
--- a/gdb/defs.h
+++ b/gdb/defs.h
@@ -271,9 +271,10 @@ struct cleanup
     void *arg;
   };
 
-/* vec.h-style vectors of strings want a typedef for char * .  */
+/* vec.h-style vectors of strings want a typedef for char * or const char *.  */
 
 typedef char * char_ptr;
+typedef const char * const_char_ptr;
 
 /* Needed for various prototypes */
 
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -5178,7 +5178,7 @@ static void
 read_import_statement (struct die_info *die, struct dwarf2_cu *cu)
 {
   struct attribute *import_attr;
-  struct die_info *imported_die;
+  struct die_info *imported_die, *child_die;
   struct dwarf2_cu *imported_cu;
   const char *imported_name;
   const char *imported_name_prefix;
@@ -5186,6 +5186,8 @@ read_import_statement (struct die_info *die, struct dwarf2_cu *cu)
   const char *import_alias;
   const char *imported_declaration = NULL;
   const char *import_prefix;
+  VEC (const_char_ptr) *excludes = NULL;
+  struct cleanup *cleanups;
 
   char *temp;
 
@@ -5265,11 +5267,60 @@ read_import_statement (struct die_info *die, struct dwarf2_cu *cu)
   else
     canonical_name = imported_name;
 
+  cleanups = make_cleanup (VEC_cleanup (const_char_ptr), &excludes);
+
+  if (die->tag == DW_TAG_imported_module && cu->language == language_fortran)
+    for (child_die = die->child; child_die && child_die->tag;
+	 child_die = sibling_die (child_die))
+      {
+	/* DWARF-4: A Fortran use statement with a “rename list” may be
+	   represented by an imported module entry with an import attribute
+	   referring to the module and owned entries corresponding to those
+	   entities that are renamed as part of being imported.  */
+
+	if (child_die->tag != DW_TAG_imported_declaration)
+	  {
+	    complaint (&symfile_complaints,
+		       _("child DW_TAG_imported_declaration expected "
+			 "- DIE at 0x%x [in module %s]"),
+		       child_die->offset, cu->objfile->name);
+	    continue;
+	  }
+
+	import_attr = dwarf2_attr (child_die, DW_AT_import, cu);
+	if (import_attr == NULL)
+	  {
+	    complaint (&symfile_complaints, _("Tag '%s' has no DW_AT_import"),
+		       dwarf_tag_name (child_die->tag));
+	    continue;
+	  }
+
+	imported_cu = cu;
+	imported_die = follow_die_ref_or_sig (child_die, import_attr,
+					      &imported_cu);
+	imported_name = dwarf2_name (imported_die, imported_cu);
+	if (imported_name == NULL)
+	  {
+	    complaint (&symfile_complaints,
+		       _("child DW_TAG_imported_declaration has unknown "
+			 "imported name - DIE at 0x%x [in module %s]"),
+		       child_die->offset, cu->objfile->name);
+	    continue;
+	  }
+
+	VEC_safe_push (const_char_ptr, excludes, imported_name);
+
+	process_die (child_die, cu);
+      }
+
   cp_add_using_directive (import_prefix,
                           canonical_name,
                           import_alias,
                           imported_declaration,
+			  excludes,
                           &cu->objfile->objfile_obstack);
+
+  do_cleanups (cleanups);
 }
 
 static void
@@ -7797,7 +7848,7 @@ read_namespace (struct die_info *die, struct dwarf2_cu *cu)
 	  const char *previous_prefix = determine_prefix (die, cu);
 
 	  cp_add_using_directive (previous_prefix, TYPE_NAME (type), NULL,
-	                          NULL, &objfile->objfile_obstack);
+				  NULL, NULL, &objfile->objfile_obstack);
 	}
     }
 
--- a/gdb/testsuite/gdb.fortran/module.exp
+++ b/gdb/testsuite/gdb.fortran/module.exp
@@ -51,6 +51,9 @@ 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 "print var_x" " = 30" "print var_x value 30"
+gdb_test "print var_y" "No symbol \"var_y\" in current context\\."
+gdb_test "print var_z" " = 31" "print var_x value 31"
 
 gdb_test "ptype modmany" {No symbol "modmany" in current context.}
 
--- a/gdb/testsuite/gdb.fortran/module.f90
+++ b/gdb/testsuite/gdb.fortran/module.f90
@@ -27,6 +27,10 @@ module modmany
         integer :: var_a = 10, var_b = 11, var_c = 12, var_i = 14
 end module modmany
 
+module moduse
+        integer :: var_x = 30, var_y = 31
+end module moduse
+
         subroutine sub1
         use mod1
         if (var_i .ne. 1) call abort
@@ -42,6 +46,7 @@ end module modmany
         program module
 
         use modmany, only: var_b, var_d => var_c, var_i
+        use moduse, var_z => var_y
 
         call sub1
         call sub2
@@ -49,5 +54,7 @@ end module modmany
         if (var_b .ne. 11) call abort
         if (var_d .ne. 12) call abort
         if (var_i .ne. 14) call abort
+        if (var_x .ne. 30) call abort
+        if (var_z .ne. 31) call abort
         var_b = var_b                         ! a-b-c-d
 end