From 048037281cf5e2a74fb28b7c638d355f362994f2 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 23 Jan 2012 21:38:23 +0100 Subject: re PR fortran/51948 ([OOP] Rejects valid: Function result value in MOVE_ALLOC, nested in SELECT TYPE) 2012-01-23 Tobias Burnus PR fortran/51948 * check.c (variable_check): Fix checking for result variables and deeply nested BLOCKs. 2012-01-23 Tobias Burnus PR fortran/51948 * gfortran.dg/move_alloc_12.f90: New. From-SVN: r183453 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/check.c | 17 +++++++++------ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/move_alloc_12.f90 | 33 +++++++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/move_alloc_12.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 85aaa21..2d1e700 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-01-23 Tobias Burnus + + PR fortran/51948 + * check.c (variable_check): Fix checking for + variables and deeply nested BLOCKs. + 2012-01-21 Tobias Burnus Steven G. Kargl diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index cb6b94f..4b72a5fb 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2c259c6..0f1e4bf 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-01-23 Tobias Burnus + + PR fortran/51948 + * gfortran.dg/move_alloc_12.f90: New. + 2012-01-23 Ramana Radhakrishnan 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 index 0000000..880b302 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/move_alloc_12.f90 @@ -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 -- cgit v1.1