[gomp] Fix MIN/MAX/IAND/IOR/IEOR reduction checking

[Jakub Jelinek]

Hi!

As attached testcase shows, simple use of iand () etc. intrinsic
function before reduction (iand:var) resulted in error.

2005-11-18  Jakub Jelinek  <jakub@redhat.com>

	* openmp.c (gfc_match_omp_clauses): Fix check for non-INTRINSIC
	procedure symbol in REDUCTION.
testsuite/
	* gfortran.dg/gomp/reduction2.f90: New test.
	* gfortran.dg/gomp/reduction3.f90: New test.

--- gcc/fortran/openmp.c.jj	2005-11-10 18:23:53.000000000 +0100
+++ gcc/fortran/openmp.c	2005-11-18 14:54:33.000000000 +0100
@@ -268,9 +268,29 @@ gfc_match_omp_clauses (gfc_omp_clauses *
 	      gfc_find_symbol (buffer, NULL, 1, &sym);
 	      if (sym != NULL)
 		{
-		  if (!sym->attr.intrinsic)
-		    gfc_error_now ("%s is not INTRINSIC procedure name at %C",
-				   buffer);
+		  if (sym->attr.intrinsic)
+		    n = sym->name;
+		  else if ((sym->attr.flavor != FL_UNKNOWN
+			    && sym->attr.flavor != FL_PROCEDURE)
+			   || sym->attr.external
+			   || sym->attr.generic
+			   || sym->attr.entry
+			   || sym->attr.result
+			   || sym->attr.dummy
+			   || sym->attr.subroutine
+			   || sym->attr.pointer
+			   || sym->attr.target
+			   || sym->attr.cray_pointer
+			   || sym->attr.cray_pointee
+			   || (sym->attr.proc != PROC_UNKNOWN
+			       && sym->attr.proc != PROC_INTRINSIC)
+			   || sym->attr.if_source != IFSRC_UNKNOWN
+			   || sym == sym->ns->proc_name)
+		    {
+		      gfc_error_now ("%s is not INTRINSIC procedure name "
+				     "at %C", buffer);
+		      sym = NULL;
+		    }
 		  else
 		    n = sym->name;
 		}
@@ -284,6 +304,18 @@ gfc_match_omp_clauses (gfc_omp_clauses *
 		reduction = OMP_LIST_IOR;
 	      else if (strcmp (n, "ieor") == 0)
 		reduction = OMP_LIST_IEOR;
+	      if (reduction != OMP_LIST_NUM
+		  && sym != NULL
+		  && ! sym->attr.intrinsic
+		  && ! sym->attr.use_assoc
+		  && ((sym->attr.flavor == FL_UNKNOWN
+		       && gfc_add_flavor (&sym->attr, FL_PROCEDURE,
+					  sym->name, NULL) == FAILURE)
+		      || gfc_add_intrinsic (&sym->attr, NULL) == FAILURE))
+		{
+		  gfc_free_omp_clauses (c);
+		  return MATCH_ERROR;
+		}
 	    }
 	  if (reduction != OMP_LIST_NUM
 	      && gfc_match_omp_variable_list (" :", &c->lists[reduction],
--- gcc/testsuite/gfortran.dg/gomp/reduction2.f90.jj	2005-11-18 13:03:39.000000000 +0100
+++ gcc/testsuite/gfortran.dg/gomp/reduction2.f90	2005-11-18 13:04:15.000000000 +0100
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+subroutine f1
+  integer :: i
+  i = 0
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+!$omp parallel reduction (ior:i)
+  i = ior (i, 16)
+!$omp end parallel
+end subroutine f1
+subroutine f2
+  integer :: i
+  i = ior (2, 4)
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f2
+subroutine f3
+  integer :: i
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f3
+subroutine f4
+  integer :: i, ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f4
--- gcc/testsuite/gfortran.dg/gomp/reduction3.f90.jj	2005-11-18 14:56:01.000000000 +0100
+++ gcc/testsuite/gfortran.dg/gomp/reduction3.f90	2005-11-18 14:55:32.000000000 +0100
@@ -0,0 +1,69 @@
+! { dg-do compile }
+
+module mreduction3
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+contains
+  function iand (a, b)
+    integer :: iand, a, b
+    iand = a + b
+  end function
+end module mreduction3
+subroutine f1
+  integer :: i, ior
+  ior = 6
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+!$omp end parallel
+end subroutine f1
+subroutine f2
+  integer :: i
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f2
+subroutine f3
+  integer :: i
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+  intrinsic ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f3
+subroutine f4
+  integer :: i, ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  ior = 4			 ! { dg-error "Expected VARIABLE" }
+!$omp end parallel
+end subroutine f4
+subroutine f5
+  use mreduction3
+  integer :: i
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = ior (i, 7)
+!$omp end parallel
+end subroutine f5
+subroutine f6
+  use mreduction3
+  integer :: i
+  i = 6
+!$omp parallel reduction (iand:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = iand (i, 18)
+!$omp end parallel
+end subroutine f6

	Jakub