From fbeb1a965d85492e2f6f3adf913b90d005151b00 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Tue, 24 Sep 2024 22:53:59 +0200 Subject: Implement IANY, IALL and IPARITY for unsigned. gcc/fortran/ChangeLog: * check.cc (gfc_check_transf_bit_intrins): Handle unsigned. * gfortran.texi: Docment IANY, IALL and IPARITY for unsigned. * iresolve.cc (gfc_resolve_iall): Set flag to use integer if type is BT_UNSIGNED. (gfc_resolve_iany): Likewise. (gfc_resolve_iparity): Likewise. * simplify.cc (do_bit_and): Adjust asserts for BT_UNSIGNED. (do_bit_ior): Likewise. (do_bit_xor): Likewise gcc/testsuite/ChangeLog: * gfortran.dg/unsigned_29.f90: New test. --- gcc/fortran/check.cc | 14 ++++++++++++- gcc/fortran/gfortran.texi | 1 + gcc/fortran/iresolve.cc | 6 +++--- gcc/fortran/simplify.cc | 51 ++++++++++++++++++++++++++++++++++++++--------- 4 files changed, 59 insertions(+), 13 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 7c630dd..533c9d7 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -4430,7 +4430,19 @@ gfc_check_mask (gfc_expr *i, gfc_expr *kind) bool gfc_check_transf_bit_intrins (gfc_actual_arglist *ap) { - if (ap->expr->ts.type != BT_INTEGER) + bt type = ap->expr->ts.type; + + if (flag_unsigned) + { + if (type != BT_INTEGER && type != BT_UNSIGNED) + { + gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER " + "or UNSIGNED", gfc_current_intrinsic_arg[0]->name, + gfc_current_intrinsic, &ap->expr->where); + return false; + } + } + else if (ap->expr->ts.type != BT_INTEGER) { gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER", gfc_current_intrinsic_arg[0]->name, diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index e5ffe67..3eb8039 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -2789,6 +2789,7 @@ As of now, the following intrinsics take unsigned arguments: @item @code{RANGE} @item @code{TRANSFER} @item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT} +@item @code{IANY}, @code{IALL} and @code{IPARITY} @end itemize This list will grow in the near future. @c --------------------------------------------------------------------- diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc index b4c9a63..b281ab7 100644 --- a/gcc/fortran/iresolve.cc +++ b/gcc/fortran/iresolve.cc @@ -1195,7 +1195,7 @@ gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED) void gfc_resolve_iall (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - resolve_transformational ("iall", f, array, dim, mask); + resolve_transformational ("iall", f, array, dim, mask, true); } @@ -1223,7 +1223,7 @@ gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j) void gfc_resolve_iany (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - resolve_transformational ("iany", f, array, dim, mask); + resolve_transformational ("iany", f, array, dim, mask, true); } @@ -1429,7 +1429,7 @@ gfc_resolve_long (gfc_expr *f, gfc_expr *a) void gfc_resolve_iparity (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - resolve_transformational ("iparity", f, array, dim, mask); + resolve_transformational ("iparity", f, array, dim, mask, true); } diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index e5681c4..bd2f648 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -3401,9 +3401,20 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) static gfc_expr * do_bit_and (gfc_expr *result, gfc_expr *e) { - gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT); - gcc_assert (result->ts.type == BT_INTEGER - && result->expr_type == EXPR_CONSTANT); + if (flag_unsigned) + { + gcc_assert ((e->ts.type == BT_INTEGER || e->ts.type == BT_UNSIGNED) + && e->expr_type == EXPR_CONSTANT); + gcc_assert ((result->ts.type == BT_INTEGER + || result->ts.type == BT_UNSIGNED) + && result->expr_type == EXPR_CONSTANT); + } + else + { + gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT); + gcc_assert (result->ts.type == BT_INTEGER + && result->expr_type == EXPR_CONSTANT); + } mpz_and (result->value.integer, result->value.integer, e->value.integer); return result; @@ -3420,9 +3431,20 @@ gfc_simplify_iall (gfc_expr *array, gfc_expr *dim, gfc_expr *mask) static gfc_expr * do_bit_ior (gfc_expr *result, gfc_expr *e) { - gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT); - gcc_assert (result->ts.type == BT_INTEGER - && result->expr_type == EXPR_CONSTANT); + if (flag_unsigned) + { + gcc_assert ((e->ts.type == BT_INTEGER || e->ts.type == BT_UNSIGNED) + && e->expr_type == EXPR_CONSTANT); + gcc_assert ((result->ts.type == BT_INTEGER + || result->ts.type == BT_UNSIGNED) + && result->expr_type == EXPR_CONSTANT); + } + else + { + gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT); + gcc_assert (result->ts.type == BT_INTEGER + && result->expr_type == EXPR_CONSTANT); + } mpz_ior (result->value.integer, result->value.integer, e->value.integer); return result; @@ -3884,9 +3906,20 @@ gfc_simplify_ior (gfc_expr *x, gfc_expr *y) static gfc_expr * do_bit_xor (gfc_expr *result, gfc_expr *e) { - gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT); - gcc_assert (result->ts.type == BT_INTEGER - && result->expr_type == EXPR_CONSTANT); + if (flag_unsigned) + { + gcc_assert ((e->ts.type == BT_INTEGER || e->ts.type == BT_UNSIGNED) + && e->expr_type == EXPR_CONSTANT); + gcc_assert ((result->ts.type == BT_INTEGER + || result->ts.type == BT_UNSIGNED) + && result->expr_type == EXPR_CONSTANT); + } + else + { + gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT); + gcc_assert (result->ts.type == BT_INTEGER + && result->expr_type == EXPR_CONSTANT); + } mpz_xor (result->value.integer, result->value.integer, e->value.integer); return result; -- cgit v1.1