Re: [fortran, patch] PR32467 - structure containing allocatable array is wrongly accepted

[Daniel Franke <franke dot daniel at gmail dot com>]

On Sunday 24 June 2007 21:25:24 Jakub Jelinek wrote:

> But it would be helpful if you could cover also all the other clauses
> in testcases (COPYPRIVATE, FIRSTPRIVATE, LASTPRIVATE and REDUCTION).
> Especially because COPYIN resp. COPYPRIVATE are handled in different
> code from the other clauses.

Jakub,

attached patch has a testcase that tests all clauses. While preparing it, I 
found that the REDUCTION-clause allows for intrinsic types only (OpenMp v2.5, 
section 2.8.3.6, Restrictions), so I excluded the "has allocatable 
components"-error from REDUCTION since the "must be of intrinsic type"-error 
is more general.

Again, regression tested on i686-pc-linux-gnu. Ok for trunk?

Regards
	Daniel

Index: fortran/openmp.c
===================================================================
--- fortran/openmp.c	(revision 125970)
+++ fortran/openmp.c	(working copy)
@@ -779,6 +779,9 @@
 		if (n->sym->attr.allocatable)
 		  gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L",
 			     n->sym->name, &code->loc);
+		if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+		  gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
+			     n->sym->name, &code->loc);
 	      }
 	    break;
 	  case OMP_LIST_COPYPRIVATE:
@@ -790,6 +793,9 @@
 		if (n->sym->attr.allocatable)
 		  gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE "
 			     "at %L", n->sym->name, &code->loc);
+		if (n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+		  gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
+			     n->sym->name, &code->loc);
 	      }
 	    break;
 	  case OMP_LIST_SHARED:
@@ -820,6 +826,11 @@
 		    if (n->sym->attr.allocatable)
 		      gfc_error ("%s clause object '%s' is ALLOCATABLE at %L",
 				 name, n->sym->name, &code->loc);
+		    /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below).  */
+		    if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&
+		        n->sym->ts.type == BT_DERIVED && n->sym->ts.derived->attr.alloc_comp)
+		      gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
+				 name, n->sym->name, &code->loc);
 		    if (n->sym->attr.cray_pointer)
 		      gfc_error ("Cray pointer '%s' in %s clause at %L",
 				 n->sym->name, name, &code->loc);
@@ -839,11 +850,11 @@
 		  case OMP_LIST_MULT:
 		  case OMP_LIST_SUB:
 		    if (!gfc_numeric_ts (&n->sym->ts))
-		      gfc_error ("%c REDUCTION variable '%s' is %s at %L",
+		      gfc_error ("%c REDUCTION variable '%s' at %L must be of intrinsic type, got %s",
 				 list == OMP_LIST_PLUS ? '+'
 				 : list == OMP_LIST_MULT ? '*' : '-',
-				 n->sym->name, gfc_typename (&n->sym->ts),
-				 &code->loc);
+				 n->sym->name, &code->loc,
+				 gfc_typename (&n->sym->ts));
 		    break;
 		  case OMP_LIST_AND:
 		  case OMP_LIST_OR:
Index: testsuite/gfortran.dg/gomp/allocatable_components_1.f90
===================================================================
--- testsuite/gfortran.dg/gomp/allocatable_components_1.f90	(revision 0)
+++ testsuite/gfortran.dg/gomp/allocatable_components_1.f90	(revision 0)
@@ -0,0 +1,59 @@
+! { dg-do compile }
+!
+! PR fortran/32467
+! Derived types with allocatable components
+!
+
+MODULE test_allocatable_components
+  type :: t
+    integer, allocatable :: a(:)
+  end type
+
+CONTAINS
+  SUBROUTINE test_copyin()
+    TYPE(t), SAVE :: a
+
+    !$omp threadprivate(a)
+    !$omp parallel copyin(a)        ! { dg-error "has ALLOCATABLE components" }
+      ! do something
+    !$omp end parallel
+  END SUBROUTINE
+
+  SUBROUTINE test_copyprivate()
+    TYPE(t) :: a
+
+    !$omp single                    ! { dg-error "has ALLOCATABLE components" }
+      ! do something
+    !$omp end single copyprivate (a)
+  END SUBROUTINE
+
+  SUBROUTINE test_firstprivate
+    TYPE(t) :: a
+
+    !$omp parallel firstprivate(a)  ! { dg-error "has ALLOCATABLE components" }
+      ! do something
+    !$omp end parallel
+  END SUBROUTINE
+
+  SUBROUTINE test_lastprivate
+    TYPE(t) :: a
+    INTEGER :: i
+
+    !$omp parallel do lastprivate(a)  ! { dg-error "has ALLOCATABLE components" }
+      DO i = 1, 1
+      END DO
+    !$omp end parallel do
+  END SUBROUTINE
+
+  SUBROUTINE test_reduction
+    TYPE(t) :: a(10)
+    INTEGER :: i
+
+    !$omp parallel do reduction(+: a)   ! { dg-error "must be of intrinsic type" }
+    DO i = 1, SIZE(a)
+    END DO
+    !$omp end parallel do
+  END SUBROUTINE
+END MODULE
+
+! { dg-final { cleanup-modules "test_allocatable_components" } }