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 D093C3948A75; Mon, 9 May 2022 20:20:07 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org D093C3948A75 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.89.237] ([93.207.89.237]) by web-mail.gmx.net (3c-app-gmx-bap38.server.lan [172.19.172.108]) (via HTTP); Mon, 9 May 2022 22:20:06 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] PR fortran/105526 - [Coarray] Add missing checks for arguments of type TEAM_TYPE Content-Type: multipart/mixed; boundary=refeik-f5555e46-6bfc-4e7f-a25f-6f6fb9a5a133 Date: Mon, 9 May 2022 22:20:06 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:IN2apWFKWhQPv0DbcMpPEyU4NJEtGCL0KG00iSJJtlNbNpNVkD8VdrIJXM8/BsFfshgF6 hbl9FM8XQ/TmtWgH3sSrcZTFJ638YgE1rn9WhWqqNzVxzt+6iuflgDz9nCdCd3oCRA8m6GpSmkks RyOP/2QOA26tn/EddQ2BjSO3yf+jro8JdfDlaHjf2Lgi59HBwARaoesTtbMs8hBB8+NlrVEviKjZ ZNCSHY1ZUnK962GzKjFg6WKeK0KUdl3S7G9rKSZzdGFUlcP74BbSa93kSvpeUee8IenXtXdmdYxg 7M= X-UI-Out-Filterresults: notjunk:1;V03:K0:ubE+ofqFewo=:ogJMUKR3sHco3ktl8TBcue 7SI3zzGz3J7NPgyX1x7Vi72hW9ONwyxbMJfBGKqm0rTCtdSGUZpDM5mhITVjoj8k2lxPTVolM J14jJRdK0JTR+XudvZ40nkRxwPQ+cORuMuYP0OunCR2q3geH3kL/Lg5ioUJ8FN22fD2RgvDzi y2C/P5nci8i7I0P9He1LadaU99I2Q6D29jVNNtfmAOLf8JRcNrExgYf7crk+JUhj9dddSyDMG yoFPsudH2bGsTIpASC8y5OdkcEshlBhbPeWCg6hCK3SktA/nGM+54Qc322AJ3bBDIfd61bs2o DlOQWfdsFvpRjXKNgG7W1NY8M/EqnRL4S4+1U7rWf0N/5g0e29lTVZHXtpKeBJpB28JWvCOhZ kVBvd1XKS8us01fsQJkXvXr8Ou7aeMhkP/ulTYcjtmS4woUKakOAYU+UXgHoohXq/7ZQ97ULO N8naHxfTMZupwChsl8menN6QNm+oG105z3UgfaJvQ5kuASHJG7CbxifwhezdG2Tk3LUc9hJS7 cyd/BGWa7CjZbOVwvbvr/DLB34nqZMA6arrHtSunXdSbt94zHeNzjXj3gOkZQmdMBYU9EKhP8 T+nPkTFcQFy/R82dHhCdZMSCJoVSebyax36HTNFa67Sk6xC1InLseBLo6aDQhB33BtqcRY5o4 2xi73O5WFjzWAG0k5mqIl7lJca0aozTydq0saOWtgIbhK+llMrhknMqQS07gY9Udsq5QGQmoL gXsluZ9yQWy8pjB3pjgfUDTpa9f2s3eU3UPdDzRclVwje1saZH2F3Uj/MEY= X-Spam-Status: No, score=-11.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 09 May 2022 20:20:11 -0000 --refeik-f5555e46-6bfc-4e7f-a25f-6f6fb9a5a133 Content-Type: text/plain; charset=UTF-8 Dear Fortranners, we were lacking checks for arguments of type TEAM_TYPE to some coarray intrinsics (FORM TEAM, CHANGE TEAM, and SYNC TEAM). The attached patch adds these, and as a bonus verifies that TEAM NUMBER is a scalar integer. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald --refeik-f5555e46-6bfc-4e7f-a25f-6f6fb9a5a133 Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Fortran-check-TEAM-arguments-to-coarray-intrinsics.patch Content-Transfer-Encoding: quoted-printable =46rom 9e5aefa51df49a498854b25ce9dacd46bf58eb4e Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 9 May 2022 22:14:21 +0200 Subject: [PATCH] Fortran: check TEAM arguments to coarray intrinsics TEAM arguments to coarray intrinsics must be scalar expressions of type TEAM_TYPE of intrinsic module ISO_FORTRAN_ENV. gcc/fortran/ChangeLog: PR fortran/105526 * resolve.cc (check_team): New. (gfc_resolve_code): Add checks for arguments to coarray intrinsics FORM TEAM, CHANGE TEAM, and SYNC TEAM. gcc/testsuite/ChangeLog: PR fortran/105526 * gfortran.dg/coarray_50.f90: New test. =2D-- gcc/fortran/resolve.cc | 32 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/coarray_50.f90 | 22 ++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/coarray_50.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 29df531cdb6..c8335f939a9 100644 =2D-- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -11831,6 +11831,23 @@ deferred_op_assign (gfc_code **code, gfc_namespac= e *ns) } +static bool +check_team (gfc_expr *team, const char *intrinsic) +{ + if (team->rank !=3D 0 + || team->ts.type !=3D BT_DERIVED + || team->ts.u.derived->from_intmod !=3D INTMOD_ISO_FORTRAN_ENV + || team->ts.u.derived->intmod_sym_id !=3D ISOFORTRAN_TEAM_TYPE) + { + gfc_error ("TEAM argument to %qs at %L must be a scalar expression = " + "of type TEAM_TYPE", intrinsic, &team->where); + return false; + } + + return true; +} + + /* Given a block of code, recursively resolve everything pointed to by th= is code block. */ @@ -11999,10 +12016,25 @@ start: break; case EXEC_FAIL_IMAGE: + break; + case EXEC_FORM_TEAM: + if (code->expr1 !=3D NULL + && (code->expr1->ts.type !=3D BT_INTEGER || code->expr1->rank)) + gfc_error ("TEAM NUMBER argument to FORM TEAM at %L must be " + "a scalar INTEGER", &code->expr1->where); + check_team (code->expr2, "FORM TEAM"); + break; + case EXEC_CHANGE_TEAM: + check_team (code->expr1, "CHANGE TEAM"); + break; + case EXEC_END_TEAM: + break; + case EXEC_SYNC_TEAM: + check_team (code->expr1, "SYNC TEAM"); break; case EXEC_ENTRY: diff --git a/gcc/testsuite/gfortran.dg/coarray_50.f90 b/gcc/testsuite/gfor= tran.dg/coarray_50.f90 new file mode 100644 index 00000000000..e88d9d93f0e =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_50.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-fcoarray=3Dsingle" } +! +! PR fortran/105526 - check TEAM arguments to coarray intrinsics + +subroutine p + use iso_fortran_env, only: team_type + implicit none + type(team_type) :: team + type t + integer :: i + end type t + type(t) :: z + form team (0, team) + form team (0, 0) ! { dg-error "scalar expression of type TEAM_TYPE= " } + form team (0, [team]) ! { dg-error "scalar expression of type TEAM_TYPE= " } + form team ([0], team) ! { dg-error "scalar INTEGER" } + form team (0., team) ! { dg-error "scalar INTEGER" } + change team (0) ! { dg-error "scalar expression of type TEAM_TYPE= " } + end team + sync team (0) ! { dg-error "scalar expression of type TEAM_TYPE= " } +end =2D- 2.35.3 --refeik-f5555e46-6bfc-4e7f-a25f-6f6fb9a5a133--