From patchwork Wed Jun 16 08:43:56 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: 1492830 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4G4fD80C88z9sXL for ; Wed, 16 Jun 2021 18:55:52 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C6C0C399C015 for ; Wed, 16 Jun 2021 08:55:49 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTPS id 076A13989007 for ; Wed, 16 Jun 2021 08:44:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 076A13989007 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 373C056162; Wed, 16 Jun 2021 04:43:56 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id yCNYztodwXQA; Wed, 16 Jun 2021 04:43:56 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 11B145615E; Wed, 16 Jun 2021 04:43:56 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 0EC03180; Wed, 16 Jun 2021 04:43:56 -0400 (EDT) Date: Wed, 16 Jun 2021 04:43:56 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix detection of volatile expressions in restricted contexts Message-ID: <20210616084356.GA96024@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP, T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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: , Cc: Piotr Trojanek Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" Detection of volatile expressions, i.e. references to volatile objects and allocators, is done in two steps: first when analysing entity names and allocators themselves (except when they occur within actual parameters of subprogram calls) and then after the subprogram call has been resolved (so that we know if such volatile expressions are allowed by the type of the corresponding formal parameter). However, conditions used in each of these steps were duplicated and thus inconsistent. This is fixed by this patch, so now all the conditions are in just one place (i.e. in Is_OK_Volatile_Context whose new parameter Check_Actuals to examine expressions within subprogram call parameters). Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_res.adb (Flag_Effectively_Volatile_Objects): Detect also allocators within restricted contexts and not just entity names. (Resolve_Actuals): Remove duplicated code for detecting restricted contexts; it is now exclusively done in Is_OK_Volatile_Context. (Resolve_Entity_Name): Adapt to new parameter of Is_OK_Volatile_Context. * sem_util.ads, sem_util.adb (Is_OK_Volatile_Context): Adapt to handle contexts both inside and outside of subprogram call actual parameters. (Within_Subprogram_Call): Remove; now handled by Is_OK_Volatile_Context itself and its parameter. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3755,19 +3755,18 @@ package body Sem_Res is begin case Nkind (N) is - - -- Do not consider object name appearing in the prefix of - -- attribute Address as a read. - - when N_Attribute_Reference => - - -- Prefix of attribute Address denotes an object, program - -- unit, or label; none of them needs to be flagged here. - - if Attribute_Name (N) = Name_Address then - return Skip; + when N_Allocator => + if not Is_OK_Volatile_Context (Context => Parent (N), + Obj_Ref => N, + Check_Actuals => True) + then + Error_Msg_N + ("allocator cannot appear in this context" + & " (SPARK RM 7.1.3(10))", N); end if; + return Skip; + -- Do not consider nested function calls because they have -- already been processed during their own resolution. @@ -3780,6 +3779,10 @@ package body Sem_Res is if Present (Id) and then Is_Object (Id) and then Is_Effectively_Volatile_For_Reading (Id) + and then + not Is_OK_Volatile_Context (Context => Parent (N), + Obj_Ref => N, + Check_Actuals => True) then Error_Msg_N ("volatile object cannot appear in this context" @@ -3789,10 +3792,8 @@ package body Sem_Res is return Skip; when others => - null; + return OK; end case; - - return OK; end Flag_Object; procedure Flag_Objects is new Traverse_Proc (Flag_Object); @@ -4962,40 +4963,14 @@ package body Sem_Res is if SPARK_Mode = On and then Comes_From_Source (A) then - -- An effectively volatile object for reading may act as an - -- actual when the corresponding formal is of a non-scalar - -- effectively volatile type for reading (SPARK RM 7.1.3(10)). + -- Inspect the expression and flag each effectively volatile + -- object for reading as illegal because it appears within + -- an interfering context. Note that this is usually done + -- in Resolve_Entity_Name, but when the effectively volatile + -- object for reading appears as an actual in a call, the call + -- must be resolved first. - if not Is_Scalar_Type (F_Typ) - and then Is_Effectively_Volatile_For_Reading (F_Typ) - then - null; - - -- An effectively volatile object for reading may act as an - -- actual in a call to an instance of Unchecked_Conversion. - -- (SPARK RM 7.1.3(10)). - - elsif Is_Unchecked_Conversion_Instance (Nam) then - null; - - -- The actual denotes an object - - elsif Is_Effectively_Volatile_Object_For_Reading (A) then - Error_Msg_N - ("volatile object cannot act as actual in a call (SPARK " - & "RM 7.1.3(10))", A); - - -- Otherwise the actual denotes an expression. Inspect the - -- expression and flag each effectively volatile object - -- for reading as illegal because it apprears within an - -- interfering context. Note that this is usually done in - -- Resolve_Entity_Name, but when the effectively volatile - -- object for reading appears as an actual in a call, the - -- call must be resolved first. - - else - Flag_Effectively_Volatile_Objects (A); - end if; + Flag_Effectively_Volatile_Objects (A); -- An effectively volatile variable cannot act as an actual -- parameter in a procedure call when the variable has enabled @@ -7890,7 +7865,8 @@ package body Sem_Res is if Is_Object (E) and then Is_Effectively_Volatile_For_Reading (E) - and then not Is_OK_Volatile_Context (Par, N) + and then + not Is_OK_Volatile_Context (Par, N, Check_Actuals => False) then SPARK_Msg_N ("volatile object cannot appear in this context " 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 @@ -18794,8 +18794,9 @@ package body Sem_Util is ---------------------------- function Is_OK_Volatile_Context - (Context : Node_Id; - Obj_Ref : Node_Id) return Boolean + (Context : Node_Id; + Obj_Ref : Node_Id; + Check_Actuals : Boolean) return Boolean is function Is_Protected_Operation_Call (Nod : Node_Id) return Boolean; -- Determine whether an arbitrary node denotes a call to a protected @@ -18878,6 +18879,12 @@ package body Sem_Util is Func_Id := Id; while Present (Func_Id) and then Func_Id /= Standard_Standard loop if Ekind (Func_Id) in E_Function | E_Generic_Function then + + -- ??? This routine could just use Return_Applies_To, but it + -- is currently wrongly called by unanalyzed return statements + -- coming from expression functions. + pragma Assert (Func_Id = Return_Applies_To (Id)); + return Is_Volatile_Function (Func_Id); end if; @@ -18894,9 +18901,17 @@ package body Sem_Util is -- Start of processing for Is_OK_Volatile_Context begin + -- For actual parameters within explicit parameter associations switch + -- the context to the corresponding subprogram call. + + if Nkind (Context) = N_Parameter_Association then + return Is_OK_Volatile_Context (Context => Parent (Context), + Obj_Ref => Obj_Ref, + Check_Actuals => Check_Actuals); + -- The volatile object appears on either side of an assignment - if Nkind (Context) = N_Assignment_Statement then + elsif Nkind (Context) = N_Assignment_Statement then return True; -- The volatile object is part of the initialization expression of @@ -18914,7 +18929,7 @@ package body Sem_Util is -- function is volatile. if Is_Return_Object (Obj_Id) then - return Within_Volatile_Function (Obj_Id); + return Within_Volatile_Function (Scope (Obj_Id)); -- Otherwise this is a normal object initialization @@ -18965,8 +18980,9 @@ package body Sem_Util is N_Slice and then Prefix (Context) = Obj_Ref and then Is_OK_Volatile_Context - (Context => Parent (Context), - Obj_Ref => Context) + (Context => Parent (Context), + Obj_Ref => Context, + Check_Actuals => Check_Actuals) then return True; @@ -18998,8 +19014,9 @@ package body Sem_Util is | N_Unchecked_Type_Conversion and then Expression (Context) = Obj_Ref and then Is_OK_Volatile_Context - (Context => Parent (Context), - Obj_Ref => Context) + (Context => Parent (Context), + Obj_Ref => Context, + Check_Actuals => Check_Actuals) then return True; @@ -19014,17 +19031,43 @@ package body Sem_Util is elsif Within_Check (Context) then return True; - -- Assume that references to effectively volatile objects that appear - -- as actual parameters in a subprogram call are always legal. A full - -- legality check is done when the actuals are resolved (see routine - -- Resolve_Actuals). + -- References to effectively volatile objects that appear as actual + -- parameters in subprogram calls can be examined only after call itself + -- has been resolved. Before that, assume such references to be legal. - elsif Within_Subprogram_Call (Context) then - return True; + elsif Nkind (Context) in N_Subprogram_Call | N_Entry_Call_Statement then + if Check_Actuals then + declare + Call : Node_Id; + Formal : Entity_Id; + Subp : constant Entity_Id := Get_Called_Entity (Context); + begin + Find_Actual (Obj_Ref, Formal, Call); + pragma Assert (Call = Context); + + -- An effectively volatile object may act as an actual when the + -- corresponding formal is of a non-scalar effectively volatile + -- type (SPARK RM 7.1.3(10)). + + if not Is_Scalar_Type (Etype (Formal)) + and then Is_Effectively_Volatile_For_Reading (Etype (Formal)) + then + return True; + + -- An effectively volatile object may act as an actual in a + -- call to an instance of Unchecked_Conversion. (SPARK RM + -- 7.1.3(10)). - -- Otherwise the context is not suitable for an effectively volatile - -- object. + elsif Is_Unchecked_Conversion_Instance (Subp) then + return True; + else + return False; + end if; + end; + else + return True; + end if; else return False; end if; @@ -29538,36 +29581,6 @@ package body Sem_Util is return Scope_Within_Or_Same (Scope (E), S); end Within_Scope; - ---------------------------- - -- Within_Subprogram_Call -- - ---------------------------- - - function Within_Subprogram_Call (N : Node_Id) return Boolean is - Par : Node_Id; - - begin - -- Climb the parent chain looking for a function or procedure call - - Par := N; - while Present (Par) loop - if Nkind (Par) in N_Entry_Call_Statement - | N_Function_Call - | N_Procedure_Call_Statement - then - return True; - - -- Prevent the search from going too far - - elsif Is_Body_Or_Package_Declaration (Par) then - exit; - end if; - - Par := Parent (Par); - end loop; - - return False; - end Within_Subprogram_Call; - ---------------- -- Wrong_Type -- ---------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2117,11 +2117,16 @@ package Sem_Util is -- conversions and hence variables. function Is_OK_Volatile_Context - (Context : Node_Id; - Obj_Ref : Node_Id) return Boolean; + (Context : Node_Id; + Obj_Ref : Node_Id; + Check_Actuals : Boolean) return Boolean; -- Determine whether node Context denotes a "non-interfering context" (as -- defined in SPARK RM 7.1.3(10)) where volatile reference Obj_Ref can - -- safely reside. + -- safely reside. When examining references that might be located within + -- actual parameters of a subprogram call that has not been resolved yet, + -- Check_Actuals should be False; such references will be assumed to be + -- legal. They will need to be checked again after subprogram call has + -- been resolved. function Is_Package_Contract_Annotation (Item : Node_Id) return Boolean; -- Determine whether aspect specification or pragma Item is one of the @@ -3285,10 +3290,6 @@ package Sem_Util is function Within_Scope (E : Entity_Id; S : Entity_Id) return Boolean; -- Returns True if entity E is declared within scope S - function Within_Subprogram_Call (N : Node_Id) return Boolean; - -- Determine whether arbitrary node N appears in an entry, function, or - -- procedure call. - procedure Wrong_Type (Expr : Node_Id; Expected_Type : Entity_Id); -- Output error message for incorrectly typed expression. Expr is the node -- for the incorrectly typed construct (Etype (Expr) is the type found),