Patchwork [Fortran] PR44556 Fix 4.5/4.6 regression in (DE)ALLOCATE stat/errmsg checking

login
register
mail settings
Submitter Tobias Burnus
Date June 18, 2010, 7:32 a.m.
Message ID <4C1B2106.5040807@net-b.de>
Download mbox | patch
Permalink /patch/56145/
State New
Headers show

Comments

Tobias Burnus - June 18, 2010, 7:32 a.m.
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
Steve Kargl - June 18, 2010, 10:07 p.m.
On Fri, Jun 18, 2010 at 09:32:22AM +0200, Tobias Burnus wrote:
> 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?
> 

OK.
Tobias Burnus - June 18, 2010, 10:24 p.m.
Steve Kargl wrote:
> On Fri, Jun 18, 2010 at 09:32:22AM +0200, Tobias Burnus wrote:
>   
>> The attached patch fixes this.
>> Build and regtested on x86-64-linux.
>> OK for the trunk
> OK.
>   

Thanks for the review  (committed as Rev. 161011).
I intent to commit the patch to the 4.5 branch in the next days.

Tobias

Patch

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