From patchwork Thu Feb 29 20:56:16 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 208510 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7301:2097:b0:108:e6aa:91d0 with SMTP id gs23csp675258dyb; Thu, 29 Feb 2024 12:57:22 -0800 (PST) X-Forwarded-Encrypted: i=3; AJvYcCXHgZWhsV7mLLBRlzw0f178AezAeBc53LxbhnPi9fDWu54Yky7QmNNfzctQ3YTP2KCB7M637ZnH0tlU1j9+ujeBjBPIng== X-Google-Smtp-Source: AGHT+IH8qUeUjMnt6a3Cl7C4A70J24CA/nwVFmHHe7PysliTyeCRBvA6yNFP9ivdWFnzgLAuVEhJ X-Received: by 2002:a05:6358:729f:b0:17b:6ba0:261 with SMTP id w31-20020a056358729f00b0017b6ba00261mr4004508rwf.27.1709240241824; Thu, 29 Feb 2024 12:57:21 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1709240241; cv=pass; d=google.com; s=arc-20160816; b=Xc45ygxk1v71TUST31YqPIBntnVzf2MNh89mRWAq34GJH0KLr6MVIJRkPgsyrMTiZ4 2UF8hKnz6YsY8H2/+KPPFOBMrLlXrgFZ2uczpS/DIveK5jc0+ZLEkeTgeAQP7IT2faj/ yZFeHta3bD8vcHxz3RGs9axMWFH7KgryezwX7Lr3Uy4bsFW0XDwo+szCr3T8JRZD+NHA bB4sDvLjHF+cHOkr5sL0sekIK2xGh0+qB6HzwrbHm6sJfI78sKGjCAibL71MzGhLzH3U Q4Z58BQ8duUsu3ch7Y7faIO44mi/Aqs1P/MsvwDty8ZMJPS7B+zjxGvvUbj0rocOEyKh ePiQ== 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=PVxvj8tRcSFPzral+cj3qw+WaEPzJruBJ0H7yCsBrgI=; fh=+IEfvAe+9BRgPHWhQEl2uIBTtAiiGDh1ExRZeB5JJoc=; b=Nfpd21KjABVYSdx/eOunnRAICLJnHe4fjvNJP1NDfMOuEJteZ67VYqq939i1cv+TFJ MmV0htnnnAFsERVTWnmqyfs6kSAflXLrwf2FnsuCKGkKUg6HbzhpB7G4sieI1t62HvgZ 3chQyTFRpHsXNM7ABBD083JgzpeFVkDaSTRzqvN7lm5aVkx4BlMOU7SfHPbaqCZwn5Ms jgLiNP56jrxuC/tLchh8n1UHTC4FvB4kVN1TZksoYIhEM10s67syKLL6ZWpOBe3lA4LO VywB6r7N72vqSyvfmIXLg4DqYoLZ7sgzZcRMpKBj4NTxs9mSMAD3p8jLnsd1/zJfiX5T +0QQ==; dara=google.com ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@gmx.de header.s=s31663417 header.b=nmA6VNcQ; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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. [8.43.85.97]) by mx.google.com with ESMTPS id c13-20020ad45aed000000b0068f765ab5c7si2094570qvh.292.2024.02.29.12.57.21 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 29 Feb 2024 12:57:21 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gmx.de header.s=s31663417 header.b=nmA6VNcQ; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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 75BFA3858291 for ; Thu, 29 Feb 2024 20:57:21 +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.17.21]) by sourceware.org (Postfix) with ESMTPS id 31AAF3858C36; Thu, 29 Feb 2024 20:56:18 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 31AAF3858C36 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 31AAF3858C36 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.17.21 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1709240180; cv=none; b=BqgvjbZB13aCzlFRL5kcayBPcFQHp7RWQTflHlriIad5ZkeNT/r4B1FuhBf848+Xxk9uosXxJoEr/Le8ysp7/jl3fH74CYO4GyDFrOPCqf1ksJ0GQ0GjLED8pMeywJmvYxTQL2mhLcQdwxop/l7CVS4KbgpyPVZ7pMZrinvBAZo= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1709240180; c=relaxed/simple; bh=/UX3aSQFx2VckbLsPVSJtLnN/Fj91R7ZkgLA0CXJvDE=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=cKkbjQybVuR7He7gMkw/M493njbV/97JrX80t3RMbC7SOYMrtT3DR//5Q9+W7hlDkeWH7iKe0gs2F79plPKWNGQN8PY9RY1T9ozpZylUXYYdZC3YNnth50p+Whvj2VD32U6dYCFPuxszGS94yieQkVi7lNROeK6h+IQXAl/SAnI= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1709240176; x=1709844976; i=anlauf@gmx.de; bh=/UX3aSQFx2VckbLsPVSJtLnN/Fj91R7ZkgLA0CXJvDE=; h=X-UI-Sender-Class:From:To:Subject:Date; b=nmA6VNcQG4YNSUpHO5mzZ/cI7jGWUid+WELdnxbA1ArW18psOqpCjf8Wp1I1s0u3 CZnBTb5NOvXBOpEe1ASabJGST2iFFbYPjreZBM7DO2mDtvEuL5mJCrOOl5COs9Fj/ +QVGUUpjI9gY0kCmKlONuX/OBLNKVJWRPO5rR6fP8XpAKURNUTlGAZag9+ZBOaBKW M+KwkaH3BsDXp3OEFTSLiqkvDhrzKVTK2kwsKnxgmlJuYeNANq0g1sbPsWv8keuhh AbxF3lY0q2Mazqznx5uybVZIK+oCW3WJ3DIT8NbRTe0NUCG89ZFJZcI6yFN51/rU6 /6EhLswISRxt8O5wRQ== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.5.187] ([79.251.5.187]) by web-mail.gmx.net (3c-app-gmx-bap14.server.lan [172.19.172.84]) (via HTTP); Thu, 29 Feb 2024 21:56:16 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: improve checks of NULL without MOLD as actual argument [PR104819] Date: Thu, 29 Feb 2024 21:56:16 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:ZI568uwdUFvliPQgyhfJohbDtrcV0yMkLiPtqTiXEv3etRConGI5pHJ4+ZHekS+wJkR0t cFa6yVWP5iVO0F8+TNXxYWpR7f3iho/6IL8+8RWclAp4rTezg+BFqjp6Eu3NS4irDK9cmCoUSvip gNwhR73cxLfcH7SrsC+LI3xDXSblhnli4O+z5itTS5OvwRwTpNX4oqQc1N4q9m6PlScPn+g93MHJ 8KMWRVr8Rk6Dq4YGrD2CK5bnI/77yjSEg7jPgHwgl/6SBdBC20nBQIyRa1eKEjOfko7Jkn+EmYdX LQ= UI-OutboundReport: notjunk:1;M01:P0:60JJgKK/Q0I=;EmNVAK/EUK51vfCLu3mn0I1P5yp Yy2v0eo5e50bdPs24q2RrejOnHlM4Cn1VPVm8sp8iY1WLwm4Z9qrMB1Zlzw0MGSkzxVn/gos6 irp9+llgwkMNaXEwyyMK3mrDmn22alIosmjemZeXQyl1pU7mV7MKhxyNv1xQd/1a6DSLHxvbS 5zwAR+7mjvjxMh3NxVp8/iZlHnjPkV/2loaRCUJ9k42zr6ih8Ly1Cm79hIopBDocskPN64TGE mPd0GRRakWT/pic8cDh86D48X3H4bx4FYmVxhbcL9O4cX2PnQiWmTvVbE1Tf/dkOhDoEwvL6y ArOFFrwT62WlDes/RL2mkxZx1hL3dIWfm8tNV5vyTvLZRMOHZwCI5nP9zNUnZvPCi8ScKj1MW HQRA2scGa0sbba5CXvsrgAMyJ7QhXooBiBnWy29CbTxqlIEf/AW6cOOpnv879ILtQs/221I40 rKRqym1GIarjo6RcieO/CNbgRwYPcxt7nnkcRH0iVdWIY88TlDcA82RP7/ZNv9k8IEG1D2aMX EZBY67oUOjHLoIQ32EG3+iORWgY1ZIBEIspKdnEgLfjkPfEvpe5inGcDLKtrlBVHPYBlXVoI1 7H+pBsxrrGdDW1McH/zFqhVLakpXBsqstVJu6c7ezfEQpZsWlfY5B2hcgdjjleWHSYGw07Djl nelP9Yhq+yOUrEn4HWyzG3KWToFXQ1QU/J/UvoKoFVYN1UoyFJGXCA6wt/A5mT0= X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, 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: 1792268295696224184 X-GMAIL-MSGID: 1792268295696224184 Dear all, here's a first patch addressing issues with NULL as actual argument: if the dummy is assumed-rank or assumed length, MOLD shall be present. There is also an interp on interoperability of c_sizeof and NULL pointers, for which we have a partially incorrect testcase (gfortran.dg/pr101329.f90) which gets fixed. See https://j3-fortran.org/doc/year/22/22-101r1.txt for more. Furthermore, nested NULL()s are now handled. Regtested on x86_64-pc-linux-gnu. OK for mainline? I consider this part as safe and would like to backport to 13-branch. Objections? Thanks, Harald From ce7199b16872b3014be68744329a8f19ddd64b05 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 29 Feb 2024 21:43:53 +0100 Subject: [PATCH] Fortran: improve checks of NULL without MOLD as actual argument [PR104819] gcc/fortran/ChangeLog: PR fortran/104819 * check.cc (gfc_check_null): Handle nested NULL()s. (is_c_interoperable): Check for MOLD argument of NULL() as part of the interoperability check. * interface.cc (gfc_compare_actual_formal): Extend checks for NULL() actual arguments for presence of MOLD argument when required by Interp J3/22-146. gcc/testsuite/ChangeLog: PR fortran/104819 * gfortran.dg/pr101329.f90: Adjust testcase to conform to interp. * gfortran.dg/null_actual_4.f90: New test. --- gcc/fortran/check.cc | 5 ++- gcc/fortran/interface.cc | 30 ++++++++++++++++++ gcc/testsuite/gfortran.dg/null_actual_4.f90 | 35 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/pr101329.f90 | 4 +-- 4 files changed, 71 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/null_actual_4.f90 diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index d661cf37f01..db74dcf3f40 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -4384,6 +4384,9 @@ gfc_check_null (gfc_expr *mold) if (mold == NULL) return true; + if (mold->expr_type == EXPR_NULL) + return true; + if (!variable_check (mold, 0, true)) return false; @@ -5216,7 +5219,7 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr) { *msg = NULL; - if (expr->expr_type == EXPR_NULL) + if (expr->expr_type == EXPR_NULL && expr->ts.type == BT_UNKNOWN) { *msg = "NULL() is not interoperable"; return false; diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 231f2f252af..64b90550be2 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -3296,6 +3296,36 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, && a->expr->ts.type != BT_ASSUMED) gfc_find_vtab (&a->expr->ts); + /* Interp J3/22-146: + "If the context of the reference to NULL is an + corresponding to an dummy argument, MOLD shall be + present." */ + if (a->expr->expr_type == EXPR_NULL + && a->expr->ts.type == BT_UNKNOWN + && f->sym->as + && f->sym->as->type == AS_ASSUMED_RANK) + { + gfc_error ("Intrinsic % without % argument at %L " + "passed to assumed-rank dummy %qs", + &a->expr->where, f->sym->name); + ok = false; + goto match; + } + + if (a->expr->expr_type == EXPR_NULL + && a->expr->ts.type == BT_UNKNOWN + && f->sym->ts.type == BT_CHARACTER + && !f->sym->ts.deferred + && f->sym->ts.u.cl + && f->sym->ts.u.cl->length == NULL) + { + gfc_error ("Intrinsic % without % argument at %L " + "passed to assumed-length dummy %qs", + &a->expr->where, f->sym->name); + ok = false; + goto match; + } + if (a->expr->expr_type == EXPR_NULL && ((f->sym->ts.type != BT_CLASS && !f->sym->attr.pointer && (f->sym->attr.allocatable || !f->sym->attr.optional diff --git a/gcc/testsuite/gfortran.dg/null_actual_4.f90 b/gcc/testsuite/gfortran.dg/null_actual_4.f90 new file mode 100644 index 00000000000..e03d5c8f7de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/null_actual_4.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! PR fortran/104819 +! +! Reject NULL without MOLD as actual to an assumed-rank dummy. +! See also interpretation request at +! https://j3-fortran.org/doc/year/22/22-101r1.txt +! +! Test nested NULL() + +program p + implicit none + integer, pointer :: a, a3(:,:,:) + character(10), pointer :: c + + call foo (a) + call foo (a3) + call foo (null (a)) + call foo (null (a3)) + call foo (null (null (a))) ! Valid: nested NULL()s + call foo (null (null (a3))) ! Valid: nested NULL()s + call foo (null ()) ! { dg-error "passed to assumed-rank dummy" } + + call str (null (c)) + call str (null (null (c))) + call str (null ()) ! { dg-error "passed to assumed-length dummy" } +contains + subroutine foo (x) + integer, pointer, intent(in) :: x(..) + print *, rank (x) + end + + subroutine str (x) + character(len=*), pointer, intent(in) :: x + end +end diff --git a/gcc/testsuite/gfortran.dg/pr101329.f90 b/gcc/testsuite/gfortran.dg/pr101329.f90 index b82210d4e28..aca171bd4f8 100644 --- a/gcc/testsuite/gfortran.dg/pr101329.f90 +++ b/gcc/testsuite/gfortran.dg/pr101329.f90 @@ -8,6 +8,6 @@ program p integer(c_int64_t), pointer :: ip8 print *, c_sizeof (c_null_ptr) ! valid print *, c_sizeof (null ()) ! { dg-error "is not interoperable" } - print *, c_sizeof (null (ip4)) ! { dg-error "is not interoperable" } - print *, c_sizeof (null (ip8)) ! { dg-error "is not interoperable" } + print *, c_sizeof (null (ip4)) ! valid + print *, c_sizeof (null (ip8)) ! valid end -- 2.35.3