[Patch, Fortran] PR 51948 - Fix variable check for MOVE_ALLOC

[Tobias Burnus <burnus at net-b dot de>]

Dear all,

the variable_check() failed when one had multiple nested blocks.

I think it worked in 4.5 because that was before PR 46484 got fixed in 
4.6. The issue that PR fixed was that the non-variableness of "f" in 
"sub" (see below) was not diagnosed. The problem is that the symbol tree 
is shared and "sym == sym->result" is also true in "sub":
  contains
     subroutine sub
       ...= allocatable(f)
     end
     function f()

This patch simply allows for more than one level of parent namespace.

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

Tobias
2012-01-23  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51948
	* check.c (variable_check): Fix checking for
	result variables and deeply nested BLOCKs.

2012-01-23  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51948
	* gfortran.dg/move_alloc_12.f90: New.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index cb6b94f..4b72a5f 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -521,15 +521,18 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
 
   if (e->expr_type == EXPR_VARIABLE
       && e->symtree->n.sym->attr.flavor != FL_PARAMETER
-      && (allow_proc
-	  || !e->symtree->n.sym->attr.function
-	  || (e->symtree->n.sym == e->symtree->n.sym->result
-	      && (e->symtree->n.sym == gfc_current_ns->proc_name
-		  || (gfc_current_ns->parent
-		      && e->symtree->n.sym
-			 == gfc_current_ns->parent->proc_name)))))
+      && (allow_proc || !e->symtree->n.sym->attr.function))
     return SUCCESS;
 
+  if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.function
+      && e->symtree->n.sym == e->symtree->n.sym->result)
+    {
+      gfc_namespace *ns;
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	if (ns->proc_name == e->symtree->n.sym)
+	  return SUCCESS;
+    }
+
   gfc_error ("'%s' argument of '%s' intrinsic at %L must be a variable",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where);
 
--- /dev/null	2012-01-23 08:22:38.999666895 +0100
+++ gcc/gcc/testsuite/gfortran.dg/move_alloc_12.f90	2012-01-23 14:23:37.000000000 +0100
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR fortran/51948
+!
+  type :: t
+  end type t
+contains
+  function func(x, y)
+    class(t) :: y
+    type(t), allocatable :: func
+    type(t), allocatable :: x
+
+    select type (y)
+      type is(t)
+        call move_alloc (x, func)
+    end select
+  end function
+
+  function func2(x, y)
+    class(t) :: y
+    class(t), allocatable :: func2
+    class(t), allocatable :: x
+
+    block
+    block
+    select type (y)
+      type is(t)
+        call move_alloc (x, func2)
+    end select
+    end block
+    end block
+  end function
+end