From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-lf1-x129.google.com (mail-lf1-x129.google.com [IPv6:2a00:1450:4864:20::129]) by sourceware.org (Postfix) with ESMTPS id 5F0A93857C65 for ; Wed, 20 Oct 2021 19:27:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 5F0A93857C65 Received: by mail-lf1-x129.google.com with SMTP id t9so84395lfd.1 for ; Wed, 20 Oct 2021 12:27:52 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=fXnDvhWuRr3zUJQCKOO3kDeYkXqJw57nza5UXNWs0dk=; b=0OoPRA/dt187oghBQEhR1vqg0p7EeEJDqvvBRTR5tgd5O+fsKHcB/f4B2P0ucLqk/y cxdFDK08f3x5KHbm9MypW1V4xJ0mXtw3/iOZZncMtF5AfRN8QAK85hi1tyE2pvHi/vGA jYt5BXR8DbPcm5NwQEM+1pXsZQkznxN4cFhdIWBlph/rat1kaul9H0WszSNG378N7cOl bh+A8QLFb/96cpvZON7KrHsMKo8nsaywP4fjMJaVX/B8k2gLYzZ7FwVqONAW04G2RZlx MoG6n+Itx8VkwOji6VFEGNtZNLxzQhj3v0otMoSQ3WnSt115GvN8nJMdKoZOmgVV8JDA x+9g== X-Gm-Message-State: AOAM531DLxQftNOWqjSIos9s0v57FnXs22v4/64N4hglnb8lLJ86Ub4o 0VUpPI1WvMoqLIz3y3UcYOGTXajdd8NpJw== X-Google-Smtp-Source: ABdhPJwHJlLiZFnJkEaTh2rzUfFuceAkpgyxigZDSNh6ENdDnFNL+RZ3TMzNkyYq/kj4FFWFi0qBCw== X-Received: by 2002:a05:6512:39cb:: with SMTP id k11mr1145055lfu.285.1634758071241; Wed, 20 Oct 2021 12:27:51 -0700 (PDT) Received: from adacore.com ([2a02:2ab8:224:2ce:72b5:e8ff:feef:ee60]) by smtp.gmail.com with ESMTPSA id x2sm259852lfr.307.2021.10.20.12.27.50 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 20 Oct 2021 12:27:50 -0700 (PDT) Date: Wed, 20 Oct 2021 19:27:49 +0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [Ada] Missing accessibility check when returning discriminated types Message-ID: <20211020192749.GA3154257@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="2fHTh5uZTiUOsy+g" Content-Disposition: inline X-Spam-Status: No, score=-13.0 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 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: 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-List-Received-Date: Wed, 20 Oct 2021 19:27:53 -0000 --2fHTh5uZTiUOsy+g Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In some cases where a function result type has an access discriminant part, Ada requires that the execution of a return statement include a check that the access discriminant does not designate an object whose accessibility level is too deep (Ada RM 6.5(21)). This check was being incorrectly omitted in some cases where the discriminant value designates a not-explicitly-aliased parameter of the function (or some part thereof). Correct this omission. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_ch6.adb (Check_Return_Construct_Accessibility): Modify generation of accessibility checks to be more consolidated and get triggered properly in required cases. * sem_util.adb (Accessibility_Level): Add extra check within condition to handle aliased formals properly in more cases. --2fHTh5uZTiUOsy+g Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -807,6 +807,7 @@ package body Sem_Ch6 is Assoc_Expr : Node_Id; Assoc_Present : Boolean := False; + Check_Cond : Node_Id; Unseen_Disc_Count : Nat := 0; Seen_Discs : Elist_Id; Disc : Entity_Id; @@ -1180,36 +1181,39 @@ package body Sem_Ch6 is and then Present (Disc) and then Ekind (Etype (Disc)) = E_Anonymous_Access_Type then - -- Perform a static check first, if possible + -- Generate a dynamic check based on the extra accessibility of + -- the result or the scope. + + Check_Cond := + Make_Op_Gt (Loc, + Left_Opnd => Accessibility_Level + (Expr => Assoc_Expr, + Level => Dynamic_Level, + In_Return_Context => True), + Right_Opnd => (if Present + (Extra_Accessibility_Of_Result + (Scope_Id)) + then + Extra_Accessibility_Of_Result (Scope_Id) + else + Make_Integer_Literal + (Loc, Scope_Depth (Scope (Scope_Id))))); + + Insert_Before_And_Analyze (Return_Stmt, + Make_Raise_Program_Error (Loc, + Condition => Check_Cond, + Reason => PE_Accessibility_Check_Failed)); + + -- If constant folding has happened on the condition for the + -- generated error, then warn about it being unconditional when + -- we know an error will be raised. - if Static_Accessibility_Level - (Expr => Assoc_Expr, - Level => Zero_On_Dynamic_Level, - In_Return_Context => True) - > Scope_Depth (Scope (Scope_Id)) + if Nkind (Check_Cond) = N_Identifier + and then Entity (Check_Cond) = Standard_True then Error_Msg_N ("access discriminant in return object would be a dangling" & " reference", Return_Stmt); - - exit; - end if; - - -- Otherwise, generate a dynamic check based on the extra - -- accessibility of the result. - - if Present (Extra_Accessibility_Of_Result (Scope_Id)) then - Insert_Before_And_Analyze (Return_Stmt, - Make_Raise_Program_Error (Loc, - Condition => - Make_Op_Gt (Loc, - Left_Opnd => Accessibility_Level - (Expr => Assoc_Expr, - Level => Dynamic_Level, - In_Return_Context => True), - Right_Opnd => Extra_Accessibility_Of_Result - (Scope_Id)), - Reason => PE_Accessibility_Check_Failed)); end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -628,9 +628,9 @@ package body Sem_Util is -- caller. if Is_Explicitly_Aliased (E) - and then Level /= Dynamic_Level - and then (In_Return_Value (Expr) - or else In_Return_Context) + and then (In_Return_Context + or else (Level /= Dynamic_Level + and then In_Return_Value (Expr))) then return Make_Level_Literal (Scope_Depth (Standard_Standard)); --2fHTh5uZTiUOsy+g--