2007-08-16 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 16 Aug 2007 18:17:46 +0000 (18:17 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 16 Aug 2007 18:17:46 +0000 (18:17 +0000)
PR fortran/33072
* module.c (gfc_match_use): Mark user operators as such.
(find_use_name_n): Distinguish between operators and other symbols.
(find_use_name,number_use_names,mio_namelist,
 load_operator_interfaces,load_generic_interfaces,read_module,
 write_generic): Update find_use_name_n calls.

2007-08-16  Tobias Burnus  <burnus@net-b.de>

PR fortran/33072
* gfortran.dg/use_9.f90: New.

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

gcc/fortran/ChangeLog
gcc/fortran/module.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/use_9.f90 [new file with mode: 0644]

index f9c4dd4..78e4852 100644 (file)
@@ -1,3 +1,12 @@
+2007-08-16  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/33072
+       * module.c (gfc_match_use): Mark user operators as such.
+       (find_use_name_n): Distinguish between operators and other symbols.
+       (find_use_name,number_use_names,mio_namelist,
+        load_operator_interfaces,load_generic_interfaces,read_module,
+        write_generic): Update find_use_name_n calls.
+
 2007-08-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        PR fortran/29459
index 9ef0f40..c5a5184 100644 (file)
@@ -612,6 +612,9 @@ gfc_match_use (void)
                 == FAILURE))
            goto cleanup;
 
+         if (type == INTERFACE_USER_OP)
+           new->operator = INTRINSIC_USER;
+
          if (only_flag)
            {
              if (m != MATCH_YES)
@@ -677,10 +680,12 @@ cleanup:
 /* Given a name and a number, inst, return the inst name
    under which to load this symbol. Returns NULL if this
    symbol shouldn't be loaded. If inst is zero, returns
-   the number of instances of this name.  */
+   the number of instances of this name. If interface is
+   true, a user-defined operator is sought, otherwise only
+   non-operators are sought.  */
 
 static const char *
-find_use_name_n (const char *name, int *inst)
+find_use_name_n (const char *name, int *inst, bool interface)
 {
   gfc_use_rename *u;
   int i;
@@ -688,7 +693,9 @@ find_use_name_n (const char *name, int *inst)
   i = 0;
   for (u = gfc_rename_list; u; u = u->next)
     {
-      if (strcmp (u->use_name, name) != 0)
+      if (strcmp (u->use_name, name) != 0
+         || (u->operator == INTRINSIC_USER && !interface)
+         || (u->operator != INTRINSIC_USER &&  interface))
        continue;
       if (++i == *inst)
        break;
@@ -713,21 +720,21 @@ find_use_name_n (const char *name, int *inst)
    Returns NULL if this symbol shouldn't be loaded.  */
 
 static const char *
-find_use_name (const char *name)
+find_use_name (const char *name, bool interface)
 {
   int i = 1;
-  return find_use_name_n (name, &i);
+  return find_use_name_n (name, &i, interface);
 }
 
 
 /* Given a real name, return the number of use names associated with it.  */
 
 static int
-number_use_names (const char *name)
+number_use_names (const char *name, bool interface)
 {
   int i = 0;
   const char *c;
-  c = find_use_name_n (name, &i);
+  c = find_use_name_n (name, &i, interface);
   return i;
 }
 
@@ -2869,7 +2876,7 @@ mio_namelist (gfc_symbol *sym)
         conditionally?  */
       if (sym->attr.flavor == FL_NAMELIST)
        {
-         check_name = find_use_name (sym->name);
+         check_name = find_use_name (sym->name, false);
          if (check_name && strcmp (check_name, sym->name) != 0)
            gfc_error ("Namelist %s cannot be renamed by USE "
                       "association to %s", sym->name, check_name);
@@ -3131,7 +3138,7 @@ load_operator_interfaces (void)
       mio_internal_string (module);
 
       /* Decide if we need to load this one or not.  */
-      p = find_use_name (name);
+      p = find_use_name (name, true);
       if (p == NULL)
        {
          while (parse_atom () != ATOM_RPAREN);
@@ -3168,18 +3175,18 @@ load_generic_interfaces (void)
       mio_internal_string (name);
       mio_internal_string (module);
 
-      n = number_use_names (name);
+      n = number_use_names (name, false);
       n = n ? n : 1;
 
       for (i = 1; i <= n; i++)
        {
          /* Decide if we need to load this one or not.  */
-         p = find_use_name_n (name, &i);
+         p = find_use_name_n (name, &i, false);
 
          if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym))
            {
              while (parse_atom () != ATOM_RPAREN);
-               continue;
+             continue;
            }
 
          if (sym == NULL)
@@ -3548,14 +3555,14 @@ read_module (void)
 
       /* See how many use names there are.  If none, go through the start
         of the loop at least once.  */
-      nuse = number_use_names (name);
+      nuse = number_use_names (name, false);
       if (nuse == 0)
        nuse = 1;
 
       for (j = 1; j <= nuse; j++)
        {
          /* Get the jth local name for this symbol.  */
-         p = find_use_name_n (name, &j);
+         p = find_use_name_n (name, &j, false);
 
          if (p == NULL && strcmp (name, module_name) == 0)
            p = name;
@@ -3958,7 +3965,7 @@ write_generic (gfc_symbol *sym)
     sym->module = gfc_get_string (module_name);
 
   /* See how many use names there are.  If none, use the symbol name.  */
-  nuse = number_use_names (sym->name);
+  nuse = number_use_names (sym->name, false);
   if (nuse == 0)
     {
       mio_symbol_interface (&sym->name, &sym->module, &sym->generic);
@@ -3968,7 +3975,7 @@ write_generic (gfc_symbol *sym)
   for (j = 1; j <= nuse; j++)
     {
       /* Get the jth local name for this symbol.  */
-      p = find_use_name_n (sym->name, &j);
+      p = find_use_name_n (sym->name, &j, false);
 
       mio_symbol_interface (&p, &sym->module, &sym->generic);
     }
index 2e4dfb3..e533501 100644 (file)
@@ -1,6 +1,11 @@
+2007-08-16  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/33072
+       * gfortran.dg/use_9.f90: New.
+
 2007-08-16  Seongbae Park <seongbae.park@gmail.com>
 
-        * g++.dg/gcov/gcov-5.C: New test.
+       * g++.dg/gcov/gcov-5.C: New test.
 
 2007-08-16  Seongbae Park  <seongbae.park@gmail.com>
 
@@ -64,7 +69,7 @@
        * g++.dg/template/crash68.C: New.
 
 2007-08-15  Maxim Kuvyrkov  <maxim@codesourcery.com>
+
        * gcc.dg/sibcall-3.c: Remove m68k from XFAIL list.
        * gcc.dg/sibcall-4.c: Ditto.
 
diff --git a/gcc/testsuite/gfortran.dg/use_9.f90 b/gcc/testsuite/gfortran.dg/use_9.f90
new file mode 100644 (file)
index 0000000..588f29d
--- /dev/null
@@ -0,0 +1,15 @@
+! { dg-do compile }
+module test
+  interface operator(.bar.)
+     module procedure func
+  end interface
+contains
+function func(a)
+  integer,intent(in) :: a
+  integer :: funct
+  func = a+1
+end function
+end module test
+
+use test, only: operator(.func.) ! { dg-error "not found in module 'test'" }
+end