This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gomp] Fix MIN/MAX/IAND/IOR/IEOR reduction checking
- From: Jakub Jelinek <jakub at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Fri, 18 Nov 2005 11:31:22 -0500
- Subject: [gomp] Fix MIN/MAX/IAND/IOR/IEOR reduction checking
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
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