From patchwork Thu Sep 12 19:39:46 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1984843 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=CER8qqdN; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; 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 [8.43.85.97]) (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 4X4STM0Zy4z1y1l for ; Fri, 13 Sep 2024 05:40:22 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C88163858C35 for ; Thu, 12 Sep 2024 19:40:20 +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 15F113858D26; Thu, 12 Sep 2024 19:39:51 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 15F113858D26 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 15F113858D26 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=1726169993; cv=none; b=GXeQ5uOaZx12reeKyzRzLodwNw/LT1rdGoQz/RasDUpE7rHCayO6ZGdZbXn5NnEHysKxqVJyIRSWzmTdhTr4Fr2HQAJEsbWh1vEuZy5QHGpnbxUCQaV8HhnjGnYr7Upe520vMdHOffsCvDscJ2BW4Z6xLgPBwW6EeeHQQqJMBe4= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1726169993; c=relaxed/simple; bh=PgOE5cOELkFFcab3vSBuo7X6LdHBfvJrPjZwo3URxfw=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=r/lGaG5iPOJRAy4sL5Hv6tjHeK9ipLGYmcFCCt+b1ZXYRp4r17RqyDmNIpbFsV7MIyHcW+SsFoiOfaEvT7Rm/JHSy0HWSdwpq622jUlqx1C3zpYWnV/maO6353W0KC6cOLEgmW6ysltzp5aWY4XQ8T5BQWJfKm6T1aQhMCl3uN8= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id B09C61310F; Thu, 12 Sep 2024 21:39:48 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1726169988; bh=PgOE5cOELkFFcab3vSBuo7X6LdHBfvJrPjZwo3URxfw=; h=Message-ID:Date:To:From:Subject:From; b=CER8qqdN+Gn1G5I2NQcyXqBA3a/Wy81yInCLGemFsZOe08Cde6DYN7zydca1tJx/G zDuspCLB1NQJAYq4bM0MLR/WRBxnFP9KrEmw3nrFD5u+sdureLne2ZTSkojVH7vwHn FYsxVKpOj8YZh7IGXpeQzn1tSpiHc1UKuxAfQ2U+tj4HjVgWG/my4K+YfMhKYhAK+9 fMiHmKTCl6h79EcCCDfUMAaDmdbCIoNFYiC6wKf34OlJH1LTDjzeADTiboK0vkCotM Zo9H17bvN3dLtKVs5izBldwmn/p3TBREHUt0ksj/iIH5eC+iPGGGKDY5ATEUELELdH jNdOhXmzEgptw== Received: from [IPV6:2a0a:a540:373e:0:5cbb:fc7e:e2a8:555b] (2a0a-a540-373e-0-5cbb-fc7e-e2a8-555b.ipv6dyn.netcologne.de [IPv6:2a0a:a540:373e:0:5cbb:fc7e:e2a8:555b]) (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-smtpin1.netcologne.de (Postfix) with ESMTPSA id 7A03911D91; Thu, 12 Sep 2024 21:39:46 +0200 (CEST) Message-ID: <808d6397-e7d5-40ab-bb0d-eb1bb156a933@netcologne.de> Date: Thu, 12 Sep 2024 21:39:46 +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, committed] module support for UNSIGNED X-NetCologne-Spam: L X-Rspamd-Action: no action X-Rspamd-Queue-Id: 7A03911D91 X-Spamd-Bar: - X-Spam-Status: No, score=-11.2 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 Hello world, I just pushed Steve's patch for module support to trunk as obvious, as https://gcc.gnu.org/g:2847a541c1f19b67ae84be8d0f6dc8e1f9371d16 . Best regards Thomas gcc/fortran/ChangeLog: * module.cc (bt_types): Add BT_UNSIGNED. gcc/testsuite/ChangeLog: * gfortran.dg/unsigned_kiss.f90: New test. +end program testkiss diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index c565b84d61b..8cf58ff5142 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -2781,6 +2781,7 @@ static const mstring bt_types[] = { minit ("UNKNOWN", BT_UNKNOWN), minit ("VOID", BT_VOID), minit ("ASSUMED", BT_ASSUMED), + minit ("UNSIGNED", BT_UNSIGNED), minit (NULL, -1) }; diff --git a/gcc/testsuite/gfortran.dg/unsigned_kiss.f90 b/gcc/testsuite/gfortran.dg/unsigned_kiss.f90 new file mode 100644 index 00000000000..46ee86ccd26 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unsigned_kiss.f90 @@ -0,0 +1,100 @@ +! +! { dg-do run } +! { dg-options "-funsigned" } +! +! Modern Fortran rewrite of Marsaglia's 64-bit KISS PRNG. +! https://www.thecodingforums.com/threads/64-bit-kiss-rngs.673657/ +! +module kissm + + implicit none + private + public uk, kseed, kiss + + integer, parameter :: uk = kind(1u_8) ! Check kind() works. + + ! Default seeds. Checks unsigned with parameter attribute. + unsigned(uk), parameter :: seed(4) = [ & + & 1234567890987654321u_uk, 362436362436362436u_uk, & + & 1066149217761810u_uk, 123456123456123456u_uk ] + + ! Seeds used during generation + unsigned(uk), save :: sd(4) = seed + + contains + + ! Tests unsigned in an internal function. + function s(x) + unsigned(uk) s + unsigned(uk), intent(in) :: x + s = ishft(x, -63) ! Tests ishft + end function + + ! Poor seeding routine. Need to check v for entropy! + ! Tests intent(in) and optional attributes. + ! Tests ishftc() and array constructors. + subroutine kseed(v) + unsigned(uk), intent(in), optional :: v + if (present(v)) then + sd = seed + [ishftc(v,1), ishftc(v,15), ishftc(v,31), ishftc(v,44)] + else + sd = seed + end if + end subroutine kseed + + function kiss() + unsigned(uk) kiss + unsigned(uk) m, t + integer k + + ! Test unsigned in a statement function + m(t, k) = ieor(t, ishft(t, k)) + + t = ishft(sd(1), 58) + sd(4) + if (s(sd(1)) == s(t)) then + sd(4) = ishft(sd(1), -6) + s(sd(1)) + else + sd(4) = ishft(sd(1), -6) + 1u_uk - s(sd(1) + t) + endif + + sd(1) = t + sd(1) + sd(2) = m(m(m(sd(2), 13), -17), 43) + sd(3) = 6906969069u_uk * sd(3) + 1234567u_uk + kiss = sd(1) + sd(2) + sd(3) + end function kiss + +end module kissm + +program testkiss + use kissm + integer, parameter :: n = 4 + unsigned(uk) prn(4) + + ! Default sequence + unsigned(uk), parameter :: a(4) = [8932985056925012148u_uk, & + & 5710300428094272059u_uk, 18342510866933518593u_uk, & + & 14303636270573868250u_uk] + + ! Sequence with the seed 123412341234u_uk + unsigned(uk), parameter :: b(4) = [4002508872477953753u_uk, & + & 18025327658415290923u_uk, 16058856976144281263u_uk, & + & 11842224026193909403u_uk] + + do i = 1, n + prn(i) = kiss() + end do + if (any(prn /= a)) stop 1 + + call kseed(123412341234u_uk) + do i = 1, n + prn(i) = kiss() + end do + if (any(prn /= b)) stop 2 + + call kseed() + do i = 1, n + prn(i) = kiss() + end do + if (any(prn /= a)) stop 3 +