[Patch, Fortran] PR32936 - Allocate's STAT & function result

[Patch, Fortran] PR32936 - Allocate's STAT & function result

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 596 bytes --]

:ADDPATCH fortran:

The ALLOCATE's STAT actual argument must be a variable; however, the
check did not properly do so and thus function names which are return
variables were rejected.

I fixed this and enhanced the check a bit.

Additionally, I was a bit surprised that  "allocated(pointer)" gave the
error that "pointer" needs to be an array; it took me a while that I
realized that it needs to have an allocatable and not a pointer [I
should have used associated()]. I therefore suggest to change the order
of the checks.

Build and regression tested with no failure.
Ok for the trunk?

Tobias

[-- Attachment #2: check.diff --]
[-- Type: text/x-patch, Size: 745 bytes --]

2007-07-30  Tobias Burnus  <burnus@net-b.de>

	* check.c (gfc_check_allocated): Reorder checks to improve
	error message.

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 127064)
+++ gcc/fortran/check.c	(working copy)
@@ -489,9 +489,6 @@ gfc_check_allocated (gfc_expr *array)
   if (variable_check (array, 0) == FAILURE)
     return FAILURE;
 
-  if (array_check (array, 0) == FAILURE)
-    return FAILURE;
-
   attr = gfc_variable_attr (array, NULL);
   if (!attr.allocatable)
     {
@@ -501,6 +498,9 @@ gfc_check_allocated (gfc_expr *array)
       return FAILURE;
     }
 
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
   return SUCCESS;
 }
 

[-- Attachment #3: stat-patch.diff --]
[-- Type: text/x-patch, Size: 3979 bytes --]

2007-07-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/32936
	* match.c (gfc_match_allocate): Better check that STAT is
	a variable.

2007-07-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/32936
	* gfortran.dg/allocate_stat.f90: New.

Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 127064)
+++ gcc/fortran/match.c	(working copy)
@@ -2001,6 +2001,8 @@ gfc_match_allocate (void)
 
   if (stat != NULL)
     {
+      bool is_variable;
+
       if (stat->symtree->n.sym->attr.intent == INTENT_IN)
 	{
 	  gfc_error ("STAT variable '%s' of ALLOCATE statement at %C cannot "
@@ -2015,7 +2017,38 @@ gfc_match_allocate (void)
 	  goto cleanup;
 	}
 
-      if (stat->symtree->n.sym->attr.flavor != FL_VARIABLE)
+      is_variable = false;
+      if (stat->symtree->n.sym->attr.flavor == FL_VARIABLE)
+	is_variable = true;
+      else if (stat->symtree->n.sym->attr.function
+	  && stat->symtree->n.sym->result == stat->symtree->n.sym
+	  && (gfc_current_ns->proc_name == stat->symtree->n.sym
+	      || (gfc_current_ns->parent
+		  && gfc_current_ns->parent->proc_name
+		     == stat->symtree->n.sym)))
+	is_variable = true;
+      else if (gfc_current_ns->entries
+	       && stat->symtree->n.sym->result == stat->symtree->n.sym)
+	{
+	  gfc_entry_list *el;
+	  for (el = gfc_current_ns->entries; el; el = el->next)
+	    if (el->sym == stat->symtree->n.sym)
+	      {
+		is_variable = true;
+	      }
+	}
+      else if (gfc_current_ns->parent && gfc_current_ns->parent->entries
+	       && stat->symtree->n.sym->result == stat->symtree->n.sym)
+	{
+	  gfc_entry_list *el;
+	  for (el = gfc_current_ns->parent->entries; el; el = el->next)
+	    if (el->sym == stat->symtree->n.sym)
+	      {
+		is_variable = true;
+	      }
+	}
+
+      if (!is_variable)
 	{
 	  gfc_error ("STAT expression at %C must be a variable");
 	  goto cleanup;
Index: gcc/testsuite/gfortran.dg/allocate_stat.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_stat.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_stat.f90	(revision 0)
@@ -0,0 +1,76 @@
+! { dg-do compile }
+! PR fortran/32936
+!
+!
+function all_res()
+  implicit none
+  real, pointer :: gain 
+  integer :: all_res
+  allocate (gain,STAT=all_res)
+  deallocate(gain)
+  call bar()
+contains
+  subroutine bar()
+    real, pointer :: gain2
+    allocate (gain2,STAT=all_res)
+    deallocate(gain2)
+  end subroutine bar
+end function all_res
+
+function func()
+  implicit none
+  real, pointer :: gain 
+  integer :: all_res2, func
+  func = 0
+entry all_res2
+  allocate (gain,STAT=all_res2)
+  deallocate(gain)
+contains
+  subroutine test
+    implicit none
+    real, pointer :: gain2
+     allocate (gain2,STAT=all_res2)
+     deallocate(gain2)
+  end subroutine test
+end function func
+
+function func2() result(res)
+  implicit none
+  real, pointer :: gain 
+  integer :: res
+  allocate (gain,STAT=func2) ! { dg-error "Expected VARIABLE" }
+  deallocate(gain)
+  res = 0
+end function func2
+
+subroutine sub()
+  implicit none
+  interface
+    integer function func2()
+    end function
+  end interface
+  real, pointer :: gain 
+  integer, parameter :: res = 2
+  allocate (gain,STAT=func2) ! { dg-error "STAT expression at .1. must be a variable" }
+  deallocate(gain)
+end subroutine sub
+
+module test
+contains
+ function one()
+   integer :: one, two
+   integer, pointer :: ptr
+   allocate(ptr, stat=one)
+   if(one == 0) deallocate(ptr)
+ entry two
+   allocate(ptr, stat=two)
+   if(associated(ptr)) deallocate(ptr)
+ end function one
+ subroutine sub()
+   integer, pointer :: p
+   allocate(p, stat=one) ! { dg-error "STAT expression at .1. must be a variable" }
+   if(associated(p)) deallocate(p)
+   allocate(p, stat=two) ! { dg-error "STAT expression at .1. must be a variable" }
+   if(associated(p)) deallocate(p)
+ end subroutine sub
+end module test

Re: [Patch, Fortran] PR32936 - Allocate's STAT & function result

[Steve Kargl]

On Mon, Jul 30, 2007 at 08:27:11PM +0200, Tobias Burnus wrote:
> :ADDPATCH fortran:
> 
> The ALLOCATE's STAT actual argument must be a variable; however, the
> check did not properly do so and thus function names which are return
> variables were rejected.
> 
> I fixed this and enhanced the check a bit.
> 
> Additionally, I was a bit surprised that  "allocated(pointer)" gave the
> error that "pointer" needs to be an array; it took me a while that I
> realized that it needs to have an allocatable and not a pointer [I
> should have used associated()]. I therefore suggest to change the order
> of the checks.
> 
> Build and regression tested with no failure.
> Ok for the trunk?
> 

OK.

-- 
Steve