diff options
author | Robert Dewar <dewar@adacore.com> | 2010-06-22 07:32:15 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-06-22 09:32:15 +0200 |
commit | 7ec8363d058e085cf510a968eeb975333e18dd9f (patch) | |
tree | f385557a32456697e597dace37ae011ba2165375 | |
parent | 74e7891f8d73153b50beebbd497d69b18fc8cb24 (diff) | |
download | gcc-7ec8363d058e085cf510a968eeb975333e18dd9f.zip gcc-7ec8363d058e085cf510a968eeb975333e18dd9f.tar.gz gcc-7ec8363d058e085cf510a968eeb975333e18dd9f.tar.bz2 |
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
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/sem_eval.adb | 32 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 96 |
3 files changed, 69 insertions, 64 deletions
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 <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 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 -- ----------------- |