* Simplification and a zero sized array
@ 2018-03-03 2:02 Steve Kargl
2018-03-03 17:07 ` Paul Richard Thomas
0 siblings, 1 reply; 2+ messages in thread
From: Steve Kargl @ 2018-03-03 2:02 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1764 bytes --]
All,
I would like to commit the attach patch, which fixes
a number of ICE's when simplification runs into a
size zero array. gfortran does not have a nice
easy way to determine if an array is size zero. Thus,
the new function is_size_zero_array was written after
staring at several gdb sessions.
This patch does not fix all of the problems with
size zero arrays:
1) findloc isn't implemented, so obviously it's not fixed.
2) I skipped looking at minloc and maxloc. These will take
more effort.
3) I skipped looking at associated. There are special
conditions with size zero arrays mentioned, but I
haven't tried to cause an ICE, yet.
4) The pad dummy argument to the spread has special condition
when she is size zero. I haven't tried to cause an
ICE, yet.
5) minval and maxval can take a size zero array of strings.
The requirements will call for someone with widechar
gfortran hacking experience to fix. At the moment,
gfortran will issue an error and die. So, anyone game
in handling the widechar stuff?
6) I haven't looked at any of the old g77 compatibility
functions. These may (or may not!) have issues.
Regression tested on x86_64-*-freebsd. OK to commit?
2018-03-02 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-02 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/66128
* gfortran.dg/zero_sized_8.f90: New test.
--
Steve
[-- Attachment #2: zero_sized.diff --]
[-- Type: text/x-diff, Size: 9822 bytes --]
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 258116)
+++ gcc/fortran/simplify.c (working copy)
@@ -257,7 +257,30 @@ 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. */
static void
@@ -950,6 +973,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);
}
@@ -1039,6 +1065,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);
}
@@ -1935,6 +1964,13 @@ gfc_simplify_count (gfc_expr *mask, gfc_expr *dim, gfc
{
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))
@@ -3226,6 +3262,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);
}
@@ -3245,6 +3284,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);
}
@@ -3685,6 +3727,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);
}
@@ -4992,6 +5037,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);
}
@@ -5011,6 +5093,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);
}
@@ -5657,6 +5775,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;
@@ -5913,6 +6039,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);
}
@@ -7230,6 +7383,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);
}
Index: gcc/testsuite/gfortran.dg/zero_sized_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/zero_sized_8.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/zero_sized_8.f90 (working copy)
@@ -0,0 +1,50 @@
+! { dg-do run }
+program p
+ complex, parameter :: a(0) = 0
+ real, parameter :: x(0) = 0
+ integer, parameter :: z(0) = 0
+ if (any(z > 0) .neqv. .false.) stop 1
+ if (all(z > 0) .neqv. .true.) stop 2
+ if (count(z > 0) /= 0) stop 3
+ if (kind(count(z > 0, kind=1)) /= 1) stop 4
+ if (iall(z) /= not(int(0, kind(z)))) stop 5
+ if (iany(z) /= 0) stop 6
+ if (iparity(z) /= 0) stop 7
+ if (maxval(z) /= -huge(0) - 1) stop 8
+ if (maxval(x) /= -huge(x)) stop 9
+ if (minval(z) /= huge(0)) stop 10
+ if (minval(x) /= huge(x)) stop 11
+ if (norm2(x) /= 0) stop 12
+ if (real(product(a)) /= 1 .and. aimag(product(a)) /= 0) stop 13
+ if (product(x) /= 1) stop 14
+ if (product(z) /= 1) stop 15
+ if (real(sum(a)) /= 0 .and. aimag(sum(a)) /= 0) stop 13
+ if (sum(x) /= 0) stop 14
+ if (sum(z) /= 0) stop 15
+ call q
+end
+
+subroutine q
+ complex, parameter :: a(0) = 0
+ real, parameter :: x(3,4,0) = 0
+ integer, parameter :: z(3,4,0) = 0
+ if (any(z > 0) .neqv. .false.) stop 101
+ if (all(z > 0) .neqv. .true.) stop 102
+ if (count(z > 0) /= 0) stop 103
+ if (kind(count(z > 0, kind=1)) /= 1) stop 104
+ if (iall(z) /= not(int(0, kind(z)))) stop 105
+ if (iany(z) /= 0) stop 106
+ if (iparity(z) /= 0) stop 107
+ if (maxval(z) /= -huge(0) - 1) stop 108
+ if (maxval(x) /= -huge(x)) stop 109
+ if (minval(z) /= huge(0)) stop 110
+ if (minval(x) /= huge(x)) stop 111
+ if (norm2(x) /= 0) stop 112
+ if (real(product(a)) /= 1 .and. aimag(product(a)) /= 0) stop 113
+ if (product(x) /= 1) stop 114
+ if (product(z) /= 1) stop 115
+ if (real(sum(a)) /= 0 .and. aimag(sum(a)) /= 0) stop 13
+ if (sum(x) /= 0) stop 14
+ if (sum(z) /= 0) stop 15
+end
+! { dg-prune-output "symmetric range implied by Standard" }
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: Simplification and a zero sized array
2018-03-03 2:02 Simplification and a zero sized array Steve Kargl
@ 2018-03-03 17:07 ` Paul Richard Thomas
0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2018-03-03 17:07 UTC (permalink / raw)
To: Steve Kargl; +Cc: fortran, gcc-patches
Hi Steve,
This looks to be OK to commit.
Thanks
Paul
On 3 March 2018 at 02:01, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
> All,
>
> I would like to commit the attach patch, which fixes
> a number of ICE's when simplification runs into a
> size zero array. gfortran does not have a nice
> easy way to determine if an array is size zero. Thus,
> the new function is_size_zero_array was written after
> staring at several gdb sessions.
>
> This patch does not fix all of the problems with
> size zero arrays:
>
> 1) findloc isn't implemented, so obviously it's not fixed.
> 2) I skipped looking at minloc and maxloc. These will take
> more effort.
> 3) I skipped looking at associated. There are special
> conditions with size zero arrays mentioned, but I
> haven't tried to cause an ICE, yet.
> 4) The pad dummy argument to the spread has special condition
> when she is size zero. I haven't tried to cause an
> ICE, yet.
>
> 5) minval and maxval can take a size zero array of strings.
> The requirements will call for someone with widechar
> gfortran hacking experience to fix. At the moment,
> gfortran will issue an error and die. So, anyone game
> in handling the widechar stuff?
>
> 6) I haven't looked at any of the old g77 compatibility
> functions. These may (or may not!) have issues.
>
> Regression tested on x86_64-*-freebsd. OK to commit?
>
>
> 2018-03-02 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-02 Steven G. Kargl <kargl@gcc.gnu.org>
>
> PR fortran/66128
>
> * gfortran.dg/zero_sized_8.f90: New test.
>
>
>
> --
> Steve
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2018-03-03 17:07 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-03-03 2:02 Simplification and a zero sized array Steve Kargl
2018-03-03 17:07 ` Paul Richard Thomas
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).