From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.21]) by sourceware.org (Postfix) with ESMTPS id 26663385828E; Wed, 5 Oct 2022 20:40:12 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 26663385828E Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1665002410; bh=3XPP/KdGvqEUCXSY5DL29r+HLuy0HOdhCBLbzdF6LNM=; h=X-UI-Sender-Class:From:To:Cc:Subject:Date:In-Reply-To:References; b=EuVOOgiFQ8iLEn/G5LZXb1PYhWQWk+o5ggiAGx/ldsljui/DTwdg4Oo8SwwiesgqU rEMbx7hmTm4NXMQKQExvXhjiMuHJNYOmo/sjgUmhNLGI6tsVKxk7hVtY0/v6KUgKWl 8xc/kNVVJqcwE6pI6JJJgfhh803MRddmVXqMMd8g= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.82.38] ([93.207.82.38]) by web-mail.gmx.net (3c-app-gmx-bap28.server.lan [172.19.172.98]) (via HTTP); Wed, 5 Oct 2022 22:40:09 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: Mikael Morin Cc: fortran , gcc-patches Subject: Re: [PATCH, v2] Fortran: reject procedures and procedure pointers as IO element [PR107074] Content-Type: multipart/mixed; boundary=abmob-07bcbc09-50ec-4847-9d7b-4d02a03ee49c Date: Wed, 5 Oct 2022 22:40:09 +0200 Importance: normal Sensitivity: Normal In-Reply-To: <3ff755f3-d514-f7cc-f79c-c554b60c2b83@orange.fr> References: <3ff755f3-d514-f7cc-f79c-c554b60c2b83@orange.fr> X-UI-Message-Type: mail X-Priority: 3 X-Provags-ID: V03:K1:VTDLBAUxksk0L43KBxAZTfzB5aJRvlGOi7jJ0aVTXftUhDaHiThzu6cMyvdCOiuDSO/Vw KJlpNbcgrkjlPCUKfkbBmq9ZUC7MKFJGVT03Ss6RFMWNyIuU+60rays/5Xat7esqo6gVoMK1h1Zd N8WLnfkTJTF6H+oUojqdzdrnvwbuUyHsiUcfck33YjgpzDoTlIaF5lz3+IQZk7f2UQ8sz87KWc5U LPlVzbxsweqX/+8T4jqESFZF0xx1D+yXQDavrOCMWAmAvdBxseWyZj994t0Hz32PAk9DmgLmpyW4 Fw= X-UI-Out-Filterresults: notjunk:1;V03:K0:WxSQuKZ13PA=:Xqn+JkRvPcSTSdCCXWurcd 0l+mojrAZOcquGfeXXtPglJLh4zzJjiDNuSGzYlmeP/TqCqU47jr2Vy+05CFAvEveTywsIUyu N8+CSMLc5LT+uWGaN/vCQUoOIT02WtoMx+IIK23uI0vEyPpW9Po0w7J7pEYvkL7thI8qIFuWZ Qyre/5jZ62irz5HzsS5NBPaI6DvDN7W4oMuTJBcsWIIsN4EuSbr65TEco4ew1mEZ1iYaU0axP 46J4Z9ggnyJ3mdaytZYQ5lIV+rTZ6St/kZlfEsyNTcylItVtWC3tWWkKp8L7MwseeOipYOAYl /jzYn5+W3ozfYAS8R6WP5QulhGs7P/nGs/swX4VLll7zg+eRMSx7xO7e3BDY79ukIVGHvJFVF ChVF9Ou4FoLZCNVSunSFUZdXWtrmQqXSaSBZc0gliFZzaJmLQeVPTUeyu8ZtCuKsy4fmduvCP vBXC0u6qY2L22Aox75GX8Y9jNVu9Z0YKgwFGOjUVBSCfB9cGA2mEihSG8lXAQh7uLQYBM0Owd PNqyKIkOw4bLUyFbUb7pgWN3CurThVeYFY8NDSQoI5X4Y4HNerTjQjZqp2tuII14chqDEt7C0 cERKHOydVg7+RuwmbVV6A+Wj+rWrUfvSxYomavFud131eH49CarbArH+5HO89MDYuE0NoMwBd 3JRL0U2JnlRnsxdSXV3GWOt8C9opqsSOlGg++IXhy1PLRnradhkyWjAQPbzr3hmgna/dyxqsk lgXWK0A7r/iqyCwwFxWzyg1+i99dGhdEVZcW4QQO3eemHMpjedNUyF/zfVdEr11TrMwxGfBgB UF7Kshm X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,FREEMAIL_FROM,GIT_PATCH_0,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 List-Id: --abmob-07bcbc09-50ec-4847-9d7b-4d02a03ee49c Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Hi Mikael, > Gesendet: Mittwoch, 05. Oktober 2022 um 12:34 Uhr > Von: "Mikael Morin" > Please move the check to resolve_transfer in resolve.cc. I have done this, see attached updated patch. Regtests cleanly on x86_64-pc-linux-gnu. > Strangely, the patch doesn't seem to fix the problem on the testcase > here. There is an outer parenthese expression preventing the condition > you added from triggering. Can you double check? You are right: I had a one-liner in my worktree from PR105371 that fixes an issue with gfc_simplify_merge and that seems to help here. It is now included. > If we take the standard to the letter, only output items are forbidden, > so a check is missing for writing context. I don't know how it can work > for input items though, so maybe not worth it. In any case, the error > shouldn't mention output items in reading context. > > Here is a variant of the testcase with procedure pointer components, > that fails differently but can probably be caught as well. > > program p > implicit none > type :: t > procedure(f), pointer, nopass :: b > end type t > type(t) :: a > > interface > real function f() > end function f > end interface > > print *, merge (a%b, a%b, .true.) > end I hadn't thought about this, and found a solution that also fixes this one. Great example! This is now an additional test. OK for mainline? And thanks for your comments! Harald --abmob-07bcbc09-50ec-4847-9d7b-4d02a03ee49c Content-Type: text/x-patch Content-Disposition: attachment; filename=pr107074-v2.diff Content-Transfer-Encoding: quoted-printable =46rom 70cba7da18023282546b9a5d80e976fc3744d732 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 5 Oct 2022 22:25:14 +0200 Subject: [PATCH] Fortran: reject procedures and procedure pointers as IO element [PR107074] gcc/fortran/ChangeLog: PR fortran/107074 * resolve.cc (resolve_transfer): A procedure, type-bound procedure or a procedure pointer cannot be an element of an IO list. * simplify.cc (gfc_simplify_merge): Do not try to reset array lower bound for scalars. gcc/testsuite/ChangeLog: PR fortran/107074 * gfortran.dg/pr107074.f90: New test. * gfortran.dg/pr107074b.f90: New test. =2D-- gcc/fortran/resolve.cc | 31 +++++++++++++++++++++++++ gcc/fortran/simplify.cc | 3 ++- gcc/testsuite/gfortran.dg/pr107074.f90 | 11 +++++++++ gcc/testsuite/gfortran.dg/pr107074b.f90 | 18 ++++++++++++++ 4 files changed, 62 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/pr107074.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr107074b.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index d133bc2d034..d9d101775f6 100644 =2D-- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -10137,6 +10137,37 @@ resolve_transfer (gfc_code *code) "an assumed-size array", &code->loc); return; } + + /* Check for procedures and procedure pointers. Fortran 2018 has: + + C1233 (R1217) An expression that is an output-item shall not have a + value that is a procedure pointer. + + There does not appear any reason to allow procedure pointers for + input, so we disallow them generally, and we reject procedures. */ + + if (exp->expr_type =3D=3D EXPR_VARIABLE) + { + /* Check for type-bound procedures. */ + for (ref =3D exp->ref; ref; ref =3D ref->next) + if (ref->type =3D=3D REF_COMPONENT + && ref->u.c.component->attr.flavor =3D=3D FL_PROCEDURE) + break; + + /* Procedure or procedure pointer? */ + if (exp->ts.type =3D=3D BT_PROCEDURE + || (ref && ref->u.c.component->attr.flavor =3D=3D FL_PROCEDURE)) + { + if (exp->symtree->n.sym->attr.proc_pointer + || (ref && ref->u.c.component->attr.proc_pointer)) + gfc_error ("Data transfer element at %L cannot be a procedure " + "pointer", &code->loc); + else + gfc_error ("Data transfer element at %L cannot be a procedure", + &code->loc); + return; + } + } } diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 6ac92cf9db8..f0482d349af 100644 =2D-- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -4915,7 +4915,8 @@ gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fso= urce, gfc_expr *mask) { result =3D gfc_copy_expr (mask->value.logical ? tsource : fsource); /* Parenthesis is needed to get lower bounds of 1. */ - result =3D gfc_get_parentheses (result); + if (result->rank) + result =3D gfc_get_parentheses (result); gfc_simplify_expr (result, 1); return result; } diff --git a/gcc/testsuite/gfortran.dg/pr107074.f90 b/gcc/testsuite/gfortr= an.dg/pr107074.f90 new file mode 100644 index 00000000000..1363c285912 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr107074.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR fortran/107074 - ICE: Bad IO basetype (8) +! Contributed by G.Steinmetz + +program p + implicit none + integer, external :: a + procedure(real), pointer :: b + print *, merge (a, a, .true.) ! { dg-error "procedure" } + print *, merge (b, b, .true.) ! { dg-error "procedure pointer" } +end diff --git a/gcc/testsuite/gfortran.dg/pr107074b.f90 b/gcc/testsuite/gfort= ran.dg/pr107074b.f90 new file mode 100644 index 00000000000..98c3fc0b90a =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr107074b.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! Additional test for PR fortran/107074 +! Contributed by M.Morin + +program p + implicit none + type :: t + procedure(f), pointer, nopass :: b + end type t + type(t) :: a + + interface + real function f() + end function f + end interface + + print *, merge (a%b, a%b, .true.) ! { dg-error "procedure pointer" } +end =2D- 2.35.3 --abmob-07bcbc09-50ec-4847-9d7b-4d02a03ee49c--