From: Daniel Franke <franke.daniel@gmail.com>
Date: Wed, 27 Jun 2007 20:02:31 +0000 (-0400)
Subject: re PR fortran/32467 (structure containing allocatable array is accepted in COPYIN... 
X-Git-Tag: releases/gcc-4.3.0~4277
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=24189c587c23578bcbe2e7395fef5afb75ee5184;p=thirdparty%2Fgcc.git

re PR fortran/32467 (structure containing allocatable array is accepted in COPYIN clause)

gcc/fortran:
2007-06-24  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/32467
	* openmp.c (resolve_omp_clauses): Emit error on allocatable components
	in COPYIN, COPYPRIVATE, FIRSTPRIVATE and LASTPRIVATE clauses.

gcc/testsuite:
2007-06-24  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/32467
        * gfortran.dg/gomp/allocatable_components_1.f90: New test.

From-SVN: r126063
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5b697d14c0c7..6fcd5bc3f2b9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-06-27  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32467
+	* openmp.c (resolve_omp_clauses): Emit error on allocatable
+	components in COPYIN, COPYPRIVATE, FIRSTPRIVATE and LASTPRIVATE
+	clauses.
+
 2007-06-25  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/32464
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 9c5c03335ea3..54981ef3a6f7 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -779,6 +779,9 @@ resolve_omp_clauses (gfc_code *code)
 		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 @@ resolve_omp_clauses (gfc_code *code)
 		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 @@ resolve_omp_clauses (gfc_code *code)
 		    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 @@ resolve_omp_clauses (gfc_code *code)
 		  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:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9f350e7b8dfd..9fb13b26a0fa 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-06-27  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32467
+	* gfortran.dg/gomp/allocatable_components_1.f90: New test.
+
 2007-06-27  Richard Guenther  <rguenther@suse.de>
 
 	PR middle-end/32492
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90
new file mode 100644
index 000000000000..02fcb1b432d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90
@@ -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" } }