resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of nonzero rank part...

fortran/
2006-11-19  Erik Edelmann  <eedelman@gcc.gnu.org>

        * resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of
        nonzero rank part references too.

testsuite/
2006-11-19  Erik Edelmann  <eedelman@gcc.gnu.org>

        * gfortran.dg/alloc_comp_constraint_5.f90: New.
        * gfortran.dg/alloc_comp_assign_2.f90: Removed invalid code.

From-SVN: r118999

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 70ca870af2c6d8ae92650722842b5f2c964116d7..6efdfac0496a92ce32d8a328a4dbf1a4a322f0f4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2006-11-19  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+       * resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of
+         nonzero rank part references too.
+
 2006-11-19  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        * module.c (gfc_use_module): Uncomment the ISO_FORTRAN_ENV code.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 31e1d7c2426d0b2a65250e0232d631829168e05b..3d567cb7cadf9d6cb2ea0d966e3461226f0db71b 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2797,14 +2797,24 @@ resolve_ref (gfc_expr * expr)
          break;
 
        case REF_COMPONENT:
-         if ((current_part_dimension || seen_part_dimension)
-             && ref->u.c.component->pointer)
+         if (current_part_dimension || seen_part_dimension)
            {
-             gfc_error
-               ("Component to the right of a part reference with nonzero "
-                "rank must not have the POINTER attribute at %L",
-                &expr->where);
-             return FAILURE;
+             if (ref->u.c.component->pointer)
+               {
+                 gfc_error
+                   ("Component to the right of a part reference with nonzero "
+                    "rank must not have the POINTER attribute at %L",
+                    &expr->where);
+                 return FAILURE;
+               }
+             else if (ref->u.c.component->allocatable)
+               {
+                 gfc_error
+                   ("Component to the right of a part reference with nonzero "
+                    "rank must not have the ALLOCATABLE attribute at %L",
+                    &expr->where);
+                 return FAILURE;
+               }
            }
 
          n_components++;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 61cf82cd076030ef960db5ae9e0e20eeb872e96c..a44c291307f383e54b6b3c4211d74e7a0a4649a1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-11-19  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+       * gfortran.dg/alloc_comp_constraint_5.f90: New.
+       * gfortran.dg/alloc_comp_assign_2.f90: Removed invalid code.
+
 2006-11-19  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        * gfortran.dg/use_3.f90: Remove error message.

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90
index 817026e41c7916c1c34a08b3846755ca4d5440ff..32c3c82dc6727293b4fca07ef375b32cfdd3bc4d 100644 (file)
--- a/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90
@@ -38,12 +38,6 @@
   if (any( (/(((y(k)%at(i)%i(j), j = 1,4), i = 1,2), k = 1,2)/) .ne. &
          (/0,0,2,1,11,12,6,5,11,12,3,2,9,8,7,6/))) call abort () 
 
-  where (y((2))%at(:)%i(2) > 8)
-    y(2)%at(:)%i(2) = 77
-  end where
-  if (any ((/(((y(k)%at(i)%i(j), j = 1,4), i = 1,2), k = 1,2)/) .ne. &
-         (/0,0,2,1,11,12,6,5,11,77,3,2,9,8,7,6/))) call abort ()
-
 ! Check that temporaries and full array  alloctable component assignments
 ! are correctly handled in FORALL.
 

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_5.f90
new file mode 100644 (file)
index 0000000..d0e57ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_5.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Check that ALLOCATABLE components aren't allowed to the right of a non-zero
+! rank part reference.
+program test
+
+    implicit none
+    type :: foo
+        real, allocatable :: bar(:)
+    end type foo
+    type(foo), target :: x(3)
+    integer :: i
+    real, pointer :: p(:)
+
+    allocate(x(:)%bar(5))! { dg-error "must not have the ALLOCATABLE attribute" }
+    x(:)%bar(1) = 1.0    ! { dg-error "must not have the ALLOCATABLE attribute" }
+    p => x(:)%bar(1)     ! { dg-error "must not have the ALLOCATABLE attribute" }
+
+end program test