From patchwork Tue Oct 26 11:03:22 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 69230 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id DDC70B70D2 for ; Tue, 26 Oct 2010 22:03:46 +1100 (EST) Received: (qmail 1692 invoked by alias); 26 Oct 2010 11:03:40 -0000 Received: (qmail 1306 invoked by uid 22791); 26 Oct 2010 11:03:36 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 26 Oct 2010 11:03:25 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B732ECB02F3; Tue, 26 Oct 2010 13:03:22 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 5wRjmGXkxCyP; Tue, 26 Oct 2010 13:03:22 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 9E923CB025F; Tue, 26 Oct 2010 13:03:22 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 7DDE0D9BB4; Tue, 26 Oct 2010 13:03:22 +0200 (CEST) Date: Tue, 26 Oct 2010 13:03:22 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [Ada] Frontend cleanup: removal of attribute Is_Overriding_Operation Message-ID: <20101026110322.GA23832@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Abstract Syntax Tree entities have two fields associated with overriding of type primitives: the flag Is_Overriding_Operation and the field Overridden_Operation. This patch removes the flag Is_Overriding_Operation and replaces all its occurrences by tests on the presence of attribute Overridden_Operation. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-26 Javier Miranda * einfo.ads, einfo.adb (Is_Overriding_Operation): Removed. (Set_Is_Overriding_Operation): Removed. * sem_ch3.adb (Check_Abstract_Overriding): Remove redundant call to Is_Overriding_Operation. * exp_ch7.adb (Check_Visibly_Controlled): Remove redundant call to Is_Overriding_Operation. * sem_ch7.adb (Declare_Inherited_Private_Subprograms): Remove redundant call to Set_Is_Overriding_Operation. * sem_util.adb (Collect_Primitive_Operations): Replace test on Is_Overriding_Operation by test on the presence of attribute Overridden_Operation. (Original_Corresponding_Operation): Remove redundant call to attribute Is_Overriding_Operation. * sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Remove redundant call to Is_Overriding_Operation. (Verify_Overriding_Indicator): Replace several occurrences of test on Is_Overriding_Operation by test on the presence of attribute Overridden_Operation. (Check_Convention): Replace test on Is_Overriding_Operation by test on the presence of Overridden_Operation. (Check_Overriding_Indicator): Add missing decoration of attribute Overridden_Operation. Minor code cleanup. (New_Overloaded_Entity): Replace occurrence of test on Is_Overriding_Operation by test on the presence of attribute Overridden_Operation. Remove redundant setting of attribute Is_Overriding_Operation plus minor code reorganization. Add missing decoration of attribute Overridden_Operation. * sem_elim.adb (Set_Eliminated): Replace test on Is_Overriding_Operation by test on the presence of Overridden_Operation. * sem_ch8.adb (Analyze_Subprogram_Renaming): Replace test on Is_Overriding_Operation by test on the presence of Overridden_Operation. Remove a redundant test on attribute Is_Overriding_Operation. * lib-xref.adb (Generate_Reference): Replace test on Is_Overriding_Operation by test on the presence of Overridden_Operation. (Output_References): Replace test on Is_Overriding_Operation by test on the presence of Overridden_Operation. * sem_disp.adb (Override_Dispatching_Operation): Replace test on Is_Overriding_Operation by test on the presence of Overridden_Operation. Add missing decoration of attribute Overridden_Operation. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 165939) +++ sem_ch3.adb (working copy) @@ -8895,7 +8895,6 @@ package body Sem_Ch3 is -- primitive marked with pragma Implemented. if Ada_Version >= Ada_2012 - and then Is_Overriding_Operation (Subp) and then Present (Overridden_Operation (Subp)) and then Has_Rep_Pragma (Overridden_Operation (Subp), Name_Implemented) Index: exp_ch7.adb =================================================================== --- exp_ch7.adb (revision 165935) +++ exp_ch7.adb (working copy) @@ -832,7 +832,7 @@ package body Exp_Ch7 is begin if Is_Derived_Type (Typ) and then Comes_From_Source (E) - and then not Is_Overriding_Operation (E) + and then not Present (Overridden_Operation (E)) then -- We know that the explicit operation on the type does not override -- the inherited operation of the parent, and that the derivation Index: sem_ch7.adb =================================================================== --- sem_ch7.adb (revision 165935) +++ sem_ch7.adb (working copy) @@ -1537,7 +1537,6 @@ package body Sem_Ch7 is New_Op := Node (Op_Elmt_2); Replace_Elmt (Op_Elmt, New_Op); Remove_Elmt (Op_List, Op_Elmt_2); - Set_Is_Overriding_Operation (New_Op); Set_Overridden_Operation (New_Op, Parent_Subp); -- We don't need to inherit its dispatching slot. Index: einfo.adb =================================================================== --- einfo.adb (revision 165944) +++ einfo.adb (working copy) @@ -283,7 +283,6 @@ package body Einfo is -- Referenced_As_LHS Flag36 -- Is_Known_Non_Null Flag37 -- Can_Never_Be_Null Flag38 - -- Is_Overriding_Operation Flag39 -- Body_Needed_For_SAL Flag40 -- Treat_As_Volatile Flag41 @@ -515,6 +514,7 @@ package body Einfo is -- Has_Inheritable_Invariants Flag248 -- Has_Predicates Flag250 + -- (unused) Flag39 -- (unused) Flag151 -- (unused) Flag249 -- (unused) Flag251 @@ -1938,12 +1938,6 @@ package body Einfo is return Flag134 (Id); end Is_Optional_Parameter; - function Is_Overriding_Operation (Id : E) return B is - begin - pragma Assert (Is_Subprogram (Id)); - return Flag39 (Id); - end Is_Overriding_Operation; - function Is_Package_Body_Entity (Id : E) return B is begin return Flag160 (Id); @@ -4418,12 +4412,6 @@ package body Einfo is Set_Flag134 (Id, V); end Set_Is_Optional_Parameter; - procedure Set_Is_Overriding_Operation (Id : E; V : B := True) is - begin - pragma Assert (Is_Subprogram (Id)); - Set_Flag39 (Id, V); - end Set_Is_Overriding_Operation; - procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is begin Set_Flag160 (Id, V); @@ -7454,7 +7442,6 @@ package body Einfo is W ("Is_Obsolescent", Flag153 (Id)); W ("Is_Only_Out_Parameter", Flag226 (Id)); W ("Is_Optional_Parameter", Flag134 (Id)); - W ("Is_Overriding_Operation", Flag39 (Id)); W ("Is_Package_Body_Entity", Flag160 (Id)); W ("Is_Packed", Flag51 (Id)); W ("Is_Packed_Array_Type", Flag138 (Id)); Index: einfo.ads =================================================================== --- einfo.ads (revision 165944) +++ einfo.ads (working copy) @@ -2484,10 +2484,6 @@ package Einfo is -- Applies to all entities, true for ordinary fixed point types and -- subtypes. --- Is_Overriding_Operation (Flag39) --- Present in subprograms. Set if the subprogram is a primitive --- operation of a derived type, that overrides an inherited operation. - -- Is_Package_Or_Generic_Package (synthesized) -- Applies to all entities. True for packages and generic packages. -- False for all other entities. @@ -5167,7 +5163,6 @@ package Einfo is -- Is_Instantiated (Flag126) (generic case only) -- Is_Intrinsic_Subprogram (Flag64) -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only) - -- Is_Overriding_Operation (Flag39) (non-generic case only) -- Is_Primitive (Flag218) -- Is_Primitive_Wrapper (Flag195) (non-generic case only) -- Is_Private_Descendant (Flag53) @@ -5287,13 +5282,13 @@ package Einfo is -- First_Entity (Node17) -- Alias (Node18) -- Last_Entity (Node20) + -- Overridden_Operation (Node26) -- Subprograms_For_Type (Node29) -- Has_Invariants (Flag232) -- Has_Postconditions (Flag240) -- Is_Machine_Code_Subprogram (Flag137) -- Is_Pure (Flag44) -- Is_Intrinsic_Subprogram (Flag64) - -- Is_Overriding_Operation (Flag39) -- Is_Primitive (Flag218) -- Is_Thunk (Flag225) -- Default_Expressions_Processed (Flag108) @@ -5432,7 +5427,6 @@ package Einfo is -- Is_Intrinsic_Subprogram (Flag64) -- Is_Machine_Code_Subprogram (Flag137) (non-generic case only) -- Is_Null_Init_Proc (Flag178) - -- Is_Overriding_Operation (Flag39) (non-generic case only) -- Is_Primitive (Flag218) -- Is_Primitive_Wrapper (Flag195) (non-generic case only) -- Is_Private_Descendant (Flag53) @@ -6314,7 +6308,6 @@ package Einfo is function Is_Object (Id : E) return B; function Is_Ordinary_Fixed_Point_Type (Id : E) return B; function Is_Overloadable (Id : E) return B; - function Is_Overriding_Operation (Id : E) return B; function Is_Private_Type (Id : E) return B; function Is_Protected_Type (Id : E) return B; function Is_Real_Type (Id : E) return B; @@ -6705,7 +6698,6 @@ package Einfo is procedure Set_Is_Obsolescent (Id : E; V : B := True); procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True); procedure Set_Is_Optional_Parameter (Id : E; V : B := True); - procedure Set_Is_Overriding_Operation (Id : E; V : B := True); procedure Set_Is_Package_Body_Entity (Id : E; V : B := True); procedure Set_Is_Packed (Id : E; V : B := True); procedure Set_Is_Packed_Array_Type (Id : E; V : B := True); @@ -7428,7 +7420,6 @@ package Einfo is pragma Inline (Is_Package_Body_Entity); pragma Inline (Is_Ordinary_Fixed_Point_Type); pragma Inline (Is_Overloadable); - pragma Inline (Is_Overriding_Operation); pragma Inline (Is_Packed); pragma Inline (Is_Packed_Array_Type); pragma Inline (Is_Potentially_Use_Visible); @@ -7832,7 +7823,6 @@ package Einfo is pragma Inline (Set_Is_Obsolescent); pragma Inline (Set_Is_Only_Out_Parameter); pragma Inline (Set_Is_Optional_Parameter); - pragma Inline (Set_Is_Overriding_Operation); pragma Inline (Set_Is_Package_Body_Entity); pragma Inline (Set_Is_Packed); pragma Inline (Set_Is_Packed_Array_Type); Index: sem_util.adb =================================================================== --- sem_util.adb (revision 165943) +++ sem_util.adb (working copy) @@ -1890,7 +1890,7 @@ package body Sem_Util is if Chars (Id) = Name_Op_Eq and then Is_Dispatching_Operation (Id) and then Present (Alias (Id)) - and then Is_Overriding_Operation (Alias (Id)) + and then Present (Overridden_Operation (Alias (Id))) and then Base_Type (Etype (First_Entity (Id))) = Base_Type (Etype (First_Entity (Alias (Id)))) then @@ -9957,9 +9957,7 @@ package body Sem_Util is -- If S overrides an inherted subprogram S2 the original corresponding -- operation of S is the original corresponding operation of S2 - elsif Is_Overriding_Operation (S) - and then Present (Overridden_Operation (S)) - then + elsif Present (Overridden_Operation (S)) then return Original_Corresponding_Operation (Overridden_Operation (S)); -- otherwise it is S itself Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 165943) +++ sem_ch6.adb (working copy) @@ -374,7 +374,7 @@ package body Sem_Ch6 is elsif Warn_On_Redundant_Constructs and then not Is_Dispatching_Operation (Designator) - and then not Is_Overriding_Operation (Designator) + and then not Present (Overridden_Operation (Designator)) and then (not Is_Operator_Symbol_Name (Chars (Designator)) or else Scop /= Scope (Etype (First_Formal (Designator)))) then @@ -1960,13 +1960,13 @@ package body Sem_Ch6 is then null; - elsif not Is_Overriding_Operation (Spec_Id) then + elsif not Present (Overridden_Operation (Spec_Id)) then Error_Msg_NE ("subprogram& is not overriding", Body_Spec, Spec_Id); end if; elsif Must_Not_Override (Body_Spec) then - if Is_Overriding_Operation (Spec_Id) then + if Present (Overridden_Operation (Spec_Id)) then Error_Msg_NE ("subprogram& overrides inherited operation", Body_Spec, Spec_Id); @@ -1991,7 +1991,7 @@ package body Sem_Ch6 is end if; elsif Style_Check -- ??? incorrect use of Style_Check! - and then Is_Overriding_Operation (Spec_Id) + and then Present (Overridden_Operation (Spec_Id)) then pragma Assert (Unit_Declaration_Node (Body_Id) = N); Style.Missing_Overriding (N, Body_Id); @@ -4196,7 +4196,7 @@ package body Sem_Ch6 is Error_Msg_Sloc := Sloc (Op); if Comes_From_Source (Op) or else No (Alias (Op)) then - if not Is_Overriding_Operation (Op) then + if not Present (Overridden_Operation (Op)) then Error_Msg_N ("\\primitive % defined #", Typ); else Error_Msg_N @@ -4672,7 +4672,7 @@ package body Sem_Ch6 is end if; elsif Is_Subprogram (Subp) then - Set_Is_Overriding_Operation (Subp); + Set_Overridden_Operation (Subp, Overridden_Subp); end if; -- If primitive flag is set or this is a protected operation, then @@ -4728,10 +4728,9 @@ package body Sem_Ch6 is end if; elsif Must_Override (Spec) then - if Is_Overriding_Operation (Subp) then - null; - - elsif not Can_Override then + if No (Overridden_Operation (Subp)) + and then not Can_Override + then Error_Msg_NE ("subprogram & is not overriding", Spec, Subp); end if; @@ -4742,8 +4741,6 @@ package body Sem_Ch6 is not Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Subp))) then - Set_Is_Overriding_Operation (Subp); - -- If style checks are enabled, indicate that the indicator is -- missing. However, at the point of declaration, the type of -- which this is a primitive operation may be private, in which @@ -7860,7 +7857,7 @@ package body Sem_Ch6 is if Ada_Version >= Ada_2012 and then No (Overridden_Subp) and then Is_Dispatching_Operation (S) - and then Is_Overriding_Operation (S) + and then Present (Overridden_Operation (S)) then Overridden_Subp := Overridden_Operation (S); end if; @@ -7982,22 +7979,18 @@ package body Sem_Ch6 is Check_Operation_From_Private_View (S, E); end if; - -- In any case the implicit operation remains hidden by - -- the existing declaration, which is overriding. + -- In any case the implicit operation remains hidden by the + -- existing declaration, which is overriding. Indicate that + -- E overrides the operation from which S is inherited. - Set_Is_Overriding_Operation (E); + if Present (Alias (S)) then + Set_Overridden_Operation (E, Alias (S)); + else + Set_Overridden_Operation (E, S); + end if; if Comes_From_Source (E) then Check_Overriding_Indicator (E, S, Is_Primitive => False); - - -- Indicate that E overrides the operation from which - -- S is inherited. - - if Present (Alias (S)) then - Set_Overridden_Operation (E, Alias (S)); - else - Set_Overridden_Operation (E, S); - end if; end if; return; @@ -8145,22 +8138,17 @@ package body Sem_Ch6 is if No (Next_Entity (Prev)) then Set_Last_Entity (Current_Scope, Prev); end if; - end if; end if; Enter_Overloaded_Entity (S); - Set_Is_Overriding_Operation (S); + Set_Overridden_Operation (S, E); Check_Overriding_Indicator (S, E, Is_Primitive => True); -- If S is a user-defined subprogram or a null procedure -- expanded to override an inherited null procedure, or a -- predefined dispatching primitive then indicate that E - -- overrides the operation from which S is inherited. It - -- seems odd that Overridden_Operation isn't set in all - -- cases where Is_Overriding_Operation is true, but doing - -- so causes infinite loops in the compiler for implicit - -- overriding subprograms. ??? + -- overrides the operation from which S is inherited. if Comes_From_Source (S) or else @@ -8176,8 +8164,6 @@ package body Sem_Ch6 is then if Present (Alias (E)) then Set_Overridden_Operation (S, Alias (E)); - else - Set_Overridden_Operation (S, E); end if; end if; Index: sem_elim.adb =================================================================== --- sem_elim.adb (revision 165935) +++ sem_elim.adb (working copy) @@ -267,7 +267,7 @@ package body Sem_Elim is -- If an overriding dispatching primitive is eliminated then -- its parent must have been eliminated. - if Is_Overriding_Operation (E) + if Present (Overridden_Operation (E)) and then not Is_Eliminated (Overridden_Operation (E)) then Error_Msg_Name_1 := Chars (E); Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 165944) +++ sem_ch8.adb (working copy) @@ -1968,7 +1968,7 @@ package body Sem_Ch8 is -- Ada 2005: check overriding indicator - if Is_Overriding_Operation (Rename_Spec) then + if Present (Overridden_Operation (Rename_Spec)) then if Must_Not_Override (Specification (N)) then Error_Msg_NE ("subprogram& overrides inherited operation", @@ -2110,7 +2110,7 @@ package body Sem_Ch8 is and then No (DTC_Entity (Old_S)) and then Present (Alias (Old_S)) and then not Is_Abstract_Subprogram (Alias (Old_S)) - and then Is_Overriding_Operation (Alias (Old_S)) + and then Present (Overridden_Operation (Alias (Old_S))) then Old_S := Alias (Old_S); end if; Index: lib-xref.adb =================================================================== --- lib-xref.adb (revision 165935) +++ lib-xref.adb (working copy) @@ -847,7 +847,7 @@ package body Lib.Xref is if Typ = 'p' and then Is_Subprogram (N) - and then Is_Overriding_Operation (N) + and then Present (Overridden_Operation (N)) then Xrefs.Table (Indx).Typ := 'P'; else @@ -2183,7 +2183,7 @@ package body Lib.Xref is -- on operation that was overridden. if Is_Subprogram (XE.Ent) - and then Is_Overriding_Operation (XE.Ent) + and then Present (Overridden_Operation (XE.Ent)) then Output_Overridden_Op (Overridden_Operation (XE.Ent)); end if; Index: sem_disp.adb =================================================================== --- sem_disp.adb (revision 165935) +++ sem_disp.adb (working copy) @@ -889,7 +889,7 @@ package body Sem_Disp is -- New_Stream_Subprogram) if Present (Old_Subp) - and then Is_Overriding_Operation (Subp) + and then Present (Overridden_Operation (Subp)) and then Is_Dispatching_Operation (Old_Subp) then pragma Assert @@ -1117,7 +1117,7 @@ package body Sem_Disp is and then Is_Controlled (Tagged_Type) and then not Is_Visibly_Controlled (Tagged_Type) then - Set_Is_Overriding_Operation (Subp, False); + Set_Overridden_Operation (Subp, Empty); -- If the subprogram specification carries an overriding -- indicator, no need for the warning: it is either redundant, @@ -1139,7 +1139,6 @@ package body Sem_Disp is else Override_Dispatching_Operation (Tagged_Type, Ovr_Subp, Subp); - Set_Is_Overriding_Operation (Subp); -- Ada 2005 (AI-251): In case of late overriding of a primitive -- that covers abstract interface subprograms we must register it