[Patch, Fortran] PR31298 - support multiple loading of (renamed) operators in USE

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

This adds support for:

USE mod, only: operator(.op.), operator(.new.)=>operator(.op.),
operator(.another.)=>operator(.op.)

Before only a single rename/import was supported.

The algorithm is partially copied from load_generic_interfaces.

I initially hoped to do:

if(i==1) [...]
     sym = uop->operator->sym
else [...]
    uop->operator->sym = sym

but this fails as sym == NULL. And

if(i==1) [...]
     operator = uop->operator
else [...]
    uop->operator = operator

only works if one disables gfc_free_interface() as otherwise the memory
is deallocated twice.

Build and regression tested on x86-64/Linux. Ok for the trunk?

Tobias

PS: What remains of PR31298 is support for
  operator(+) => operator(.myplus.)
(i.e. intrinsic operator on the left, user operator on the right; the
other way round or renaming intrinsic operators is not allowed.)

2007-08-17  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-17  Tobias Burnus  <burnus@net-b.de>

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

Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(Revision 127578)
+++ gcc/fortran/module.c	(Arbeitskopie)
@@ -1388,7 +1388,8 @@ write_atom (atom_type atom, const void *
    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
@@ -2238,7 +2239,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;
@@ -2257,6 +2258,7 @@ mio_symbol_ref (gfc_symbol **symp)
       if (p->u.rsym.state == UNUSED)
 	p->u.rsym.state = NEEDED;
     }
+  return p;
 }
 
 
@@ -2907,10 +2909,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)
     {
@@ -2936,7 +2939,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;
@@ -2948,6 +2951,7 @@ mio_interface_rest (gfc_interface **ip)
     }
 
   mio_rparen ();
+  return pi;
 }
 
 
@@ -3127,6 +3131,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 ();
 
@@ -3137,16 +3143,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);
+	    }
 	}
     }
 
Index: gcc/testsuite/gfortran.dg/use_10.f90
===================================================================
--- gcc/testsuite/gfortran.dg/use_10.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/use_10.f90	(Revision 0)
@@ -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