re PR fortran/41197 (ICE with ALLOCATE and nonscalar STAT= variable)

2009-09-07  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/41197
	* resolve_c (resolve_allocate_deallocate):  Complain
	if stat or errmsg varaible is an array.

2009-09-07  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/41197
	* gfortran.dg/allocate_alloc_opt_1.f90:  Use scalar
	variables for stat and errmsg.
	* gfortran.dg/deallocate_alloc_opt_1.f90:  Likewise.
	* gfortran.dg/allocate_stat_2.f90:  New test.

From-SVN: r151480

6 files changed, 37 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c392d9d..d2a301d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-09-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/41197
+	* resolve_c (resolve_allocate_deallocate):  Complain
+	if stat or errmsg varaible is an array.
+
 2009-09-05  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/41258
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b665c35..fd365eb 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5732,9 +5732,10 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	gfc_error ("Illegal stat-variable at %L for a PURE procedure",
 		   &stat->where);
 
-      if (stat->ts.type != BT_INTEGER
-	  && !(stat->ref && (stat->ref->type == REF_ARRAY
-	       || stat->ref->type == REF_COMPONENT)))
+      if ((stat->ts.type != BT_INTEGER
+	   && !(stat->ref && (stat->ref->type == REF_ARRAY
+			      || stat->ref->type == REF_COMPONENT)))
+	  || stat->rank > 0)
 	gfc_error ("Stat-variable at %L must be a scalar INTEGER "
 		   "variable", &stat->where);
 
@@ -5759,10 +5760,11 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	gfc_error ("Illegal errmsg-variable at %L for a PURE procedure",
 		   &errmsg->where);
 
-      if (errmsg->ts.type != BT_CHARACTER
-	  && !(errmsg->ref
-	       && (errmsg->ref->type == REF_ARRAY
-	  	   || errmsg->ref->type == REF_COMPONENT)))
+      if ((errmsg->ts.type != BT_CHARACTER
+	   && !(errmsg->ref
+		&& (errmsg->ref->type == REF_ARRAY
+		    || errmsg->ref->type == REF_COMPONENT)))
+	  || errmsg->rank > 0 )
 	gfc_error ("Errmsg-variable at %L must be a scalar CHARACTER "
 		   "variable", &errmsg->where);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bdd1391..41a9089 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2009-09-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/41197
+	* gfortran.dg/allocate_alloc_opt_1.f90:  Use scalar
+	variables for stat and errmsg.
+	* gfortran.dg/deallocate_alloc_opt_1.f90:  Likewise.
+	* gfortran.dg/allocate_stat_2.f90:  New test.
+
 2009-09-07  Bernd Schmidt  <bernd.schmidt@analog.com>
 
 	* gcc.c-torture/compile/20090907-1.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
index cd611cc..52e0262f 100644
--- a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
@@ -26,8 +26,8 @@ program a
 
   allocate(err) ! { dg-error "nonprocedure pointer or an allocatable" }
 
-  allocate(error(2),stat=j,errmsg=error) ! { dg-error "shall not be ALLOCATEd within" }
-  allocate(i(2), stat = i)  ! { dg-error "shall not be ALLOCATEd within" }
+  allocate(error(2),stat=j,errmsg=error(1)) ! { dg-error "shall not be ALLOCATEd within" }
+  allocate(i(2), stat = i(1))  ! { dg-error "shall not be ALLOCATEd within" }
 
   allocate(n) ! { dg-error "must be ALLOCATABLE or a POINTER" }
 
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat_2.f90 b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90
new file mode 100644
index 0000000..7cf6d65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR 41197
+program main
+  integer, dimension (4) :: ier = 0
+  character(len=30), dimension(2) :: er
+  integer, dimension (:), allocatable :: a
+  allocate (a (16), stat = ier) ! { dg-error "must be a scalar INTEGER" }
+  allocate (a (14), stat=ier(1),errmsg=er) ! { dg-error "must be a scalar CHARACTER" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
index 75da701..5c00741 100644
--- a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
+++ b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
@@ -26,8 +26,8 @@ program a
 
   deallocate(err) ! { dg-error "nonprocedure pointer or an allocatable" }
 
-  deallocate(error,stat=j,errmsg=error) ! { dg-error "shall not be DEALLOCATEd within" }
-  deallocate(i, stat = i)  ! { dg-error "shall not be DEALLOCATEd within" }
+  deallocate(error,stat=j,errmsg=error(1)) ! { dg-error "shall not be DEALLOCATEd within" }
+  deallocate(i, stat = i(1))  ! { dg-error "shall not be DEALLOCATEd within" }
 
   deallocate(n) ! { dg-error "must be ALLOCATABLE or a POINTER" }