aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRobert Dewar <dewar@adacore.com>2010-06-22 07:32:15 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2010-06-22 09:32:15 +0200
commit7ec8363d058e085cf510a968eeb975333e18dd9f (patch)
treef385557a32456697e597dace37ae011ba2165375
parent74e7891f8d73153b50beebbd497d69b18fc8cb24 (diff)
downloadgcc-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/ChangeLog5
-rw-r--r--gcc/ada/sem_eval.adb32
-rw-r--r--gcc/ada/sem_util.adb96
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 --
-----------------