Dear all,
here is an updated version of the patch that includes suggestions
and comments by Mikael in PR93483.
Basic new features are:
- a new enum value ARITH_NOT_REDUCED to keep track if we encountered
an expression that was not reduced via reduce_unary/reduce_binary
- a cleanup of the related checking, resulting in more readable
code.
- a new testcase by Mikael that exhibited a flaw in the first patch
due to a false resolution of a symbol by premature simplification.
Regtested again. OK for mainline?
Thanks,
Harald
Am 12.10.22 um 21:45 schrieb Harald Anlauf via Fortran:
Dear Fortranners,
this one was really bugging me for quite some time. We failed to
properly handle (= simplify) expressions using array constructors
with typespec, and with parentheses and unary '+' and '-'
sprinkled here and there. When there was no typespec, there was
no related problem.
The underlying issue apparently was that we should simplify
elements of the array constructor before attempting the type
conversion.
Thanks to Gerhard, who insisted by submitted many related PRs.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 8eb55ff1620047e302e00a0f5202ab45b9a3fcab Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Sat, 15 Oct 2022 21:56:56 +0200
Subject: [PATCH] Fortran: handle bad array ctors with typespec [PR93483,
PR107216, PR107219]
gcc/fortran/ChangeLog:
PR fortran/93483
PR fortran/107216
PR fortran/107219
* arith.cc (reduce_unary): Handled expressions are EXP_CONSTANT and
EXPR_ARRAY. Do not attempt to reduce otherwise.
(reduce_binary_ac): Likewise.
(reduce_binary_ca): Likewise.
(reduce_binary_aa): Moved check for EXP_CONSTANT and EXPR_ARRAY
from here ...
(reduce_binary): ... to here.
(eval_intrinsic): Catch failed reductions.
* gfortran.h (GFC_INTRINSIC_OPS): New enum ARITH_NOT_REDUCED to keep
track of failed reductions because an erroneous expression was
encountered.
gcc/testsuite/ChangeLog:
PR fortran/93483
PR fortran/107216
PR fortran/107219
* gfortran.dg/array_constructor_56.f90: New test.
* gfortran.dg/array_constructor_57.f90: New test.
Co-authored-by: Mikael Morin <mik...@gcc.gnu.org>
---
gcc/fortran/arith.cc | 27 ++++++++---------
gcc/fortran/gfortran.h | 5 ++--
.../gfortran.dg/array_constructor_56.f90 | 22 ++++++++++++++
.../gfortran.dg/array_constructor_57.f90 | 30 +++++++++++++++++++
4 files changed, 68 insertions(+), 16 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_56.f90
create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_57.f90
diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index 14ba931e37f..c8e882badab 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1282,14 +1282,14 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op,
if (op->expr_type == EXPR_CONSTANT)
return eval (op, result);
+ if (op->expr_type != EXPR_ARRAY)
+ return ARITH_NOT_REDUCED;
+
rc = ARITH_OK;
head = gfc_constructor_copy (op->value.constructor);
for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
{
- if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
- rc = ARITH_INVALID_TYPE;
- else
- rc = reduce_unary (eval, c->expr, &r);
+ rc = reduce_unary (eval, c->expr, &r);
if (rc != ARITH_OK)
break;
@@ -1330,8 +1330,8 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
if (c->expr->expr_type == EXPR_CONSTANT)
rc = eval (c->expr, op2, &r);
- else if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
- rc = ARITH_INVALID_TYPE;
+ else if (c->expr->expr_type != EXPR_ARRAY)
+ rc = ARITH_NOT_REDUCED;
else
rc = reduce_binary_ac (eval, c->expr, op2, &r);
@@ -1384,8 +1384,8 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
if (c->expr->expr_type == EXPR_CONSTANT)
rc = eval (op1, c->expr, &r);
- else if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
- rc = ARITH_INVALID_TYPE;
+ else if (c->expr->expr_type != EXPR_ARRAY)
+ rc = ARITH_NOT_REDUCED;
else
rc = reduce_binary_ca (eval, op1, c->expr, &r);
@@ -1445,11 +1445,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
c && d;
c = gfc_constructor_next (c), d = gfc_constructor_next (d))
{
- if ((c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
- || (d->expr->expr_type == EXPR_OP && d->expr->ts.type == BT_UNKNOWN))
- rc = ARITH_INVALID_TYPE;
- else
- rc = reduce_binary (eval, c->expr, d->expr, &r);
+ rc = reduce_binary (eval, c->expr, d->expr, &r);
if (rc != ARITH_OK)
break;
@@ -1490,6 +1486,9 @@ reduce_binary (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
if (op1->expr_type == EXPR_ARRAY && op2->expr_type == EXPR_CONSTANT)
return reduce_binary_ac (eval, op1, op2, result);
+ if (op1->expr_type != EXPR_ARRAY || op2->expr_type != EXPR_ARRAY)
+ return ARITH_NOT_REDUCED;
+
return reduce_binary_aa (eval, op1, op2, result);
}
@@ -1668,7 +1667,7 @@ eval_intrinsic (gfc_intrinsic_op op,
else
rc = reduce_binary (eval.f3, op1, op2, &result);
- if (rc == ARITH_INVALID_TYPE)
+ if (rc == ARITH_INVALID_TYPE || rc == ARITH_NOT_REDUCED)
goto runtime;
/* Something went wrong. */
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 10bb098d136..7b8f0b148bd 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -222,11 +222,12 @@ enum gfc_intrinsic_op
Assumptions are made about the numbering of the interface_op enums. */
#define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
-/* Arithmetic results. */
+/* Arithmetic results. ARITH_NOT_REDUCED is used to keep track of failed
+ reductions because an erroneous expression was encountered. */
enum arith
{ ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
- ARITH_WRONGCONCAT, ARITH_INVALID_TYPE
+ ARITH_WRONGCONCAT, ARITH_INVALID_TYPE, ARITH_NOT_REDUCED
};
/* Statements. */
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_56.f90 b/gcc/testsuite/gfortran.dg/array_constructor_56.f90
new file mode 100644
index 00000000000..4701fb36225
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_56.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! Test the fix for the following:
+! PR fortran/93483
+! PR fortran/107216
+! PR fortran/107219
+!
+! Contributed by G.Steinmetz
+
+program p
+ real, parameter :: r0(*) = +[real :: +(1) ]
+ real, parameter :: r1(*) = +[real :: +[1] ]
+ real, parameter :: r2(*) = -[real :: [(1)]]
+ real, parameter :: r3(*) = +[real :: [-(1)]]
+ real, parameter :: r4(*) = -[real :: [[(1)]]]
+ real, parameter :: r5(*) = -[real :: -[1, 2]]
+ real, parameter :: r6(*) = +[real :: +[1, 2]]
+ real, parameter :: r7(*) = [real :: 1, 2] * [real :: 1, (2)]
+ real, parameter :: r8(*) = [real :: 1, (2)] * [real :: 1, 2]
+ real, parameter :: r9(*) = +[real :: 1, 2] * [real :: 1, (2)]
+ real, parameter :: rr(*) = -[real :: 1, (2)] * [real :: 1, 2]
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_57.f90 b/gcc/testsuite/gfortran.dg/array_constructor_57.f90
new file mode 100644
index 00000000000..1298c09cc40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_57.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! PR fortran/93483
+!
+! Verify that resolution (host associated parameter vs. contained function) works.
+!
+! Contributed by Mikael Morin
+
+module m
+ implicit none
+ integer, parameter :: a(*) = [ 7, 11 ]
+contains
+ subroutine bug
+ real :: b(1), c(1)
+ b = [ real :: (a(1)) ]
+ c = [ real :: a(1) ]
+ print *, b, c
+ if (any (b /= [ 14. ])) stop 1
+ if (any (c /= [ 14. ])) stop 2
+ contains
+ function a(c)
+ integer :: a, c
+ a = c + 13
+ end function a
+ end subroutine bug
+end module m
+
+program p
+ use m
+ call bug
+end program p
--
2.35.3
