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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c392d9d..d2a301d 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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..52e0262 100644 (file)
--- 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 (file)
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 (file)
--- 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" }