re PR fortran/66128 (ICE for some intrinsics with zero sized array parameter)

2018-03-03  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/66128
	* simplify.c (is_size_zero_array): New function to check for size
	zero array.
	(gfc_simplify_all, gfc_simplify_any, gfc_simplify_count,
	 gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity,
	 gfc_simplify_minval, gfc_simplify_maxval, gfc_simplify_norm2,
	 gfc_simplify_product, gfc_simplify_sum): Use it, and implement
	requirements from F2018.

2018-03-03  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/66128
	* gfortran.dg/zero_sized_8.f90: New test.

From-SVN: r258223

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c04a552344c3918605526fb8eec8005fcc7d5bd5..eb64c7452f173c84c7715a0e2dee5c68d26c51ec 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2018-03-03  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/66128
+       * simplify.c (is_size_zero_array): New function to check for size
+       zero array.
+       (gfc_simplify_all, gfc_simplify_any, gfc_simplify_count, 
+        gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity,
+        gfc_simplify_minval, gfc_simplify_maxval, gfc_simplify_norm2,
+        gfc_simplify_product, gfc_simplify_sum): Use it, and implement
+       requirements from F2018.
+
 2018-03-03  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/51434

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index b130abacc521fc4266b4c3f9812ef57d90989f4b..3bd98688e8839b074a74c9224057d0d5207243d6 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -258,6 +258,29 @@ is_constant_array_expr (gfc_expr *e)
   return true;
 }
 
+/* Test for a size zero array.  */
+static bool
+is_size_zero_array (gfc_expr *array)
+{
+  gfc_expr *e;
+  bool t;
+
+  e = gfc_copy_expr (array);
+  gfc_simplify_expr (e, 1);
+
+  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;
+
+  gfc_free_expr (e);
+
+  return t;
+}
+
 
 /* Initialize a transformational result expression with a given value.  */
 
@@ -951,6 +974,9 @@ 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))
+    return gfc_get_logical_expr (mask->ts.kind, &mask->where, true);
+
   return simplify_transformation (mask, dim, NULL, true, gfc_and);
 }
 
@@ -1040,6 +1066,9 @@ 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))
+    return gfc_get_logical_expr (mask->ts.kind, &mask->where, false);
+
   return simplify_transformation (mask, dim, NULL, false, gfc_or);
 }
 
@@ -1936,6 +1965,13 @@ gfc_simplify_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
 {
   gfc_expr *result;
 
+  if (is_size_zero_array (mask))
+    {
+      int k;
+      k = kind ? mpz_get_si (kind->value.integer) : gfc_default_integer_kind;
+      return gfc_get_int_expr (k, NULL, 0);
+    }
+
   if (!is_constant_array_expr (mask)
       || !gfc_is_constant_expr (dim)
       || !gfc_is_constant_expr (kind))
@@ -3227,6 +3263,9 @@ 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))
+    return gfc_get_int_expr (array->ts.kind, NULL, -1);
+
   return simplify_transformation (array, dim, mask, -1, do_bit_and);
 }
 
@@ -3246,6 +3285,9 @@ 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))
+    return gfc_get_int_expr (array->ts.kind, NULL, 0);
+
   return simplify_transformation (array, dim, mask, 0, do_bit_ior);
 }
 
@@ -3686,6 +3728,9 @@ 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))
+    return gfc_get_int_expr (array->ts.kind, NULL, 0);
+
   return simplify_transformation (array, dim, mask, 0, do_bit_xor);
 }
 
@@ -4993,6 +5038,43 @@ 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))
+    {
+      gfc_expr *result;
+      int i;
+
+      i = gfc_validate_kind (array->ts.type, array->ts.kind, false);
+      result = gfc_get_constant_expr (array->ts.type, array->ts.kind,
+                                     &array->where);
+      switch (array->ts.type)
+       {
+         case BT_INTEGER:
+           mpz_set (result->value.integer, gfc_integer_kinds[i].huge);
+           break;
+
+         case BT_REAL:
+           mpfr_set (result->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE);
+           break;
+
+         case BT_CHARACTER:
+           /* If ARRAY has size zero and type character, the result has the
+              value of a string of characters of length LEN (ARRAY), with
+              each character equal to CHAR(n - 1, KIND (ARRAY)), where n is
+              the number of characters in the collating sequence for
+              characters with the kind type parameter of ARRAY.  */
+           gfc_error ("MINVAL(string) at %L is not implemented, yet!",
+                       &array->where);
+           gfc_free_expr (result);
+           return &gfc_bad_expr;
+           break;
+
+         default:
+           gcc_unreachable ();
+       }
+
+      return result;
+    }
+
   return simplify_transformation (array, dim, mask, INT_MAX, gfc_min);
 }
 
@@ -5012,6 +5094,42 @@ 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))
+    {
+      gfc_expr *result;
+      int i;
+
+      i = gfc_validate_kind (array->ts.type, array->ts.kind, false);
+      result = gfc_get_constant_expr (array->ts.type, array->ts.kind,
+                                     &array->where);
+      switch (array->ts.type)
+       {
+         case BT_INTEGER:
+           mpz_set (result->value.integer, gfc_integer_kinds[i].min_int);
+           break;
+
+         case BT_REAL:
+           mpfr_set (result->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE);
+           mpfr_neg (result->value.real, result->value.real,  GFC_RND_MODE);
+           break;
+
+         case BT_CHARACTER:
+           /* If ARRAY has size zero and type character, the result has the
+               value of a string of characters of length LEN (ARRAY), with
+               each character equal to CHAR (0, KIND (ARRAY)).  */
+           gfc_error ("MAXVAL(string) at %L is not implemented, yet!",
+                       &array->where);
+           gfc_free_expr (result);
+           return &gfc_bad_expr;
+           break;
+
+         default:
+           gcc_unreachable ();
+       }
+
+      return result;
+    }
+
   return simplify_transformation (array, dim, mask, INT_MIN, gfc_max);
 }
 
@@ -5658,6 +5776,14 @@ gfc_simplify_norm2 (gfc_expr *e, gfc_expr *dim)
 {
   gfc_expr *result;
 
+  if (is_size_zero_array (e))
+    {
+      gfc_expr *result;
+      result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      return result;
+    }
+
   if (!is_constant_array_expr (e)
       || (dim != NULL && !gfc_is_constant_expr (dim)))
     return NULL;
@@ -5914,6 +6040,33 @@ 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))
+    {
+      gfc_expr *result;
+
+      result = gfc_get_constant_expr (array->ts.type, array->ts.kind,
+                                     &array->where);
+      switch (array->ts.type)
+       {
+         case BT_INTEGER:
+           mpz_set_ui (result->value.integer, 1);
+           break;
+
+         case BT_REAL:
+           mpfr_set_ui (result->value.real, 1, GFC_RND_MODE);
+           break;
+
+         case BT_COMPLEX:
+           mpc_set_ui (result->value.complex, 1, GFC_MPC_RND_MODE);
+           break;
+
+         default:
+           gcc_unreachable ();
+       }
+
+      return result;
+    }
+
   return simplify_transformation (array, dim, mask, 1, gfc_multiply);
 }
 
@@ -7231,6 +7384,33 @@ 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))
+    {
+      gfc_expr *result;
+
+      result = gfc_get_constant_expr (array->ts.type, array->ts.kind,
+                                     &array->where);
+      switch (array->ts.type)
+       {
+         case BT_INTEGER:
+           mpz_set_ui (result->value.integer, 0);
+           break;
+
+         case BT_REAL:
+           mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+           break;
+
+         case BT_COMPLEX:
+           mpc_set_ui (result->value.complex, 0, GFC_MPC_RND_MODE);
+           break;
+
+         default:
+           gcc_unreachable ();
+       }
+
+      return result;
+    }
+
   return simplify_transformation (array, dim, mask, 0, gfc_add);
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2460b06280cb7b733840b7d2444e75f5482f094c..1df6a18f4e082725d5f9b338c9de9cdbb7f5077d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-03-03  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/66128
+       * gfortran.dg/zero_sized_8.f90: New test.
+
 2018-03-03  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/51434