Commit 964f13da by Robert Dewar Committed by Arnaud Charlet

sem_ch8.adb: Update comment.

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch8.adb: Update comment.
	* sem_res.adb: Minor code reorganization (use Ekind_In).

From-SVN: r161143
parent 719aaf4d
2010-06-22 Robert Dewar <dewar@adacore.com>
* sem_ch8.adb: Update comment.
* sem_res.adb: Minor code reorganization (use Ekind_In).
2010-06-22 Ed Schonberg <schonberg@adacore.com> 2010-06-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Add_Implicit_Operator): If the context of the expanded * sem_ch8.adb (Add_Implicit_Operator): If the context of the expanded
......
...@@ -4377,8 +4377,13 @@ package body Sem_Ch8 is ...@@ -4377,8 +4377,13 @@ package body Sem_Ch8 is
return; return;
end if; end if;
-- Set the entity. Note that the reason we call Set_Entity here, as
-- opposed to Set_Entity_With_Style_Check is that in the overloaded
-- case, the initial call can set the wrong homonym. The call that
-- sets the right homonym is in Sem_Res and that call does use
-- Set_Entity_With_Style_Check, so we don't miss a style check.
Set_Entity (N, E); Set_Entity (N, E);
-- Why no Style_Check here???
if Is_Type (E) then if Is_Type (E) then
Set_Etype (N, E); Set_Etype (N, E);
...@@ -6034,10 +6039,12 @@ package body Sem_Ch8 is ...@@ -6034,10 +6039,12 @@ package body Sem_Ch8 is
if Nkind (Parent (N)) = N_Indexed_Component then if Nkind (Parent (N)) = N_Indexed_Component then
declare declare
Is_Binary_Call : constant Boolean Is_Binary_Call : constant Boolean :=
:= Present (Next (First (Expressions (Parent (N))))); Present
Is_Binary_Op : constant Boolean (Next (First (Expressions (Parent (N)))));
:= First_Entity (Predef_Op) /= Last_Entity (Predef_Op); Is_Binary_Op : constant Boolean :=
First_Entity
(Predef_Op) /= Last_Entity (Predef_Op);
Predef_Op2 : constant Entity_Id := Homonym (Predef_Op); Predef_Op2 : constant Entity_Id := Homonym (Predef_Op);
begin begin
......
...@@ -1042,7 +1042,7 @@ package body Sem_Res is ...@@ -1042,7 +1042,7 @@ package body Sem_Res is
if (Is_Entity_Name (N) if (Is_Entity_Name (N)
and then Is_Overloadable (Entity (N)) and then Is_Overloadable (Entity (N))
and then (Ekind (Entity (N)) /= E_Enumeration_Literal and then (Ekind (Entity (N)) /= E_Enumeration_Literal
or else Is_Overloaded (N))) or else Is_Overloaded (N)))
-- Rewrite as call if it is an explicit dereference of an expression of -- Rewrite as call if it is an explicit dereference of an expression of
-- a subprogram access type, and the subprogram type is not that of a -- a subprogram access type, and the subprogram type is not that of a
...@@ -1058,11 +1058,10 @@ package body Sem_Res is ...@@ -1058,11 +1058,10 @@ package body Sem_Res is
or else or else
(Nkind (N) = N_Selected_Component (Nkind (N) = N_Selected_Component
and then (Ekind (Entity (Selector_Name (N))) = E_Function and then (Ekind (Entity (Selector_Name (N))) = E_Function
or else or else
((Ekind (Entity (Selector_Name (N))) = E_Entry (Ekind_In (Entity (Selector_Name (N)), E_Entry,
or else E_Procedure)
Ekind (Entity (Selector_Name (N))) = E_Procedure) and then Is_Overloaded (Selector_Name (N)))))
and then Is_Overloaded (Selector_Name (N)))))
-- If one of the above three conditions is met, rewrite as call. -- If one of the above three conditions is met, rewrite as call.
-- Apply the rewriting only once. -- Apply the rewriting only once.
...@@ -5400,9 +5399,7 @@ package body Sem_Res is ...@@ -5400,9 +5399,7 @@ package body Sem_Res is
F := First_Formal (Nam); F := First_Formal (Nam);
A := First_Actual (N); A := First_Actual (N);
while Present (F) and then Present (A) loop while Present (F) and then Present (A) loop
if (Ekind (F) = E_Out_Parameter if Ekind_In (F, E_Out_Parameter, E_In_Out_Parameter)
or else
Ekind (F) = E_In_Out_Parameter)
and then Warn_On_Modified_As_Out_Parameter (F) and then Warn_On_Modified_As_Out_Parameter (F)
and then Is_Entity_Name (A) and then Is_Entity_Name (A)
and then Present (Entity (A)) and then Present (Entity (A))
...@@ -6365,8 +6362,7 @@ package body Sem_Res is ...@@ -6365,8 +6362,7 @@ package body Sem_Res is
return; return;
elsif T = Any_Access elsif T = Any_Access
or else Ekind (T) = E_Allocator_Type or else Ekind_In (T, E_Allocator_Type, E_Access_Attribute_Type)
or else Ekind (T) = E_Access_Attribute_Type
then then
T := Find_Unique_Access_Type; T := Find_Unique_Access_Type;
...@@ -6434,8 +6430,8 @@ package body Sem_Res is ...@@ -6434,8 +6430,8 @@ package body Sem_Res is
if Expander_Active if Expander_Active
and then and then
(Ekind (T) = E_Anonymous_Access_Type (Ekind_In (T, E_Anonymous_Access_Type,
or else Ekind (T) = E_Anonymous_Access_Subprogram_Type E_Anonymous_Access_Subprogram_Type)
or else Is_Private_Type (T)) or else Is_Private_Type (T))
then then
if Etype (L) /= T then if Etype (L) /= T then
...@@ -7820,9 +7816,7 @@ package body Sem_Res is ...@@ -7820,9 +7816,7 @@ package body Sem_Res is
end if; end if;
if Has_Discriminants (T) if Has_Discriminants (T)
and then (Ekind (Entity (S)) = E_Component and then Ekind_In (Entity (S), E_Component, E_Discriminant)
or else
Ekind (Entity (S)) = E_Discriminant)
and then Present (Original_Record_Component (Entity (S))) and then Present (Original_Record_Component (Entity (S)))
and then Ekind (Original_Record_Component (Entity (S))) = E_Component and then Ekind (Original_Record_Component (Entity (S))) = E_Component
and then Present (Discriminant_Checking_Func and then Present (Discriminant_Checking_Func
...@@ -8572,7 +8566,7 @@ package body Sem_Res is ...@@ -8572,7 +8566,7 @@ package body Sem_Res is
(Etype (Entity (Orig_N)) = Orig_T (Etype (Entity (Orig_N)) = Orig_T
or else or else
(Ekind (Entity (Orig_N)) = E_Loop_Parameter (Ekind (Entity (Orig_N)) = E_Loop_Parameter
and then Covers (Orig_T, Etype (Entity (Orig_N))))) and then Covers (Orig_T, Etype (Entity (Orig_N)))))
then then
-- One more check, do not give warning if the analyzed conversion -- One more check, do not give warning if the analyzed conversion
-- has an expression with non-static bounds, and the bounds of the -- has an expression with non-static bounds, and the bounds of the
...@@ -8958,9 +8952,7 @@ package body Sem_Res is ...@@ -8958,9 +8952,7 @@ package body Sem_Res is
-- Exclude user-defined intrinsic operations of the same name, which are -- Exclude user-defined intrinsic operations of the same name, which are
-- treated separately and rewritten as calls. -- treated separately and rewritten as calls.
if Ekind (Op) /= E_Function if Ekind (Op) /= E_Function or else Chars (N) /= Nam then
or else Chars (N) /= Nam
then
Op_Node := New_Node (Operator_Kind (Nam, Is_Binary), Sloc (N)); Op_Node := New_Node (Operator_Kind (Nam, Is_Binary), Sloc (N));
Set_Chars (Op_Node, Nam); Set_Chars (Op_Node, Nam);
Set_Etype (Op_Node, Etype (N)); Set_Etype (Op_Node, Etype (N));
...@@ -8999,9 +8991,8 @@ package body Sem_Res is ...@@ -8999,9 +8991,8 @@ package body Sem_Res is
end case; end case;
end if; end if;
elsif Ekind (Op) = E_Function elsif Ekind (Op) = E_Function and then Is_Intrinsic_Subprogram (Op) then
and then Is_Intrinsic_Subprogram (Op)
then
-- Operator renames a user-defined operator of the same name. Use -- Operator renames a user-defined operator of the same name. Use
-- the original operator in the node, which is the one that Gigi -- the original operator in the node, which is the one that Gigi
-- knows about. -- knows about.
...@@ -9441,9 +9432,8 @@ package body Sem_Res is ...@@ -9441,9 +9432,8 @@ package body Sem_Res is
-- out-of-scope references. -- out-of-scope references.
elsif elsif
(Ekind (Target_Comp_Base) = E_Anonymous_Access_Type Ekind_In (Target_Comp_Base, E_Anonymous_Access_Type,
or else E_Anonymous_Access_Subprogram_Type)
Ekind (Target_Comp_Base) = E_Anonymous_Access_Subprogram_Type)
and then Ekind (Opnd_Comp_Base) = Ekind (Target_Comp_Base) and then Ekind (Opnd_Comp_Base) = Ekind (Target_Comp_Base)
and then and then
Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type) Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type)
...@@ -9714,9 +9704,8 @@ package body Sem_Res is ...@@ -9714,9 +9704,8 @@ package body Sem_Res is
-- Ada 2005 (AI-251): Anonymous access types where target references an -- Ada 2005 (AI-251): Anonymous access types where target references an
-- interface type. -- interface type.
elsif (Ekind (Target_Type) = E_General_Access_Type elsif Ekind_In (Target_Type, E_General_Access_Type,
or else E_Anonymous_Access_Type)
Ekind (Target_Type) = E_Anonymous_Access_Type)
and then Is_Interface (Directly_Designated_Type (Target_Type)) and then Is_Interface (Directly_Designated_Type (Target_Type))
then then
-- Check the static accessibility rule of 4.6(17). Note that the -- Check the static accessibility rule of 4.6(17). Note that the
...@@ -9785,8 +9774,8 @@ package body Sem_Res is ...@@ -9785,8 +9774,8 @@ package body Sem_Res is
if Is_Entity_Name (Operand) if Is_Entity_Name (Operand)
and then not Is_Local_Anonymous_Access (Opnd_Type) and then not Is_Local_Anonymous_Access (Opnd_Type)
and then (Ekind (Entity (Operand)) = E_In_Parameter and then
or else Ekind (Entity (Operand)) = E_Constant) Ekind_In (Entity (Operand), E_In_Parameter, E_Constant)
and then Present (Discriminal_Link (Entity (Operand))) and then Present (Discriminal_Link (Entity (Operand)))
then then
Error_Msg_N Error_Msg_N
...@@ -9801,15 +9790,14 @@ package body Sem_Res is ...@@ -9801,15 +9790,14 @@ package body Sem_Res is
-- General and anonymous access types -- General and anonymous access types
elsif (Ekind (Target_Type) = E_General_Access_Type elsif Ekind_In (Target_Type, E_General_Access_Type,
or else Ekind (Target_Type) = E_Anonymous_Access_Type) E_Anonymous_Access_Type)
and then and then
Conversion_Check Conversion_Check
(Is_Access_Type (Opnd_Type) (Is_Access_Type (Opnd_Type)
and then Ekind (Opnd_Type) /= and then not
E_Access_Subprogram_Type Ekind_In (Opnd_Type, E_Access_Subprogram_Type,
and then Ekind (Opnd_Type) /= E_Access_Protected_Subprogram_Type),
E_Access_Protected_Subprogram_Type,
"must be an access-to-object type") "must be an access-to-object type")
then then
if Is_Access_Constant (Opnd_Type) if Is_Access_Constant (Opnd_Type)
...@@ -9895,8 +9883,8 @@ package body Sem_Res is ...@@ -9895,8 +9883,8 @@ package body Sem_Res is
-- access type. -- access type.
if Is_Entity_Name (Operand) if Is_Entity_Name (Operand)
and then (Ekind (Entity (Operand)) = E_In_Parameter and then
or else Ekind (Entity (Operand)) = E_Constant) Ekind_In (Entity (Operand), E_In_Parameter, E_Constant)
and then Present (Discriminal_Link (Entity (Operand))) and then Present (Discriminal_Link (Entity (Operand)))
then then
Error_Msg_N Error_Msg_N
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment