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> 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. * g-expect-vms.adb, sem_res.adb: Minor reformatting.
* exp_aggr.adb: Minor comment changes and reformatting. * exp_aggr.adb: Minor comment changes and reformatting.
* sem_eval.adb (Find_Universal_Operator_Type): Put in proper alpha order * sem_eval.adb (Find_Universal_Operator_Type): Put in proper alpha order
......
...@@ -3802,23 +3802,25 @@ package body Sem_Eval is ...@@ -3802,23 +3802,25 @@ package body Sem_Eval is
Priv_E : Entity_Id; Priv_E : Entity_Id;
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean; function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean;
-- Check whether one operand is a mixed-mode operation that requires -- Check whether one operand is a mixed-mode operation that requires the
-- the presence of a fixed-point type. Given that all operands are -- presence of a fixed-point type. Given that all operands are universal
-- universal and have been constant-folded, retrieve the original -- and have been constant-folded, retrieve the original function call.
-- function call.
--------------------------- ---------------------------
-- Is_Mixed_Mode_Operand -- -- Is_Mixed_Mode_Operand --
--------------------------- ---------------------------
function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean is function Is_Mixed_Mode_Operand (Op : Node_Id) return Boolean is
Onod : constant Node_Id := Original_Node (Op);
begin begin
return Nkind (Original_Node (Op)) = N_Function_Call return Nkind (Onod) = N_Function_Call
and then Present (Next_Actual (First_Actual (Original_Node (Op)))) and then Present (Next_Actual (First_Actual (Onod)))
and then Etype (First_Actual (Original_Node (Op))) /= and then Etype (First_Actual (Onod)) /=
Etype (Next_Actual (First_Actual (Original_Node (Op)))); Etype (Next_Actual (First_Actual (Onod)));
end Is_Mixed_Mode_Operand; end Is_Mixed_Mode_Operand;
-- Start of processing for Find_Universal_Operator_Type
begin begin
if Nkind (Call) /= N_Function_Call if Nkind (Call) /= N_Function_Call
or else Nkind (Name (Call)) /= N_Expanded_Name or else Nkind (Name (Call)) /= N_Expanded_Name
...@@ -3827,20 +3829,18 @@ package body Sem_Eval is ...@@ -3827,20 +3829,18 @@ package body Sem_Eval is
-- There are two cases where the context does not imply the type of the -- There are two cases where the context does not imply the type of the
-- operands: either the universal expression appears in a type -- 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. -- operator, where the context type is always Boolean.
elsif Nkind (Parent (N)) = N_Type_Conversion elsif Nkind (Parent (N)) = N_Type_Conversion
or else or else Is_Relational
Is_Relational or else In_Membership
or else
In_Membership
then then
Pack := Entity (Prefix (Name (Call))); Pack := Entity (Prefix (Name (Call)));
-- If the prefix is a package declared elsewhere, iterate over -- If the prefix is a package declared elsewhere, iterate over its
-- its visible entities, otherwise iterate over all declarations -- visible entities, otherwise iterate over all declarations in the
-- in the designated scope. -- designated scope.
if Ekind (Pack) = E_Package if Ekind (Pack) = E_Package
and then not In_Open_Scopes (Pack) and then not In_Open_Scopes (Pack)
......
...@@ -5848,6 +5848,54 @@ package body Sem_Util is ...@@ -5848,6 +5848,54 @@ package body Sem_Util is
and then Is_Imported (Entity (Name (N))); and then Is_Imported (Entity (Name (N)));
end Is_CPP_Constructor_Call; 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 -- -- Is_Dependent_Component_Of_Mutable_Object --
---------------------------------------------- ----------------------------------------------
...@@ -7115,54 +7163,6 @@ package body Sem_Util is ...@@ -7115,54 +7163,6 @@ package body Sem_Util is
end Is_VMS_Operator; 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 -- -- 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