[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Thu, 4 Aug 2011 08:09:35 +0000 (10:09 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 4 Aug 2011 08:09:35 +0000 (10:09 +0200)
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

gcc/ada/ChangeLog
gcc/ada/exp_ch7.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch5.adb

index c4f4d47..aa77d3d 100644 (file)
@@ -1,5 +1,20 @@
 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
        constraint that subtype must come from source code to be in ALFA, so
        that anonymous subtypes can be in ALFA too.
index 7f2496e..21a1ffe 100644 (file)
@@ -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);
index ec14ece..081b7fa 100644 (file)
@@ -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
index 6283207..239f9fe 100644 (file)
@@ -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.