re PR fortran/44556 (incorrect error: Stat-variable at (1) shall not be DEALLOCATEd within the same DEALLOCATE statement)

2010-06-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44556
        * resolve.c (resolve_allocate_deallocate): Properly check
        part-refs in stat=/errmsg= for invalid use.

2010-06-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/44556
        * gfortran.dg/allocate_alloc_opt_11.f90: New.

From-SVN: r161011

4 files changed, 83 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 11bda1f..dfaeeec 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-06-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44556
+	* resolve.c (resolve_allocate_deallocate): Properly check
+	part-refs in stat=/errmsg= for invalid use.
+
 2010-06-17  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/44558
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 52920f4..0951498 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6591,8 +6591,29 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
-	  gfc_error ("Stat-variable at %L shall not be %sd within "
-		     "the same %s statement", &stat->where, fcn, fcn);
+	  {
+	    gfc_ref *ref1, *ref2;
+	    bool found = true;
+
+	    for (ref1 = p->expr->ref, ref2 = stat->ref; ref1 && ref2;
+		 ref1 = ref1->next, ref2 = ref2->next)
+	      {
+		if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT)
+		  continue;
+		if (ref1->u.c.component->name != ref2->u.c.component->name)
+		  {
+		    found = false;
+		    break;
+		  }
+	      }
+
+	    if (found)
+	      {
+		gfc_error ("Stat-variable at %L shall not be %sd within "
+			   "the same %s statement", &stat->where, fcn, fcn);
+		break;
+	      }
+	  }
     }
 
   /* Check the errmsg variable.  */
@@ -6620,8 +6641,29 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
-	  gfc_error ("Errmsg-variable at %L shall not be %sd within "
-		     "the same %s statement", &errmsg->where, fcn, fcn);
+	  {
+	    gfc_ref *ref1, *ref2;
+	    bool found = true;
+
+	    for (ref1 = p->expr->ref, ref2 = errmsg->ref; ref1 && ref2;
+		 ref1 = ref1->next, ref2 = ref2->next)
+	      {
+		if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT)
+		  continue;
+		if (ref1->u.c.component->name != ref2->u.c.component->name)
+		  {
+		    found = false;
+		    break;
+		  }
+	      }
+
+	    if (found)
+	      {
+		gfc_error ("Errmsg-variable at %L shall not be %sd within "
+			   "the same %s statement", &errmsg->where, fcn, fcn);
+		break;
+	      }
+	  }
     }
 
   /* Check that an allocate-object appears only once in the statement.  
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ce75762..2ac6bd6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-06-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44556
+	* gfortran.dg/allocate_alloc_opt_11.f90: New.
+
 2010-06-18  Bernd Schmidt  <bernds@codesourcery.com>
 
 	* gcc.target/arm/pr40900.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90
new file mode 100644
index 0000000..c8c7ac6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/44556
+!
+! Contributed by Jonathan Hogg and Steve Kargl.
+!
+program oh_my
+   implicit none
+   type a
+      integer, allocatable :: b(:), d(:)
+      character(len=80) :: err
+      character(len=80), allocatable :: str(:)
+      integer :: src
+   end type a
+
+   integer j
+   type(a) :: c
+   c%err = 'ok'
+   allocate(c%d(1)) 
+   allocate(c%b(2), errmsg=c%err, stat=c%d(1)) ! OK
+   deallocate(c%b, errmsg=c%err, stat=c%d(1))  ! OK
+   allocate(c%b(2), errmsg=c%err, stat=c%b(1)) ! { dg-error "the same ALLOCATE statement" }
+   deallocate(c%b, errmsg=c%err, stat=c%b(1))  ! { dg-error "the same DEALLOCATE statement" }
+   allocate(c%str(2), errmsg=c%str(1), stat=j) ! { dg-error "the same ALLOCATE statement" }
+   deallocate(c%str, errmsg=c%str(1), stat=j)  ! { dg-error "the same DEALLOCATE statement" }
+end program oh_my