tob@archimedes:~/scratch/gcc> head -n 15 ../intrinsic_use.diff

2010-07-11  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44702
        * module.c (sort_iso_c_rename_list): Remove.
        (import_iso_c_binding_module,use_iso_fortran_env_module):
        Allow multiple imports of the same symbol.

2010-07-11  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44702
        * gfortran.dg/use_rename_6.f90: New.
        * gfortran.dg/use_iso_c_binding.f90: Update dg-error.

From-SVN: r162061

gcc/fortran/ChangeLog

+2010-07-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44702
+	* module.c (sort_iso_c_rename_list): Remove.
+	(import_iso_c_binding_module,use_iso_fortran_env_module):
+	Allow multiple imports of the same symbol.
+
 2010-07-11  Mikael Morin  <mikael@gcc.gnu.org>
 
 	* arith.c (gfc_arith_done_1): Release mpfr internal caches.

gcc/fortran/module.c

@@ -5201,53 +5201,6 @@ gfc_dump_module (const char *name, int dump_flag)
 }
 
 
-static void
-sort_iso_c_rename_list (void)
-{
-  gfc_use_rename *tmp_list = NULL;
-  gfc_use_rename *curr;
-  gfc_use_rename *kinds_used[ISOCBINDING_NUMBER] = {NULL};
-  int c_kind;
-  int i;
-
-  for (curr = gfc_rename_list; curr; curr = curr->next)
-    {
-      c_kind = get_c_kind (curr->use_name, c_interop_kinds_table);
-      if (c_kind == ISOCBINDING_INVALID || c_kind == ISOCBINDING_LAST)
-	{
-	  gfc_error ("Symbol '%s' referenced at %L does not exist in "
-		     "intrinsic module ISO_C_BINDING.", curr->use_name,
-		     &curr->where);
-	}
-      else
-	/* Put it in the list.  */
-	kinds_used[c_kind] = curr;
-    }
-
-  /* Make a new (sorted) rename list.  */
-  i = 0;
-  while (i < ISOCBINDING_NUMBER && kinds_used[i] == NULL)
-    i++;
-
-  if (i < ISOCBINDING_NUMBER)
-    {
-      tmp_list = kinds_used[i];
-
-      i++;
-      curr = tmp_list;
-      for (; i < ISOCBINDING_NUMBER; i++)
-	if (kinds_used[i] != NULL)
-	  {
-	    curr->next = kinds_used[i];
-	    curr = curr->next;
-	    curr->next = NULL;
-	  }
-    }
-
-  gfc_rename_list = tmp_list;
-}
-
-
 /* Import the intrinsic ISO_C_BINDING module, generating symbols in
    the current namespace for all named constants, pointer types, and
    procedures in the module unless the only clause was used or a rename
@@ -5261,7 +5214,6 @@ import_iso_c_binding_module (void)
   const char *iso_c_module_name = "__iso_c_binding";
   gfc_use_rename *u;
   int i;
-  char *local_name;
 
   /* Look only in the current namespace.  */
   mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name);
@@ -5286,57 +5238,32 @@ import_iso_c_binding_module (void)
 
   /* Generate the symbols for the named constants representing
      the kinds for intrinsic data types.  */
-  if (only_flag)
+  for (i = 0; i < ISOCBINDING_NUMBER; i++)
     {
-      /* Sort the rename list because there are dependencies between types
-	 and procedures (e.g., c_loc needs c_ptr).  */
-      sort_iso_c_rename_list ();
-      
+      bool found = false;
       for (u = gfc_rename_list; u; u = u->next)
-	{
-	  i = get_c_kind (u->use_name, c_interop_kinds_table);
+	if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0)
+	  {
+	    u->found = 1;
+	    found = true;
+	    generate_isocbinding_symbol (iso_c_module_name,
+					 (iso_c_binding_symbol) i,
+					 u->local_name);
+	  }
 
-	  if (i == ISOCBINDING_INVALID || i == ISOCBINDING_LAST)
-	    {
-	      gfc_error ("Symbol '%s' referenced at %L does not exist in "
-			 "intrinsic module ISO_C_BINDING.", u->use_name,
-			 &u->where);
-	      continue;
-	    }
-	  
-	  generate_isocbinding_symbol (iso_c_module_name,
-				       (iso_c_binding_symbol) i,
-				       u->local_name);
-	}
-    }
-  else
-    {
-      for (i = 0; i < ISOCBINDING_NUMBER; i++)
-	{
-	  local_name = NULL;
-	  for (u = gfc_rename_list; u; u = u->next)
-	    {
-	      if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0)
-		{
-		  local_name = u->local_name;
-		  u->found = 1;
-		  break;
-		}
-	    }
-	  generate_isocbinding_symbol (iso_c_module_name,
-				       (iso_c_binding_symbol) i,
-				       local_name);
-	}
+      if (!found && !only_flag)
+	generate_isocbinding_symbol (iso_c_module_name,
+				     (iso_c_binding_symbol) i, NULL);
+   }
 
-      for (u = gfc_rename_list; u; u = u->next)
-	{
-	  if (u->found)
-	    continue;
+   for (u = gfc_rename_list; u; u = u->next)
+     {
+      if (u->found)
+	continue;
 
-	  gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
-		     "module ISO_C_BINDING", u->use_name, &u->where);
-	}
-    }
+      gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+		 "module ISO_C_BINDING", u->use_name, &u->where);
+     }
 }
 
 
@@ -5378,7 +5305,6 @@ static void
 use_iso_fortran_env_module (void)
 {
   static char mod[] = "iso_fortran_env";
-  const char *local_name;
   gfc_use_rename *u;
   gfc_symbol *mod_sym;
   gfc_symtree *mod_symtree;
@@ -5414,60 +5340,41 @@ use_iso_fortran_env_module (void)
 		 "non-intrinsic module name used previously", mod);
 
   /* Generate the symbols for the module integer named constants.  */
-  if (only_flag)
-    for (u = gfc_rename_list; u; u = u->next)
-      {
-	for (i = 0; symbol[i].name; i++)
-	  if (strcmp (symbol[i].name, u->use_name) == 0)
-	    break;
 
-	if (symbol[i].name == NULL)
-	  {
-	    gfc_error ("Symbol '%s' referenced at %L does not exist in "
-		       "intrinsic module ISO_FORTRAN_ENV", u->use_name,
-		       &u->where);
-	    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 %L is "
-			   "incompatible with option %s", &u->where,
-			   gfc_option.flag_default_integer
-			     ? "-fdefault-integer-8" : "-fdefault-real-8");
-
-        if (gfc_notify_std (symbol[i].standard, "The symbol '%s', referrenced "
-			    "at %C, is not in the selected standard",
-			    symbol[i].name) == FAILURE)
-	  continue;
-
-	create_int_parameter (u->local_name[0] ? u->local_name
-					       : symbol[i].name,
-			      symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV,
-			      symbol[i].id);
-      }
-  else
+  for (i = 0; symbol[i].name; i++)
     {
-      for (i = 0; symbol[i].name; i++)
+      bool found = false;
+      for (u = gfc_rename_list; u; u = u->next)
 	{
-	  local_name = NULL;
-
-	  for (u = gfc_rename_list; u; u = u->next)
+	  if (strcmp (symbol[i].name, u->use_name) == 0)
 	    {
-	      if (strcmp (symbol[i].name, u->use_name) == 0)
-		{
-		  local_name = u->local_name;
-		  u->found = 1;
-		  break;
-		}
+	      found = true;
+	      u->found = 1;
+
+	      if (gfc_notify_std (symbol[i].standard, "The symbol '%s', "
+				  "referrenced at %C, is not in the selected "
+				  "standard", symbol[i].name) == 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",
+				 gfc_option.flag_default_integer
+				   ? "-fdefault-integer-8"
+				   : "-fdefault-real-8");
+
+	      create_int_parameter (u->local_name[0] ? u->local_name : u->use_name,
+				    symbol[i].value, mod,
+				    INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
 	    }
+	}
 
-	  if (u && gfc_notify_std (symbol[i].standard, "The symbol '%s', "
-				   "referrenced at %C, is not in the selected "
-				   "standard", symbol[i].name) == FAILURE)
-	    continue;
-	  else if ((gfc_option.allow_std & symbol[i].standard) == 0)
+      if (!found && !only_flag)
+	{
+	  if ((gfc_option.allow_std & symbol[i].standard) == 0)
 	    continue;
 
 	  if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
@@ -5478,19 +5385,18 @@ use_iso_fortran_env_module (void)
 			     gfc_option.flag_default_integer
 				? "-fdefault-integer-8" : "-fdefault-real-8");
 
-	  create_int_parameter (local_name ? local_name : symbol[i].name,
-				symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV,
-				symbol[i].id);
+	  create_int_parameter (symbol[i].name, symbol[i].value, mod,
+				INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
 	}
+    }
 
-      for (u = gfc_rename_list; u; u = u->next)
-	{
-	  if (u->found)
-	    continue;
+  for (u = gfc_rename_list; u; u = u->next)
+    {
+      if (u->found)
+	continue;
 
-	  gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+      gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
 		     "module ISO_FORTRAN_ENV", u->use_name, &u->where);
-	}
     }
 }
 

gcc/testsuite/ChangeLog

+2010-07-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44702
+	* gfortran.dg/use_rename_6.f90: New.
+	* gfortran.dg/use_iso_c_binding.f90: Update dg-error.
+
 2010-07-11  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/44869

gcc/testsuite/gfortran.dg/use_iso_c_binding.f90

@@ -7,12 +7,12 @@
 ! intrinsic one.  --Rickett, 09.26.06
 module use_stmt_0
   ! this is an error because c_ptr_2 does not exist 
-  use, intrinsic :: iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) does not exist" }
+  use, intrinsic :: iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" }
 end module use_stmt_0
 
 module use_stmt_1
   ! this is an error because c_ptr_2 does not exist 
-  use iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) does not exist" }
+  use iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" }
 end module use_stmt_1
 
 module use_stmt_2

gcc/testsuite/gfortran.dg/use_rename_6.f90

+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/44702
+!
+! Based on a test case by Joe Krahn.
+!
+! Multiple import of the same symbol was failing for
+! intrinsic modules.
+!
+subroutine one()
+  use iso_c_binding, only: a => c_ptr, b => c_ptr, c_ptr
+  implicit none
+  type(a) :: x
+  type(b) :: y
+  type(c_ptr) :: z
+end subroutine one
+
+subroutine two()
+  use iso_c_binding, a => c_ptr, b => c_ptr
+  implicit none
+  type(a) :: x
+  type(b) :: y
+end subroutine two
+
+subroutine three()
+  use iso_fortran_env, only: a => error_unit, b => error_unit, error_unit
+  implicit none
+  if(a /= b) call shall_not_be_there()
+  if(a /= error_unit) call shall_not_be_there()
+end subroutine three
+
+subroutine four()
+  use iso_fortran_env, a => error_unit, b => error_unit
+  implicit none
+  if(a /= b) call shall_not_be_there()
+end subroutine four
+
+! { dg-final { scan-tree-dump-times "shall_not_be_there" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }