From patchwork Wed Oct 20 19:27:49 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 46457 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 7A9F33857C67 for ; Wed, 20 Oct 2021 19:38:48 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7A9F33857C67 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1634758728; bh=fXnDvhWuRr3zUJQCKOO3kDeYkXqJw57nza5UXNWs0dk=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=I5INDv4kRUSDaIYFwlmfS/dNEQ6d7z+JqIewtcb2wrO3mCUTlhgR5g1YCNR2RDX5Y vfPF3U1O6UaPwJZXMB4GGG7H0eNRwDHRcYjglfFVhuRPyRRI2hWD6U7mi8pd8XzHCj 0R055Fdbi1fkPEESXTPOwTMbkJtUL6jm545x1R84= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org 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 To: gcc-patches@gcc.gnu.org Subject: [Ada] Missing accessibility check when returning discriminated types Message-ID: <20211020192749.GA3154257@adacore.com> MIME-Version: 1.0 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-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Justin Squirek Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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. 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));