if Nkind (Call_Node) in N_Subprogram_Call
and then Present (Controlling_Argument (Call_Node))
then
+ if Tagged_Type_Expansion then
+ Expand_Dispatching_Call (Call_Node);
+
+ -- Expand_Dispatching_Call takes care of all the needed processing
+
+ return;
+ end if;
+
+ -- VM targets
+
declare
Call_Typ : constant Entity_Id := Etype (Call_Node);
Typ : constant Entity_Id := Find_Dispatching_Type (Subp);
Prev_Call : Node_Id;
begin
+ Apply_Tag_Checks (Call_Node);
+
if not Is_Limited_Type (Typ) then
Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
end if;
- if Tagged_Type_Expansion then
- Expand_Dispatching_Call (Call_Node);
-
- -- The following return is worrisome. Is it really OK to skip
- -- all remaining processing in this procedure ???
-
- return;
-
- -- VM targets
-
- else
- Apply_Tag_Checks (Call_Node);
-
- -- If this is a dispatching "=", we must first compare the
- -- tags so we generate: x.tag = y.tag and then x = y
-
- if Subp = Eq_Prim_Op then
+ -- If this is a dispatching "=", we must first compare the
+ -- tags so we generate: x.tag = y.tag and then x = y
- -- Mark the node as analyzed to avoid reanalyzing this
- -- dispatching call (which would cause a never-ending loop)
-
- Prev_Call := Relocate_Node (Call_Node);
- Set_Analyzed (Prev_Call);
+ if Subp = Eq_Prim_Op then
- Param := First_Actual (Call_Node);
- New_Call :=
- Make_And_Then (Loc,
- Left_Opnd =>
- Make_Op_Eq (Loc,
- Left_Opnd =>
- Make_Selected_Component (Loc,
- Prefix => New_Value (Param),
- Selector_Name =>
- New_Occurrence_Of
- (First_Tag_Component (Typ), Loc)),
+ -- Mark the node as analyzed to avoid reanalyzing this
+ -- dispatching call (which would cause a never-ending loop)
+
+ Prev_Call := Relocate_Node (Call_Node);
+ Set_Analyzed (Prev_Call);
+
+ Param := First_Actual (Call_Node);
+ New_Call :=
+ Make_And_Then (Loc,
+ Left_Opnd =>
+ Make_Op_Eq (Loc,
+ Left_Opnd =>
+ Make_Selected_Component (Loc,
+ Prefix => New_Value (Param),
+ Selector_Name =>
+ New_Occurrence_Of
+ (First_Tag_Component (Typ), Loc)),
+
+ Right_Opnd =>
+ Make_Selected_Component (Loc,
+ Prefix =>
+ Unchecked_Convert_To (Typ,
+ New_Value (Next_Actual (Param))),
+ Selector_Name =>
+ New_Occurrence_Of
+ (First_Tag_Component (Typ), Loc))),
+ Right_Opnd => Prev_Call);
- Right_Opnd =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (Typ,
- New_Value (Next_Actual (Param))),
- Selector_Name =>
- New_Occurrence_Of
- (First_Tag_Component (Typ), Loc))),
- Right_Opnd => Prev_Call);
-
- Rewrite (Call_Node, New_Call);
-
- Analyze_And_Resolve
- (Call_Node, Call_Typ, Suppress => All_Checks);
- end if;
+ Rewrite (Call_Node, New_Call);
+ Analyze_And_Resolve
+ (Call_Node, Call_Typ, Suppress => All_Checks);
+ end if;
- -- Expansion of a dispatching call results in an indirect call,
- -- which in turn causes current values to be killed (see
- -- Resolve_Call), so on VM targets we do the call here to
- -- ensure consistent warnings between VM and non-VM targets.
+ -- Expansion of a dispatching call results in an indirect call,
+ -- which in turn causes current values to be killed (see
+ -- Resolve_Call), so on VM targets we do the call here to
+ -- ensure consistent warnings between VM and non-VM targets.
- Kill_Current_Values;
- end if;
+ Kill_Current_Values;
-- If this is a dispatching "=" then we must update the reference
-- to the call node because we generated: