From 3832c6f7e672e76bba74a508bf3a49740ea38046 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 28 Nov 2022 20:43:02 +0100 Subject: Fortran: intrinsic MERGE shall use all its arguments [PR107874] gcc/fortran/ChangeLog: PR fortran/107874 * simplify.cc (gfc_simplify_merge): When simplifying MERGE with a constant scalar MASK, ensure that arguments TSOURCE and FSOURCE are either constant or will be evaluated. * trans-intrinsic.cc (gfc_conv_intrinsic_merge): Evaluate arguments before generating conditional expression. gcc/testsuite/ChangeLog: PR fortran/107874 * gfortran.dg/merge_init_expr_2.f90: Adjust code to the corrected simplification. * gfortran.dg/merge_1.f90: New test. Co-authored-by: Steven G. Kargl --- gcc/fortran/simplify.cc | 17 ++++++++++++++++- gcc/fortran/trans-intrinsic.cc | 3 +++ 2 files changed, 19 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 9c2fea8..b618418 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -4913,7 +4913,22 @@ gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) if (mask->expr_type == EXPR_CONSTANT) { - result = gfc_copy_expr (mask->value.logical ? tsource : fsource); + /* The standard requires evaluation of all function arguments. + Simplify only when the other dropped argument (FSOURCE or TSOURCE) + is a constant expression. */ + if (mask->value.logical) + { + if (!gfc_is_constant_expr (fsource)) + return NULL; + result = gfc_copy_expr (tsource); + } + else + { + if (!gfc_is_constant_expr (tsource)) + return NULL; + result = gfc_copy_expr (fsource); + } + /* Parenthesis is needed to get lower bounds of 1. */ result = gfc_get_parentheses (result); gfc_simplify_expr (result, 1); diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index bb93802..9342698 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -7557,6 +7557,9 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr) &se->pre); se->string_length = len; } + tsource = gfc_evaluate_now (tsource, &se->pre); + fsource = gfc_evaluate_now (fsource, &se->pre); + mask = gfc_evaluate_now (mask, &se->pre); type = TREE_TYPE (tsource); se->expr = fold_build3_loc (input_location, COND_EXPR, type, mask, tsource, fold_convert (type, fsource)); -- cgit v1.1