diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2013-01-06 21:32:48 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2013-01-06 21:32:48 +0000 |
| commit | f04986a90b4ece27f2d144881adaf9f3d7cd6731 (patch) | |
| tree | dfd2767db2b73b5d9034f73b9a1615edf6c836fd /gcc/fortran/trans-expr.c | |
| parent | 1ab05c31a0854497acc8503d4aca9b36d38c3f28 (diff) | |
| download | gcc-f04986a90b4ece27f2d144881adaf9f3d7cd6731.zip gcc-f04986a90b4ece27f2d144881adaf9f3d7cd6731.tar.gz gcc-f04986a90b4ece27f2d144881adaf9f3d7cd6731.tar.bz2 | |
PR fortran/PR53876 PR fortran/PR54990 PR fortran/PR54992
2013-01-06 Paul Thomas <pault@gcc.gnu.org>
PR fortran/PR53876
PR fortran/PR54990
PR fortran/PR54992
* trans-array.c (build_array_ref): Check the TYPE_CANONICAL
to see if it is GFC_CLASS_TYPE_P.
* trans-expr.c (gfc_get_vptr_from_expr): The same.
(gfc_conv_class_to_class): If the types are not the same,
cast parmese->expr to the type of ctree.
* trans-types.c (gfc_get_derived_type): GFC_CLASS_TYPE_P of
CLASS components must be set.
2013-01-06 Paul Thomas <pault@gcc.gnu.org>
PR fortran/PR53876
PR fortran/PR54990
PR fortran/PR54992
* gfortran.dg/class_array_15.f03: New test.
From-SVN: r194953
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 30 |
1 files changed, 23 insertions, 7 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 01d3595..9452e27 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -198,16 +198,31 @@ gfc_vtable_final_get (tree decl) #undef VTABLE_FINAL_FIELD -/* Obtain the vptr of the last class reference in an expression. */ +/* Obtain the vptr of the last class reference in an expression. + Return NULL_TREE if no class reference is found. */ tree gfc_get_vptr_from_expr (tree expr) { - tree tmp = expr; - while (tmp && !GFC_CLASS_TYPE_P (TREE_TYPE (tmp))) - tmp = TREE_OPERAND (tmp, 0); - tmp = gfc_class_vptr_get (tmp); - return tmp; + tree tmp; + tree type; + + for (tmp = expr; tmp; tmp = TREE_OPERAND (tmp, 0)) + { + type = TREE_TYPE (tmp); + while (type) + { + if (GFC_CLASS_TYPE_P (type)) + return gfc_class_vptr_get (tmp); + if (type != TYPE_CANONICAL (type)) + type = TYPE_CANONICAL (type); + else + type = NULL_TREE; + } + if (TREE_CODE (tmp) == VAR_DECL) + break; + } + return NULL_TREE; } @@ -594,7 +609,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, } else { - if (CLASS_DATA (e)->attr.codimension) + if (TREE_TYPE (parmse->expr) != TREE_TYPE (ctree)) parmse->expr = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, TREE_TYPE (ctree), parmse->expr); gfc_add_modify (&block, ctree, parmse->expr); @@ -1562,6 +1577,7 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) c->norestrict_decl = f2; field = f2; } + tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE); |