From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x331.google.com (mail-wm1-x331.google.com [IPv6:2a00:1450:4864:20::331]) by sourceware.org (Postfix) with ESMTPS id 98F753858433 for ; Tue, 13 Jun 2023 07:37:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 98F753858433 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wm1-x331.google.com with SMTP id 5b1f17b1804b1-3f6dfc4dffaso38468035e9.0 for ; Tue, 13 Jun 2023 00:37:47 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1686641866; x=1689233866; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=mVvd908sNUNNolGTSbMkpWZF5QTWAFR/VDt5apmbNoY=; b=aUFodOn/KuaNyFzSQ2tQ3Tj77Yhij7KAUQAuiwQnKxDNVOQBV9zofqcMfAUdox9V62 FoGjJZTtr7qLj7WhrN2TZlQTC2hZbhbN+u+UzQPXlyJbFr+6wYy8OukkDW4ilAKgIhAp EGNzX+U76vl8CS806QlRiHfkjMqBwE9EPejncIKG9w9Clc+ucaCnSLAPJLJ2swHOoRB3 TRRKwQPdWfExEWO8waQxJEcHjMdQ5TGEizHJhQJDw/oD2Rohot3Dym1b3JirRMWixxPe eMctFmPfLjaqeIgEbSL7JS3cvWG5Ta/pO73a1qC3iBxTrI/M1bucjFpxAQAN4Bw9SI/b BrPg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1686641866; x=1689233866; 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=mVvd908sNUNNolGTSbMkpWZF5QTWAFR/VDt5apmbNoY=; b=ehKOY3SaQnbTogSdvlOtY/QNIYR95BTJ7ioV8du+4DstZsb7wZio17zMzFpsPTahK7 wfMfb81tEwVyGkmwkUemQm3ksEZyUZVHm03SpRPg4/jT52/Uf9tiXTzgZGJ/ccyR0eyH pP4O4FJgbTC7FVmxPPFEucJIi3sInegxIiasg6n7LWHie/T17FmyuOF61PYHtj+W/pCe TiptaSWrGGBuhFHFjLiRuukpRsV5ro7pWPfGcJhgk7XpGmxUaRVcKp8yd7IDGziOp96X tiW/9HhH4DJ+rIe+mg4ACuUyPepBGH+Uo9fbaxQoEHEu9DriERcZWCcJBa6HUSwwPoQv iHBQ== X-Gm-Message-State: AC+VfDw1sWa3k7GYQo86Nps3oa01aQSN+HmUrlpo+Uq4ak8bOcjD1GdW O2mpj8I37Q7dYT/Y0NauUOcygZ/cNZoEQOByFfrexw== X-Google-Smtp-Source: ACHHUZ5L/EkmywtLg8NjxUYB00gE1Z2CbArbMzJbrmCYTvRVaLylL/GFJFLVx6+mKgmErrzudT3h3Q== X-Received: by 2002:a05:600c:104b:b0:3f7:f884:7be1 with SMTP id 11-20020a05600c104b00b003f7f8847be1mr7158878wmx.20.1686641866320; Tue, 13 Jun 2023 00:37:46 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:bfa8:5d29:40e5:cc66]) by smtp.gmail.com with ESMTPSA id 4-20020a05600c024400b003f60101074dsm13499434wmj.33.2023.06.13.00.37.45 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 13 Jun 2023 00:37:45 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Piotr Trojanek Subject: [COMMITTED] ada: Cleanup expansion of locally handled exception handlers Date: Tue, 13 Jun 2023 09:37:44 +0200 Message-Id: <20230613073744.239061-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.7 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,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 List-Id: From: Piotr Trojanek Code cleanup related to handling exceptions in GNATprove; semantics is unaffected. gcc/ada/ * exp_ch11.ads (Find_Local_Handler): Fix typo in comment. * exp_ch11.adb (Find_Local_Handler): Remove redundant check for the Exception_Handler list being present; use membership test to eliminate local object LCN; fold nested IF statements. Remove useless ELSIF condition. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch11.adb | 124 +++++++++++++++++++------------------------ gcc/ada/exp_ch11.ads | 2 +- 2 files changed, 55 insertions(+), 71 deletions(-) diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 753412eab16..da02eb9bfb2 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1803,95 +1803,79 @@ package body Exp_Ch11 is -- Test for handled sequence of statements with at least one -- exception handler which might be the one we are looking for. - elsif Nkind (P) = N_Handled_Sequence_Of_Statements - and then Present (Exception_Handlers (P)) - then - -- Before we proceed we need to check if the node N is covered - -- by the statement part of P rather than one of its exception - -- handlers (an exception handler obviously does not cover its - -- own statements). - - -- This test is more delicate than might be thought. It is not - -- just a matter of checking the Statements (P), because the node - -- might be waiting to be wrapped in a transient scope, in which - -- case it will end up in the block statements, even though it - -- is not there now. - - if Is_List_Member (N) then - declare - LCN : constant List_Id := List_Containing (N); + -- We need to check if the node N is covered by the statement part of + -- P rather than one of its exception handlers (an exception handler + -- obviously does not cover its own statements). - begin - if LCN = Statements (P) - or else - LCN = SSE.Actions_To_Be_Wrapped (Before) - or else - LCN = SSE.Actions_To_Be_Wrapped (After) - or else - LCN = SSE.Actions_To_Be_Wrapped (Cleanup) - then - -- Loop through exception handlers + -- This test is more delicate than might be thought. It is not just + -- a matter of checking the Statements (P), because the node might be + -- waiting to be wrapped in a transient scope, in which case it will + -- end up in the block statements, even though it is not there now. - H := First (Exception_Handlers (P)); - while Present (H) loop + elsif Nkind (P) = N_Handled_Sequence_Of_Statements + and then Is_List_Member (N) + and then List_Containing (N) in Statements (P) + | SSE.Actions_To_Be_Wrapped (Before) + | SSE.Actions_To_Be_Wrapped (After) + | SSE.Actions_To_Be_Wrapped (Cleanup) + then + -- Loop through exception handlers - -- Guard against other constructs appearing in the - -- list of exception handlers. + H := First (Exception_Handlers (P)); + while Present (H) loop - if Nkind (H) = N_Exception_Handler then + -- Guard against other constructs appearing in the list of + -- exception handlers. - -- Loop through choices in one handler + if Nkind (H) = N_Exception_Handler then - C := First (Exception_Choices (H)); - while Present (C) loop + -- Loop through choices in one handler - -- Deal with others case + C := First (Exception_Choices (H)); + while Present (C) loop - if Nkind (C) = N_Others_Choice then + -- Deal with others case - -- Matching others handler, but we need - -- to ensure there is no choice parameter. - -- If there is, then we don't have a local - -- handler after all (since we do not allow - -- choice parameters for local handlers). + if Nkind (C) = N_Others_Choice then - if No (Choice_Parameter (H)) then - return H; - else - return Empty; - end if; + -- Matching others handler, but we need to ensure + -- there is no choice parameter. If there is, then we + -- don't have a local handler after all (since we do + -- not allow choice parameters for local handlers). - -- If not others must be entity name + if No (Choice_Parameter (H)) then + return H; + else + return Empty; + end if; - elsif Nkind (C) /= N_Others_Choice then - pragma Assert (Is_Entity_Name (C)); - pragma Assert (Present (Entity (C))); + -- If not others must be entity name - -- Get exception being handled, dealing with - -- renaming. + else + pragma Assert (Is_Entity_Name (C)); + pragma Assert (Present (Entity (C))); - EHandle := Get_Renamed_Entity (Entity (C)); + -- Get exception being handled, dealing with renaming - -- If match, then check choice parameter + EHandle := Get_Renamed_Entity (Entity (C)); - if ERaise = EHandle then - if No (Choice_Parameter (H)) then - return H; - else - return Empty; - end if; - end if; - end if; + -- If match, then check choice parameter - Next (C); - end loop; + if ERaise = EHandle then + if No (Choice_Parameter (H)) then + return H; + else + return Empty; + end if; end if; + end if; - Next (H); - end loop; - end if; - end; - end if; + Next (C); + end loop; + end if; + + Next (H); + end loop; end if; N := P; diff --git a/gcc/ada/exp_ch11.ads b/gcc/ada/exp_ch11.ads index 483c7591038..8d5b998eeb3 100644 --- a/gcc/ada/exp_ch11.ads +++ b/gcc/ada/exp_ch11.ads @@ -59,7 +59,7 @@ package Exp_Ch11 is (Ename : Entity_Id; Nod : Node_Id) return Node_Id; -- This function searches for a local exception handler that will handle - -- the exception named by Ename. If such a local hander exists, then the + -- the exception named by Ename. If such a local handler exists, then the -- corresponding N_Exception_Handler is returned. If no such handler is -- found then Empty is returned. In order to match and return True, the -- handler may not have a choice parameter specification. Nod is the raise -- 2.40.0