From: Erik Edelmann <eedelman@gcc.gnu.org>
Date: Sun, 19 Nov 2006 21:27:16 +0000 (+0000)
Subject: resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of nonzero rank part... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=51f824b647754fb8fd2df8198a66efd57a4e3751;p=gcc.git

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

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 70ca870af2c..6efdfac0496 100644
--- 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 31e1d7c2426..3d567cb7cad 100644
--- 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 61cf82cd076..a44c291307f 100644
--- 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 817026e41c7..32c3c82dc67 100644
--- 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
index 00000000000..d0e57aea593
--- /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