diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-01-27 14:08:52 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-01-27 14:08:52 +0100 |
| commit | 102344e274f23609bc9bc008ded4a6fd501e5549 (patch) | |
| tree | de5f3b6f1b72f66e6ec9b8487e790dcc491f196d /gcc/fortran/primary.c | |
| parent | 4cb2a86715695603f8abf1396436b68a7281221b (diff) | |
| download | gcc-102344e274f23609bc9bc008ded4a6fd501e5549.zip gcc-102344e274f23609bc9bc008ded4a6fd501e5549.tar.gz gcc-102344e274f23609bc9bc008ded4a6fd501e5549.tar.bz2 | |
re PR fortran/51970 ([OOP] gimplification failed for polymorphic MOVE_ALLOC)
2012-01-27 Tobias Burnus <burnus@net-b.de>
PR fortran/51970
PR fortran/51977
* primary.c (gfc_match_varspec. gfc_match_rvalue): Set
handle array spec for BT_CLASS.
* expr.c (gfc_get_variable_expr, gfc_lval_expr_from_sym)
* frontend-passes.c (create_var): Ditto.
* resolve.c (resolve_actual_arglist, resolve_assoc_var): Ditto.
* trans-decl.c (gfc_trans_deferred_vars): Use class_pointer
instead of attr.pointer.
(gfc_generate_function_code): Use CLASS_DATA (sym) for BT_CLASS.
* trans-intrinsic.c (conv_intrinsic_move_alloc): Move assert.
* trans-stmt.c (trans_associate_var): Ask for the descriptor.
2012-01-27 Tobias Burnus <burnus@net-b.de>
PR fortran/51970
PR fortran/51977
* gfortran.dg/move_alloc_13.f90: New.
From-SVN: r183622
Diffstat (limited to 'gcc/fortran/primary.c')
| -rw-r--r-- | gcc/fortran/primary.c | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 83d9132..d1d96ff 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1868,18 +1868,24 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && (CLASS_DATA (sym)->attr.dimension || CLASS_DATA (sym)->attr.codimension))) { + gfc_array_spec *as; + + tail = extend_ref (primary, tail); + tail->type = REF_ARRAY; + /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character variables. We'll leave the decision till resolve time. */ - tail = extend_ref (primary, tail); - tail->type = REF_ARRAY; - m = gfc_match_array_ref (&tail->u.ar, equiv_flag ? NULL : sym->as, - equiv_flag, - sym->ts.type == BT_CLASS && CLASS_DATA (sym) - ? (CLASS_DATA (sym)->as - ? CLASS_DATA (sym)->as->corank : 0) - : (sym->as ? sym->as->corank : 0)); + if (equiv_flag) + as = NULL; + else if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)) + as = CLASS_DATA (sym)->as; + else + as = sym->as; + + m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, + as ? as->corank : 0); if (m != MATCH_YES) return m; @@ -2893,7 +2899,10 @@ gfc_match_rvalue (gfc_expr **result) e->value.function.actual = actual_arglist; e->where = gfc_current_locus; - if (sym->as != NULL) + if (sym->ts.type == BT_CLASS && sym->attr.class_ok + && CLASS_DATA (sym)->as) + e->rank = CLASS_DATA (sym)->as->rank; + else if (sym->as != NULL) e->rank = sym->as->rank; if (!sym->attr.function |