aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/check.c
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2011-12-03 12:30:18 +0100
committerTobias Burnus <burnus@gcc.gnu.org>2011-12-03 12:30:18 +0100
commitf9fcedbdbdd06c20dd345a09fb253a947bab6e67 (patch)
treef1b18b0ac724eb7e6fcbd1c9bf1f3d91f53a5875 /gcc/fortran/check.c
parentfde50fe6afbf70fc1dfeb1f0c69e404c894bfd2c (diff)
downloadgcc-f9fcedbdbdd06c20dd345a09fb253a947bab6e67.zip
gcc-f9fcedbdbdd06c20dd345a09fb253a947bab6e67.tar.gz
gcc-f9fcedbdbdd06c20dd345a09fb253a947bab6e67.tar.bz2
[multiple changes]
2011-12-03 Tobias Burnus <burnus@net-b.de> PR fortran/50684 * check.c (variable_check): Fix intent(in) check. 2011-12-03 Tobias Burnus <burnus@net-b.de> PR fortran/50684 * gfortran.dg/move_alloc_8.f90: New. From-SVN: r181967
Diffstat (limited to 'gcc/fortran/check.c')
-rw-r--r--gcc/fortran/check.c29
1 files changed, 25 insertions, 4 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 605c77d..f2c4272 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -476,10 +476,31 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
&& (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
|| gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L cannot be INTENT(IN)",
- gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
- &e->where);
- return FAILURE;
+ gfc_ref *ref;
+ bool pointer = e->symtree->n.sym->ts.type == BT_CLASS
+ && CLASS_DATA (e->symtree->n.sym)
+ ? CLASS_DATA (e->symtree->n.sym)->attr.class_pointer
+ : e->symtree->n.sym->attr.pointer;
+
+ for (ref = e->ref; ref; ref = ref->next)
+ {
+ if (pointer && ref->type == REF_COMPONENT)
+ break;
+ if (ref->type == REF_COMPONENT
+ && ((ref->u.c.component->ts.type == BT_CLASS
+ && CLASS_DATA (ref->u.c.component)->attr.class_pointer)
+ || (ref->u.c.component->ts.type != BT_CLASS
+ && ref->u.c.component->attr.pointer)))
+ break;
+ }
+
+ if (!ref)
+ {
+ gfc_error ("'%s' argument of '%s' intrinsic at %L cannot be "
+ "INTENT(IN)", gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where);
+ return FAILURE;
+ }
}
if (e->expr_type == EXPR_VARIABLE