From 7ec8363d058e085cf510a968eeb975333e18dd9f Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 22 Jun 2010 07:32:15 +0000 Subject: sem_util.adb (Is_Delegate): Put in proper alpha order. 2010-06-22 Robert Dewar * sem_util.adb (Is_Delegate): Put in proper alpha order. * sem_eval.adb: Minor reformatting. From-SVN: r161140 --- gcc/ada/ChangeLog | 5 +++ gcc/ada/sem_eval.adb | 32 +++++++++--------- gcc/ada/sem_util.adb | 96 ++++++++++++++++++++++++++-------------------------- 3 files changed, 69 insertions(+), 64 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bc310e3..81521cf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2010-06-22 Robert Dewar + * sem_util.adb (Is_Delegate): Put in proper alpha order. + * sem_eval.adb: Minor reformatting. + +2010-06-22 Robert Dewar + * 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 diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 11fba8e..6b2602e 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -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) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index df56bc5..9e0dece 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 -- ----------------- -- cgit v1.1