OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Steven G. Kargl 2018-03-03 19:49:20 +00:00
parent 250540af39
commit 94e6b5e5a6
3 changed files with 196 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -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

180
gcc/fortran/simplify.c
View File

@ -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);
}

5
gcc/testsuite/ChangeLog
View File

@ -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