From patchwork Fri Jun 18 07:32:22 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [Fortran] PR44556 Fix 4.5/4.6 regression in (DE)ALLOCATE stat/errmsg
 checking
Date: Thu, 17 Jun 2010 21:32:22 -0000
From: Tobias Burnus <burnus@net-b.de>
X-Patchwork-Id: 56145
Message-Id: <4C1B2106.5040807@net-b.de>
To: gcc patches <gcc-patches@gcc.gnu.org>, gfortran <fortran@gcc.gnu.org>

Since 4.5, gfortran has a check which prevents "allocate(a, stat=a)",
i.e. that the allocate and stat variable is the same. However, the
current check fails for different components of the same derived type.

The attached patch fixes this.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias


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.

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 160936)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -6589,8 +6589,29 @@ resolve_allocate_deallocate (gfc_code *c
 
       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.  */
@@ -6618,8 +6639,29 @@ resolve_allocate_deallocate (gfc_code *c
 
       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.  

Index: gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90	(Revision 0)
@@ -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