diff mbox

[Fortran] PR51816 - fix USE of intrinsic operators

Message ID 4F0D6FAA.3080907@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Jan. 11, 2012, 11:16 a.m. UTC
This patch fixes two issues related to intrinsic operators:

a) No error for nonexisting operators:
    USE m, operator(*)

b) An bogus error if one tried to use-associate the same operator 
multiple times:
    USE m, operator(+), operator(+)

Those are old issues. New issue (and thus the PR is marked as 
regression) is that the bogus error now also is printed for:
    USE m, operator(+)
    USE m, operator(+)

Build and regtested on x86-64-linux.
OK for trunk?

Tobias
diff mbox

Patch

2011-01-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51816
	* module.c (read_module): Don't make nonexisting
	intrinsic operators as found.
	(rename_list_remove_duplicate): New function.
	(gfc_use_modules): Use it.

2011-01-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51816
	* gfortran.dg/use_18.f90: New.
	* gfortran.dg/use_19.f90: New.

Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(revision 183091)
+++ gcc/fortran/module.c	(working copy)
@@ -4465,7 +4465,7 @@  read_module (void)
   int i;
   int ambiguous, j, nuse, symbol;
   pointer_info *info, *q;
-  gfc_use_rename *u;
+  gfc_use_rename *u = NULL;
   gfc_symtree *st;
   gfc_symbol *sym;
 
@@ -4678,6 +4678,8 @@  read_module (void)
 	}
 
       mio_interface (&gfc_current_ns->op[i]);
+      if (u && !gfc_current_ns->op[i])
+	u->found = 0;
     }
 
   mio_rparen ();
@@ -6093,6 +6095,31 @@  gfc_use_module (gfc_use_list *module)
 }
 
 
+/* Remove duplicated intrinsic operators from the rename list. */
+
+static void
+rename_list_remove_duplicate (gfc_use_rename *list)
+{
+  gfc_use_rename *seek, *last;
+
+  for (; list; list = list->next)
+    if (list->op != INTRINSIC_USER && list->op != INTRINSIC_NONE)
+      {
+	last = list;
+	for (seek = list->next; seek; seek = last->next)
+	  {
+	    if (list->op == seek->op)
+	      {
+		last->next = seek->next;
+		free (seek);
+	      }
+	    else
+	      last = seek;
+	  }
+      }
+}
+
+
 /* Process all USE directives.  */
 
 void
@@ -6171,6 +6198,7 @@  gfc_use_modules (void)
   for (; module_list; module_list = next)
     {
       next = module_list->next;
+      rename_list_remove_duplicate (module_list->rename);
       gfc_use_module (module_list);
       if (module_list->intrinsic)
 	free_rename (module_list->rename);
Index: gcc/testsuite/gfortran.dg/use_18.f90
===================================================================
--- gcc/testsuite/gfortran.dg/use_18.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/use_18.f90	(working copy)
@@ -0,0 +1,51 @@ 
+! { dg-do compile }
+!
+! PR fortran/51816
+!
+! Contributed by Harald Anlauf 
+!
+module foo
+  implicit none
+  type t
+     integer :: i
+  end type t
+  interface operator (*)
+     module procedure mult
+  end interface
+contains
+  function mult (i, j)
+    type(t), intent(in) :: i, j
+    integer             :: mult
+    mult = i%i * j%i
+  end function mult
+end module foo
+
+module bar
+  implicit none
+  type t2
+     integer :: i
+  end type t2
+  interface operator (>)
+     module procedure gt
+  end interface
+contains
+  function gt (i, j)
+    type(t2), intent(in) :: i, j
+    logical             :: gt
+    gt = i%i > j%i
+  end function gt
+end module bar
+
+use bar, only : t2, operator(>) , operator(>)
+use foo, only : t
+use foo, only : operator (*)
+use foo, only : t
+use foo, only : operator (*)
+implicit none
+type(t) :: i = t(1), j = t(2)
+type(t2) :: k = t2(1), l = t2(2)
+print *, i*j
+print *, k > l
+end
+
+! { dg-final { cleanup-modules "foo bar" } }
Index: gcc/testsuite/gfortran.dg/use_19.f90
===================================================================
--- gcc/testsuite/gfortran.dg/use_19.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/use_19.f90	(working copy)
@@ -0,0 +1,11 @@ 
+! { dg-do compile }
+!
+! PR fortran/51816
+!
+module m
+end module m
+
+use m, only: operator(/) ! { dg-error "Intrinsic operator '/' referenced at .1. not found in module 'm'" }
+end
+
+! { dg-final { cleanup-modules "m" } }