From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1285) id 5CCC63861906; Wed, 27 Sep 2023 08:26:49 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 5CCC63861906 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1695803209; bh=6xbkFnyUT163W0EtZ5ASgZqn95UfdmHR7YlrjGvRz3U=; h=From:To:Subject:Date:From; b=txhQDBRS+SEuNjA0r8VPR3wno0qiHwoaDBt8LXp6ZBePg8oSolESDnGo1PxiBWgbm o8HqICCzxGhSlzmyG8ZlFnaJFlwMd0Cg0tlr+Q6gKdforw5NIq48ZMzVNIJB4FthCQ n+MQoGIzsSK5yUYNSLois26InkW/mqxl3Bd7HGYc= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Eric Botcazou To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-7886] ada: Fix exception raised on invalid contract in generic package X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/releases/gcc-13 X-Git-Oldrev: a0d76c325f0bfa29256072084182ee8c9c4457dd X-Git-Newrev: a28d0a363e95b70a856763562072ff5153c0e7ab Message-Id: <20230927082649.5CCC63861906@sourceware.org> Date: Wed, 27 Sep 2023 08:26:49 +0000 (GMT) List-Id: https://gcc.gnu.org/g:a28d0a363e95b70a856763562072ff5153c0e7ab commit r13-7886-ga28d0a363e95b70a856763562072ff5153c0e7ab Author: Eric Botcazou Date: Mon Apr 24 11:07:38 2023 +0200 ada: Fix exception raised on invalid contract in generic package This lets the compiler give a proper error message instead. gcc/ada/ * contracts.adb (Contract_Error): New exception. (Add_Contract_Item): Raise Contract_Error instead of Program_Error. (Add_Generic_Contract_Pragma): Deal with Contract_Error. Diff: --- gcc/ada/contracts.adb | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 39c067300d6..3a7d6028a73 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -62,6 +62,11 @@ with Warnsw; use Warnsw; package body Contracts is + Contract_Error : exception; + -- This exception is raised by Add_Contract_Item when it is invoked on an + -- invalid pragma. Note that clients of the package must filter them out + -- before invoking Add_Contract_Item, so it should not escape the package. + procedure Analyze_Package_Instantiation_Contract (Inst_Id : Entity_Id); -- Analyze all delayed pragmas chained on the contract of package -- instantiation Inst_Id as if they appear at the end of a declarative @@ -197,7 +202,7 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; -- Entry bodies, the applicable pragmas are: @@ -215,7 +220,7 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; -- Entry or subprogram declarations, the applicable pragmas are: @@ -264,7 +269,7 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; -- Packages or instantiations, the applicable pragmas are: @@ -288,7 +293,7 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; -- Package bodies, the applicable pragmas are: @@ -301,7 +306,7 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; -- The four volatility refinement pragmas are ok for all types. @@ -329,7 +334,7 @@ package body Contracts is -- The pragma is not a proper contract item - raise Program_Error; + raise Contract_Error; end if; end; @@ -353,7 +358,7 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; -- Task bodies, the applicable pragmas are: @@ -367,7 +372,7 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; -- Task units, the applicable pragmas are: @@ -402,11 +407,11 @@ package body Contracts is -- The pragma is not a proper contract item else - raise Program_Error; + raise Contract_Error; end if; else - raise Program_Error; + raise Contract_Error; end if; end Add_Contract_Item; @@ -2196,6 +2201,12 @@ package body Contracts is else Add_Contract_Item (Prag, Templ_Id); end if; + + exception + -- We do not stop the compilation at this point in the case of an + -- invalid pragma because it will be properly diagnosed afterward. + + when Contract_Error => null; end Add_Generic_Contract_Pragma; -- Local variables