sem_ch4.adb (Try_Primitive_Operation): Code cleanup to ensure that we generate the same errors compiling under -gnatc.
2006-10-31 Ed Schonberg <schonberg@adacore.com> Javier Miranda <miranda@adacore.com> Robert Dewar <dewar@adacore.com> * sem_ch4.adb (Try_Primitive_Operation): Code cleanup to ensure that we generate the same errors compiling under -gnatc. (Try_Object_Operation): If no candidate interpretation succeeds, but there is at least one primitive operation with the right name, report error in call rather than on a malformed selected component. (Analyze_Selected_Component): If the prefix is an incomplete type from a limited view, and the full view is available, use the full view to determine whether this is a prefixed call to a primitive operation. (Operator_Check): Verify that a candidate interpretation is a binary operation before checking the type of its second formal. (Analyze_Call): Add additional warnings for function call contexts not yet supported. (Analyze_Allocator): Move the check for "initialization not allowed for limited types" after analyzing the expression. This is necessary, because OK_For_Limited_Init looks at the structure of the expression. Before analysis, we don't necessarily know what sort of expression it is. For example, we don't know whether F(X) is a function call or an indexed component; the former is legal in Ada 2005; the latter is not. (Analyze_Allocator): Correct code for AI-287 -- extension aggregates were missing. We also didn't handle qualified expressions. Now also allow function calls. Use new common routine OK_For_Limited_Init. (Analyze_Type_Conversion): Do not perform some legality checks in an instance, because the error message will be redundant or spurious. (Analyze_Overloaded_Selected_Component): Do not do style check when setting an entity, since we do not know it is the right entity yet. (Analyze_Selected_Component): Move Generate_Reference call to Sem_Res (Analyze_Overloaded_Selected_Component): Same change (Analyze_Selected_Component): Remove unnecessary prefix type retrieval since regular incomplete subtypes are transformed into corresponding subtypes of their full views. (Complete_Object_Operation): Treat name of transformed subprogram call as coming from source, for browsing purposes. (Try_Primitive_Operation): If formal is an access parameter, compare with base type of object to determine whether it is a primitive operation. (Operator_Check): If no interpretation of the operator matches, check whether a use clause on any candidate might make the operation legal. (Try_Class_Wide_Operation): Check whether the first parameter is an access type whose designated type is class-wide. From-SVN: r118302
This commit is contained in:
parent
affbee12f4
commit
b67a385c62
|
@ -41,11 +41,11 @@ with Opt; use Opt;
|
||||||
with Output; use Output;
|
with Output; use Output;
|
||||||
with Restrict; use Restrict;
|
with Restrict; use Restrict;
|
||||||
with Rident; use Rident;
|
with Rident; use Rident;
|
||||||
with Rtsfind; use Rtsfind;
|
|
||||||
with Sem; use Sem;
|
with Sem; use Sem;
|
||||||
with Sem_Cat; use Sem_Cat;
|
with Sem_Cat; use Sem_Cat;
|
||||||
with Sem_Ch3; use Sem_Ch3;
|
with Sem_Ch3; use Sem_Ch3;
|
||||||
with Sem_Ch8; use Sem_Ch8;
|
with Sem_Ch8; use Sem_Ch8;
|
||||||
|
with Sem_Disp; use Sem_Disp;
|
||||||
with Sem_Dist; use Sem_Dist;
|
with Sem_Dist; use Sem_Dist;
|
||||||
with Sem_Eval; use Sem_Eval;
|
with Sem_Eval; use Sem_Eval;
|
||||||
with Sem_Res; use Sem_Res;
|
with Sem_Res; use Sem_Res;
|
||||||
|
@ -298,9 +298,7 @@ package body Sem_Ch4 is
|
||||||
-- Start of processing for Ambiguous_Operands
|
-- Start of processing for Ambiguous_Operands
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Nkind (N) = N_In
|
if Nkind (N) in N_Membership_Test then
|
||||||
or else Nkind (N) = N_Not_In
|
|
||||||
then
|
|
||||||
Error_Msg_N ("ambiguous operands for membership", N);
|
Error_Msg_N ("ambiguous operands for membership", N);
|
||||||
|
|
||||||
elsif Nkind (N) = N_Op_Eq
|
elsif Nkind (N) = N_Op_Eq
|
||||||
|
@ -341,7 +339,7 @@ package body Sem_Ch4 is
|
||||||
procedure Analyze_Allocator (N : Node_Id) is
|
procedure Analyze_Allocator (N : Node_Id) is
|
||||||
Loc : constant Source_Ptr := Sloc (N);
|
Loc : constant Source_Ptr := Sloc (N);
|
||||||
Sav_Errs : constant Nat := Serious_Errors_Detected;
|
Sav_Errs : constant Nat := Serious_Errors_Detected;
|
||||||
E : Node_Id := Expression (N);
|
E : Node_Id := Expression (N);
|
||||||
Acc_Type : Entity_Id;
|
Acc_Type : Entity_Id;
|
||||||
Type_Id : Entity_Id;
|
Type_Id : Entity_Id;
|
||||||
|
|
||||||
|
@ -357,27 +355,18 @@ package body Sem_Ch4 is
|
||||||
Check_Fully_Declared (Type_Id, N);
|
Check_Fully_Declared (Type_Id, N);
|
||||||
Set_Directly_Designated_Type (Acc_Type, Type_Id);
|
Set_Directly_Designated_Type (Acc_Type, Type_Id);
|
||||||
|
|
||||||
|
Analyze_And_Resolve (Expression (E), Type_Id);
|
||||||
|
|
||||||
if Is_Limited_Type (Type_Id)
|
if Is_Limited_Type (Type_Id)
|
||||||
and then Comes_From_Source (N)
|
and then Comes_From_Source (N)
|
||||||
and then not In_Instance_Body
|
and then not In_Instance_Body
|
||||||
then
|
then
|
||||||
-- Ada 2005 (AI-287): Do not post an error if the expression
|
if not OK_For_Limited_Init (Expression (E)) then
|
||||||
-- corresponds to a limited aggregate. Limited aggregates
|
|
||||||
-- are checked in sem_aggr in a per-component manner
|
|
||||||
-- (compare with handling of Get_Value subprogram).
|
|
||||||
|
|
||||||
if Ada_Version >= Ada_05
|
|
||||||
and then Nkind (Expression (E)) = N_Aggregate
|
|
||||||
then
|
|
||||||
null;
|
|
||||||
else
|
|
||||||
Error_Msg_N ("initialization not allowed for limited types", N);
|
Error_Msg_N ("initialization not allowed for limited types", N);
|
||||||
Explain_Limited_Type (Type_Id, N);
|
Explain_Limited_Type (Type_Id, N);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Analyze_And_Resolve (Expression (E), Type_Id);
|
|
||||||
|
|
||||||
-- A qualified expression requires an exact match of the type,
|
-- A qualified expression requires an exact match of the type,
|
||||||
-- class-wide matching is not allowed.
|
-- class-wide matching is not allowed.
|
||||||
|
|
||||||
|
@ -928,6 +917,26 @@ package body Sem_Ch4 is
|
||||||
|
|
||||||
End_Interp_List;
|
End_Interp_List;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- Check for not-yet-implemented cases of AI-318.
|
||||||
|
-- We only need to check for inherently limited types,
|
||||||
|
-- because other limited types will be returned by copy,
|
||||||
|
-- which works just fine.
|
||||||
|
|
||||||
|
if Ada_Version >= Ada_05
|
||||||
|
and then not Debug_Flag_Dot_L
|
||||||
|
and then Is_Inherently_Limited_Type (Etype (N))
|
||||||
|
and then (Nkind (Parent (N)) = N_Selected_Component
|
||||||
|
or else Nkind (Parent (N)) = N_Indexed_Component
|
||||||
|
or else Nkind (Parent (N)) = N_Slice
|
||||||
|
or else Nkind (Parent (N)) = N_Attribute_Reference
|
||||||
|
or else Nkind (Parent (N)) = N_Component_Declaration
|
||||||
|
or else Nkind (Parent (N)) = N_Formal_Object_Declaration
|
||||||
|
or else Nkind (Parent (N)) = N_Generic_Association)
|
||||||
|
then
|
||||||
|
Error_Msg_N ("(Ada 2005) limited function call in this context" &
|
||||||
|
" is not yet implemented", N);
|
||||||
|
end if;
|
||||||
end Analyze_Call;
|
end Analyze_Call;
|
||||||
|
|
||||||
---------------------------
|
---------------------------
|
||||||
|
@ -2333,9 +2342,7 @@ package body Sem_Ch4 is
|
||||||
if Chars (Comp) = Chars (Sel)
|
if Chars (Comp) = Chars (Sel)
|
||||||
and then Is_Visible_Component (Comp)
|
and then Is_Visible_Component (Comp)
|
||||||
then
|
then
|
||||||
Set_Entity_With_Style_Check (Sel, Comp);
|
Set_Entity (Sel, Comp);
|
||||||
Generate_Reference (Comp, Sel);
|
|
||||||
|
|
||||||
Set_Etype (Sel, Etype (Comp));
|
Set_Etype (Sel, Etype (Comp));
|
||||||
Add_One_Interp (N, Etype (Comp), Etype (Comp));
|
Add_One_Interp (N, Etype (Comp), Etype (Comp));
|
||||||
|
|
||||||
|
@ -2610,6 +2617,18 @@ package body Sem_Ch4 is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Prefix_Type := Designated_Type (Prefix_Type);
|
Prefix_Type := Designated_Type (Prefix_Type);
|
||||||
|
|
||||||
|
-- (Ada 2005): if the prefix is the limited view of a type, and
|
||||||
|
-- the context already includes the full view, use the full view
|
||||||
|
-- in what follows, either to retrieve a component of to find
|
||||||
|
-- a primitive operation.
|
||||||
|
|
||||||
|
if Is_Incomplete_Type (Prefix_Type)
|
||||||
|
and then From_With_Type (Prefix_Type)
|
||||||
|
and then Present (Non_Limited_View (Prefix_Type))
|
||||||
|
then
|
||||||
|
Prefix_Type := Non_Limited_View (Prefix_Type);
|
||||||
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Ekind (Prefix_Type) = E_Private_Subtype then
|
if Ekind (Prefix_Type) = E_Private_Subtype then
|
||||||
|
@ -2661,8 +2680,6 @@ package body Sem_Ch4 is
|
||||||
and then Is_Visible_Component (Comp)
|
and then Is_Visible_Component (Comp)
|
||||||
then
|
then
|
||||||
Set_Entity_With_Style_Check (Sel, Comp);
|
Set_Entity_With_Style_Check (Sel, Comp);
|
||||||
Generate_Reference (Comp, Sel);
|
|
||||||
|
|
||||||
Set_Etype (Sel, Etype (Comp));
|
Set_Etype (Sel, Etype (Comp));
|
||||||
|
|
||||||
if Ekind (Comp) = E_Discriminant then
|
if Ekind (Comp) = E_Discriminant then
|
||||||
|
@ -2687,19 +2704,22 @@ package body Sem_Ch4 is
|
||||||
|
|
||||||
Resolve (Name);
|
Resolve (Name);
|
||||||
|
|
||||||
-- Ada 2005 (AI-50217): Check wrong use of incomplete type.
|
-- Ada 2005 (AI-50217): Check wrong use of incomplete types or
|
||||||
|
-- subtypes in a package specification.
|
||||||
-- Example:
|
-- Example:
|
||||||
|
|
||||||
-- limited with Pkg;
|
-- limited with Pkg;
|
||||||
-- package Pkg is
|
-- package Pkg is
|
||||||
-- type Acc_Inc is access Pkg.T;
|
-- type Acc_Inc is access Pkg.T;
|
||||||
-- X : Acc_Inc;
|
-- X : Acc_Inc;
|
||||||
-- N : Natural := X.all.Comp; -- ERROR
|
-- N : Natural := X.all.Comp; -- ERROR, limited view
|
||||||
-- end Pkg;
|
-- end Pkg; -- Comp is not visible
|
||||||
|
|
||||||
if Nkind (Name) = N_Explicit_Dereference
|
if Nkind (Name) = N_Explicit_Dereference
|
||||||
and then From_With_Type (Etype (Prefix (Name)))
|
and then From_With_Type (Etype (Prefix (Name)))
|
||||||
and then not Is_Potentially_Use_Visible (Etype (Name))
|
and then not Is_Potentially_Use_Visible (Etype (Name))
|
||||||
|
and then Nkind (Parent (Cunit_Entity (Current_Sem_Unit))) =
|
||||||
|
N_Package_Specification
|
||||||
then
|
then
|
||||||
Error_Msg_NE
|
Error_Msg_NE
|
||||||
("premature usage of incomplete}", Prefix (Name),
|
("premature usage of incomplete}", Prefix (Name),
|
||||||
|
@ -3182,6 +3202,15 @@ package body Sem_Ch4 is
|
||||||
if not Comes_From_Source (N) then
|
if not Comes_From_Source (N) then
|
||||||
return;
|
return;
|
||||||
|
|
||||||
|
-- If there was an error in a generic unit, no need to replicate the
|
||||||
|
-- error message. Conversely, constant-folding in the generic may
|
||||||
|
-- transform the argument of a conversion into a string literal, which
|
||||||
|
-- is legal. Therefore the following tests are not performed in an
|
||||||
|
-- instance.
|
||||||
|
|
||||||
|
elsif In_Instance then
|
||||||
|
return;
|
||||||
|
|
||||||
elsif Nkind (Expr) = N_Null then
|
elsif Nkind (Expr) = N_Null then
|
||||||
Error_Msg_N ("argument of conversion cannot be null", N);
|
Error_Msg_N ("argument of conversion cannot be null", N);
|
||||||
Error_Msg_N ("\use qualified expression instead", N);
|
Error_Msg_N ("\use qualified expression instead", N);
|
||||||
|
@ -4372,8 +4401,9 @@ package body Sem_Ch4 is
|
||||||
|
|
||||||
if Etype (N) = Any_Type then
|
if Etype (N) = Any_Type then
|
||||||
declare
|
declare
|
||||||
L : Node_Id;
|
L : Node_Id;
|
||||||
R : Node_Id;
|
R : Node_Id;
|
||||||
|
Op_Id : Entity_Id := Empty;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
R := Right_Opnd (N);
|
R := Right_Opnd (N);
|
||||||
|
@ -4546,11 +4576,51 @@ package body Sem_Ch4 is
|
||||||
Error_Msg_N ("there is no applicable operator& for}", N);
|
Error_Msg_N ("there is no applicable operator& for}", N);
|
||||||
|
|
||||||
else
|
else
|
||||||
Error_Msg_N ("invalid operand types for operator&", N);
|
-- Another attempt to find a fix: one of the candidate
|
||||||
|
-- interpretations may not be use-visible. This has
|
||||||
|
-- already been checked for predefined operators, so
|
||||||
|
-- we examine only user-defined functions.
|
||||||
|
|
||||||
if Nkind (N) /= N_Op_Concat then
|
Op_Id := Get_Name_Entity_Id (Chars (N));
|
||||||
Error_Msg_NE ("\left operand has}!", N, Etype (L));
|
|
||||||
Error_Msg_NE ("\right operand has}!", N, Etype (R));
|
while Present (Op_Id) loop
|
||||||
|
if Ekind (Op_Id) /= E_Operator
|
||||||
|
and then Is_Overloadable (Op_Id)
|
||||||
|
then
|
||||||
|
if not Is_Immediately_Visible (Op_Id)
|
||||||
|
and then not In_Use (Scope (Op_Id))
|
||||||
|
and then not Is_Abstract (Op_Id)
|
||||||
|
and then not Is_Hidden (Op_Id)
|
||||||
|
and then Ekind (Scope (Op_Id)) = E_Package
|
||||||
|
and then
|
||||||
|
Has_Compatible_Type
|
||||||
|
(L, Etype (First_Formal (Op_Id)))
|
||||||
|
and then Present
|
||||||
|
(Next_Formal (First_Formal (Op_Id)))
|
||||||
|
and then
|
||||||
|
Has_Compatible_Type
|
||||||
|
(R,
|
||||||
|
Etype (Next_Formal (First_Formal (Op_Id))))
|
||||||
|
then
|
||||||
|
Error_Msg_N
|
||||||
|
("No legal interpretation for operator&", N);
|
||||||
|
Error_Msg_NE
|
||||||
|
("\use clause on& would make operation legal",
|
||||||
|
N, Scope (Op_Id));
|
||||||
|
exit;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Op_Id := Homonym (Op_Id);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
if No (Op_Id) then
|
||||||
|
Error_Msg_N ("invalid operand types for operator&", N);
|
||||||
|
|
||||||
|
if Nkind (N) /= N_Op_Concat then
|
||||||
|
Error_Msg_NE ("\left operand has}!", N, Etype (L));
|
||||||
|
Error_Msg_NE ("\right operand has}!", N, Etype (R));
|
||||||
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
@ -4913,15 +4983,21 @@ package body Sem_Ch4 is
|
||||||
--------------------------
|
--------------------------
|
||||||
|
|
||||||
function Try_Object_Operation (N : Node_Id) return Boolean is
|
function Try_Object_Operation (N : Node_Id) return Boolean is
|
||||||
K : constant Node_Kind := Nkind (Parent (N));
|
K : constant Node_Kind := Nkind (Parent (N));
|
||||||
Loc : constant Source_Ptr := Sloc (N);
|
Loc : constant Source_Ptr := Sloc (N);
|
||||||
Is_Subprg_Call : constant Boolean := K = N_Procedure_Call_Statement
|
Candidate : Entity_Id := Empty;
|
||||||
or else K = N_Function_Call;
|
Is_Subprg_Call : constant Boolean := K = N_Procedure_Call_Statement
|
||||||
Obj : constant Node_Id := Prefix (N);
|
or else K = N_Function_Call;
|
||||||
Subprog : constant Node_Id := Selector_Name (N);
|
Obj : constant Node_Id := Prefix (N);
|
||||||
|
Subprog : constant Node_Id := Selector_Name (N);
|
||||||
|
Success : Boolean := False;
|
||||||
|
|
||||||
|
Report_Error : Boolean := False;
|
||||||
|
-- If no candidate interpretation matches the context, redo the
|
||||||
|
-- analysis with error enabled to provide additional information.
|
||||||
|
|
||||||
Actual : Node_Id;
|
Actual : Node_Id;
|
||||||
New_Call_Node : Node_Id := Empty;
|
New_Call_Node : Node_Id := Empty;
|
||||||
Node_To_Replace : Node_Id;
|
Node_To_Replace : Node_Id;
|
||||||
Obj_Type : Entity_Id := Etype (Obj);
|
Obj_Type : Entity_Id := Etype (Obj);
|
||||||
|
|
||||||
|
@ -4971,6 +5047,12 @@ package body Sem_Ch4 is
|
||||||
First_Actual := First (Parameter_Associations (Call_Node));
|
First_Actual := First (Parameter_Associations (Call_Node));
|
||||||
Set_Name (Call_Node, Subprog);
|
Set_Name (Call_Node, Subprog);
|
||||||
|
|
||||||
|
-- For cross-reference purposes, treat the new node as being in
|
||||||
|
-- the source if the original one is.
|
||||||
|
|
||||||
|
Set_Comes_From_Source (Subprog, Comes_From_Source (N));
|
||||||
|
Set_Comes_From_Source (Call_Node, Comes_From_Source (N));
|
||||||
|
|
||||||
if Nkind (N) = N_Selected_Component
|
if Nkind (N) = N_Selected_Component
|
||||||
and then not Inside_A_Generic
|
and then not Inside_A_Generic
|
||||||
then
|
then
|
||||||
|
@ -5111,6 +5193,7 @@ package body Sem_Ch4 is
|
||||||
Node_To_Replace : Node_Id) return Boolean
|
Node_To_Replace : Node_Id) return Boolean
|
||||||
is
|
is
|
||||||
Anc_Type : Entity_Id;
|
Anc_Type : Entity_Id;
|
||||||
|
Cls_Type : Entity_Id;
|
||||||
Hom : Entity_Id;
|
Hom : Entity_Id;
|
||||||
Hom_Ref : Node_Id;
|
Hom_Ref : Node_Id;
|
||||||
Success : Boolean;
|
Success : Boolean;
|
||||||
|
@ -5118,25 +5201,29 @@ package body Sem_Ch4 is
|
||||||
begin
|
begin
|
||||||
-- Loop through ancestor types, traverse the homonym chain of the
|
-- Loop through ancestor types, traverse the homonym chain of the
|
||||||
-- subprogram, and try out those homonyms whose first formal has the
|
-- subprogram, and try out those homonyms whose first formal has the
|
||||||
-- class-wide type of the ancestor.
|
-- class-wide type of the ancestor, or an access type to it.
|
||||||
|
|
||||||
-- Should we verify that it is declared in the same package as the
|
|
||||||
-- ancestor type ???
|
|
||||||
|
|
||||||
Anc_Type := Obj_Type;
|
Anc_Type := Obj_Type;
|
||||||
|
|
||||||
loop
|
loop
|
||||||
|
Cls_Type := Class_Wide_Type (Anc_Type);
|
||||||
|
|
||||||
Hom := Current_Entity (Subprog);
|
Hom := Current_Entity (Subprog);
|
||||||
while Present (Hom) loop
|
while Present (Hom) loop
|
||||||
if (Ekind (Hom) = E_Procedure
|
if (Ekind (Hom) = E_Procedure
|
||||||
or else
|
or else
|
||||||
Ekind (Hom) = E_Function)
|
Ekind (Hom) = E_Function)
|
||||||
|
and then Scope (Hom) = Scope (Anc_Type)
|
||||||
and then Present (First_Formal (Hom))
|
and then Present (First_Formal (Hom))
|
||||||
and then Etype (First_Formal (Hom)) =
|
and then
|
||||||
Class_Wide_Type (Anc_Type)
|
(Etype (First_Formal (Hom)) = Cls_Type
|
||||||
|
or else
|
||||||
|
(Is_Access_Type (Etype (First_Formal (Hom)))
|
||||||
|
and then
|
||||||
|
Designated_Type (Etype (First_Formal (Hom))) =
|
||||||
|
Cls_Type))
|
||||||
then
|
then
|
||||||
Hom_Ref := New_Reference_To (Hom, Sloc (Subprog));
|
Hom_Ref := New_Reference_To (Hom, Sloc (Subprog));
|
||||||
|
|
||||||
Set_Etype (Call_Node, Any_Type);
|
Set_Etype (Call_Node, Any_Type);
|
||||||
Set_Parent (Call_Node, Parent (Node_To_Replace));
|
Set_Parent (Call_Node, Parent (Node_To_Replace));
|
||||||
|
|
||||||
|
@ -5145,7 +5232,7 @@ package body Sem_Ch4 is
|
||||||
Analyze_One_Call
|
Analyze_One_Call
|
||||||
(N => Call_Node,
|
(N => Call_Node,
|
||||||
Nam => Hom,
|
Nam => Hom,
|
||||||
Report => False,
|
Report => Report_Error,
|
||||||
Success => Success,
|
Success => Success,
|
||||||
Skip_First => True);
|
Skip_First => True);
|
||||||
|
|
||||||
|
@ -5218,15 +5305,15 @@ package body Sem_Ch4 is
|
||||||
|
|
||||||
or else
|
or else
|
||||||
(Ekind (Typ) = E_Anonymous_Access_Type
|
(Ekind (Typ) = E_Anonymous_Access_Type
|
||||||
and then Designated_Type (Typ) = Obj_Type);
|
and then Designated_Type (Typ) = Base_Type (Obj_Type));
|
||||||
end Valid_First_Argument_Of;
|
end Valid_First_Argument_Of;
|
||||||
|
|
||||||
-- Start of processing for Try_Primitive_Operation
|
-- Start of processing for Try_Primitive_Operation
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- Look for subprograms in the list of primitive operations
|
-- Look for subprograms in the list of primitive operations
|
||||||
-- The name must be identical, and the kind of call indicates
|
-- The name must be identical, and the kind of call indicates the
|
||||||
-- the expected kind of operation (function or procedure).
|
-- expected kind of operation (function or procedure).
|
||||||
|
|
||||||
Elmt := First_Elmt (Primitive_Operations (Obj_Type));
|
Elmt := First_Elmt (Primitive_Operations (Obj_Type));
|
||||||
while Present (Elmt) loop
|
while Present (Elmt) loop
|
||||||
|
@ -5239,21 +5326,22 @@ package body Sem_Ch4 is
|
||||||
(Nkind (Call_Node) = N_Function_Call)
|
(Nkind (Call_Node) = N_Function_Call)
|
||||||
= (Ekind (Prim_Op) = E_Function)
|
= (Ekind (Prim_Op) = E_Function)
|
||||||
then
|
then
|
||||||
-- If this primitive operation corresponds with an immediate
|
-- Ada 2005 (AI-251): If this primitive operation corresponds
|
||||||
-- ancestor interface there is no need to add it to the list
|
-- with an immediate ancestor interface there is no need to add
|
||||||
-- of interpretations; the corresponding aliased primitive is
|
-- it to the list of interpretations; the corresponding aliased
|
||||||
-- also in this list of primitive operations and will be
|
-- primitive is also in this list of primitive operations and
|
||||||
-- used instead.
|
-- will be used instead.
|
||||||
|
|
||||||
if Present (Abstract_Interface_Alias (Prim_Op))
|
if Present (Abstract_Interface_Alias (Prim_Op))
|
||||||
and then Present (DTC_Entity (Alias (Prim_Op)))
|
and then Is_Ancestor (Find_Dispatching_Type
|
||||||
and then Etype (DTC_Entity (Alias (Prim_Op))) = RTE (RE_Tag)
|
(Alias (Prim_Op)), Obj_Type)
|
||||||
then
|
then
|
||||||
goto Continue;
|
goto Continue;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if not Success then
|
if not Success then
|
||||||
Prim_Op_Ref := New_Reference_To (Prim_Op, Sloc (Subprog));
|
Prim_Op_Ref := New_Reference_To (Prim_Op, Sloc (Subprog));
|
||||||
|
Candidate := Prim_Op;
|
||||||
|
|
||||||
Set_Etype (Call_Node, Any_Type);
|
Set_Etype (Call_Node, Any_Type);
|
||||||
Set_Parent (Call_Node, Parent (Node_To_Replace));
|
Set_Parent (Call_Node, Parent (Node_To_Replace));
|
||||||
|
@ -5263,7 +5351,7 @@ package body Sem_Ch4 is
|
||||||
Analyze_One_Call
|
Analyze_One_Call
|
||||||
(N => Call_Node,
|
(N => Call_Node,
|
||||||
Nam => Prim_Op,
|
Nam => Prim_Op,
|
||||||
Report => False,
|
Report => Report_Error,
|
||||||
Success => Success,
|
Success => Success,
|
||||||
Skip_First => True);
|
Skip_First => True);
|
||||||
|
|
||||||
|
@ -5357,15 +5445,54 @@ package body Sem_Ch4 is
|
||||||
Set_Etype (New_Call_Node, Any_Type);
|
Set_Etype (New_Call_Node, Any_Type);
|
||||||
Set_Parent (New_Call_Node, Parent (Node_To_Replace));
|
Set_Parent (New_Call_Node, Parent (Node_To_Replace));
|
||||||
|
|
||||||
return
|
if Try_Primitive_Operation
|
||||||
Try_Primitive_Operation
|
(Call_Node => New_Call_Node,
|
||||||
(Call_Node => New_Call_Node,
|
Node_To_Replace => Node_To_Replace)
|
||||||
Node_To_Replace => Node_To_Replace)
|
|
||||||
|
|
||||||
or else
|
or else
|
||||||
Try_Class_Wide_Operation
|
Try_Class_Wide_Operation
|
||||||
(Call_Node => New_Call_Node,
|
(Call_Node => New_Call_Node,
|
||||||
Node_To_Replace => Node_To_Replace);
|
Node_To_Replace => Node_To_Replace)
|
||||||
|
then
|
||||||
|
return True;
|
||||||
|
|
||||||
|
elsif Present (Candidate) then
|
||||||
|
|
||||||
|
-- The argument list is not type correct. Re-analyze with error
|
||||||
|
-- reporting enabled, and use one of the possible candidates.
|
||||||
|
-- In all_errors mode, re-analyze all failed interpretations.
|
||||||
|
|
||||||
|
if All_Errors_Mode then
|
||||||
|
Report_Error := True;
|
||||||
|
if Try_Primitive_Operation
|
||||||
|
(Call_Node => New_Call_Node,
|
||||||
|
Node_To_Replace => Node_To_Replace)
|
||||||
|
|
||||||
|
or else
|
||||||
|
Try_Class_Wide_Operation
|
||||||
|
(Call_Node => New_Call_Node,
|
||||||
|
Node_To_Replace => Node_To_Replace)
|
||||||
|
then
|
||||||
|
null;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
else
|
||||||
|
Analyze_One_Call
|
||||||
|
(N => New_Call_Node,
|
||||||
|
Nam => Candidate,
|
||||||
|
Report => True,
|
||||||
|
Success => Success,
|
||||||
|
Skip_First => True);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
return True; -- No need for further errors.
|
||||||
|
|
||||||
|
else
|
||||||
|
-- There was no candidate operation, so report it as an error
|
||||||
|
-- in the caller: Analyze_Selected_Component.
|
||||||
|
|
||||||
|
return False;
|
||||||
|
end if;
|
||||||
end Try_Object_Operation;
|
end Try_Object_Operation;
|
||||||
|
|
||||||
end Sem_Ch4;
|
end Sem_Ch4;
|
||||||
|
|
Loading…
Reference in New Issue