From: Thomas Koenig <tkoenig@netcologne.de>
To: "fortran@gcc.gnu.org" <fortran@gcc.gnu.org>,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [patch, fortran] Fix PR 84697
Date: Tue, 06 Mar 2018 21:40:00 -0000 [thread overview]
Message-ID: <b5995f78-a509-0db3-17cb-df5b6d21849e@netcologne.de> (raw)
[-- Attachment #1: Type: text/plain, Size: 1685 bytes --]
Hello world,
the attached patch fixes a bug, partly an 8 regression, for
simplifying an expression containing minloc or maxloc.
The underlying problem was that
integer, dimension(0), parameter :: z=0
ended up as EXPR_CONSTANT even though the rank was one, which
was then passed to the simplification routines, which either
ICEd or gave wrong results.
In doing this, I had to change the logic of the is_size_zero_array
function. Trying to call it from within the simplification rountines
led to the simplification routines to be called, and so on... until
the stack ran out.
As soon as this is committed, I'll also look if there is anything left
in PR66128, and close that bug if appropriate
Regression-tested. OK for trunk?
2017-03-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/84697
PR fortran/66128
* expr.c (simplify_parameter_variable): If p is a size zero array
and not an ARRAY_EXPR insert an empty array constructor and
return.
* gfortran.h: Add prototype for gfc_is_size_zero_array.
* simplify.c (is_size_zero_array): Make non-static and rename into
(gfc_is_size_zero_array): Check for parameter arrays of zero
size by comparing shape and absence of constructor.
(gfc_simplify_all): Use gfc_is_size_zero_array instead of
is_size_zero_array.
(gfc_simplify_count): Likewise.
(gfc_simplify_iall): Likewise.
(gfc_simplify_iany): Likewise.
(gfc_simplify_iparity): Likewise.
(gfc_simplify_minval): Likewise.
(gfc_simplify_maxval): Likewise.
(gfc_simplify_product): Likewise.
(gfc_simplify_sum): Likewise.
2017-03-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/84697
PR fortran/66128
* gfortran.dg/minmaxloc_zerosize_1.f90: New test.
[-- Attachment #2: p3.diff --]
[-- Type: text/x-patch, Size: 5562 bytes --]
Index: expr.c
===================================================================
--- expr.c (Revision 258264)
+++ expr.c (Arbeitskopie)
@@ -1857,6 +1857,22 @@ simplify_parameter_variable (gfc_expr *p, int type
gfc_expr *e;
bool t;
+ if (gfc_is_size_zero_array (p))
+ {
+ if (p->expr_type == EXPR_ARRAY)
+ return true;
+
+ e = gfc_get_expr ();
+ e->expr_type = EXPR_ARRAY;
+ e->ts = p->ts;
+ e->rank = p->rank;
+ e->value.constructor = NULL;
+ e->shape = gfc_copy_shape (p->shape, p->rank);
+ e->where = p->where;
+ gfc_replace_expr (p, e);
+ return true;
+ }
+
e = gfc_copy_expr (p->symtree->n.sym->value);
if (e == NULL)
return false;
Index: gfortran.h
===================================================================
--- gfortran.h (Revision 258264)
+++ gfortran.h (Arbeitskopie)
@@ -3464,6 +3464,7 @@ int gfc_code_walker (gfc_code **, walk_code_fn_t,
void gfc_convert_mpz_to_signed (mpz_t, int);
gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
+bool gfc_is_size_zero_array (gfc_expr *);
/* trans-array.c */
Index: simplify.c
===================================================================
--- simplify.c (Revision 258264)
+++ simplify.c (Arbeitskopie)
@@ -259,26 +259,28 @@ is_constant_array_expr (gfc_expr *e)
}
/* Test for a size zero array. */
-static bool
-is_size_zero_array (gfc_expr *array)
+bool
+gfc_is_size_zero_array (gfc_expr *array)
{
- gfc_expr *e;
- bool t;
- e = gfc_copy_expr (array);
- gfc_simplify_expr (e, 1);
+ if (array->rank == 0)
+ return false;
- if (e->expr_type == EXPR_CONSTANT && e->rank > 0 && !e->shape)
- t = true;
- else if (e->expr_type == EXPR_ARRAY && e->rank > 0
- && !e->shape && !e->value.constructor)
- t = true;
- else
- t = false;
+ if (array->expr_type == EXPR_VARIABLE && array->rank > 0
+ && array->symtree->n.sym->attr.flavor == FL_PARAMETER
+ && array->shape != NULL)
+ {
+ for (int i = 0; i < array->rank; i++)
+ if (mpz_cmp_si (array->shape[i], 0) <= 0)
+ return true;
- gfc_free_expr (e);
+ return false;
+ }
- return t;
+ if (array->expr_type == EXPR_ARRAY)
+ return array->value.constructor == NULL;
+
+ return false;
}
@@ -974,7 +976,7 @@ gfc_simplify_aint (gfc_expr *e, gfc_expr *k)
gfc_expr *
gfc_simplify_all (gfc_expr *mask, gfc_expr *dim)
{
- if (is_size_zero_array (mask))
+ if (gfc_is_size_zero_array (mask))
return gfc_get_logical_expr (mask->ts.kind, &mask->where, true);
return simplify_transformation (mask, dim, NULL, true, gfc_and);
@@ -1066,7 +1068,7 @@ gfc_simplify_and (gfc_expr *x, gfc_expr *y)
gfc_expr *
gfc_simplify_any (gfc_expr *mask, gfc_expr *dim)
{
- if (is_size_zero_array (mask))
+ if (gfc_is_size_zero_array (mask))
return gfc_get_logical_expr (mask->ts.kind, &mask->where, false);
return simplify_transformation (mask, dim, NULL, false, gfc_or);
@@ -1965,7 +1967,7 @@ gfc_simplify_count (gfc_expr *mask, gfc_expr *dim,
{
gfc_expr *result;
- if (is_size_zero_array (mask))
+ if (gfc_is_size_zero_array (mask))
{
int k;
k = kind ? mpz_get_si (kind->value.integer) : gfc_default_integer_kind;
@@ -3263,7 +3265,7 @@ do_bit_and (gfc_expr *result, gfc_expr *e)
gfc_expr *
gfc_simplify_iall (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
- if (is_size_zero_array (array))
+ if (gfc_is_size_zero_array (array))
return gfc_get_int_expr (array->ts.kind, NULL, -1);
return simplify_transformation (array, dim, mask, -1, do_bit_and);
@@ -3285,7 +3287,7 @@ do_bit_ior (gfc_expr *result, gfc_expr *e)
gfc_expr *
gfc_simplify_iany (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
- if (is_size_zero_array (array))
+ if (gfc_is_size_zero_array (array))
return gfc_get_int_expr (array->ts.kind, NULL, 0);
return simplify_transformation (array, dim, mask, 0, do_bit_ior);
@@ -3728,7 +3730,7 @@ do_bit_xor (gfc_expr *result, gfc_expr *e)
gfc_expr *
gfc_simplify_iparity (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
- if (is_size_zero_array (array))
+ if (gfc_is_size_zero_array (array))
return gfc_get_int_expr (array->ts.kind, NULL, 0);
return simplify_transformation (array, dim, mask, 0, do_bit_xor);
@@ -5038,7 +5040,7 @@ gfc_min (gfc_expr *op1, gfc_expr *op2)
gfc_expr *
gfc_simplify_minval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
{
- if (is_size_zero_array (array))
+ if (gfc_is_size_zero_array (array))
{
gfc_expr *result;
int i;
@@ -5094,7 +5096,7 @@ gfc_max (gfc_expr *op1, gfc_expr *op2)
gfc_expr *
gfc_simplify_maxval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
{
- if (is_size_zero_array (array))
+ if (gfc_is_size_zero_array (array))
{
gfc_expr *result;
int i;
@@ -5776,7 +5778,7 @@ gfc_simplify_norm2 (gfc_expr *e, gfc_expr *dim)
{
gfc_expr *result;
- if (is_size_zero_array (e))
+ if (gfc_is_size_zero_array (e))
{
gfc_expr *result;
result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
@@ -6040,7 +6042,7 @@ gfc_simplify_precision (gfc_expr *e)
gfc_expr *
gfc_simplify_product (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
- if (is_size_zero_array (array))
+ if (gfc_is_size_zero_array (array))
{
gfc_expr *result;
@@ -7384,7 +7386,7 @@ gfc_simplify_sqrt (gfc_expr *e)
gfc_expr *
gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
{
- if (is_size_zero_array (array))
+ if (gfc_is_size_zero_array (array))
{
gfc_expr *result;
[-- Attachment #3: minmaxloc_zerosize_1.f90 --]
[-- Type: text/x-fortran, Size: 872 bytes --]
! { dg-do run }
! { dg-additional-options "-fdump-tree-original" }
program main
implicit none
integer, parameter :: z(0) = 0
integer, parameter, dimension(1) :: a = minloc(z)
integer, parameter, dimension(1) :: b = minloc(z,mask=z>0)
integer, parameter :: c = minloc(z,dim=1)
integer, parameter, dimension(1) :: d = maxloc(z)
integer, parameter, dimension(1) :: e = maxloc(z,mask=z>0)
integer, parameter :: f = maxloc(z,dim=1)
character(len=12) line
if (a(1) /= 0) stop 1
if (b(1) /= 0) stop 2
if (c /= 0) stop 3
if (d(1) /= 0) stop 4
if (e(1) /= 0) stop 5
if (f /= 0) stop 6
write (unit=line,fmt='(6I2)') minloc(z), minloc(z,mask=z>0), minloc(z,dim=1), &
maxloc(z), maxloc(z,mask=z<0), maxloc(z,dim=1)
if (line /= ' 0 0 0 0 0 0') stop 7
end program main
! { dg-final { scan-tree-dump-times "_gfortran_stop" 1 "original" } }
next reply other threads:[~2018-03-06 21:40 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-03-06 21:40 Thomas Koenig [this message]
2018-03-06 22:00 ` Steve Kargl
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=b5995f78-a509-0db3-17cb-df5b6d21849e@netcologne.de \
--to=tkoenig@netcologne.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).