[multiple changes]

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* make.adb, makeutl.adb, makeutl.ads, clean.adb (Makeutl.Queue): new
	package.

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

	* cstand.adb (Create_Standard): select Universal_Integer as an ALFA type
	* sem_ch3.adb (Array_Type_Declaration): detect array types in ALFA
	* sem_util.adb, sem_util.ads (Has_Static_Array_Bounds): new function to
	detect that an array has static bounds.

From-SVN: r177264

gcc/ada/ChangeLog

+2011-08-03  Emmanuel Briot  <briot@adacore.com>
+
+	* make.adb, makeutl.adb, makeutl.ads, clean.adb (Makeutl.Queue): new
+	package.
+
+2011-08-03  Yannick Moy  <moy@adacore.com>
+
+	* cstand.adb (Create_Standard): select Universal_Integer as an ALFA type
+	* sem_ch3.adb (Array_Type_Declaration): detect array types in ALFA
+	* sem_util.adb, sem_util.ads (Has_Static_Array_Bounds): new function to
+	detect that an array has static bounds.
+
 2011-08-03  Thomas Quinot  <quinot@adacore.com>
 
 	* exp_dist.adb: Minor reformatting.

gcc/ada/clean.adb

@@ -141,34 +141,6 @@ package body Clean is
    --  Table to store all the source files of a library unit: spec, body and
    --  subunits, to detect .dg files and delete them.
 
-   ----------------------------
-   -- Queue (Q) manipulation --
-   ----------------------------
-
-   procedure Init_Q;
-   --  Must be called to initialize the Q
-
-   procedure Insert_Q (Lib_File  : File_Name_Type);
-   --  If Lib_File is not marked, inserts it at the end of Q and mark it
-
-   function Empty_Q return Boolean;
-   --  Returns True if Q is empty
-
-   procedure Extract_From_Q (Lib_File : out File_Name_Type);
-   --  Extracts the first element from the Q
-
-   Q_Front : Natural;
-   --  Points to the first valid element in the Q
-
-   package Q is new Table.Table (
-     Table_Component_Type => File_Name_Type,
-     Table_Index_Type     => Natural,
-     Table_Low_Bound      => 0,
-     Table_Initial        => 4000,
-     Table_Increment      => 100,
-     Table_Name           => "Clean.Q");
-   --  This is the actual queue
-
    -----------------------------
    -- Other local subprograms --
    -----------------------------
@@ -399,8 +371,11 @@ package body Clean is
       Text    : Text_Buffer_Ptr;
       The_ALI : ALI_Id;
 
+      Found : Boolean;
+      Source : Queue.Source_Info;
+
    begin
-      Init_Q;
+      Queue.Initialize (Queue_Per_Obj_Dir => False);
 
       --  It does not really matter if there is or not an object file
       --  corresponding to an ALI file: if there is one, it will be deleted.
@@ -414,12 +389,23 @@ package body Clean is
       for N_File in 1 .. Osint.Number_Of_Files loop
          Main_Source_File := Next_Main_Source;
          Main_Lib_File := Osint.Lib_File_Name
-                             (Main_Source_File, Current_File_Index);
-         Insert_Q (Main_Lib_File);
+           (Main_Source_File, Current_File_Index);
+
+         if Main_Lib_File /= No_File then
+            Queue.Insert
+              ((Format  => Format_Gnatmake,
+                File    => Main_Lib_File,
+                Unit    => No_Unit_Name,
+                Index   => 0,
+                Project => No_Project));
+         end if;
 
-         while not Empty_Q loop
+         while not Queue.Is_Empty loop
             Sources.Set_Last (0);
-            Extract_From_Q (Lib_File);
+            Queue.Extract (Found, Source);
+            pragma Assert (Found);
+            pragma Assert (Source.File /= No_File);
+            Lib_File := Source.File;
             Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
 
             --  If we have existing ALI file that is not read-only, process it
@@ -448,7 +434,14 @@ package body Clean is
                         for K in ALI.Units.Table (J).First_With ..
                           ALI.Units.Table (J).Last_With
                         loop
-                           Insert_Q (Withs.Table (K).Afile);
+                           if Withs.Table (K).Afile /= No_File then
+                              Queue.Insert
+                                ((Format  => Format_Gnatmake,
+                                  File    => Withs.Table (K).Afile,
+                                  Unit    => No_Unit_Name,
+                                  Index   => 0,
+                                  Project => No_Project));
+                           end if;
                         end loop;
                      end loop;
 
@@ -1348,26 +1341,6 @@ package body Clean is
       end if;
    end Display_Copyright;
 
-   -------------
-   -- Empty_Q --
-   -------------
-
-   function Empty_Q return Boolean is
-   begin
-      return Q_Front >= Q.Last;
-   end Empty_Q;
-
-   --------------------
-   -- Extract_From_Q --
-   --------------------
-
-   procedure Extract_From_Q (Lib_File : out File_Name_Type) is
-      Lib : constant File_Name_Type := Q.Table (Q_Front);
-   begin
-      Q_Front  := Q_Front + 1;
-      Lib_File := Lib;
-   end Extract_From_Q;
-
    ---------------
    -- Gnatclean --
    ---------------
@@ -1535,16 +1508,6 @@ package body Clean is
       return False;
    end In_Extension_Chain;
 
-   ------------
-   -- Init_Q --
-   ------------
-
-   procedure Init_Q is
-   begin
-      Q_Front := Q.First;
-      Q.Set_Last (Q.First);
-   end Init_Q;
-
    ----------------
    -- Initialize --
    ----------------
@@ -1596,24 +1559,6 @@ package body Clean is
       All_Projects := False;
    end Initialize;
 
-   --------------
-   -- Insert_Q --
-   --------------
-
-   procedure Insert_Q (Lib_File : File_Name_Type) is
-   begin
-      --  Do not insert an empty name or an already marked source
-
-      if Lib_File /= No_File and then not Makeutl.Is_Marked (Lib_File) then
-         Q.Table (Q.Last) := Lib_File;
-         Q.Increment_Last;
-
-         --  Mark the source that has been just added to the Q
-
-         Makeutl.Mark (Lib_File);
-      end if;
-   end Insert_Q;
-
    ----------------------
    -- Object_File_Name --
    ----------------------

gcc/ada/cstand.adb

@@ -1334,6 +1334,7 @@ package body CStand is
       Set_Scope (Universal_Integer, Standard_Standard);
       Build_Signed_Integer_Type
         (Universal_Integer, Standard_Long_Long_Integer_Size);
+      Set_Is_In_ALFA (Universal_Integer);
 
       Universal_Real := New_Standard_Entity;
       Decl := New_Node (N_Full_Type_Declaration, Stloc);

gcc/ada/makeutl.ads

@@ -250,21 +250,86 @@ package Makeutl is
 
    end Mains;
 
-   ----------------------
-   -- Marking Routines --
-   ----------------------
-
-   procedure Mark (Source_File : File_Name_Type; Index : Int := 0);
-   --  Mark a unit, identified by its source file and, when Index is not 0, the
-   --  index of the unit in the source file. Marking is used to signal that the
-   --  unit has already been inserted in the Q.
-
-   function Is_Marked
-     (Source_File : File_Name_Type;
-      Index       : Int := 0) return Boolean;
-   --  Returns True if the unit was previously marked
-
-   procedure Delete_All_Marks;
-   --  Remove all file/index couples marked
+   -----------
+   -- Queue --
+   -----------
+
+   type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
+
+   package Queue is
+      --  The queue of sources to be checked for compilation.
+      --  There can be a single such queue per application.
+
+      type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
+         record
+            case Format is
+            when Format_Gprbuild =>
+               Id : Source_Id := null;
+
+            when Format_Gnatmake =>
+               File      : File_Name_Type := No_File;
+               Unit      : Unit_Name_Type := No_Unit_Name;
+               Index     : Int := 0;
+               Project   : Project_Id := No_Project;
+            end case;
+         end record;
+      --  Information about files stored in the queue. The exact information
+      --  depends on the builder, and in particular whether it only supports
+      --  project-based files (in which case we have a full Source_Id record).
+
+      procedure Initialize
+        (Queue_Per_Obj_Dir : Boolean;
+         Force : Boolean := False);
+      --  Initialize the queue.
+      --  Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
+      --  when True, there cannot be simultaneous compilations with the object
+      --  files in the same object directory when project files are used.
+      --
+      --  Nothing is done if Force is False and the queue was already
+      --  initialized.
+
+      procedure Remove_Marks;
+      --  Remove all marks set for the files.
+      --  This means that the files will be handed to the compiler if they are
+      --  added to the queue, and is mostly useful when recompiling several
+      --  executables in non-project mode, as the switches may be different
+      --  and -s may be in use.
+
+      function Is_Empty return Boolean;
+      --  Returns True if the queue is empty
+
+      function Is_Virtually_Empty return Boolean;
+      --  Returns True if the queue is empty or if all object directories are
+      --  busy.
+
+      procedure Insert (Source  : Source_Info);
+      function Insert (Source  : Source_Info) return Boolean;
+      --  Insert source in the queue.
+      --  The second version returns False if the Source was already marked in
+      --  the queue.
+
+      procedure Extract
+        (Found  : out Boolean;
+         Source : out Source_Info);
+      --  Get the first source that can be compiled from the queue. If no
+      --  source may be compiled, sets Found to False. In this case, the value
+      --  for Source is undefined.
+
+      function Size return Natural;
+      --  Return the total size of the queue, including the sources already
+      --  extracted.
+
+      function Processed return Natural;
+      --  Return the number of source in the queue that have aready been
+      --  processed.
+
+      procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
+      procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
+      --  Mark Obj_Dir as busy or free (see the parameter to Initialize)
+
+      function Element (Rank : Positive) return File_Name_Type;
+      --  Get the file name for element of index Rank in the queue
+
+   end Queue;
 
 end Makeutl;

gcc/ada/sem_ch3.adb

@@ -4639,6 +4639,7 @@ package body Sem_Ch3 is
       Nb_Index      : Nat;
       P             : constant Node_Id := Parent (Def);
       Priv          : Entity_Id;
+      T_In_ALFA     : Boolean := True;
 
    begin
       if Nkind (Def) = N_Constrained_Array_Definition then
@@ -4665,6 +4666,12 @@ 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:
 
@@ -4740,10 +4747,18 @@ package body Sem_Ch3 is
             Check_SPARK_Restriction ("subtype mark required", Component_Typ);
          end if;
 
+         if Present (Element_Type)
+           and then not Is_In_ALFA (Element_Type)
+         then
+            T_In_ALFA := False;
+         end if;
+
       --  Ada 2005 (AI-230): Access Definition case
 
       else pragma Assert (Present (Access_Definition (Component_Def)));
 
+         T_In_ALFA := False;
+
          --  Indicate that the anonymous access type is created by the
          --  array type declaration.
 
@@ -4820,6 +4835,12 @@ package body Sem_Ch3 is
                                (Implicit_Base, Finalize_Storage_Only
                                                         (Element_Type));
 
+         --  Final check for static bounds on array
+
+         if not Has_Static_Array_Bounds (T) then
+            T_In_ALFA := False;
+         end if;
+
       --  Unconstrained array case
 
       else
@@ -4844,6 +4865,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);
 
       if Aliased_Present (Component_Definition (Def)) then
          Check_SPARK_Restriction

gcc/ada/sem_util.adb

@@ -5550,6 +5550,69 @@ package body Sem_Util is
       end if;
    end Has_Private_Component;
 
+   -----------------------------
+   -- Has_Static_Array_Bounds --
+   -----------------------------
+
+   function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean is
+      Ndims : constant Nat := Number_Dimensions (Typ);
+
+      Index : Node_Id;
+      Low   : Node_Id;
+      High  : Node_Id;
+
+   begin
+      --  Unconstrained types do not have static bounds
+
+      if not Is_Constrained (Typ) then
+         return False;
+      end if;
+
+      --  First treat specially string literals, as the lower bound and length
+      --  of string literals are not stored like those of arrays.
+
+      --  A string literal always has static bounds
+
+      if Ekind (Typ) = E_String_Literal_Subtype then
+         return True;
+      end if;
+
+      --  Treat all dimensions in turn
+
+      Index := First_Index (Typ);
+      for Indx in 1 .. Ndims loop
+
+         --  In case of an erroneous index which is not a discrete type, return
+         --  that the type is not static.
+
+         if not Is_Discrete_Type (Etype (Index))
+           or else Etype (Index) = Any_Type
+         then
+            return False;
+         end if;
+
+         Get_Index_Bounds (Index, Low, High);
+
+         if Error_Posted (Low) or else Error_Posted (High) then
+            return False;
+         end if;
+
+         if         Is_OK_Static_Expression (Low)
+           and then Is_OK_Static_Expression (High)
+         then
+            null;
+         else
+            return False;
+         end if;
+
+         Next (Index);
+      end loop;
+
+      --  If we fall through the loop, all indexes matched
+
+      return True;
+   end Has_Static_Array_Bounds;
+
    ----------------
    -- Has_Stream --
    ----------------

gcc/ada/sem_util.ads

@@ -624,6 +624,9 @@ package Sem_Util is
    --  Check if a type has a (sub)component of a private type that has not
    --  yet received a full declaration.
 
+   function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean;
+   --  Return whether an array type has static bounds
+
    function Has_Stream (T : Entity_Id) return Boolean;
    --  Tests if type T is derived from Ada.Streams.Root_Stream_Type, or in the
    --  case of a composite type, has a component for which this predicate is