diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-12-03 12:30:18 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-12-03 12:30:18 +0100 |
| commit | f9fcedbdbdd06c20dd345a09fb253a947bab6e67 (patch) | |
| tree | f1b18b0ac724eb7e6fcbd1c9bf1f3d91f53a5875 /gcc/fortran/check.c | |
| parent | fde50fe6afbf70fc1dfeb1f0c69e404c894bfd2c (diff) | |
| download | gcc-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.c | 29 |
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 |