From patchwork Mon Dec 18 18:11:59 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 180627 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7300:24d3:b0:fb:cd0c:d3e with SMTP id r19csp1472855dyi; Mon, 18 Dec 2023 11:15:41 -0800 (PST) X-Google-Smtp-Source: AGHT+IHmixxp8GS5yys3ljLYhbFx6k7qCl49Dr4R7Rw0rfU9qBRwZURVy8x0ZQ7zTSZWAKiEckkf X-Received: by 2002:a05:6102:3d1f:b0:466:6074:11a with SMTP id i31-20020a0561023d1f00b004666074011amr2600154vsv.30.1702926941118; Mon, 18 Dec 2023 11:15:41 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1702926941; cv=pass; d=google.com; s=arc-20160816; b=yNh25isHDwBfIbmHZmwIHBazY0QVExK0baWOjRyga3Vq7d65L3nzSpyw28E1GAwhsI zH92z9kBnK2qU0LoPnft2Eo+qi/cxfrAHW77iMRsySVPMq7e2awtnzvsBgySmWWpmOco 8sW6H7z02TF3Exi/BPsgyX2zRg4ZbwdWrYoUa6w/PlArQuiCmi4y4cnbQH9Vs90zQlht KCVYo3ko4vJiVI12KqfROdboZGATFsuKKdIsyrXBoqZun0LLn03etI+aM5D2i7VlTzlt zYrcxowRp1G6d4lHFPLrGUv06evIrMahC5h1PjrbbAcr1C5NClonRj+aIlz6Huj/TBK+ WC4A== ARC-Message-Signature: i=2; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:ui-outboundreport:sensitivity :importance:date:subject:to:from:message-id:mime-version :dkim-signature:arc-filter:dmarc-filter:delivered-to; bh=dsravwaGsa7gLHsK7awPR319Frkqb7c6IUece2hNKVA=; fh=+IEfvAe+9BRgPHWhQEl2uIBTtAiiGDh1ExRZeB5JJoc=; b=vvOougzdV1C8ICrG8UJWuCOskVA1VTFXJHXC6coEjetyADwvaQFANMLRRPTd3HhaXm sd4YKB/+veNmf9bYAWImq7o8BNWSD4K1wi89l0Eh0OZKD2ow8dudTBJuZZAMq+91kk+k tGcsYEPWefGxxiBc8Yi28NXpIK0T3PD2U3+Ik5Cnq1a7GB0DoqMJbWVkr0+72eO107Gp PRYBwaMTC/SzycBg5Fm7Keako3OeG02v2Xpl77FsNkmp1DwzF509BQNeg+8N1qs/JVHh +vBK9QRlupCF7C7B9MZCXBAeHZQz4PJ3/8jaSN4z3KKpixquoqMrCV/A1rVGEW2IBRCV 6Omw== ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@gmx.de header.s=s31663417 header.b=Orymh5FW; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=QUARANTINE sp=QUARANTINE dis=NONE) header.from=gmx.de Received: from server2.sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id e5-20020a67eb85000000b00466280d362dsi617162vso.291.2023.12.18.11.15.40 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 18 Dec 2023 11:15:41 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gmx.de header.s=s31663417 header.b=Orymh5FW; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=QUARANTINE sp=QUARANTINE dis=NONE) header.from=gmx.de Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D1F5A3858037 for ; Mon, 18 Dec 2023 18:12:26 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id D217F3858C35; Mon, 18 Dec 2023 18:12:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D217F3858C35 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org D217F3858C35 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.19 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1702923124; cv=none; b=YPYYxxi0xeKYOi0Bd4NcCwQFtDr1XcaEOzC9AhgiPXPAKXEfN8kgDBpuAd65vPKdrEAiAFqhuuOsuxst3vq+xu5YOuur7+lXK7qcmEc4UVxT+Hqof1Dpna50VG+91ytPgMGZwEqG1L4L41oLVUX79eNPV8TyFb86cBGsceq5FtI= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1702923124; c=relaxed/simple; bh=Es7CqXo/UtF4kopcE3PkoF5Oo+P6axXCuQ9E0vGsouw=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=UU3K6pLVTLErKRHvSOtbbZkATulKmvyoWiAh+0S/IANcImSVlHsT1HPopZYm/NHIJ9fWCLTekQNpWSxFQi4vPKfPxDpN+3VtQTRrQzHOdJ28FmiDf0KNPJALm2hozduXcdA9xN5c7OwzhYTT1eW7iUXsRqOW11oR4fXX3OV/zsE= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1702923119; x=1703527919; i=anlauf@gmx.de; bh=Es7CqXo/UtF4kopcE3PkoF5Oo+P6axXCuQ9E0vGsouw=; h=X-UI-Sender-Class:From:To:Subject:Date; b=Orymh5FW7k3Fzz2i6t+791NlwD90ineCvjRdCH9ag6iUCxu63YQST0TP6haYiNkM rBivN2CA4wQ6QIy9BB+SpVW7UxVry8/sOmarmZeR6V8OHmZKxvbab11HrO1a9ctZI 51285zvZ1v+/YpQCc2LOqEMXOMw71NEHWpo8bl6jHawwMFw0eXl70HzoyRNYGbcSH m63K5VVc9NVkv2NVBFTJOhM/CtzceqNxpXKPhssNc+rnvyQHTxB8L0MAXn/8Kqetp u067X01rB+FzZaHhs1A55WoT4kA3iJawa+jilLRMaMLHMV7UkbwhgerOUoPBHLIy2 LxghcDtzwFgCmFOj7w== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.148.3] ([79.232.148.3]) by web-mail.gmx.net (3c-app-gmx-bs40.server.lan [172.19.170.92]) (via HTTP); Mon, 18 Dec 2023 19:11:59 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: update DATE_AND_TIME intrinsic for Fortran 2018 [PR96580] Date: Mon, 18 Dec 2023 19:11:59 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:mgRqXof3GaC0NyHA4g3UDHFMBO3gzcWLBd/ImhjRfUC9VRcOqJOkj4asiXE0VRxTCJpXr gZlcgafre3+VTBHuGNEAh2lfFytX6JtwfKJ+IIcMTET+sK3edasxS2QEHYaOYYI+9UgECYV0d6vG YBrTf1ZbA6YWgCFg7V4mCs06ljHzyc1z3LLbwoNaxQ6lzDU3TOBQdhw7tWX6JUocqoGs+qqBINC0 rvwRK/wlv7kzei34dpuUXBGXQv1f2DVOBXWk6w+PVvSXp0CK2IE80CtwdG4+qVZiG2G6wLRAsADE AY= UI-OutboundReport: notjunk:1;M01:P0:Xx/A6mm01dg=;cPSKCxO+HftOna1JxrB3EFFe4Ru LSvLWgwE6gJgtZ+5x82HGH77tC1Ryo59LrrLuItotrbec2Vf+BoTNjhjd9BVGKVmYZGsNZK0w eUFVXdXMZ/EzR+jGowLTggKuBnrDgshBrKli2ciz3JGUGn2SL3iwz3De/3bzPe3wlLw1BO1Q1 0Yo9K89E2e3H0sRjhfsZjl66dRYFyofWnrGPXcAPOoapwdr4xU6WuWxclBw7LbsX4IUWtO3zD 2eMAwBVCDr0NiImuOCO21Tl1Ih+uu/NxPpuUN0Xt3PX7wyQWX9O1bbtbygnW3EWv2AIJAr9Qv DR8y/9jyLBqQ8ABLf81TaCQkCyra6CqvVdjb6JTxlazCnmUBbQi35JU+ex3QjZiuamUXPcCZX hEJg9p+XzHDR4KPTVe5j5e5dW6L4Lk8XFiD5E6jBqEpSB79YuLKAAvNouUmmcVo5TaK+6u3n4 O7OrA5H2/ylwJp7khQ5yxZIhaW3KggYtrRhLiTXuEQdaIAXb2ohYk1GI+7asy4osb4h8iYc6n 0uFL/+TIhQJgH1IlBQl4dpIi7K+mjWQtHiliHYcLMCEgSVqtyhewtFTKDBAPTiSWansWYDOR+ vzdq/jM6+5DyY8ZrMbRXXkb/vvdJGsEUAW4Xw1MTsVj4LJ4Y9uJw3yd7yaDt3jHz4S234pPDj 3q+Ebkh/r8/rePgCtm4fiKTRpqTDyBcG254dO+9eFYHNB3cqaQgGArbHWffA4renVv2BM2sQb tmLdwE4ZdA5aqt/S05P24ZjB2CIGJ3owu0E8L1Smetxewi2wxrzIsxEFNd6KQ3tFAtjwfOa4p vakNsClZFXRyVBq6+w5CQw5STiVqjj4X9K8ue7d6jd12k= X-Spam-Status: No, score=-10.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_BARRACUDACENTRAL, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE 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+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1785648320109550233 X-GMAIL-MSGID: 1785648320109550233 Dear all, starting with Fortran 2018, DATE_AND_TIME allowed a non-default integer VALUES argument. While gfortran accepts this silently, this failed at runtime because the library implementation beyond kind=4 and kind=8 was missing. Futhermore, the standard effectively requires that the integer kind is at least 2. The attached patch adds several checks, plus adds checking for the array size to be sufficient, extends the implementation to the remaining kinds, and corrects several issues in the related documentation. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 1850bb6cbae7229e2c26e66a0a621817339f85e9 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 18 Dec 2023 18:59:02 +0100 Subject: [PATCH] Fortran: update DATE_AND_TIME intrinsic for Fortran 2018 [PR96580] Fortran 2018 allows a non-default integer kind for its VALUES argument if it has a decimal exponent range of at least four. Update checks, library implementation and documentation. gcc/fortran/ChangeLog: PR fortran/96580 * check.cc (array_size_check): New helper function. (gfc_check_date_and_time): Use it for checking minimum size of VALUES argument. Update kind check to Fortran 2018. * intrinsic.texi: Fix documentation of DATE_AND_TIME. libgfortran/ChangeLog: PR fortran/96580 * intrinsics/date_and_time.c (date_and_time): Handle VALUES argument for kind=2 and kind=16 (if available). gcc/testsuite/ChangeLog: PR fortran/96580 * gfortran.dg/date_and_time_2.f90: New test. * gfortran.dg/date_and_time_3.f90: New test. * gfortran.dg/date_and_time_4.f90: New test. --- gcc/fortran/check.cc | 48 +++++++++++++++++++ gcc/fortran/intrinsic.texi | 39 +++++++-------- gcc/testsuite/gfortran.dg/date_and_time_2.f90 | 21 ++++++++ gcc/testsuite/gfortran.dg/date_and_time_3.f90 | 29 +++++++++++ gcc/testsuite/gfortran.dg/date_and_time_4.f90 | 30 ++++++++++++ libgfortran/intrinsics/date_and_time.c | 32 +++++++++++-- 6 files changed, 177 insertions(+), 22 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/date_and_time_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/date_and_time_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/date_and_time_4.f90 diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 3b1a0f9f4f4..b91a743be42 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -1251,6 +1251,33 @@ gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name) } } +/* Check size of an array argument against a required size. + Returns true if the requirement is satisfied or if the size cannot be + determined, otherwise return false and raise a gfc_error */ + +static bool +array_size_check (gfc_expr *a, int n, long size_min) +{ + bool ok = true; + mpz_t size; + + if (gfc_array_size (a, &size)) + { + HOST_WIDE_INT sz = gfc_mpz_get_hwi (size); + if (size_min >= 0 && sz < size_min) + { + gfc_error ("Size of %qs argument of %qs intrinsic at %L " + "too small (%wd/%ld)", + gfc_current_intrinsic_arg[n]->name, + gfc_current_intrinsic, &a->where, sz, size_min); + ok = false; + } + mpz_clear (size); + } + + return ok; +} + /***** Check functions *****/ @@ -6539,6 +6566,27 @@ gfc_check_date_and_time (gfc_expr *date, gfc_expr *time, return false; if (!variable_check (values, 3, false)) return false; + if (!array_size_check (values, 3, 8)) + return false; + + if (values->ts.kind != gfc_default_integer_kind + && !gfc_notify_std (GFC_STD_F2018, "VALUES argument of " + "DATE_AND_TIME at %L has non-default kind", + &values->where)) + return false; + + /* F2018:16.9.59 DATE_AND_TIME + "VALUES shall be a rank-one array of type integer + with a decimal exponent range of at least four." + This is a hard limit also required by the implementation in + libgfortran. */ + if (values->ts.kind < 2) + { + gfc_error ("VALUES argument of DATE_AND_TIME at %L must have " + "a decimal exponent range of at least four", + &values->where); + return false; + } } return true; diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index d4dd47fef0f..2c37cf4286a 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -4729,22 +4729,22 @@ end program test_ctime @item @emph{Description}: @code{DATE_AND_TIME(DATE, TIME, ZONE, VALUES)} gets the corresponding date and time information from the real-time system clock. @var{DATE} is -@code{INTENT(OUT)} and has form ccyymmdd. @var{TIME} is @code{INTENT(OUT)} and -has form hhmmss.sss. @var{ZONE} is @code{INTENT(OUT)} and has form (+-)hhmm, -representing the difference with respect to Coordinated Universal Time (UTC). -Unavailable time and date parameters return blanks. +@code{INTENT(OUT)} and of the form ccyymmdd. @var{TIME} is @code{INTENT(OUT)} +and of the form hhmmss.sss. @var{ZONE} is @code{INTENT(OUT)} and of the form +(+-)hhmm, representing the difference with respect to Coordinated Universal +Time (UTC). Unavailable time and date parameters return blanks. @var{VALUES} is @code{INTENT(OUT)} and provides the following: @multitable @columnfractions .15 .70 -@item @code{VALUE(1)}: @tab The year -@item @code{VALUE(2)}: @tab The month -@item @code{VALUE(3)}: @tab The day of the month -@item @code{VALUE(4)}: @tab Time difference with UTC in minutes -@item @code{VALUE(5)}: @tab The hour of the day -@item @code{VALUE(6)}: @tab The minutes of the hour -@item @code{VALUE(7)}: @tab The seconds of the minute -@item @code{VALUE(8)}: @tab The milliseconds of the second +@item @code{VALUES(1)}: @tab The year, including the century +@item @code{VALUES(2)}: @tab The month of the year +@item @code{VALUES(3)}: @tab The day of the month +@item @code{VALUES(4)}: @tab The time difference from UTC in minutes +@item @code{VALUES(5)}: @tab The hour of the day +@item @code{VALUES(6)}: @tab The minutes of the hour +@item @code{VALUES(7)}: @tab The seconds of the minute +@item @code{VALUES(8)}: @tab The milliseconds of the second @end multitable @item @emph{Standard}: @@ -4758,13 +4758,14 @@ Subroutine @item @emph{Arguments}: @multitable @columnfractions .15 .70 -@item @var{DATE} @tab (Optional) The type shall be @code{CHARACTER(LEN=8)} -or larger, and of default kind. -@item @var{TIME} @tab (Optional) The type shall be @code{CHARACTER(LEN=10)} -or larger, and of default kind. -@item @var{ZONE} @tab (Optional) The type shall be @code{CHARACTER(LEN=5)} -or larger, and of default kind. -@item @var{VALUES}@tab (Optional) The type shall be @code{INTEGER(8)}. +@item @var{DATE} @tab (Optional) Scalar of type default @code{CHARACTER}. +Recommended length is 8 or larger. +@item @var{TIME} @tab (Optional) Scalar of type default @code{CHARACTER}. +Recommended length is 10 or larger. +@item @var{ZONE} @tab (Optional) Scalar of type default @code{CHARACTER}. +Recommended length is 5 or larger. +@item @var{VALUES}@tab (Optional) Rank-1 array of type @code{INTEGER} with +a decimal exponent range of at least four and array size at least 8. @end multitable @item @emph{Return value}: diff --git a/gcc/testsuite/gfortran.dg/date_and_time_2.f90 b/gcc/testsuite/gfortran.dg/date_and_time_2.f90 new file mode 100644 index 00000000000..663611a3ec3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/date_and_time_2.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-additional-options "-std=f2018" } +! +! PR fortran/96580 - constraints on VALUES argument of DATE_AND_TIME intrinsic + +program test_time_and_date + implicit none + integer(1), dimension(8) :: values1 + integer(2), dimension(8) :: values2 + integer(4), dimension(8) :: values + integer(4), dimension(9) :: values4 + integer(8), dimension(8) :: values8 + integer , dimension(7) :: values7 + + call date_and_time(VALUES=values1) ! { dg-error "decimal exponent range" } + call date_and_time(VALUES=values2) + call date_and_time(VALUES=values) + call date_and_time(VALUES=values4) + call date_and_time(VALUES=values8) + call date_and_time(VALUES=values7) ! { dg-error "at .1. too small \\(7/8\\)" } +end program test_time_and_date diff --git a/gcc/testsuite/gfortran.dg/date_and_time_3.f90 b/gcc/testsuite/gfortran.dg/date_and_time_3.f90 new file mode 100644 index 00000000000..020266d87e9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/date_and_time_3.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! { dg-additional-options "-std=f2018" } +! +! PR fortran/96580 - integer kind of VALUES argument of DATE_AND_TIME intrinsic + +program test_time_and_date + implicit none + integer(2), dimension(8) :: values2 + integer(4), dimension(8) :: values4 + integer(8), dimension(8) :: values8 + + call date_and_time(VALUES=values2) + call date_and_time(VALUES=values4) + call date_and_time(VALUES=values8) + + ! Check consistency of year and of time difference from UTC + if (values2(1) /= -HUGE(0_2) .and. values4(1) /= -HUGE(0_4)) then + if (abs (values4(1) - values2(1)) > 1) stop 1 + end if + if (values2(4) /= -HUGE(0_2) .and. values4(4) /= -HUGE(0_4)) then + if (values2(4) /= values4(4)) stop 2 + end if + if (values4(1) /= -HUGE(0_4) .and. values8(1) /= -HUGE(0_8)) then + if (abs (values8(1) - values4(1)) > 1) stop 3 + end if + if (values4(4) /= -HUGE(0_4) .and. values8(4) /= -HUGE(0_8)) then + if (values4(4) /= values8(4)) stop 4 + end if +end program test_time_and_date diff --git a/gcc/testsuite/gfortran.dg/date_and_time_4.f90 b/gcc/testsuite/gfortran.dg/date_and_time_4.f90 new file mode 100644 index 00000000000..6039c85ecb2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/date_and_time_4.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! { dg-additional-options "-std=f2018" } +! { dg-require-effective-target fortran_integer_16 } +! +! PR fortran/96580 - integer kind of VALUES argument of DATE_AND_TIME intrinsic + +program test_time_and_date + implicit none + integer(4), dimension(8) :: values4 + integer(8), dimension(8) :: values8 + integer(16),dimension(8) :: values16 + + call date_and_time(VALUES=values4) + call date_and_time(VALUES=values8) + call date_and_time(VALUES=values16) + + ! Check consistency of year and of time difference from UTC + if (values16(1) /= -HUGE(0_16) .and. values4(1) /= -HUGE(0_4)) then + if (abs (values4(1) - values16(1)) > 1) stop 1 + end if + if (values16(4) /= -HUGE(0_16) .and. values4(4) /= -HUGE(0_4)) then + if (values16(4) /= values4(4)) stop 2 + end if + if (values4(1) /= -HUGE(0_4) .and. values8(1) /= -HUGE(0_8)) then + if (abs (values8(1) - values4(1)) > 1) stop 3 + end if + if (values4(4) /= -HUGE(0_4) .and. values8(4) /= -HUGE(0_8)) then + if (values4(4) /= values8(4)) stop 4 + end if +end program test_time_and_date diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c index 681a815b741..929bbdc41be 100644 --- a/libgfortran/intrinsics/date_and_time.c +++ b/libgfortran/intrinsics/date_and_time.c @@ -209,20 +209,20 @@ date_and_time (char *__date, char *__time, char *__zone, delta = 1; if (unlikely (len < VALUES_SIZE)) - runtime_error ("Incorrect extent in VALUE argument to" + runtime_error ("Incorrect extent in VALUES argument to" " DATE_AND_TIME intrinsic: is %ld, should" " be >=%ld", (long int) len, (long int) VALUES_SIZE); /* Cope with different type kinds. */ if (elt_size == 4) - { + { GFC_INTEGER_4 *vptr4 = __values->base_addr; for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta) *vptr4 = values[i]; } else if (elt_size == 8) - { + { GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->base_addr; for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta) @@ -233,6 +233,32 @@ date_and_time (char *__date, char *__time, char *__zone, *vptr8 = values[i]; } } + else if (elt_size == 2) + { + GFC_INTEGER_2 *vptr2 = (GFC_INTEGER_2 *)__values->base_addr; + + for (i = 0; i < VALUES_SIZE; i++, vptr2 += delta) + { + if (values[i] == - GFC_INTEGER_4_HUGE) + *vptr2 = - GFC_INTEGER_2_HUGE; + else + *vptr2 = (GFC_INTEGER_2) values[i]; + } + } +#if defined (HAVE_GFC_INTEGER_16) + else if (elt_size == 16) + { + GFC_INTEGER_16 *vptr16 = (GFC_INTEGER_16 *)__values->base_addr; + + for (i = 0; i < VALUES_SIZE; i++, vptr16 += delta) + { + if (values[i] == - GFC_INTEGER_4_HUGE) + *vptr16 = - GFC_INTEGER_16_HUGE; + else + *vptr16 = values[i]; + } + } +#endif else abort (); } -- 2.35.3