[multiple changes]

2017-09-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb, sem_aux.adb, sem_res.adb: Minor reformatting.

2017-09-06  Yannick Moy  <moy@adacore.com>

	* sem_ch12.adb (Analyze_Instance_And_Renamings): Refactor to set
	global variable Ignore_SPARK_Mode_Pragmas_In_Instance only once.

2017-09-06  Bob Duff  <duff@adacore.com>

	* sem_ch8.adb: Change Assert to be consistent with
	other similar ones.

2017-09-06  Bob Duff  <duff@adacore.com>

	* binde.adb (Find_Elab_Order): Do not run Elab_Old unless
	requested. Previously, the -do switch meant "run Elab_New and
	Elab_Old and use the order chosen by Elab_Old, possibly with
	debugging printouts comparing the two orders."	Now it means
	"do not run Elab_New." This is of use if there are bugs that
	cause Elab_New to crash.
	(Elab_Position, Num_Chosen): Change type to Nat, to avoid various
	type conversions.
	* ali.ads (Elab_Position): Change type to Nat, to avoid various
	type conversions.

2017-09-06  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Check_Mode_Restriction_In_Enclosing_Context): Fix
	reference to SPARK RM.

2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>

	* layout.adb: Use SSU short hand consistently throughout the file.

2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>

	* freeze.adb (Freeze_Record_Type)
	<Sized_Component_Total_Round_RM_Size>: New local variable to
	accumulate the rounded RM_Size of components.  Update it for
	every component whose RM_Size is statically known.  Add missing
	guard to check that bit packing is really required before issuing
	the error about packing.  Swap condition for clarity's sake.
	* sem_prag.adb (Usage_Error): fix reference to
	SPARK RM in comment

2017-09-06  Fedor Rybin  <frybin@adacore.com>

	* makeutl.adb, makeutl.ads, mlib.adb, mlib.ads, mlib-fil.adb,
	mlib-fil.ads, mlib-prj.adb, mlib-prj.ads, mlib-tgt.adb, mlib-tgt.ads,
	mlib-tgt-specific.adb, mlib-tgt-specific.ads,
	mlib-tgt-specific-aix.adb, mlib-tgt-specific-darwin.adb,
	mlib-tgt-specific-hpux.adb, mlib-tgt-specific-linux.adb,
	mlib-tgt-specific-mingw.adb, mlib-tgt-specific-solaris.adb,
	mlib-tgt-specific-vxworks.adb, mlib-tgt-specific-xi.adb, mlib-utl.adb,
	mlib-utl.ads, prj.adb, prj.ads, prj-attr.adb, prj-attr.ads,
	prj-attr-pm.adb, prj-attr-pm.ads, prj-com.ads, prj-conf.adb,
	prj-conf.ads, prj-dect.adb, prj-dect.ads, prj-env.adb, prj-env.ads,
	prj-err.adb, prj-err.ads, prj-ext.adb, prj-ext.ads, prj-makr.adb,
	prj-makr.ads, prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb, prj-pars.ads,
	prj-part.adb, prj-part.ads, prj-pp.adb, prj-pp.ads, prj-proc.adb,
	prj-proc.ads, prj-strt.adb, prj-strt.ads, prj-tree.adb, prj-tree.ads,
	prj-util.adb, prj-util.ads, sinput-p.adb, sinput-p.ads: Remove obsolete
	project manager sources.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Assigment): If the left-hand side is an
	entity of a mutable type and the right-hand side is a conditional
	expression, resolve the alternatives of the conditional using
	the base type of the target entity, because the alternatives
	may have distinct subtypes. This is particularly relevant if
	the alternatives are aggregates.

From-SVN: r251797

1 files changed, 124 insertions, 97 deletions

diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb
index 869cc43..329c6ca 100644
--- a/gcc/ada/binde.adb
+++ b/gcc/ada/binde.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -229,7 +229,7 @@ package body Binde is
       --  Used in computing transitive closure for Elaborate_All and also in
       --  locating cycles and paths in the diagnose routines.
 
-      Elab_Position : Natural;
+      Elab_Position : Nat;
       --  Initialized to zero. Set non-zero when a unit is chosen and placed in
       --  the elaboration order. The value represents the ordinal position in
       --  the elaboration order.
@@ -279,7 +279,7 @@ package body Binde is
    --  Current unit, set by Gather_Dependencies, and picked up in Build_Link to
    --  set the Reason_Unit field of the created dependency link.
 
-   Num_Chosen : Natural;
+   Num_Chosen : Nat;
    --  Number of units chosen in the elaboration order so far
 
    -----------------------
@@ -329,7 +329,8 @@ package body Binde is
    --  the reason for the link is R. Ea_Id is the contents to be placed in the
    --  Elab_All_Link of the entry.
 
-   procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id);
+   procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id;
+                     Msg : String);
    --  Chosen is the next entry chosen in the elaboration order. This procedure
    --  updates all data structures appropriately.
 
@@ -984,7 +985,9 @@ package body Binde is
    -- Choose --
    ------------
 
-   procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id) is
+   procedure Choose (Elab_Order : in out Unit_Id_Table; Chosen : Unit_Id;
+                     Msg : String)
+   is
       pragma Assert (Chosen /= No_Unit_Id);
       S : Successor_Id;
       U : Unit_Id;
@@ -993,7 +996,7 @@ package body Binde is
       if Debug_Flag_C then
          Write_Str ("Choosing Unit ");
          Write_Unit_Name (Units.Table (Chosen).Uname);
-         Write_Eol;
+         Write_Str (Msg);
       end if;
 
       --  We shouldn't be choosing something with unelaborated predecessors,
@@ -1081,7 +1084,18 @@ package body Binde is
       Num_Chosen := Num_Chosen + 1;
 
       pragma Assert
-        (Errors_Detected > 0 or else Num_Chosen = Natural (Last (Elab_Order)));
+        (Errors_Detected > 0 or else Num_Chosen = Last (Elab_Order));
+      pragma Assert (Units.Last = UNR.Last);
+      pragma Assert (Num_Chosen + Num_Left = Int (UNR.Last));
+      if Debug_Flag_C then
+         Write_Str (" ");
+         Write_Int (Int (Num_Chosen));
+         Write_Str ("+");
+         Write_Int (Num_Left);
+         Write_Str ("=");
+         Write_Int (Int (UNR.Last));
+         Write_Eol;
+      end if;
 
       UNR.Table (Chosen).Elab_Position := Num_Chosen;
 
@@ -1099,7 +1113,8 @@ package body Binde is
          then
             null;
          else
-            Choose (Elab_Order, Corresponding_Body (Chosen));
+            Choose (Elab_Order, Corresponding_Body (Chosen),
+                    " [Elaborate_Body]");
          end if;
       end if;
    end Choose;
@@ -1196,7 +1211,7 @@ package body Binde is
             --  sufficiently long, generate error message and return True.
 
             if U = Uto and then PL >= ML then
-               Choose (Elab_Order, U);
+               Choose (Elab_Order, U, " [Find_Link: base]");
                return True;
 
             --  All done if already visited
@@ -1213,7 +1228,7 @@ package body Binde is
                while S /= No_Successor loop
                   if Find_Link (Succ.Table (S).After, PL + 1) then
                      Elab_Error_Msg (S);
-                     Choose (Elab_Order, U);
+                     Choose (Elab_Order, U, " [Find_Link: recursive]");
                      return True;
                   end if;
 
@@ -1591,7 +1606,7 @@ package body Binde is
          Error_Msg ("?since all units compiled with static elaboration model");
       end if;
 
-      if Do_New then
+      if Do_New and not Debug_Flag_Old and not Debug_Flag_Older then
          if Debug_Flag_V then
             Write_Line ("Doing new...");
          end if;
@@ -1602,13 +1617,14 @@ package body Binde is
       end if;
 
       --  Elab_New does not support the pessimistic order, so if that was
-      --  requested, use the old results. Use Elab_Old if -dp was selected.
-      --  Elab_New does not yet give proper error messages for illegal
-      --  Elaborate_Alls, so if there is one, run Elab_Old.
+      --  requested, use the old results. Use Elab_Old if -dp or -do was
+      --  selected. Elab_New does not yet give proper error messages for
+      --  illegal Elaborate_Alls, so if there is one, run Elab_Old.
 
       if Do_Old
         or Pessimistic_Elab_Order
         or Debug_Flag_Old
+        or Debug_Flag_Older
         or Illegal_Elab_All
       then
          if Debug_Flag_V then
@@ -1623,119 +1639,129 @@ package body Binde is
       declare
          Old_Order : Unit_Id_Array renames
                        Old_Elab_Order.Table (1 .. Last (Old_Elab_Order));
-         New_Order : Unit_Id_Array renames
-                       Elab_Order.Table (1 .. Last (Elab_Order));
-         Old_Pairs : constant Nat := Num_Spec_Body_Pairs (Old_Order);
-         New_Pairs : constant Nat := Num_Spec_Body_Pairs (New_Order);
-
       begin
          if Do_Old and Do_New then
-            Write_Line (Get_Name_String (First_Main_Lib_File));
-
-            pragma Assert (Old_Order'Length = New_Order'Length);
-            pragma Debug (Validate (Old_Order, Doing_New => False));
-            pragma Debug (Validate (New_Order, Doing_New => True));
+            declare
+               New_Order : Unit_Id_Array renames
+                             Elab_Order.Table (1 .. Last (Elab_Order));
+               Old_Pairs : constant Nat := Num_Spec_Body_Pairs (Old_Order);
+               New_Pairs : constant Nat := Num_Spec_Body_Pairs (New_Order);
 
-            --  Misc debug printouts that can be used for experimentation by
-            --  changing the 'if's below.
+            begin
+               Write_Line (Get_Name_String (First_Main_Lib_File));
 
-            if True then
-               if New_Order = Old_Order then
-                  Write_Line ("Elab_New: same order.");
-               else
-                  Write_Line ("Elab_New: diff order.");
-               end if;
-            end if;
+               pragma Assert (Old_Order'Length = New_Order'Length);
+               pragma Debug (Validate (Old_Order, Doing_New => False));
+               pragma Debug (Validate (New_Order, Doing_New => True));
 
-            if New_Order /= Old_Order and then False then
-               Write_Line ("Elaboration orders differ:");
-               Write_Elab_Order
-                 (Old_Order, Title => "OLD ELABORATION ORDER");
-               Write_Elab_Order
-                 (New_Order, Title => "NEW ELABORATION ORDER");
-            end if;
+               --  Misc debug printouts that can be used for experimentation by
+               --  changing the 'if's below.
 
-            if True then
-               Write_Str ("Pairs: ");
-               Write_Int (Old_Pairs);
+               if True then
+                  if New_Order = Old_Order then
+                     Write_Line ("Elab_New: same order.");
+                  else
+                     Write_Line ("Elab_New: diff order.");
+                  end if;
+               end if;
 
-               if Old_Pairs = New_Pairs then
-                  Write_Str (" = ");
-               elsif Old_Pairs < New_Pairs then
-                  Write_Str (" < ");
-               else
-                  Write_Str (" > ");
+               if New_Order /= Old_Order and then False then
+                  Write_Line ("Elaboration orders differ:");
+                  Write_Elab_Order
+                    (Old_Order, Title => "OLD ELABORATION ORDER");
+                  Write_Elab_Order
+                    (New_Order, Title => "NEW ELABORATION ORDER");
                end if;
 
-               Write_Int (New_Pairs);
-               Write_Eol;
-            end if;
+               if True then
+                  Write_Str ("Pairs: ");
+                  Write_Int (Old_Pairs);
 
-            if Old_Pairs /= New_Pairs and then False then
-               Write_Str ("Pairs: ");
-               Write_Int (Old_Pairs);
+                  if Old_Pairs = New_Pairs then
+                     Write_Str (" = ");
+                  elsif Old_Pairs < New_Pairs then
+                     Write_Str (" < ");
+                  else
+                     Write_Str (" > ");
+                  end if;
 
-               if Old_Pairs < New_Pairs then
-                  Write_Str (" < ");
-               else
-                  Write_Str (" > ");
+                  Write_Int (New_Pairs);
+                  Write_Eol;
                end if;
 
-               Write_Int (New_Pairs);
-               Write_Eol;
+               if Old_Pairs /= New_Pairs and then False then
+                  Write_Str ("Pairs: ");
+                  Write_Int (Old_Pairs);
 
-               if Old_Pairs /= New_Pairs and then Debug_Flag_V then
-                  Write_Elab_Order
-                    (Old_Order, Title => "OLD ELABORATION ORDER");
-                  Write_Elab_Order
-                    (New_Order, Title => "NEW ELABORATION ORDER");
-                  pragma Assert (New_Pairs >= Old_Pairs);
+                  if Old_Pairs < New_Pairs then
+                     Write_Str (" < ");
+                  else
+                     Write_Str (" > ");
+                  end if;
+
+                  Write_Int (New_Pairs);
+                  Write_Eol;
+
+                  if Old_Pairs /= New_Pairs and then Debug_Flag_V then
+                     Write_Elab_Order
+                       (Old_Order, Title => "OLD ELABORATION ORDER");
+                     Write_Elab_Order
+                       (New_Order, Title => "NEW ELABORATION ORDER");
+                     pragma Assert (New_Pairs >= Old_Pairs);
+                  end if;
                end if;
-            end if;
+            end;
          end if;
 
          --  The Elab_New algorithm doesn't implement the -p switch, so if that
-         --  was used, use the results from the old algorithm.
-
-         if Pessimistic_Elab_Order or Debug_Flag_Old then
-            New_Order := Old_Order;
+         --  was used, use the results from the old algorithm. Likewise if the
+         --  user has requested the old algorithm.
+
+         if Pessimistic_Elab_Order or Debug_Flag_Old or Debug_Flag_Older then
+            pragma Assert
+              (Last (Elab_Order) = 0
+                 or else Last (Elab_Order) = Old_Order'Last);
+            Init (Elab_Order);
+            Append_All (Elab_Order, Old_Order);
          end if;
 
          --  Now set the Elab_Positions in the Units table. It is important to
          --  do this late, in case we're running both Elab_New and Elab_Old.
 
          declare
+            New_Order : Unit_Id_Array renames
+                          Elab_Order.Table (1 .. Last (Elab_Order));
             Units_Array : Units.Table_Type renames
                             Units.Table (Units.First .. Units.Last);
-
          begin
             for J in New_Order'Range loop
                pragma Assert
-                 (UNR.Table (New_Order (J)).Elab_Position = Positive (J));
-               Units_Array  (New_Order (J)).Elab_Position := Positive (J);
+                 (UNR.Table (New_Order (J)).Elab_Position = J);
+               Units_Array  (New_Order (J)).Elab_Position := J;
             end loop;
-         end;
 
-         if Errors_Detected = 0 then
+            if Errors_Detected = 0 then
 
-            --  Display elaboration order if -l was specified
+               --  Display elaboration order if -l was specified
 
-            if Elab_Order_Output then
-               if Zero_Formatting then
-                  Write_Elab_Order (New_Order, Title => "");
-               else
-                  Write_Elab_Order (New_Order, Title => "ELABORATION ORDER");
+               if Elab_Order_Output then
+                  if Zero_Formatting then
+                     Write_Elab_Order (New_Order, Title => "");
+                  else
+                     Write_Elab_Order
+                       (New_Order, Title => "ELABORATION ORDER");
+                  end if;
                end if;
-            end if;
 
-            --  Display list of sources in the closure (except predefined
-            --  sources) if -R was used. Include predefined sources if -Ra
-            --  was used.
+               --  Display list of sources in the closure (except predefined
+               --  sources) if -R was used. Include predefined sources if -Ra
+               --  was used.
 
-            if List_Closure then
-               Write_Closure (New_Order);
+               if List_Closure then
+                  Write_Closure (New_Order);
+               end if;
             end if;
-         end if;
+         end;
       end;
    end Find_Elab_Order;
 
@@ -2927,7 +2953,7 @@ package body Binde is
             --  a circularity. In the latter case, diagnose the circularity,
             --  removing it from the graph and continue.
             --  ????But Diagnose_Elaboration_Problem always raises an
-            --  exception.
+            --  exception, so the loop never goes around more than once.
 
             Get_No_Pred : while No_Pred = No_Unit_Id loop
                exit Outer when Num_Left < 1;
@@ -2979,7 +3005,7 @@ package body Binde is
 
             --  Choose the best candidate found
 
-            Choose (Elab_Order, Best_So_Far);
+            Choose (Elab_Order, Best_So_Far, " [Best_So_Far]");
 
             --  If it's a spec with a body, and the body is not yet chosen,
             --  choose the body if possible. The case where the body is
@@ -3007,7 +3033,8 @@ package body Binde is
                   end if;
 
                   if Choose_The_Body then
-                     Choose (Elab_Order, Corresponding_Body (Best_So_Far));
+                     Choose (Elab_Order, Corresponding_Body (Best_So_Far),
+                             " [body]");
                   end if;
                end;
             end if;
@@ -3027,7 +3054,7 @@ package body Binde is
                        and then UNR.Table (SCC (J)).Num_Pred = 0
                      then
                         Chose_One_Or_More := True;
-                        Choose (Elab_Order, SCC (J));
+                        Choose (Elab_Order, SCC (J), " [same SCC]");
                      end if;
                   end loop;
 
@@ -3074,7 +3101,7 @@ package body Binde is
          pragma Assert (SCC (U) = U);
       begin
          for J in Nodes (U)'Range loop
-            Write_Int (Int (UNR.Table (Nodes (U) (J)).Elab_Position));
+            Write_Int (UNR.Table (Nodes (U) (J)).Elab_Position);
             Write_Str (". ");
             Write_Unit_Name (Units.Table (Nodes (U) (J)).Uname);
             Write_Eol;
@@ -3125,7 +3152,7 @@ package body Binde is
             --  a circularity. In the latter case, diagnose the circularity,
             --  removing it from the graph and continue.
             --  ????But Diagnose_Elaboration_Problem always raises an
-            --  exception.
+            --  exception, so the loop never goes around more than once.
 
             Get_No_Pred : while No_Pred = No_Unit_Id loop
                exit Outer when Num_Left < 1;
@@ -3173,7 +3200,7 @@ package body Binde is
 
             --  Choose the best candidate found
 
-            Choose (Elab_Order, Best_So_Far);
+            Choose (Elab_Order, Best_So_Far, " [Elab_Old Best_So_Far]");
          end loop Outer;
       end Find_Elab_Order;