From bbeffd6b40a97a661e78e10556a5b5f3edc4d78f Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Tue, 14 Aug 2012 16:45:55 +0000 Subject: re PR fortran/47586 ([F03] allocatable components: deep copy missing) fortran/ PR fortran/47586 * trans-expr.c (expr_is_variable): Handle regular, procedure pointer, and typebound functions returning a data pointer. testsuite/ PR fortran/47586 * gfortran.dg/typebound_proc_20.f90: Enable runtime test. * gfortran.dg/typebound_proc_27.f03: New test. From-SVN: r190394 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-expr.c | 45 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f89d3a5..7161b62 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,11 @@ 2012-08-14 Mikael Morin + PR fortran/47586 + * trans-expr.c (expr_is_variable): Handle regular, procedure pointer, + and typebound functions returning a data pointer. + +2012-08-14 Mikael Morin + * decl.c (match_ppc_decl): Copy the procedure interface's symbol as procedure interface's result. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 53fdf45..4f7d0262 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6961,6 +6961,8 @@ static bool expr_is_variable (gfc_expr *expr) { gfc_expr *arg; + gfc_component *comp; + gfc_symbol *func_ifc; if (expr->expr_type == EXPR_VARIABLE) return true; @@ -6972,7 +6974,50 @@ expr_is_variable (gfc_expr *expr) return expr_is_variable (arg); } + /* A data-pointer-returning function should be considered as a variable + too. */ + if (expr->expr_type == EXPR_FUNCTION + && expr->ref == NULL) + { + if (expr->value.function.isym != NULL) + return false; + + if (expr->value.function.esym != NULL) + { + func_ifc = expr->value.function.esym; + goto found_ifc; + } + else + { + gcc_assert (expr->symtree); + func_ifc = expr->symtree->n.sym; + goto found_ifc; + } + + gcc_unreachable (); + } + + comp = gfc_get_proc_ptr_comp (expr); + if ((expr->expr_type == EXPR_PPC || expr->expr_type == EXPR_FUNCTION) + && comp) + { + func_ifc = comp->ts.interface; + goto found_ifc; + } + + if (expr->expr_type == EXPR_COMPCALL) + { + gcc_assert (!expr->value.compcall.tbp->is_generic); + func_ifc = expr->value.compcall.tbp->u.specific->n.sym; + goto found_ifc; + } + return false; + +found_ifc: + gcc_assert (func_ifc->attr.function + && func_ifc->result != NULL); + return func_ifc->result->attr.pointer; } -- cgit v1.1