From patchwork Thu Jun 15 08:03:56 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 71147 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 968B7385558F for ; Thu, 15 Jun 2023 08:05:49 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 968B7385558F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1686816349; bh=P1PtsqnQe2bRtJi9aR7UCSrVVRRDpWcfJkxH5XyedBg=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=QI3LgJK554pvHgDx4cvtCcf82Kl6yfJfdmu3x6S4yLcrcCN0HDkXi0QGF6oePFpZ1 20Dbm+mALmr58NkdANJnpXn6PIGvBVn8tV1A2griRjFrgVBGv0z1SToEt2w4jHuEVi iQL2TZIUxxijh/+ffvO/jl2pChwdamqWA9y8Zu68= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x134.google.com (mail-lf1-x134.google.com [IPv6:2a00:1450:4864:20::134]) by sourceware.org (Postfix) with ESMTPS id 026793858033 for ; Thu, 15 Jun 2023 08:04:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 026793858033 Received: by mail-lf1-x134.google.com with SMTP id 2adb3069b0e04-4f764e9295dso2735548e87.0 for ; Thu, 15 Jun 2023 01:03:59 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1686816238; x=1689408238; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=P1PtsqnQe2bRtJi9aR7UCSrVVRRDpWcfJkxH5XyedBg=; b=UJiA1OI1iVKICVA/dCEg7axyAFBFaCGDLApzFTFRpCnp1AANZ+7SjvBBEbJiyAmkBZ Cf5+zSCz003EA+KwrUBrnuT6Txq31nYSws6eB64cFeAcZ+oIFm6ZRhJF/BEEgnrK1t4G rzZiuru92OfUxBInKfNbCsELZug9qmds9nN9z/F0E/U2wZBJsba+UnNHygIdPIOM1VzF YB7ecsPMRmYgrI3akFuMS4+hOa1Mpomsv211TkOr39Kyhie64rg7zUluTRFV14VuOGo/ 1nRVrGQy61PINe8M5ODo5EGDJavn2wq9Q8mWgvKgBFlohAekOdhewxGS36Gkh3Ee+A5K ep9g== X-Gm-Message-State: AC+VfDyvsLD6I8x0hkaHz/7LDenVa0Co4RIzoJ841MUTYENRfMaQ7r7v WCx6pjz8lUcsGAAA4MiAq6WQcFd7oxz2BylijcwkDw== X-Google-Smtp-Source: ACHHUZ6iK1awfW9dK1ruEyoa5hU8DrNP894ytSxi7Hd5O4Jimb2RmdgBK/IIPUvU9JfvN+YteNXouQ== X-Received: by 2002:a05:6512:3119:b0:4ed:bdac:7a49 with SMTP id n25-20020a056512311900b004edbdac7a49mr10091372lfb.54.1686816238305; Thu, 15 Jun 2023 01:03:58 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id l7-20020a7bc447000000b003f7f36896f9sm19517159wmi.42.2023.06.15.01.03.57 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 Jun 2023 01:03:57 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Piotr Trojanek Subject: [COMMITTED] ada: Accept aspect Always_Terminates without expression Date: Thu, 15 Jun 2023 10:03:56 +0200 Message-Id: <20230615080356.938975-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" From: Piotr Trojanek The recently added aspect Always_Terminates is now accepted without explicit boolean expression, where a missing expression implicitly means True, similar to aspects Async_Readers, Async_Writers, etc. gcc/ada/ * aspects.adb (Base_Aspect): Fix layout. * aspects.ads (Aspect_Argument): Expression for Always_Terminates is optional. * sem_prag.adb (Analyze_Always_Terminates_In_Decl_Part): Only analyze expression when pragma argument is present. (Analyze_Pragma): Argument for Always_Terminates is optional; fix whitespace for Async_Readers. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.adb | 28 ++++++++--------- gcc/ada/aspects.ads | 2 +- gcc/ada/sem_prag.adb | 74 +++++++++++++++++++++++--------------------- 3 files changed, 53 insertions(+), 51 deletions(-) diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 852f0c2a1f9..c14769c640c 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -41,20 +41,20 @@ package body Aspects is -- type. False means it is not inherited. Base_Aspect : constant array (Aspect_Id) of Boolean := - (Aspect_Atomic => True, - Aspect_Atomic_Components => True, - Aspect_Constant_Indexing => True, - Aspect_Default_Iterator => True, - Aspect_Discard_Names => True, - Aspect_Independent_Components => True, - Aspect_Iterator_Element => True, - Aspect_Stable_Properties => True, - Aspect_Type_Invariant => True, - Aspect_Unchecked_Union => True, - Aspect_Variable_Indexing => True, - Aspect_Volatile => True, - Aspect_Volatile_Full_Access => True, - others => False); + (Aspect_Atomic => True, + Aspect_Atomic_Components => True, + Aspect_Constant_Indexing => True, + Aspect_Default_Iterator => True, + Aspect_Discard_Names => True, + Aspect_Independent_Components => True, + Aspect_Iterator_Element => True, + Aspect_Stable_Properties => True, + Aspect_Type_Invariant => True, + Aspect_Unchecked_Union => True, + Aspect_Variable_Indexing => True, + Aspect_Volatile => True, + Aspect_Volatile_Full_Access => True, + others => False); -- The following array indicates type aspects that are inherited and apply -- to the class-wide type as well. diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 19f7c07130f..05677978037 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -372,7 +372,7 @@ package Aspects is Aspect_Address => Expression, Aspect_Aggregate => Expression, Aspect_Alignment => Expression, - Aspect_Always_Terminates => Expression, + Aspect_Always_Terminates => Optional_Expression, Aspect_Annotate => Expression, Aspect_Async_Readers => Optional_Expression, Aspect_Async_Writers => Optional_Expression, diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index bca4eb50430..1fa946439ee 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -430,7 +430,8 @@ package body Sem_Prag is is Subp_Decl : constant Node_Id := Find_Related_Declaration_Or_Body (N); Spec_Id : constant Entity_Id := Unique_Defining_Entity (Subp_Decl); - Expr : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); + Arg1 : constant Node_Id := + First (Pragma_Argument_Associations (N)); Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; Saved_IGR : constant Node_Id := Ignored_Ghost_Region; @@ -446,51 +447,52 @@ package body Sem_Prag is return; end if; - -- Set the Ghost mode in effect from the pragma. Due to the delayed - -- analysis of the pragma, the Ghost mode at point of declaration and - -- point of analysis may not necessarily be the same. Use the mode in - -- effect at the point of declaration. + if Present (Arg1) then - Set_Ghost_Mode (N); + -- Set the Ghost mode in effect from the pragma. Due to the delayed + -- analysis of the pragma, the Ghost mode at point of declaration and + -- point of analysis may not necessarily be the same. Use the mode in + -- effect at the point of declaration. - -- Ensure that the subprogram and its formals are visible when analyzing - -- the expression of the pragma. + Set_Ghost_Mode (N); - if not In_Open_Scopes (Spec_Id) then - Restore_Scope := True; + -- Ensure that the subprogram and its formals are visible when + -- analyzing the expression of the pragma. - if Is_Generic_Subprogram (Spec_Id) then - Push_Scope (Spec_Id); - Install_Generic_Formals (Spec_Id); - else - Push_Scope (Spec_Id); - Install_Formals (Spec_Id); + if not In_Open_Scopes (Spec_Id) then + Restore_Scope := True; + + if Is_Generic_Subprogram (Spec_Id) then + Push_Scope (Spec_Id); + Install_Generic_Formals (Spec_Id); + else + Push_Scope (Spec_Id); + Install_Formals (Spec_Id); + end if; end if; - end if; - Errors := Serious_Errors_Detected; - Preanalyze_Assert_Expression (Expr, Standard_Boolean); + Errors := Serious_Errors_Detected; + Preanalyze_Assert_Expression (Expression (Arg1), Standard_Boolean); - -- Emit a clarification message when the expression contains at least - -- one undefined reference, possibly due to contract freezing. + -- Emit a clarification message when the expression contains at least + -- one undefined reference, possibly due to contract freezing. - if Errors /= Serious_Errors_Detected - and then Present (Freeze_Id) - and then Has_Undefined_Reference (Expr) - then - Contract_Freeze_Error (Spec_Id, Freeze_Id); - end if; + if Errors /= Serious_Errors_Detected + and then Present (Freeze_Id) + and then Has_Undefined_Reference (Expression (Arg1)) + then + Contract_Freeze_Error (Spec_Id, Freeze_Id); + end if; - if Restore_Scope then - End_Scope; - end if; + if Restore_Scope then + End_Scope; + end if; - -- Currently it is not possible to inline pre/postconditions on a - -- subprogram subject to pragma Inline_Always. + Restore_Ghost_Region (Saved_GM, Saved_IGR); + end if; Set_Is_Analyzed_Pragma (N); - Restore_Ghost_Region (Saved_GM, Saved_IGR); end Analyze_Always_Terminates_In_Decl_Part; ----------------------------------------- @@ -13279,7 +13281,7 @@ package body Sem_Prag is -- Always_Terminates -- ----------------------- - -- pragma Always_Terminates (boolean_EXPRESSION); + -- pragma Always_Terminates [ (boolean_EXPRESSION) ]; -- Characteristics: @@ -13321,7 +13323,7 @@ package body Sem_Prag is begin GNAT_Pragma; Check_No_Identifiers; - Check_Arg_Count (1); + Check_At_Most_N_Arguments (1); -- Ensure the proper placement of the pragma. Exceptional_Cases -- must be associated with a subprogram declaration or a body that @@ -14011,7 +14013,7 @@ package body Sem_Prag is begin GNAT_Pragma; Check_No_Identifiers; - Check_At_Most_N_Arguments (1); + Check_At_Most_N_Arguments (1); Obj_Or_Type_Decl := Find_Related_Context (N, Do_Checks => True);