OSDN Git Service

2012-01-23 Tobias Burnus <burnus@net-b.de>
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 23 Jan 2012 20:38:23 +0000 (20:38 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 23 Jan 2012 20:38:23 +0000 (20:38 +0000)
        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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183453 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/move_alloc_12.f90 [new file with mode: 0644]

index 85aaa21..2d1e700 100644 (file)
@@ -1,3 +1,9 @@
+2012-01-23  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/51948
+       * check.c (variable_check): Fix checking for
+        variables and deeply nested BLOCKs.
+
 2012-01-21  Tobias Burnus  <burnus@net-b.de>
            Steven G. Kargl  <kargl@gcc.gnu.org>
 
index cb6b94f..4b72a5f 100644 (file)
@@ -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);
 
index 2c259c6..0f1e4bf 100644 (file)
@@ -1,3 +1,8 @@
+2012-01-23  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/51948
+       * gfortran.dg/move_alloc_12.f90: New.
+
 2012-01-23  Ramana Radhakrishnan  <ramana.radhakrishnan@linaro.org>
 
        PR middle-end/45416
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_12.f90 b/gcc/testsuite/gfortran.dg/move_alloc_12.f90
new file mode 100644 (file)
index 0000000..880b302
--- /dev/null
@@ -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