diff mbox series

[fortran] Fix PR 84697

Message ID b5995f78-a509-0db3-17cb-df5b6d21849e@netcologne.de
State New
Headers show
Series [fortran] Fix PR 84697 | expand

Commit Message

Thomas Koenig March 6, 2018, 9:40 p.m. UTC 
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.

Comments

Steve Kargl March 6, 2018, 10 p.m. UTC | #1 
On Tue, Mar 06, 2018 at 10:40:14PM +0100, Thomas Koenig wrote:
> 
> 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

I don't think there is anything of value left unless you want to
investigate the old g77 compatibility functions.

> 
> Regression-tested. OK for trunk?
> 

OK.
diff mbox series

Patch

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;