re PR fortran/31298 ([F03] use mod, operator(+) => operator(.userOp.) not supported)

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

	PR fortran/31298
	* module.c (mio_symbol_ref,mio_interface_rest):  Return pointer_info.
	(load_operator_interfaces): Support multible loading of an operator.

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

	PR fortran/31298
	* gfortran.dg/use_10.f90: New.

From-SVN: r127812

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fe7ae49d8427e4d254ecd3a3dcc4b2e7e8a25f4e..81d7bddd56d09c558193e0d92cccf7df13bcc93a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-08-26  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/31298
+       * module.c (mio_symbol_ref,mio_interface_rest):  Return pointer_info.
+       (load_operator_interfaces): Support multible loading of an operator.
+
 2007-08-26  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/32985

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 00f3674b597be22d3229d54609bf0b28542d5021..0b01ee4c8cbec569690399c9c3c027f4198925e9 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1391,7 +1391,8 @@ write_atom (atom_type atom, const void *v)
    written.  */
 
 static void mio_expr (gfc_expr **);
-static void mio_symbol_ref (gfc_symbol **);
+pointer_info *mio_symbol_ref (gfc_symbol **);
+pointer_info *mio_interface_rest (gfc_interface **);
 static void mio_symtree_ref (gfc_symtree **);
 
 /* Read or write an enumerated value.  On writing, we return the input
@@ -2247,7 +2248,7 @@ mio_formal_arglist (gfc_symbol *sym)
 
 /* Save or restore a reference to a symbol node.  */
 
-void
+pointer_info *
 mio_symbol_ref (gfc_symbol **symp)
 {
   pointer_info *p;
@@ -2266,6 +2267,7 @@ mio_symbol_ref (gfc_symbol **symp)
       if (p->u.rsym.state == UNUSED)
        p->u.rsym.state = NEEDED;
     }
+  return p;
 }
 
 
@@ -2916,10 +2918,11 @@ mio_namelist (gfc_symbol *sym)
    interfaces.  Checking for duplicate and ambiguous interfaces has to
    be done later when all symbols have been loaded.  */
 
-static void
+pointer_info *
 mio_interface_rest (gfc_interface **ip)
 {
   gfc_interface *tail, *p;
+  pointer_info *pi = NULL;
 
   if (iomode == IO_OUTPUT)
     {
@@ -2945,7 +2948,7 @@ mio_interface_rest (gfc_interface **ip)
 
          p = gfc_get_interface ();
          p->where = gfc_current_locus;
-         mio_symbol_ref (&p->sym);
+         pi = mio_symbol_ref (&p->sym);
 
          if (tail == NULL)
            *ip = p;
@@ -2957,6 +2960,7 @@ mio_interface_rest (gfc_interface **ip)
     }
 
   mio_rparen ();
+  return pi;
 }
 
 
@@ -3136,6 +3140,8 @@ load_operator_interfaces (void)
   const char *p;
   char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
   gfc_user_op *uop;
+  pointer_info *pi = NULL;
+  int n, i;
 
   mio_lparen ();
 
@@ -3146,16 +3152,34 @@ load_operator_interfaces (void)
       mio_internal_string (name);
       mio_internal_string (module);
 
-      /* Decide if we need to load this one or not.  */
-      p = find_use_name (name, true);
-      if (p == NULL)
-       {
-         while (parse_atom () != ATOM_RPAREN);
-       }
-      else
+      n = number_use_names (name, true);
+      n = n ? n : 1;
+
+      for (i = 1; i <= n; i++)
        {
-         uop = gfc_get_uop (p);
-         mio_interface_rest (&uop->operator);
+         /* Decide if we need to load this one or not.  */
+         p = find_use_name_n (name, &i, true);
+
+         if (p == NULL)
+           {
+             while (parse_atom () != ATOM_RPAREN);
+             continue;
+           }
+
+         if (i == 1)
+           {
+             uop = gfc_get_uop (p);
+             pi = mio_interface_rest (&uop->operator);
+           }
+         else
+           {
+             if (gfc_find_uop (p, NULL))
+               continue;
+             uop = gfc_get_uop (p);
+             uop->operator = gfc_get_interface ();
+             uop->operator->where = gfc_current_locus;
+             add_fixup (pi->integer, &uop->operator->sym);
+           }
        }
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5d2f2575fff5d2d209b53b38f9538d4c37be15a3..43875beb80f1f726a7dad3b2394cb6bd618cf27c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-08-26  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/31298
+       * gfortran.dg/use_10.f90: New.
+
 2007-08-26  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/32985

diff --git a/gcc/testsuite/gfortran.dg/use_10.f90 b/gcc/testsuite/gfortran.dg/use_10.f90
new file mode 100644 (file)
index 0000000..e52fcff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_10.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+module a
+ implicit none
+interface operator(.op.)
+  module procedure sub
+end interface
+interface operator(.ops.)
+  module procedure sub2
+end interface
+
+contains
+  function sub(i)
+    integer :: sub
+    integer,intent(in) :: i
+    sub = -i
+  end function sub
+  function sub2(i)
+    integer :: sub2
+    integer,intent(in) :: i
+    sub2 = i
+  end function sub2
+end module a
+
+program test
+use a, only: operator(.op.), operator(.op.), &
+operator(.my.)=>operator(.op.),operator(.ops.)=>operator(.op.)
+implicit none
+if (.my.2 /= -2 .or. .op.3 /= -3 .or. .ops.7 /= -7) call abort()
+end