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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126063 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5b697d1..6fcd5bc 100644 (file)
--- 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 9c5c033..54981ef 100644 (file)
--- 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 9f350e7..9fb13b2 100644 (file)
--- 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 (file)
index 0000000..02fcb1b
--- /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" } }