From patchwork Thu Jan 6 17:12:55 2022 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: 1576196 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=YN8XcUGH; dkim-atps=neutral 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 bilbo.ozlabs.org (Postfix) with ESMTPS id 4JVCnV2fLmz9sPC for ; Fri, 7 Jan 2022 04:21:34 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id ACC55385800A for ; Thu, 6 Jan 2022 17:21:31 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org ACC55385800A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1641489691; bh=ssxvWEXrrAVlJ/HE14HLu4hqQ08hb8nqFpzYI4flwwg=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=YN8XcUGH3QYAZAZJMCBnWRoali95JhHv12SEJKH9tQIEKAQ9ZFj/NaDZotCnQUWYe zxs8cmEmwNnZ5mEEJOoHDrqMXbLcoluBg0HUsweBHZQAAapgYYe/ttuDooy4QAURzR PFFrggBqgU+efqoaJy7jF19RUpTPvYSG46kUyu2E= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x332.google.com (mail-wm1-x332.google.com [IPv6:2a00:1450:4864:20::332]) by sourceware.org (Postfix) with ESMTPS id E4D643858037 for ; Thu, 6 Jan 2022 17:12:57 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org E4D643858037 Received: by mail-wm1-x332.google.com with SMTP id a83-20020a1c9856000000b00344731e044bso1562617wme.1 for ; Thu, 06 Jan 2022 09:12:57 -0800 (PST) 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=ssxvWEXrrAVlJ/HE14HLu4hqQ08hb8nqFpzYI4flwwg=; b=DJPClYhvVKjcuWJX9Xu8fwUPTA7g5BZ/cUBJFtEztK41bBf52haaUIDiMWF9+d8A4v iJI1WluG/Ptd5xszl7UEkAPmNJc+gq1Yxz1BCSps9OK08psDuDePuU2FNVxQLXKZmXx2 yUAGMGArB3Kceqg0bXETTACQoJGx3o9vEHdcPyW3fHGTPHhFQNIVJrdSrJdu8eg13+ag ilj3J41ykNuPFmCy18oQqzINSbMB5L/tU8FPsc+0lvUeUhdWhhZev5uETSQcunKjAdJU Va1dzcbgrfMnRFvldvl78deXAzICUyDftSjyVZwm+7VjrkHGoY18X+AwrHzbNTZ9GTD6 JJ8g== X-Gm-Message-State: AOAM532jCUhFI+qTRfh+utLucg3QUXypMeNN/TMScJvTH6wF4OOZ6ih3 aE2BoIYLe1Vg7X0IPpMBDs2E7b9EGPbj8w== X-Google-Smtp-Source: ABdhPJwFQDhdoNPNrH/ZxWDLaHxqDJ6acGXLxN9lfNHn7hrzzXJdA3KQYl1PE7AHmbDvWrQ4SJclng== X-Received: by 2002:a05:600c:3546:: with SMTP id i6mr8056016wmq.88.1641489176898; Thu, 06 Jan 2022 09:12:56 -0800 (PST) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id k9sm2738259wro.80.2022.01.06.09.12.56 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 06 Jan 2022 09:12:56 -0800 (PST) Date: Thu, 6 Jan 2022 17:12:55 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Rename Any_Access into Universal_Access Message-ID: <20220106171255.GA2921486@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.7 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 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: Eric Botcazou Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" The front-end defines an Any_Access entity which is only used as the type of the literal null. Now, since AI95-0230, the RM 4.2(8/2) clause reads: "An integer literal is of type universal_integer. A real literal is of type universal_real. The literal null is of type universal_access." and e.g. Find_Non_Universal_Interpretations deals with Any_Access as if it was an universal type, so it is more consistent to rename it into Universal_Access. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * stand.ads (Any_Access): Delete. (Universal_Access): New entity. * einfo.ads: Remove obsolete reference to Any_Access. * gen_il-gen-gen_entities.adb: Likewise. * cstand.adb (Create_Standard): Do not create Any_Access and create Universal_Access as a full type instead. * errout.adb (Set_Msg_Insertion_Type_Reference): Do not deal with Any_Access and deal with Universal_Access instead. * sem_ch3.adb (Analyze_Object_Declaration): Replace Any_Access with Universal_Access. * sem_ch4.adb (Analyze_Null): Likewise. (Find_Non_Universal_Interpretations): Likewise. (Find_Equality_Types.Try_One_Interp): Likewise and avoid shadowing by renaming a local variable of the same name. * sem_res.adb (Make_Call_Into_Operato): Likewise. (Resolve_Equality_Op): Likewise. * sem_type.adb (Covers): Likewise. (Specific_Type): Likewise. diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -1191,15 +1191,6 @@ package body CStand is pragma Assert (not Known_Esize (Any_Id)); pragma Assert (not Known_Alignment (Any_Id)); - Any_Access := New_Standard_Entity ("an access type"); - Mutate_Ekind (Any_Access, E_Access_Type); - Set_Scope (Any_Access, Standard_Standard); - Set_Etype (Any_Access, Any_Access); - Init_Size (Any_Access, System_Address_Size); - Set_Elem_Alignment (Any_Access); - Set_Directly_Designated_Type - (Any_Access, Any_Type); - Any_Character := New_Standard_Entity ("a character type"); Mutate_Ekind (Any_Character, E_Enumeration_Type); Set_Scope (Any_Character, Standard_Standard); @@ -1416,6 +1407,16 @@ package body CStand is Set_Size_Known_At_Compile_Time (Universal_Fixed); + Universal_Access := New_Standard_Entity ("universal_access"); + Decl := New_Node (N_Full_Type_Declaration, Stloc); + Set_Defining_Identifier (Decl, Universal_Access); + Mutate_Ekind (Universal_Access, E_Access_Type); + Set_Etype (Universal_Access, Universal_Access); + Set_Scope (Universal_Access, Standard_Standard); + Init_Size (Universal_Access, System_Address_Size); + Set_Elem_Alignment (Universal_Access); + Set_Directly_Designated_Type (Universal_Access, Any_Type); + -- Create type declaration for Duration, using a 64-bit size. The -- delta and size values depend on the mode set in system.ads. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4864,10 +4864,6 @@ package Einfo is -- associated with an access attribute. After resolution a specific access -- type will be established as determined by the context. --- Finally, the type Any_Access is used to label -null- during type --- resolution. Any_Access is also replaced by the context type after --- resolution. - -------------------------------------------------------- -- Description of Defined Attributes for Entity_Kinds -- -------------------------------------------------------- diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3622,8 +3622,7 @@ package body Errout is Set_Msg_Str ("exception name"); return; - elsif Error_Msg_Node_1 = Any_Access - or else Error_Msg_Node_1 = Any_Array + elsif Error_Msg_Node_1 = Any_Array or else Error_Msg_Node_1 = Any_Boolean or else Error_Msg_Node_1 = Any_Character or else Error_Msg_Node_1 = Any_Composite @@ -3640,17 +3639,21 @@ package body Errout is Set_Msg_Name_Buffer; return; - elsif Error_Msg_Node_1 = Universal_Real then - Set_Msg_Str ("type universal real"); - return; - elsif Error_Msg_Node_1 = Universal_Integer then Set_Msg_Str ("type universal integer"); return; + elsif Error_Msg_Node_1 = Universal_Real then + Set_Msg_Str ("type universal real"); + return; + elsif Error_Msg_Node_1 = Universal_Fixed then Set_Msg_Str ("type universal fixed"); return; + + elsif Error_Msg_Node_1 = Universal_Access then + Set_Msg_Str ("type universal access"); + return; end if; -- Special case of anonymous array diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -652,10 +652,7 @@ begin -- Gen_IL.Gen.Gen_Entities Cc (E_Access_Type, Access_Kind); -- An access type created by an access type declaration with no all - -- keyword present. Note that the predefined type Any_Access, which - -- has E_Access_Type Ekind, is used to label NULL in the upwards pass - -- of type analysis, to be replaced by the true access type in the - -- downwards resolution pass. + -- keyword present. Cc (E_Access_Subtype, Access_Kind); -- An access subtype created by a subtype declaration for any access diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4409,9 +4409,9 @@ package body Sem_Ch3 is -- If E is null and has been replaced by an N_Raise_Constraint_Error -- node (which was marked already-analyzed), we need to set the type - -- to something other than Any_Access in order to keep gigi happy. + -- to something else than Universal_Access to keep gigi happy. - if Etype (E) = Any_Access then + if Etype (E) = Universal_Access then Set_Etype (E, T); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -239,8 +239,7 @@ package body Sem_Ch4 is -- operand types. If one of the operands has a universal interpretation, -- the legality check uses some compatible non-universal interpretation of -- the other operand. N can be an operator node, or a function call whose - -- name is an operator designator. Any_Access, which is the initial type of - -- the literal NULL, is a universal type for the purpose of this routine. + -- name is an operator designator. function Find_Primitive_Operation (N : Node_Id) return Boolean; -- Find candidate interpretations for the name Obj.Proc when it appears in @@ -3273,7 +3272,7 @@ package body Sem_Ch4 is procedure Analyze_Null (N : Node_Id) is begin - Set_Etype (N, Any_Access); + Set_Etype (N, Universal_Access); end Analyze_Null; ---------------------- @@ -6678,14 +6677,9 @@ package body Sem_Ch4 is return; end if; - if T1 = Universal_Integer or else T1 = Universal_Real - - -- If the left operand of an equality operator is null, the visibility - -- of the operator must be determined from the interpretation of the - -- right operand. This processing must be done for Any_Access, which - -- is the internal representation of the type of the literal null. - - or else T1 = Any_Access + if T1 = Universal_Integer + or else T1 = Universal_Real + or else T1 = Universal_Access then if not Is_Overloaded (R) then Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (Etype (R))); @@ -6770,7 +6764,7 @@ package body Sem_Ch4 is -- operator. -- This is because the expected type for Obj'Access in a call to -- the Standard."=" operator whose formals are of type - -- Universal_Access is Universal_Integer, and Universal_Access + -- Universal_Access is Universal_Access, and Universal_Access -- doesn't have a designated type. For more detail see RM 6.4.1(3) -- and 3.10.2. -- This procedure assumes that the context is a universal_access. @@ -6992,7 +6986,7 @@ package body Sem_Ch4 is -------------------- procedure Try_One_Interp (T1 : Entity_Id) is - Universal_Access : Boolean; + Anonymous_Access : Boolean; Bas : Entity_Id; begin @@ -7013,7 +7007,7 @@ package body Sem_Ch4 is -- In Ada 2005, the equality operator for anonymous access types -- is declared in Standard, and preference rules apply to it. - Universal_Access := Is_Anonymous_Access_Type (T1) + Anonymous_Access := Is_Anonymous_Access_Type (T1) or else References_Anonymous_Access_Type (R, T1); if Present (Scop) then @@ -7028,7 +7022,7 @@ package body Sem_Ch4 is or else In_Instance or else T1 = Universal_Integer or else T1 = Universal_Real - or else T1 = Any_Access + or else T1 = Universal_Access or else T1 = Any_String or else T1 = Any_Composite or else (Ekind (T1) = E_Access_Subprogram_Type @@ -7036,7 +7030,7 @@ package body Sem_Ch4 is then null; - elsif Scop /= Standard_Standard or else not Universal_Access then + elsif Scop /= Standard_Standard or else not Anonymous_Access then -- The scope does not contain an operator for the type @@ -7057,7 +7051,7 @@ package body Sem_Ch4 is then null; - elsif not Universal_Access then + elsif not Anonymous_Access then -- Save candidate type for subsequent error message, if any if not Is_Limited_Type (T1) then @@ -7070,7 +7064,7 @@ package body Sem_Ch4 is -- Ada 2005 (AI-230): Keep restriction imposed by Ada 83 and 95: -- Do not allow anonymous access types in equality operators. - if Ada_Version < Ada_2005 and then Universal_Access then + if Ada_Version < Ada_2005 and then Anonymous_Access then return; end if; @@ -7091,7 +7085,7 @@ package body Sem_Ch4 is -- Finally, also check for RM 4.5.2 (9.6/2). if T1 /= Standard_Void_Type - and then (Universal_Access + and then (Anonymous_Access or else Has_Compatible_Type (R, T1, For_Comparison => True)) @@ -7109,7 +7103,7 @@ package body Sem_Ch4 is or else not Is_Tagged_Type (T1) or else Chars (Op_Id) = Name_Op_Eq) - and then (not Universal_Access + and then (not Anonymous_Access or else Check_Access_Object_Types (R, T1)) then if Found @@ -7124,14 +7118,14 @@ package body Sem_Ch4 is else T_F := It.Typ; - Is_Universal_Access := Universal_Access; + Is_Universal_Access := Anonymous_Access; end if; else Found := True; T_F := T1; I_F := Index; - Is_Universal_Access := Universal_Access; + Is_Universal_Access := Anonymous_Access; end if; if not Analyzed (L) then 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 @@ -1774,12 +1774,12 @@ package body Sem_Res is elsif Opnd_Type = Universal_Real then Orig_Type := Type_In_P (Is_Real_Type'Access); + elsif Opnd_Type = Universal_Access then + Orig_Type := Type_In_P (Is_Definite_Access_Type'Access); + elsif Opnd_Type = Any_String then Orig_Type := Type_In_P (Is_String_Type'Access); - elsif Opnd_Type = Any_Access then - Orig_Type := Type_In_P (Is_Definite_Access_Type'Access); - elsif Opnd_Type = Any_Composite then Orig_Type := Type_In_P (Is_Composite_Type'Access); @@ -8748,7 +8748,7 @@ package body Sem_Res is Set_Etype (N, Any_Type); return; - elsif T = Any_Access + elsif T = Universal_Access or else Ekind (T) in E_Allocator_Type | E_Access_Attribute_Type then T := Find_Unique_Access_Type; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -915,10 +915,10 @@ package body Sem_Type is elsif (T2 = Universal_Integer and then Is_Integer_Type (T1)) or else (T2 = Universal_Real and then Is_Real_Type (T1)) or else (T2 = Universal_Fixed and then Is_Fixed_Point_Type (T1)) + or else (T2 = Universal_Access and then Is_Access_Type (T1)) or else (T2 = Any_Fixed and then Is_Fixed_Point_Type (T1)) or else (T2 = Any_Character and then Is_Character_Type (T1)) or else (T2 = Any_String and then Is_String_Type (T1)) - or else (T2 = Any_Access and then Is_Access_Type (T1)) then return True; @@ -1215,7 +1215,7 @@ package body Sem_Type is and then Is_Access_Type (T2) and then Designated_Type (T1) = Designated_Type (T2)) or else - (T1 = Any_Access + (T1 = Universal_Access and then Is_Access_Type (Underlying_Type (T2))) or else (T2 = Any_Composite @@ -3388,12 +3388,12 @@ package body Sem_Type is elsif T1 = Any_Character and then Is_Character_Type (T2) then return B2; - elsif T1 = Any_Access + elsif T1 = Universal_Access and then (Is_Access_Type (T2) or else Is_Remote_Access (T2)) then return T2; - elsif T2 = Any_Access + elsif T2 = Universal_Access and then (Is_Access_Type (T1) or else Is_Remote_Access (T1)) then return T1; @@ -3401,7 +3401,7 @@ package body Sem_Type is -- In an instance, the specific type may have a private view. Use full -- view to check legality. - elsif T2 = Any_Access + elsif T2 = Universal_Access and then Is_Private_Type (T1) and then Present (Full_View (T1)) and then Is_Access_Type (Full_View (T1)) diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads --- a/gcc/ada/stand.ads +++ b/gcc/ada/stand.ads @@ -375,9 +375,6 @@ package Stand is -- them the type is still Any_Type, the node has no possible interpretation -- and an error can be emitted (and Any_Type will be propagated upwards). - Any_Access : Entity_Id; - -- Used to resolve the overloaded literal NULL - Any_Array : Entity_Id; -- Used to represent some unknown array type @@ -451,6 +448,9 @@ package Stand is -- universal integer and universal real, it is never used for runtime -- calculations). + Universal_Access : Entity_Id; + -- Entity for universal access type. It is only used for the literal null + Standard_Integer_8 : Entity_Id; Standard_Integer_16 : Entity_Id; Standard_Integer_32 : Entity_Id;