From patchwork Fri May 26 07:36:14 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: 70129 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 3967D3888C59 for ; Fri, 26 May 2023 07:40:02 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3967D3888C59 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1685086802; bh=jo2wm2NoMWkAPSxaTNcGrSw0fo0m60aTw3AMU5mZIw0=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=ee6CZqE5Et9TBxNfhk2kKxgX0bLOtbsiZYXYUGQ7NeUh09Fg7qrMSmiSxGtNj+PoA ZVxgGpg0aM/bnNuTtmdZKPDSupSypkRbB9wTic7KmjpuizVB/KjeDaa/gjvVN+ixPa C5DQG5qpqwBHKuDw6zp5wc5NlmXUZyAYVrTof4V0= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32f.google.com (mail-wm1-x32f.google.com [IPv6:2a00:1450:4864:20::32f]) by sourceware.org (Postfix) with ESMTPS id 7732F383907F for ; Fri, 26 May 2023 07:36:17 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 7732F383907F Received: by mail-wm1-x32f.google.com with SMTP id 5b1f17b1804b1-3f6dbe3c230so4556365e9.3 for ; Fri, 26 May 2023 00:36:17 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1685086576; x=1687678576; 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=jo2wm2NoMWkAPSxaTNcGrSw0fo0m60aTw3AMU5mZIw0=; b=Zd6hwO++o9mGve3tk6jQuSQpIUnqxq8AVy/4+ixJI+64MmSjf9PAA2bWSi4lmZhHXx zJ9GmjzItese7KcNNWl2rtIg3z6vgyo27zWSt6qTU9DhHiyyoqc8pjtdo1mhubkZkJnn N6D/j06hzwfwdggMbr42P5wMN/VugXA+FO6Msq5EsQmwomj08Ogma/pmi2ux2dplMtd6 U1r2a2pcV3xev1oXZRR+QUAMdxvlJgMKvahzLDzUxXYEc0GLAPHKG1DXo7YZvcOkaKCS O9Y2Rhy7OMmNua8ijoRTzIztJvH7+2Be66jNUQZmGkGc4zxBLWpc7Bhqx8OsDaIzTOyp i49g== X-Gm-Message-State: AC+VfDwHSHim1HptMgtV3M34xuql7x/DK+jKvv37c2jZhR00QafBl9lj is6ltwRF3Vm2AFRieh9KFBCMWZirJVhv3CUJ5bUx6Q== X-Google-Smtp-Source: ACHHUZ47uxvY26qtnLIxX/gULSEFgNRZO2jaCr+NVrbgxmw6VlunX9VPFAVHhIRVlD9vFFGBN+ZdMg== X-Received: by 2002:a1c:f616:0:b0:3f4:1cd8:3e99 with SMTP id w22-20020a1cf616000000b003f41cd83e99mr783883wmc.28.1685086576161; Fri, 26 May 2023 00:36:16 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:777b:eef4:6f79:f26f]) by smtp.gmail.com with ESMTPSA id f4-20020a1c6a04000000b003f1978bbcd6sm14064623wmc.3.2023.05.26.00.36.15 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 26 May 2023 00:36:15 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [COMMITTED] ada: Crash on loop in dispatching conditional entry call Date: Fri, 26 May 2023 09:36:14 +0200 Message-Id: <20230526073614.2068758-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.2 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: Javier Miranda gcc/ada/ * exp_ch9.adb (Expand_N_Conditional_Entry_Call): Factorize code to avoid duplicating subtrees; required to avoid problems when the copied code has implicit labels. * sem_util.ads (New_Copy_Separate_List): Removed. (New_Copy_Separate_Tree): Removed. * sem_util.adb (New_Copy_Separate_List): Removed. (New_Copy_Separate_Tree): Removed. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch9.adb | 38 +++++++++++---- gcc/ada/sem_util.adb | 107 ------------------------------------------- gcc/ada/sem_util.ads | 10 ---- 3 files changed, 30 insertions(+), 125 deletions(-) diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index df4a083e96b..68f1290cab4 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -7712,7 +7712,7 @@ package body Exp_Ch9 is -- or else K = Ada.Tags.TK_Tagged -- then -- ; - -- + -- -- (code factorized after if-stmt) -- else -- S := @@ -7737,11 +7737,14 @@ package body Exp_Ch9 is -- ; -- end if; - -- + -- -- (code factorized after if-stmt) -- else -- + -- goto L0; -- skip triggering statements -- end if; -- end if; + -- + -- L0: -- end; procedure Expand_N_Conditional_Entry_Call (N : Node_Id) is @@ -7757,6 +7760,8 @@ package body Exp_Ch9 is Decl : Node_Id; Decls : List_Id; Formals : List_Id; + Label : Node_Id; + Label_Id : Entity_Id := Empty; Lim_Typ_Stmts : List_Id; N_Stats : List_Id; Obj : Entity_Id; @@ -7883,12 +7888,13 @@ package body Exp_Ch9 is -- then -- -- end if; - -- + -- -- (code factorized after if-stmt) -- else -- + -- goto L0; -- skip triggering statements -- end if; - N_Stats := New_Copy_Separate_List (Statements (Alt)); + N_Stats := New_List; Prepend_To (N_Stats, Make_Implicit_If_Statement (N, @@ -7922,6 +7928,14 @@ package body Exp_Ch9 is Then_Statements => New_List (Blk))); + Label_Id := Make_Identifier (Loc, New_External_Name ('L', 0)); + Set_Entity (Label_Id, + Make_Defining_Identifier (Loc, Chars (Label_Id))); + + Append_To (Else_Statements (N), + Make_Goto_Statement (Loc, + Name => New_Occurrence_Of (Entity (Label_Id), Loc))); + Append_To (Conc_Typ_Stmts, Make_Implicit_If_Statement (N, Condition => New_Occurrence_Of (B, Loc), @@ -7930,15 +7944,14 @@ package body Exp_Ch9 is -- Generate: -- ; - -- + -- -- (code factorized after if-stmt) - Lim_Typ_Stmts := New_Copy_Separate_List (Statements (Alt)); - Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (Blk)); + Lim_Typ_Stmts := New_List (New_Copy_Tree (Blk)); -- Generate: -- if K = Ada.Tags.TK_Limited_Tagged -- or else K = Ada.Tags.TK_Tagged - -- then + -- then -- Lim_Typ_Stmts -- else -- Conc_Typ_Stmts @@ -7950,6 +7963,15 @@ package body Exp_Ch9 is Then_Statements => Lim_Typ_Stmts, Else_Statements => Conc_Typ_Stmts)); + Label := Make_Label (Loc, Label_Id); + Append_To (Decls, + Make_Implicit_Label_Declaration (Loc, + Defining_Identifier => Entity (Label_Id), + Label_Construct => Label)); + + Append_List_To (Stmts, Statements (Alt)); -- triggering-statements + Append_To (Stmts, Label); + Rewrite (N, Make_Block_Statement (Loc, Declarations => diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d15e20b81a7..64c12cc7ecf 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -22886,113 +22886,6 @@ package body Sem_Util is end if; end New_Copy_List_Tree; - ---------------------------- - -- New_Copy_Separate_List -- - ---------------------------- - - function New_Copy_Separate_List (List : List_Id) return List_Id is - begin - if List = No_List then - return No_List; - - else - declare - List_Copy : constant List_Id := New_List; - N : Node_Id := First (List); - - begin - while Present (N) loop - Append (New_Copy_Separate_Tree (N), List_Copy); - Next (N); - end loop; - - return List_Copy; - end; - end if; - end New_Copy_Separate_List; - - ---------------------------- - -- New_Copy_Separate_Tree -- - ---------------------------- - - function New_Copy_Separate_Tree (Source : Node_Id) return Node_Id is - function Search_Decl (N : Node_Id) return Traverse_Result; - -- Subtree visitor which collects declarations - - procedure Search_Declarations is new Traverse_Proc (Search_Decl); - -- Subtree visitor instantiation - - ----------------- - -- Search_Decl -- - ----------------- - - Decls : Elist_Id; - - function Search_Decl (N : Node_Id) return Traverse_Result is - begin - if Nkind (N) in N_Declaration then - Append_New_Elmt (N, Decls); - end if; - - return OK; - end Search_Decl; - - -- Local variables - - Source_Copy : constant Node_Id := New_Copy_Tree (Source); - - -- Start of processing for New_Copy_Separate_Tree - - begin - Decls := No_Elist; - Search_Declarations (Source_Copy); - - -- Associate a new Entity with all the subtree declarations (keeping - -- their original name). - - if Present (Decls) then - declare - Elmt : Elmt_Id; - Decl : Node_Id; - New_E : Entity_Id; - - begin - Elmt := First_Elmt (Decls); - while Present (Elmt) loop - Decl := Node (Elmt); - New_E := Make_Temporary (Sloc (Decl), 'P'); - - if Nkind (Decl) = N_Expression_Function then - Decl := Specification (Decl); - end if; - - if Nkind (Decl) in N_Function_Instantiation - | N_Function_Specification - | N_Generic_Function_Renaming_Declaration - | N_Generic_Package_Renaming_Declaration - | N_Generic_Procedure_Renaming_Declaration - | N_Package_Body - | N_Package_Instantiation - | N_Package_Renaming_Declaration - | N_Package_Specification - | N_Procedure_Instantiation - | N_Procedure_Specification - then - Set_Chars (New_E, Chars (Defining_Unit_Name (Decl))); - Set_Defining_Unit_Name (Decl, New_E); - else - Set_Chars (New_E, Chars (Defining_Identifier (Decl))); - Set_Defining_Identifier (Decl, New_E); - end if; - - Next_Elmt (Elmt); - end loop; - end; - end if; - - return Source_Copy; - end New_Copy_Separate_Tree; - ------------------- -- New_Copy_Tree -- ------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 6f5b20e5cf2..b5bcd267e33 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2623,16 +2623,6 @@ package Sem_Util is -- below. As for New_Copy_Tree, it is illegal to attempt to copy extended -- nodes (entities) either directly or indirectly using this function. - function New_Copy_Separate_List (List : List_Id) return List_Id; - -- Copy recursively a list of nodes using New_Copy_Separate_Tree - - function New_Copy_Separate_Tree (Source : Node_Id) return Node_Id; - -- Perform a deep copy of the subtree rooted at Source using New_Copy_Tree - -- replacing entities of local declarations by new entities. This behavior - -- is required by the backend to ensure entities uniqueness when a copy of - -- a subtree is attached to the tree. The new entities keep their original - -- names to facilitate debugging the tree copy. - function New_Copy_Tree (Source : Node_Id; Map : Elist_Id := No_Elist;