Commit 7ec8363d by Robert Dewar Committed by Arnaud Charlet

sem_util.adb (Is_Delegate): Put in proper alpha order.

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

	* sem_util.adb (Is_Delegate): Put in proper alpha order.
	* sem_eval.adb: Minor reformatting.

From-SVN: r161140
parent 74e7891f
2010-06-22 Robert Dewar <dewar@adacore.com>
* sem_util.adb (Is_Delegate): Put in proper alpha order.
* sem_eval.adb: Minor reformatting.
2010-06-22 Robert Dewar <dewar@adacore.com>
* g-expect-vms.adb, sem_res.adb: Minor reformatting.
* exp_aggr.adb: Minor comment changes and reformatting.
* sem_eval.adb (Find_Universal_Operator_Type): Put in proper alpha order
......
......@@ -3802,23 +3802,25 @@ package body Sem_Eval is
Priv_E : Entity_Id;
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean;
-- Check whether one operand is a mixed-mode operation that requires
-- the presence of a fixed-point type. Given that all operands are
-- universal and have been constant-folded, retrieve the original
-- function call.
-- Check whether one operand is a mixed-mode operation that requires the
-- presence of a fixed-point type. Given that all operands are universal
-- and have been constant-folded, retrieve the original function call.
---------------------------
-- Is_Mixed_Mode_Operand --
---------------------------
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean is
Onod : constant Node_Id := Original_Node (Op);
begin
return Nkind (Original_Node (Op)) = N_Function_Call
and then Present (Next_Actual (First_Actual (Original_Node (Op))))
and then Etype (First_Actual (Original_Node (Op))) /=
Etype (Next_Actual (First_Actual (Original_Node (Op))));
return Nkind (Onod) = N_Function_Call
and then Present (Next_Actual (First_Actual (Onod)))
and then Etype (First_Actual (Onod)) /=
Etype (Next_Actual (First_Actual (Onod)));
end Is_Mixed_Mode_Operand;
-- Start of processing for Find_Universal_Operator_Type
begin
if Nkind (Call) /= N_Function_Call
or else Nkind (Name (Call)) /= N_Expanded_Name
......@@ -3827,20 +3829,18 @@ package body Sem_Eval is
-- There are two cases where the context does not imply the type of the
-- operands: either the universal expression appears in a type
-- type conversion, or we are in the case of a predefined relational
-- conversion, or we are in the case of a predefined relational
-- operator, where the context type is always Boolean.
elsif Nkind (Parent (N)) = N_Type_Conversion
or else
Is_Relational
or else
In_Membership
or else Is_Relational
or else In_Membership
then
Pack := Entity (Prefix (Name (Call)));
-- If the prefix is a package declared elsewhere, iterate over
-- its visible entities, otherwise iterate over all declarations
-- in the designated scope.
-- If the prefix is a package declared elsewhere, iterate over its
-- visible entities, otherwise iterate over all declarations in the
-- designated scope.
if Ekind (Pack) = E_Package
and then not In_Open_Scopes (Pack)
......
......@@ -5848,6 +5848,54 @@ package body Sem_Util is
and then Is_Imported (Entity (Name (N)));
end Is_CPP_Constructor_Call;
-----------------
-- Is_Delegate --
-----------------
function Is_Delegate (T : Entity_Id) return Boolean is
Desig_Type : Entity_Id;
begin
if VM_Target /= CLI_Target then
return False;
end if;
-- Access-to-subprograms are delegates in CIL
if Ekind (T) = E_Access_Subprogram_Type then
return True;
end if;
if Ekind (T) not in Access_Kind then
-- A delegate is a managed pointer. If no designated type is defined
-- it means that it's not a delegate.
return False;
end if;
Desig_Type := Etype (Directly_Designated_Type (T));
if not Is_Tagged_Type (Desig_Type) then
return False;
end if;
-- Test if the type is inherited from [mscorlib]System.Delegate
while Etype (Desig_Type) /= Desig_Type loop
if Chars (Scope (Desig_Type)) /= No_Name
and then Is_Imported (Scope (Desig_Type))
and then Get_Name_String (Chars (Scope (Desig_Type))) = "delegate"
then
return True;
end if;
Desig_Type := Etype (Desig_Type);
end loop;
return False;
end Is_Delegate;
----------------------------------------------
-- Is_Dependent_Component_Of_Mutable_Object --
----------------------------------------------
......@@ -7115,54 +7163,6 @@ package body Sem_Util is
end Is_VMS_Operator;
-----------------
-- Is_Delegate --
-----------------
function Is_Delegate (T : Entity_Id) return Boolean is
Desig_Type : Entity_Id;
begin
if VM_Target /= CLI_Target then
return False;
end if;
-- Access-to-subprograms are delegates in CIL
if Ekind (T) = E_Access_Subprogram_Type then
return True;
end if;
if Ekind (T) not in Access_Kind then
-- A delegate is a managed pointer. If no designated type is defined
-- it means that it's not a delegate.
return False;
end if;
Desig_Type := Etype (Directly_Designated_Type (T));
if not Is_Tagged_Type (Desig_Type) then
return False;
end if;
-- Test if the type is inherited from [mscorlib]System.Delegate
while Etype (Desig_Type) /= Desig_Type loop
if Chars (Scope (Desig_Type)) /= No_Name
and then Is_Imported (Scope (Desig_Type))
and then Get_Name_String (Chars (Scope (Desig_Type))) = "delegate"
then
return True;
end if;
Desig_Type := Etype (Desig_Type);
end loop;
return False;
end Is_Delegate;
-----------------
-- Is_Variable --
-----------------
......
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