Patchwork [Ada] Frontend cleanup: removal of attribute Is_Overriding_Operation

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 26, 2010, 11:03 a.m.
Message ID <20101026110322.GA23832@adacore.com>
Download mbox | patch
Permalink /patch/69230/
State New
Headers show

Comments

Arnaud Charlet - Oct. 26, 2010, 11:03 a.m.
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  <miranda@adacore.com>

	* 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.

Patch

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