diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-03-26 15:51:56 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-03-26 15:51:56 +0100 |
| commit | 03580130330b02a736f579b26db05f8bec204c8e (patch) | |
| tree | a12a62d2bce2b18dae2fe81e0c3e3d6fd692d0c4 /gcc/fortran/simplify.c | |
| parent | 795175513e9978d3141e8729da8dbff875e2d46c (diff) | |
| download | gcc-03580130330b02a736f579b26db05f8bec204c8e.zip gcc-03580130330b02a736f579b26db05f8bec204c8e.tar.gz gcc-03580130330b02a736f579b26db05f8bec204c8e.tar.bz2 | |
re PR fortran/56649 (ICE gfc_conv_structure with MERGE)
2013-03-26 Tobias Burnus <burnus@net-b.de>
PR fortran/56649
* simplify.c (gfc_simplify_merge): Simplify more.
2013-03-26 Tobias Burnus <burnus@net-b.de>
PR fortran/56649
* gfortran.dg/merge_init_expr_2.f90: New.
* gfortran.dg/merge_char_1.f90: Modify test to
stay a run-time test.
* gfortran.dg/merge_char_3.f90: Ditto.
From-SVN: r197109
Diffstat (limited to 'gcc/fortran/simplify.c')
| -rw-r--r-- | gcc/fortran/simplify.c | 43 |
1 files changed, 39 insertions, 4 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index a0909a3..dc5dad2 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3976,12 +3976,47 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg) gfc_expr * gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) { - if (tsource->expr_type != EXPR_CONSTANT - || fsource->expr_type != EXPR_CONSTANT - || mask->expr_type != EXPR_CONSTANT) + gfc_expr * result; + gfc_constructor *tsource_ctor, *fsource_ctor, *mask_ctor; + + if (mask->expr_type == EXPR_CONSTANT) + return gfc_get_parentheses (gfc_copy_expr (mask->value.logical + ? tsource : fsource)); + + if (!mask->rank || !is_constant_array_expr (mask) + || !is_constant_array_expr (tsource) || !is_constant_array_expr (fsource)) return NULL; - return gfc_copy_expr (mask->value.logical ? tsource : fsource); + result = gfc_get_array_expr (tsource->ts.type, tsource->ts.kind, + &tsource->where); + if (tsource->ts.type == BT_DERIVED) + result->ts.u.derived = tsource->ts.u.derived; + else if (tsource->ts.type == BT_CHARACTER) + result->ts.u.cl = tsource->ts.u.cl; + + tsource_ctor = gfc_constructor_first (tsource->value.constructor); + fsource_ctor = gfc_constructor_first (fsource->value.constructor); + mask_ctor = gfc_constructor_first (mask->value.constructor); + + while (mask_ctor) + { + if (mask_ctor->expr->value.logical) + gfc_constructor_append_expr (&result->value.constructor, + gfc_copy_expr (tsource_ctor->expr), + NULL); + else + gfc_constructor_append_expr (&result->value.constructor, + gfc_copy_expr (fsource_ctor->expr), + NULL); + tsource_ctor = gfc_constructor_next (tsource_ctor); + fsource_ctor = gfc_constructor_next (fsource_ctor); + mask_ctor = gfc_constructor_next (mask_ctor); + } + + result->shape = gfc_get_shape (1); + gfc_array_size (result, &result->shape[0]); + + return result; } |