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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162061 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 093631c..af17f5c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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.

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index aa6e72e..426a17c 100644 (file)
--- a/gcc/fortran/module.c
+++ b/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);
-       }
     }
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2970eac..1182677 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90
index b35c024..8a28490 100644 (file)
--- a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/use_rename_6.f90 b/gcc/testsuite/gfortran.dg/use_rename_6.f90
new file mode 100644 (file)
index 0000000..02f25c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_6.f90
@@ -0,0 +1,40 @@
+! { 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" } }