Dear all,

this email contains a updated patch, which replaces the FIXME by an implementation. See below.


Dear Dominique,

On 01/08/2012 11:13 PM, Dominique Dhumieres wrote:
Your patch passed my tests and in top of that fixes the ICE for pr51522.f90.
:-)

However I don't understand the errors:

   integer(c_int) function vect_Utils_vuTriIneqHolds_c(u, v, tol, exception)&
           1
Error: Parameter 'c_int' at (1) has not been declared or is a variable, which 
does not reduce to a constant expression

   real(c_double) function vect_Utils_vuNorm_c(u, tol, badLevel, exception) bind
        1
Error: Parameter 'c_double' at (1) has not been declared or is a variable, 
which does not reduce to a constant expression

Is it related to the FIXME?

No, it's related to two bugs in the source code:
a) The USE statement is not a statement by its own (due to the tailing "&")
b) There is no USE statement for:  vect_Utils_vuNorm_c

I think the error message for (b) is good. I admit that for (a) a syntax error would have been better.

Excerpt from the test case (which has been created using "delta" which deletes lines, honouring certain constraints):

integer(c_int) function vect_Utils_vuTriIneqHolds_c(u, v, tol, exception) &
    use, intrinsic :: iso_c_binding
real(c_double) function vect_Utils_vuNorm_c(u, tol, badLevel, exception) bind(c)
  end function vect_Utils_vuNorm_c

* * *

Regarding the FIXME: No, it is completely unrelated and it is rather difficult to encounter.

Ingredients for reject-valid bugs related to the FIXME:
- One needs to USE a module name of an intrinsic module (iso_* or omp*)
- No non_intrinsic module with that name exists
- Multiple USE statements are used - some but not all with INTRINSIC attribute
- One renames symbols
- One uses the renamed-away symbols for other purposes

I believe that it is very unlikely that someone generates such a code.

Example:
  use iso_c_binding
  use, intrinsic :: iso_c_binding, c_double_orig => c_double
  integer :: c_double

That's valid and rejected. If a non_intrinsic module "iso_c_binding" exists, the code actually works correctly. It only wrongly use-associates "c_double" if no non_intrinsic module exists. Workaround: Use "intrinsic" in both USE statements - or in none.


However, I have now decided that it is better to actually implement the FIXME; the updated patch is attached. (It was simpler than expected.) Only gfc_use_modules has been changed and a new test case been added.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
2012-01-09  Tobias Burnus  <bur...@net-b.de>

	PR fortran/51578
	* gfortran.h (gfc_use_list):
	* match.h (gfc_use_module): Rename to ...
	(gfc_use_modules): ... this.
	* module.c (use_locus, specified_nonint, specified_int): Remove
	global variable.
	(module_name): Change type to const char*, used with gfc_get_string.
	(module_list): New global variable.
	(free_rename): Free argument not global var.
	(gfc_match_use): Save match to module_list.
	(load_generic_interfaces, read_module): Don't free symtree.
	(write_dt_extensions, gfc_dump_module): Fix module-name I/O due to the
	type change of module_name.
	(write_symbol0, write_generic): Optimize due to the type change.
	(import_iso_c_binding_module, use_iso_fortran_env_module): Use
	locus of rename->where.
	(gfc_use_module): Take module_list as argument.
	(gfc_use_modules): New function.
	(gfc_module_init_2, gfc_module_done_2): Init module_list, rename_list.
	* parse.c (last_was_use_stmt): New global variable.
	(use_modules): New function.
	(decode_specification_statement, decode_statement): Move USE match up
	and call use_modules.
	(next_free, next_fixed): Call use_modules.
	(accept_statement): Don't call gfc_module_use.

2012-01-09  Tobias Burnus  <bur...@net-b.de>

	PR fortran/51578
	* gfortran.dg/use_17.f90: New.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e8a3de0..f339271 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1299,7 +1299,9 @@ gfc_use_rename;
 typedef struct gfc_use_list
 {
   const char *module_name;
-  int only_flag;
+  bool intrinsic;
+  bool non_intrinsic;
+  bool only_flag;
   struct gfc_use_rename *rename;
   locus where;
   /* Next USE statement.  */
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index df18074..a5d5497 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -249,7 +249,7 @@ match gfc_match_expr (gfc_expr **);
 
 /* module.c.  */
 match gfc_match_use (void);
-void gfc_use_module (void);
+void gfc_use_modules (void);
 
 #endif  /* GFC_MATCH_H  */
 
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 1ab08ae..1542263 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -188,10 +188,8 @@ static FILE *module_fp;
 static struct md5_ctx ctx;
 
 /* The name of the module we're reading (USE'ing) or writing.  */
-static char module_name[GFC_MAX_SYMBOL_LEN + 1];
-
-/* The way the module we're reading was specified.  */
-static bool specified_nonint, specified_int;
+static const char *module_name;
+static gfc_use_list *module_list;
 
 static int module_line, module_column, only_flag;
 static int prev_module_line, prev_module_column, prev_character;
@@ -207,8 +205,6 @@ static int symbol_number;	/* Counter for assigning symbol numbers */
 /* Tells mio_expr_ref to make symbols for unused equivalence members.  */
 static bool in_load_equiv;
 
-static locus use_locus;
-
 
 
 /*****************************************************************/
@@ -519,14 +515,14 @@ add_fixup (int integer, void *gp)
 /* Free the rename list left behind by a USE statement.  */
 
 static void
-free_rename (void)
+free_rename (gfc_use_rename *list)
 {
   gfc_use_rename *next;
 
-  for (; gfc_rename_list; gfc_rename_list = next)
+  for (; list; list = next)
     {
-      next = gfc_rename_list->next;
-      free (gfc_rename_list);
+      next = list->next;
+      free (list);
     }
 }
 
@@ -541,29 +537,29 @@ gfc_match_use (void)
   interface_type type, type2;
   gfc_intrinsic_op op;
   match m;
-
-  specified_int = false;
-  specified_nonint = false;
-
+  gfc_use_list *use_list;
+ 
+  use_list = gfc_get_use_list ();
+  
   if (gfc_match (" , ") == MATCH_YES)
     {
       if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES)
 	{
 	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module "
 			      "nature in USE statement at %C") == FAILURE)
-	    return MATCH_ERROR;
+	    goto cleanup;
 
 	  if (strcmp (module_nature, "intrinsic") == 0)
-	    specified_int = true;
+	    use_list->intrinsic = true;
 	  else
 	    {
 	      if (strcmp (module_nature, "non_intrinsic") == 0)
-		specified_nonint = true;
+		use_list->non_intrinsic = true;
 	      else
 		{
 		  gfc_error ("Module nature in USE statement at %C shall "
 			     "be either INTRINSIC or NON_INTRINSIC");
-		  return MATCH_ERROR;
+		  goto cleanup;
 		}
 	    }
 	}
@@ -576,6 +572,7 @@ gfc_match_use (void)
 	      || strcmp (module_nature, "non_intrinsic") == 0)
 	    gfc_error ("\"::\" was expected after module nature at %C "
 		       "but was not found");
+	  free (use_list);
 	  return m;
 	}
     }
@@ -585,35 +582,41 @@ gfc_match_use (void)
       if (m == MATCH_YES &&
 	  gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
 			  "\"USE :: module\" at %C") == FAILURE)
-	return MATCH_ERROR;
+	goto cleanup;
 
       if (m != MATCH_YES)
 	{
 	  m = gfc_match ("% ");
 	  if (m != MATCH_YES)
-	    return m;
+	    {
+	      free (use_list);
+	      return m;
+	    }
 	}
     }
 
-  use_locus = gfc_current_locus;
+  use_list->where = gfc_current_locus;
 
-  m = gfc_match_name (module_name);
+  m = gfc_match_name (name);
   if (m != MATCH_YES)
-    return m;
+    {
+      free (use_list);
+      return m;
+    }
 
-  free_rename ();
-  only_flag = 0;
+  use_list->module_name = gfc_get_string (name);
 
   if (gfc_match_eos () == MATCH_YES)
-    return MATCH_YES;
+    goto done;
+
   if (gfc_match_char (',') != MATCH_YES)
     goto syntax;
 
   if (gfc_match (" only :") == MATCH_YES)
-    only_flag = 1;
+    use_list->only_flag = true;
 
   if (gfc_match_eos () == MATCH_YES)
-    return MATCH_YES;
+    goto done;
 
   for (;;)
     {
@@ -622,8 +625,8 @@ gfc_match_use (void)
       new_use->where = gfc_current_locus;
       new_use->found = 0;
 
-      if (gfc_rename_list == NULL)
-	gfc_rename_list = new_use;
+      if (use_list->rename == NULL)
+	use_list->rename = new_use;
       else
 	tail->next = new_use;
       tail = new_use;
@@ -653,7 +656,7 @@ gfc_match_use (void)
 	  if (type == INTERFACE_USER_OP)
 	    new_use->op = INTRINSIC_USER;
 
-	  if (only_flag)
+	  if (use_list->only_flag)
 	    {
 	      if (m != MATCH_YES)
 		strcpy (new_use->use_name, name);
@@ -684,11 +687,11 @@ gfc_match_use (void)
 		goto cleanup;
 	    }
 
-	  if (strcmp (new_use->use_name, module_name) == 0
-	      || strcmp (new_use->local_name, module_name) == 0)
+	  if (strcmp (new_use->use_name, use_list->module_name) == 0
+	      || strcmp (new_use->local_name, use_list->module_name) == 0)
 	    {
 	      gfc_error ("The name '%s' at %C has already been used as "
-			 "an external module name.", module_name);
+			 "an external module name.", use_list->module_name);
 	      goto cleanup;
 	    }
 	  break;
@@ -707,15 +710,27 @@ gfc_match_use (void)
 	goto syntax;
     }
 
+done:
+  if (module_list)
+    {
+      gfc_use_list *last = module_list;
+      while (last->next)
+	last = last->next;
+      last->next = use_list;
+    }
+  else
+    module_list = use_list;
+
   return MATCH_YES;
 
 syntax:
   gfc_syntax_error (ST_USE);
 
 cleanup:
-  free_rename ();
+  free_rename (use_list->rename);
+  free (use_list);
   return MATCH_ERROR;
- }
+}
 
 
 /* Given a name and a number, inst, return the inst name
@@ -4016,20 +4031,7 @@ load_generic_interfaces (void)
 
 	  if (!sym)
 	    {
-	      /* Make the symbol inaccessible if it has been added by a USE
-		 statement without an ONLY(11.3.2).  */
-	      if (st && only_flag
-		     && !st->n.sym->attr.use_only
-		     && !st->n.sym->attr.use_rename
-		     && strcmp (st->n.sym->module, module_name) == 0)
-		{
-		  sym = st->n.sym;
-		  gfc_delete_symtree (&gfc_current_ns->sym_root, name);
-		  st = gfc_get_unique_symtree (gfc_current_ns);
-		  st->n.sym = sym;
-		  sym = NULL;
-		}
-	      else if (st)
+	      if (st)
 		{
 		  sym = st->n.sym;
 		  if (strcmp (st->name, p) != 0)
@@ -4046,7 +4048,7 @@ load_generic_interfaces (void)
 		{
 		  gfc_get_symbol (p, NULL, &sym);
 		  sym->name = gfc_get_string (name);
-		  sym->module = gfc_get_string (module_name);
+		  sym->module = module_name;
 		  sym->attr.flavor = FL_PROCEDURE;
 		  sym->attr.generic = 1;
 		  sym->attr.use_assoc = 1;
@@ -4434,7 +4436,7 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info)
      the new symbol is generic there can be no ambiguity.  */
   if (st_sym->attr.generic
 	&& st_sym->module
-	&& strcmp (st_sym->module, module_name))
+	&& st_sym->module != module_name)
     {
       /* The new symbol's attributes have not yet been read.  Since
 	 we need attr.generic, read it directly.  */
@@ -4609,16 +4611,6 @@ read_module (void)
 	    {
 	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
 
-	      /* Delete the symtree if the symbol has been added by a USE
-		 statement without an ONLY(11.3.2).  Remember that the rsym
-		 will be the same as the symbol found in the symtree, for
-		 this case.  */
-	      if (st && (only_flag || info->u.rsym.renamed)
-		     && !st->n.sym->attr.use_only
-		     && !st->n.sym->attr.use_rename
-		     && info->u.rsym.sym == st->n.sym)
-		gfc_delete_symtree (&gfc_current_ns->sym_root, name);
-
 	      /* Create a symtree node in the current namespace for this
 		 symbol.  */
 	      st = check_unique_name (p)
@@ -4649,9 +4641,6 @@ read_module (void)
 	      if (strcmp (name, p) != 0)
 		sym->attr.use_rename = 1;
 
-	      /* We need to set the only_flag here so that symbols from the
-		 same USE...ONLY but earlier are not deleted from the tree in
-		 the gfc_delete_symtree above.  */
 	      sym->attr.use_only = only_flag;
 
 	      /* Store the symtree pointing to this symbol.  */
@@ -4976,7 +4965,14 @@ write_dt_extensions (gfc_symtree *st)
   if (st->n.sym->module != NULL)
     mio_pool_string (&st->n.sym->module);
   else
-    mio_internal_string (module_name);
+    {
+      char name[GFC_MAX_SYMBOL_LEN + 1];
+      if (iomode == IO_OUTPUT)
+	strcpy (name, module_name);
+      mio_internal_string (name);
+      if (iomode == IO_INPUT)
+	module_name = gfc_get_string (name);
+    }
   mio_rparen ();
 }
 
@@ -5051,7 +5047,7 @@ write_symbol0 (gfc_symtree *st)
 
   sym = st->n.sym;
   if (sym->module == NULL)
-    sym->module = gfc_get_string (module_name);
+    sym->module = module_name;
 
   if (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
       && !sym->attr.subroutine && !sym->attr.function)
@@ -5142,7 +5138,7 @@ write_generic (gfc_symtree *st)
     return;
 
   if (sym->module == NULL)
-    sym->module = gfc_get_string (module_name);
+    sym->module = module_name;
 
   mio_symbol_interface (&st->name, &sym->module, &sym->generic);
 }
@@ -5378,7 +5374,7 @@ gfc_dump_module (const char *name, int dump_flag)
 
   /* Write the module itself.  */
   iomode = IO_OUTPUT;
-  strcpy (module_name, name);
+  module_name = gfc_get_string (name);
 
   init_pi_tree ();
 
@@ -5537,8 +5533,8 @@ import_iso_c_binding_module (void)
 
 	    if (not_in_std)
 	      {
-		gfc_error ("The symbol '%s', referenced at %C, is not "
-			   "in the selected standard", name);
+		gfc_error ("The symbol '%s', referenced at %L, is not "
+			   "in the selected standard", name, &u->where);
 		continue;
 	      }
 
@@ -5817,16 +5813,17 @@ use_iso_fortran_env_module (void)
 	      u->found = 1;
 
 	      if (gfc_notify_std (symbol[i].standard, "The symbol '%s', "
-				  "referenced at %C, is not in the selected "
-				  "standard", symbol[i].name) == FAILURE)
+				  "referenced at %L, is not in the selected "
+				  "standard", symbol[i].name,
+				  &u->where) == FAILURE)
 	        continue;
 
 	      if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
 		  && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
 		gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named "
 				 "constant from intrinsic module "
-				 "ISO_FORTRAN_ENV at %C is incompatible with "
-				 "option %s",
+				 "ISO_FORTRAN_ENV at %L is incompatible with "
+				 "option %s", &u->where,
 				 gfc_option.flag_default_integer
 				   ? "-fdefault-integer-8"
 				   : "-fdefault-real-8");
@@ -5959,8 +5956,8 @@ use_iso_fortran_env_module (void)
 
 /* Process a USE directive.  */
 
-void
-gfc_use_module (void)
+static void
+gfc_use_module (gfc_use_list *module)
 {
   char *filename;
   gfc_state_data *p;
@@ -5969,22 +5966,25 @@ gfc_use_module (void)
   gfc_use_list *use_stmt;
   locus old_locus = gfc_current_locus;
 
-  gfc_current_locus = use_locus;
+  gfc_current_locus = module->where;
+  module_name = module->module_name;
+  gfc_rename_list = module->rename;
+  only_flag = module->only_flag;
 
-  filename = (char *) alloca (strlen (module_name) + strlen (MODULE_EXTENSION)
-			      + 1);
+  filename = XALLOCAVEC (char, strlen (module_name) + strlen (MODULE_EXTENSION)
+			       + 1);
   strcpy (filename, module_name);
   strcat (filename, MODULE_EXTENSION);
 
   /* First, try to find an non-intrinsic module, unless the USE statement
      specified that the module is intrinsic.  */
   module_fp = NULL;
-  if (!specified_int)
+  if (!module->intrinsic)
     module_fp = gfc_open_included_file (filename, true, true);
 
   /* Then, see if it's an intrinsic one, unless the USE statement
      specified that the module is non-intrinsic.  */
-  if (module_fp == NULL && !specified_nonint)
+  if (module_fp == NULL && !module->non_intrinsic)
     {
       if (strcmp (module_name, "iso_fortran_env") == 0
 	  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ISO_FORTRAN_ENV "
@@ -5992,6 +5992,7 @@ gfc_use_module (void)
        {
 	 use_iso_fortran_env_module ();
 	 gfc_current_locus = old_locus;
+	 module->intrinsic = true;
 	 return;
        }
 
@@ -6001,12 +6002,13 @@ gfc_use_module (void)
 	{
 	  import_iso_c_binding_module();
 	  gfc_current_locus = old_locus;
+	  module->intrinsic = true;
 	  return;
 	}
 
       module_fp = gfc_open_intrinsic_module (filename);
 
-      if (module_fp == NULL && specified_int)
+      if (module_fp == NULL && module->intrinsic)
 	gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
 			 module_name);
     }
@@ -6083,11 +6085,7 @@ gfc_use_module (void)
   fclose (module_fp);
 
   use_stmt = gfc_get_use_list ();
-  use_stmt->module_name = gfc_get_string (module_name);
-  use_stmt->only_flag = only_flag;
-  use_stmt->rename = gfc_rename_list;
-  use_stmt->where = use_locus;
-  gfc_rename_list = NULL;
+  *use_stmt = *module;
   use_stmt->next = gfc_current_ns->use_stmts;
   gfc_current_ns->use_stmts = use_stmt;
 
@@ -6095,6 +6093,93 @@ gfc_use_module (void)
 }
 
 
+/* Process all USE directives.  */
+
+void
+gfc_use_modules (void)
+{
+  gfc_use_list *next, *seek, *last;
+
+  for (next = module_list; next; next = next->next)
+    {
+      bool non_intrinsic = next->non_intrinsic;
+      bool intrinsic = next->intrinsic;
+      bool neither = !non_intrinsic && !intrinsic;
+
+      for (seek = next->next; seek; seek = seek->next)
+	{
+	  if (next->module_name != seek->module_name)
+	    continue;
+
+	  if (seek->non_intrinsic)
+	    non_intrinsic = true;
+	  else if (seek->intrinsic)
+	    intrinsic = true;
+	  else
+	    neither = true;
+	}
+
+      if (intrinsic && neither && !non_intrinsic)
+	{
+	  char *filename;
+          FILE *fp;
+
+	  filename = XALLOCAVEC (char,
+				 strlen (next->module_name)
+				 + strlen (MODULE_EXTENSION) + 1);
+	  strcpy (filename, next->module_name);
+	  strcat (filename, MODULE_EXTENSION);
+	  fp = gfc_open_included_file (filename, true, true);
+	  if (fp != NULL)
+	    {
+	      non_intrinsic = true;
+	      fclose (fp);
+	    }
+	}
+
+      last = next;
+      for (seek = next->next; seek; seek = last->next)
+	{
+	  if (next->module_name != seek->module_name)
+	    {
+	      last = seek;
+	      continue;
+	    }
+
+	  if ((!next->intrinsic && !seek->intrinsic)
+	      || (next->intrinsic && seek->intrinsic)
+	      || !non_intrinsic)
+	    {
+	      if (!seek->only_flag)
+		next->only_flag = false;
+	      if (seek->rename)
+		{
+		  gfc_use_rename *r = seek->rename;
+		  while (r->next)
+		    r = r->next;
+		  r->next = next->rename;
+		  next->rename = seek->rename;
+		}
+	      last->next = seek->next; 
+	      free (seek);
+	    }
+	  else
+	    last = seek;
+	}
+    }
+
+  for (; module_list; module_list = next)
+    {
+      next = module_list->next;
+      gfc_use_module (module_list);
+      if (module_list->intrinsic)
+	free_rename (module_list->rename);
+      free (module_list);
+    }
+  gfc_rename_list = NULL;
+}
+
+
 void
 gfc_free_use_stmts (gfc_use_list *use_stmts)
 {
@@ -6118,11 +6203,14 @@ void
 gfc_module_init_2 (void)
 {
   last_atom = ATOM_LPAREN;
+  gfc_rename_list = NULL;
+  module_list = NULL;
 }
 
 
 void
 gfc_module_done_2 (void)
 {
-  free_rename ();
+  free_rename (gfc_rename_list);
+  gfc_rename_list = NULL;
 }
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ea1d773..3f9e45e 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -37,6 +37,7 @@ static locus label_locus;
 static jmp_buf eof_buf;
 
 gfc_state_data *gfc_state_stack;
+static bool last_was_use_stmt = false;
 
 /* TODO: Re-order functions to kill these forward decls.  */
 static void check_statement_label (gfc_statement);
@@ -74,6 +75,26 @@ match_word (const char *str, match (*subr) (void), locus *old_locus)
 }
 
 
+/* Load symbols from all USE statements encounted in this scoping unit.  */
+
+static void
+use_modules (void)
+{
+  gfc_error_buf old_error;
+
+  gfc_push_error (&old_error);
+  gfc_buffer_error (0);
+  gfc_use_modules ();
+  gfc_buffer_error (1);
+  gfc_pop_error (&old_error);
+  gfc_commit_symbols ();
+  gfc_warning_check ();
+  gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
+  gfc_current_ns->old_equiv = gfc_current_ns->equiv;
+  last_was_use_stmt = false;
+}
+
+
 /* Figure out what the next statement is, (mostly) regardless of
    proper ordering.  The do...while(0) is there to prevent if/else
    ambiguity.  */
@@ -108,8 +129,19 @@ decode_specification_statement (void)
 
   old_locus = gfc_current_locus;
 
+  if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
+    {
+      last_was_use_stmt = true;
+      return ST_USE;
+    }
+  else
+    {
+      undo_new_statement ();
+      if (last_was_use_stmt)
+	use_modules ();
+    }
+
   match ("import", gfc_match_import, ST_IMPORT);
-  match ("use", gfc_match_use, ST_USE);
 
   if (gfc_current_block ()->result->ts.type != BT_DERIVED)
     goto end_of_block;
@@ -252,6 +284,22 @@ decode_statement (void)
 
   old_locus = gfc_current_locus;
 
+  c = gfc_peek_ascii_char ();
+
+  if (c == 'u')
+    {
+      if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
+	{
+	  last_was_use_stmt = true;
+	  return ST_USE;
+	}
+      else
+	undo_new_statement ();
+    }
+
+  if (last_was_use_stmt)
+    use_modules ();
+
   /* Try matching a data declaration or function declaration. The
       input "REALFUNCTIONA(N)" can mean several things in different
       contexts, so it (and its relatives) get special treatment.  */
@@ -322,8 +370,6 @@ decode_statement (void)
      statement, we eliminate most possibilities by peeking at the
      first character.  */
 
-  c = gfc_peek_ascii_char ();
-
   switch (c)
     {
     case 'a':
@@ -454,7 +500,6 @@ decode_statement (void)
 
     case 'u':
       match ("unlock", gfc_match_unlock, ST_UNLOCK);
-      match ("use", gfc_match_use, ST_USE);
       break;
 
     case 'v':
@@ -713,6 +758,8 @@ next_free (void)
 
 	  gcc_assert (c == ' ' || c == '\t');
 	  gfc_gobble_whitespace ();
+	  if (last_was_use_stmt)
+	    use_modules ();
 	  return decode_omp_directive ();
 	}
 
@@ -801,7 +848,8 @@ next_fixed (void)
 		  gfc_error ("Bad continuation line at %C");
 		  return ST_NONE;
 		}
-
+	      if (last_was_use_stmt)
+		use_modules ();
 	      return decode_omp_directive ();
 	    }
 	  /* FALLTHROUGH */
@@ -1595,10 +1643,6 @@ accept_statement (gfc_statement st)
 {
   switch (st)
     {
-    case ST_USE:
-      gfc_use_module ();
-      break;
-
     case ST_IMPLICIT_NONE:
       gfc_set_implicit_none ();
       break;
--- /dev/null	2012-01-09 08:01:37.463648492 +0100
+++ gcc/gcc/testsuite/gfortran.dg/use_17.f90	2012-01-09 09:45:46.000000000 +0100
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR fortran/51578
+!
+! Contributed by Billy Backer
+!
+! Check that indict importing of the symbol "axx" works
+! even if renaming prevent the direct import.
+!
+module mod1
+integer :: axx=2
+end module mod1
+
+module mod2
+use mod1
+end module mod2
+
+subroutine sub1
+use mod1, oxx=>axx
+use mod2
+implicit none
+print*,axx ! Valid - was working before
+end subroutine sub1
+
+subroutine sub2
+use mod2
+use mod1, oxx=>axx
+implicit none
+print*,axx ! Valid - was failing before
+end subroutine sub2
+
+subroutine test1
+  use :: iso_c_binding
+  use, intrinsic :: iso_c_binding, only: c_double_orig => c_double
+  integer :: c_double
+  integer, parameter :: p1 = c_int, p2 = c_double_orig
+end subroutine test1
+
+! { dg-final { cleanup-modules "mod1 mod2" } }

Reply via email to