From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Thu, 4 Aug 2011 08:09:35 +0000 (+0200)
Subject: [multiple changes]
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5c0e97dd35b7d16366bbae34539edff776f0b43c;p=gcc.git

[multiple changes]

2011-08-04  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb (Array_Type_Declaration): move test for type in ALFA
	after index creation; mark unconstrained base array type generated as
	being in/not in ALFA as well
	(Make_Index): mark subtype created as in/not in ALFA
	* sem_ch5.adb (Analyze_Iteration_Scheme): mark entity for iterating
	over a loop as in/not in ALFA, depending on its type and form of loop
	iteration.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Build_Object_Declarations): Initialize flag Abort
	directly to False on .NET and JVM.

From-SVN: r177326
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c4f4d47786e..aa77d3df316 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb (Array_Type_Declaration): move test for type in ALFA
+	after index creation; mark unconstrained base array type generated as
+	being in/not in ALFA as well
+	(Make_Index): mark subtype created as in/not in ALFA
+	* sem_ch5.adb (Analyze_Iteration_Scheme): mark entity for iterating
+	over a loop as in/not in ALFA, depending on its type and form of loop
+	iteration.
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Build_Object_Declarations): Initialize flag Abort
+	directly to False on .NET and JVM.
+
 2011-08-04  Yannick Moy  <moy@adacore.com>
 
 	* sem_ch3.adb (Constrain_Enumeration, Constrain_Integer): remove
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 7f2496e1979..21a1ffea63a 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2817,7 +2817,9 @@ package body Exp_Ch7 is
       --  order to detect this scenario, save the state of entry into the
       --  finalization code.
 
-      if Abort_Allowed then
+      if Abort_Allowed
+        and then VM_Target = No_VM
+      then
          declare
             Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E');
 
@@ -2869,7 +2871,9 @@ package body Exp_Ch7 is
                         Attribute_Name => Name_Identity)));
          end;
 
-      --  No abort
+      --  No abort or .NET/JVM. The VM version of Ada.Exceptions does not
+      --  include routine Raise_From_Controlled_Operation which is the sole
+      --  user of flag Abort.
 
       else
          A_Expr := New_Reference_To (Standard_False, Loc);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ec14ece6448..081b7fa10b0 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4678,12 +4678,6 @@ package body Sem_Ch3 is
             Check_SPARK_Restriction ("subtype mark required", Index);
          end if;
 
-         if Present (Etype (Index))
-           and then not Is_In_ALFA (Etype (Index))
-         then
-            T_In_ALFA := False;
-         end if;
-
          --  Add a subtype declaration for each index of private array type
          --  declaration whose etype is also private. For example:
 
@@ -4738,6 +4732,12 @@ package body Sem_Ch3 is
 
          Make_Index (Index, P, Related_Id, Nb_Index);
 
+         if Present (Etype (Index))
+           and then not Is_In_ALFA (Etype (Index))
+         then
+            T_In_ALFA := False;
+         end if;
+
          --  Check error of subtype with predicate for index type
 
          Bad_Predicated_Subtype_Use
@@ -4878,6 +4878,7 @@ package body Sem_Ch3 is
       Set_Component_Type (Base_Type (T), Element_Type);
       Set_Packed_Array_Type (T, Empty);
       Set_Is_In_ALFA (T, T_In_ALFA);
+      Set_Is_In_ALFA (Base_Type (T), T_In_ALFA);
 
       if Aliased_Present (Component_Definition (Def)) then
          Check_SPARK_Restriction
@@ -16538,6 +16539,19 @@ package body Sem_Ch3 is
          then
             Set_Is_Non_Static_Subtype (Def_Id);
          end if;
+
+         --  By default, consider that the subtype is in ALFA if its base type
+         --  is in ALFA.
+
+         Set_Is_In_ALFA (Def_Id, Is_In_ALFA (Base_Type (Def_Id)));
+
+         --  In ALFA, all subtypes should have a static range
+
+         if Nkind (R) = N_Range
+           and then not Is_Static_Range (R)
+         then
+            Set_Is_In_ALFA (Def_Id, False);
+         end if;
       end if;
 
       --  Final step is to label the index with this constructed type
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 6283207cc51..239f9fe35bf 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2082,6 +2082,17 @@ package body Sem_Ch5 is
                   Set_Etype (Id, Etype (DS));
                end if;
 
+               --  The entity for iterating over a loop is always in ALFA if
+               --  its type is in ALFA, and it is not an iteration over
+               --  elements of a container using the OF syntax.
+
+               if Is_In_ALFA (Etype (Id))
+                 and then (No (Iterator_Specification (N))
+                           or else not Of_Present (Iterator_Specification (N)))
+               then
+                  Set_Is_In_ALFA (Id);
+               end if;
+
                --  Treat a range as an implicit reference to the type, to
                --  inhibit spurious warnings.