From patchwork Wed Sep 18 20:20:44 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1986976 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=netcologne.de header.i=@netcologne.de header.a=rsa-sha256 header.s=nc1116a header.b=owvEC5QE; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4X896J0qwwz1y2j for ; Thu, 19 Sep 2024 06:21:43 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4DC86385C6CF for ; Wed, 18 Sep 2024 20:21:41 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout1.netcologne.de (cc-smtpout1.netcologne.de [IPv6:2001:4dd0:100:1062:25:2:0:1]) by sourceware.org (Postfix) with ESMTPS id 9D4AF385840A; Wed, 18 Sep 2024 20:20:48 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 9D4AF385840A Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=netcologne.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=netcologne.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 9D4AF385840A Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2001:4dd0:100:1062:25:2:0:1 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1726690869; cv=none; b=fIf6Rj5E3Mpu6GXS2Qd1usSKv95r7tnzXFc4GJ8isQWXnhcLnqgPFvkoh1nhZbSVIumST0Wv/eaPE0PKnROEVRANMcCniykoSzEnBVnwyvr5xx8DTJVTJOpDYOHSsLmPQw6AZQN+I0IF42YPe88ZaXxBQiZwHoxVGK0N+ZMRzig= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1726690869; c=relaxed/simple; bh=g5iirnA/oSZMB7tM3i1MALXNt6rlEuw/kCTUYWKqw4g=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=pzYLQ4mZ5iv+06vTsOTgYbmAMBQjj/JrLKx1ly4e68YBVyFJWlLfG+Fr/rzaglooGVFIngahrvF0E2IXhj1iltJhW+7zjOKOhTxBRWrrZVdLHEGt9OqcjEw358A9Gt2bPmtIGHH18akgTEy9BirZDwt7+WxRueITe0ua0hHJmFY= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 77F7512E75; Wed, 18 Sep 2024 22:20:46 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1726690846; bh=g5iirnA/oSZMB7tM3i1MALXNt6rlEuw/kCTUYWKqw4g=; h=Message-ID:Date:To:From:Subject:From; b=owvEC5QEU8i1hroHarF25/gR6m5JRMRjUAjUiQ5NHh90pc4BS+2pPWdJDUtZG0hZn grl9oT077B2xR9KMYBMrKAycWPBr8akrAkCDh+Gs5XVrBwzJ24J+ELbfuCERuYTP1T zSE6bNFCfeamLDrt9E9T/bheLF+7cngW61GkNpzgg62MhD/1fcg5RQaxmvd2XOS4X3 HG341Lkj7KNJ+tqXOStNk1x29GBy8qfa3lDzqFnxNurmaHXpEUJ79GIiuNH7uZBwh3 yrm07eENZnCpaI1lnEVOVhhw4Jwyj1+fcEUGPHMX+2QOkoteN07evju3swbGefc6PT ojVoKcocUspAw== Received: from [IPV6:2001:4dd7:e9b0:0:8fca:5aa0:12d1:3314] (2001-4dd7-e9b0-0-8fca-5aa0-12d1-3314.ipv6dyn.netcologne.de [IPv6:2001:4dd7:e9b0:0:8fca:5aa0:12d1:3314]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id 4C69F11DC0; Wed, 18 Sep 2024 22:20:44 +0200 (CEST) Message-ID: <0b226d7d-f4cb-42e4-a3a5-8c4d56a987c3@netcologne.de> Date: Wed, 18 Sep 2024 22:20:44 +0200 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Content-Language: en-US, de-DE To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Implement IANY, IALL and IPARITY for unsigned X-NetCologne-Spam: L X-Rspamd-Queue-Id: 4C69F11DC0 X-Spamd-Bar: ---- X-Rspamd-Action: no action X-Spam-Status: No, score=-10.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_LOW, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org OK for trunk? This is based on the previous submissions. Again, this does not generate a new library version; rather it re-uses the signed integer version already present in the library. OK for trunk? Previous submissions (without which this will not work): https://gcc.gnu.org/pipermail/fortran/2024-September/060975.html https://gcc.gnu.org/pipermail/fortran/2024-September/060987.html 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 +++++++++++++++++++---- gcc/testsuite/gfortran.dg/unsigned_29.f90 | 40 ++++++++++++++++++ 5 files changed, 99 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/unsigned_29.f90 + if (any(v_any_2 /= [4291624908u, 4210752250u])) error stop 16 + if (any(v_parity_1 /= [267390960u, 1717986918u])) error stop 17 + if (any(v_parity_2 /= [869020620u, 1515870810u])) error stop 18 + end subroutine test2 +end program memain diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 7c630dd73f4..533c9d7d343 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 e5ffe67eeee..3eb8039c09f 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 92a591cf6d7..58a1821ef10 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 e5681c42a48..bd2f6485c95 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; diff --git a/gcc/testsuite/gfortran.dg/unsigned_29.f90 b/gcc/testsuite/gfortran.dg/unsigned_29.f90 new file mode 100644 index 00000000000..fc648aa6f52 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unsigned_29.f90 @@ -0,0 +1,40 @@ +! { dg-do run } +! { dg-options "-funsigned" } +program memain + implicit none + call test1 + call test2 +contains + subroutine test1 + unsigned, dimension(2,2) :: v + integer(8), dimension(2,2) :: i + v = reshape([4278255360u, 4042322160u, 3435973836u, 2863311530u],[2,2]) + i = int(v,8) + if (iall(v) /= 2147516416u) error stop 1 + if (iany(v) /= 4294901758u) error stop 2 + if (iparity(v) /= 1771465110u) error stop 3 + if (any(iall(v,dim=1) /= [4026593280u, 2290649224u])) error stop 4 + if (any(iall(v,dim=2) /= [3422604288u, 2694881440u])) error stop 5 + if (any(iany(v,dim=1) /= [4293984240u, 4008636142u])) error stop 6 + if (any(iany(v,dim=2) /= [4291624908u, 4210752250u])) error stop 7 + if (any(iparity(v,dim=1) /= [267390960u, 1717986918u])) error stop 8 + if (any(iparity(v,dim=2) /= [869020620u, 1515870810u])) error stop 9 + end subroutine test1 + subroutine test2 + unsigned, dimension(2,2), parameter :: v & + = reshape([4278255360u, 4042322160u, 3435973836u, 2863311530u],[2,2]) + unsigned, parameter :: v_all = iall(v), v_any = iany(v), v_parity = iparity(v) + unsigned, parameter, dimension(2) :: v_all_1 = iall(v,dim=1), v_all_2 = iall(v,dim=2) + unsigned, parameter, dimension(2) :: v_any_1 = iany(v,dim=1), v_any_2 = iany(v,dim=2) + unsigned, parameter, dimension(2) :: v_parity_1 = iparity(v,dim=1), v_parity_2 = iparity(v,dim=2) + if (v_all /= 2147516416u) error stop 10 + if (v_any /= 4294901758u) error stop 11 + if (v_parity /= 1771465110u) error stop 12 + if (any(v_all_1 /= [4026593280u, 2290649224u])) error stop 13 + if (any(v_all_2 /= [3422604288u, 2694881440u])) error stop 14 + if (any(v_any_1 /= [4293984240u, 4008636142u])) error stop 15