aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2018-07-02 07:20:27 +0000
committerPaul Thomas <pault@gcc.gnu.org>2018-07-02 07:20:27 +0000
commit87c789f1c0b2df4164de597d2a1ca6f70d72e119 (patch)
tree8e2a752a33758a41f8ea754df5bc976c9cdd3edc
parent61c74e84bb802ab0c63cc23705b1202f65453337 (diff)
downloadgcc-87c789f1c0b2df4164de597d2a1ca6f70d72e119.zip
gcc-87c789f1c0b2df4164de597d2a1ca6f70d72e119.tar.gz
gcc-87c789f1c0b2df4164de597d2a1ca6f70d72e119.tar.bz2
re PR fortran/45305 (Array-valued calles to elementals are not simplified)
2018-07-02 Paul Thomas <pault@gcc.gnu.org> PR fortran/45305 * expr.c : Add a prototype for scalarize_intrinsic_call. (gfc_simplify_expr): Use scalarize_intrinsic_call for elemental intrinsic function calls. (scalarize_intrinsic_call): Add 'init_flag' argument. Check if the expression or any of the actual argument expressions are NULL. Before calling gfc_check_init_expr, check 'init_flag'. Only simplify the scalarized expressions if there are no errors on the stack. (gfc_check_init_expr): Set 'init_flag' true in the call to scalarize_intrinsic_call. 2018-07-02 Paul Thomas <pault@gcc.gnu.org> PR fortran/45305 * gfortran.dg/scalarize_parameter_array_2.f90: New test. From-SVN: r262299
-rw-r--r--gcc/fortran/ChangeLog14
-rw-r--r--gcc/fortran/expr.c35
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/scalarize_parameter_array_2.f9015
4 files changed, 64 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e11f34a..4d2768c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2018-07-02 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/45305
+ * expr.c : Add a prototype for scalarize_intrinsic_call.
+ (gfc_simplify_expr): Use scalarize_intrinsic_call for elemental
+ intrinsic function calls.
+ (scalarize_intrinsic_call): Add 'init_flag' argument. Check if
+ the expression or any of the actual argument expressions are
+ NULL. Before calling gfc_check_init_expr, check 'init_flag'.
+ Only simplify the scalarized expressions if there are no errors
+ on the stack.
+ (gfc_check_init_expr): Set 'init_flag' true in the call to
+ scalarize_intrinsic_call.
+
2018-06-28 Fritz Reese <fritzoreese@gmail.com>
PR fortran/82865
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a799a49..951bdce 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1896,6 +1896,10 @@ simplify_parameter_variable (gfc_expr *p, int type)
return t;
}
+
+static bool
+scalarize_intrinsic_call (gfc_expr *, bool init_flag);
+
/* Given an expression, simplify it by collapsing constant
expressions. Most simplification takes place when the expression
tree is being constructed. If an intrinsic function is simplified
@@ -1919,6 +1923,8 @@ bool
gfc_simplify_expr (gfc_expr *p, int type)
{
gfc_actual_arglist *ap;
+ gfc_intrinsic_sym* isym = NULL;
+
if (p == NULL)
return true;
@@ -1938,6 +1944,14 @@ gfc_simplify_expr (gfc_expr *p, int type)
&& gfc_intrinsic_func_interface (p, 1) == MATCH_ERROR)
return false;
+ if (p->expr_type == EXPR_FUNCTION)
+ {
+ if (p->symtree)
+ isym = gfc_find_function (p->symtree->n.sym->name);
+ if (isym && isym->elemental)
+ scalarize_intrinsic_call (p, false);
+ }
+
break;
case EXPR_SUBSTRING:
@@ -2051,7 +2065,7 @@ et0 (gfc_expr *e)
/* Scalarize an expression for an elemental intrinsic call. */
static bool
-scalarize_intrinsic_call (gfc_expr *e)
+scalarize_intrinsic_call (gfc_expr *e, bool init_flag)
{
gfc_actual_arglist *a, *b;
gfc_constructor_base ctor;
@@ -2059,6 +2073,15 @@ scalarize_intrinsic_call (gfc_expr *e)
gfc_constructor *ci, *new_ctor;
gfc_expr *expr, *old;
int n, i, rank[5], array_arg;
+ int errors = 0;
+
+ if (e == NULL)
+ return false;
+
+ a = e->value.function.actual;
+ for (; a; a = a->next)
+ if (a->expr && !gfc_is_constant_expr (a->expr))
+ return false;
/* Find which, if any, arguments are arrays. Assume that the old
expression carries the type information and that the first arg
@@ -2093,7 +2116,7 @@ scalarize_intrinsic_call (gfc_expr *e)
for (; a; a = a->next)
{
/* Check that this is OK for an initialization expression. */
- if (a->expr && !gfc_check_init_expr (a->expr))
+ if (a->expr && init_flag && !gfc_check_init_expr (a->expr))
goto cleanup;
rank[n] = 0;
@@ -2118,6 +2141,7 @@ scalarize_intrinsic_call (gfc_expr *e)
n++;
}
+ gfc_get_errors (NULL, &errors);
/* Using the array argument as the master, step through the array
calling the function for each element and advancing the array
@@ -2152,7 +2176,8 @@ scalarize_intrinsic_call (gfc_expr *e)
/* Simplify the function calls. If the simplification fails, the
error will be flagged up down-stream or the library will deal
with it. */
- gfc_simplify_expr (new_ctor->expr, 0);
+ if (errors == 0)
+ gfc_simplify_expr (new_ctor->expr, 0);
for (i = 0; i < n; i++)
if (args[i])
@@ -2626,7 +2651,7 @@ gfc_check_init_expr (gfc_expr *e)
array argument. */
isym = gfc_find_function (e->symtree->n.sym->name);
if (isym && isym->elemental
- && (t = scalarize_intrinsic_call (e)))
+ && (t = scalarize_intrinsic_call (e, true)))
break;
}
@@ -5344,7 +5369,7 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
s = expr->symtree->n.sym;
if (s->ts.type != BT_CLASS)
return false;
-
+
rc = NULL;
for (r = expr->ref; r; r = r->next)
if (r->type == REF_COMPONENT)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a043fff..196d7fe 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-07-02 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/45305
+ * gfortran.dg/scalarize_parameter_array_2.f90: New test.
+
2018-07-02 Martin Liska <mliska@suse.cz>
PR ipa/86279
diff --git a/gcc/testsuite/gfortran.dg/scalarize_parameter_array_2.f90 b/gcc/testsuite/gfortran.dg/scalarize_parameter_array_2.f90
new file mode 100644
index 0000000..2e0b475
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scalarize_parameter_array_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! Test the fix for PR45305. The if statements should simplify away so
+! that 'I_do_not_exist' is not referenced.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+if (any (abs(bessel_jn([1,2], 1.0) - bessel_jn([1,2], 1.0)) &
+ > epsilon(0.0))) &
+ call I_do_not_exist()
+
+if (any (abs(bessel_jn(1, 2, 1.0) - bessel_jn([1,2], 1.0)) &
+ > epsilon(0.0))) &
+ call I_do_not_exist()
+end