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.
===================================================================
@@ -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);
===================================================================
@@ -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" } }
===================================================================
@@ -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" } }