===================================================================
@@ -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)
===================================================================
@@ -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
===================================================================
@@ -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.
===================================================================
@@ -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));
===================================================================
@@ -2484,10 +2484,6 @@ package Einfo is
-- Applies to all entities, true for ordinary fixed point types and
-- subtypes.
-
-- 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);
===================================================================
@@ -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
===================================================================
@@ -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;
===================================================================
@@ -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);
===================================================================
@@ -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;
===================================================================
@@ -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;
===================================================================
@@ -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