diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2016-11-17 08:52:24 +0100 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2016-11-17 08:52:24 +0100 |
| commit | 04f1c83099aab49f530f492b9d8119cf9d5ffcdd (patch) | |
| tree | 8b4f0fafbd80536213bd821e526cc672875a48af /gcc/fortran/simplify.c | |
| parent | 9bd99cce5b3769fd98b3db0d858222fa67e56486 (diff) | |
| download | gcc-04f1c83099aab49f530f492b9d8119cf9d5ffcdd.zip gcc-04f1c83099aab49f530f492b9d8119cf9d5ffcdd.tar.gz gcc-04f1c83099aab49f530f492b9d8119cf9d5ffcdd.tar.bz2 | |
re PR fortran/66227 ([OOP] EXTENDS_TYPE_OF n returns wrong result for polymorphic variable allocated to extended type)
2016-11-17 Janus Weil <janus@gcc.gnu.org>
PR fortran/66227
* simplify.c (gfc_simplify_extends_type_of): Fix missed optimization.
Prevent over-simplification. Fix a comment. Add a comment.
2016-11-17 Janus Weil <janus@gcc.gnu.org>
PR fortran/66227
* gfortran.dg/extends_type_of_3.f90: Fix and extend the test case.
From-SVN: r242535
Diffstat (limited to 'gcc/fortran/simplify.c')
| -rw-r--r-- | gcc/fortran/simplify.c | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 549d9005..9047c63 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -2517,7 +2517,7 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold) if (UNLIMITED_POLY (a) || UNLIMITED_POLY (mold)) return NULL; - /* Return .false. if the dynamic type can never be the same. */ + /* Return .false. if the dynamic type can never be an extension. */ if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS && !gfc_type_is_extension_of (mold->ts.u.derived->components->ts.u.derived, @@ -2527,18 +2527,19 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold) mold->ts.u.derived->components->ts.u.derived)) || (a->ts.type == BT_DERIVED && mold->ts.type == BT_CLASS && !gfc_type_is_extension_of - (a->ts.u.derived, - mold->ts.u.derived->components->ts.u.derived) - && !gfc_type_is_extension_of (mold->ts.u.derived->components->ts.u.derived, a->ts.u.derived)) || (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED && !gfc_type_is_extension_of (mold->ts.u.derived, - a->ts.u.derived->components->ts.u.derived))) + a->ts.u.derived->components->ts.u.derived) + && !gfc_type_is_extension_of + (a->ts.u.derived->components->ts.u.derived, + mold->ts.u.derived))) return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false); - if (mold->ts.type == BT_DERIVED + /* Return .true. if the dynamic type is guaranteed to be an extension. */ + if (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED && gfc_type_is_extension_of (mold->ts.u.derived, a->ts.u.derived->components->ts.u.derived)) return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, true); |