[multiple changes]

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* impunit.adb, exp_ch4.adb, s-finmas.adb: Minor reformatting.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (TC_Rec_Add_Process_Element): For a choice with multiple
	values, we generate multiple triples of parameters in the TypeCode.
	Bump Choice_Index for each such triple so that a subsequent default
	choice is associated with the correct index in the typecode.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* a-cdlili.adb (Iterate): Initialize properly an iterator over a null
	container.
	(First, Last): Handle properly an iterator over a null container.

2011-08-29  Bob Duff  <duff@adacore.com>

	* sem_ch10.adb (Analyze_With_Clause,Install_Withed_Unit): Abandon
	processing if we run across a node with no Scope. This can happen if
	we're with-ing an library-level instance, and that instance got errors
	that caused "instantiation abandoned".
	* sem_util.adb (Unit_Declaration_Node): Make it more robust, by raising
	an exception instead of using Assert, so it won't go into an infinite
	loop, even when assertions are turned off.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* a-coorse.adb: Proper handling of empty ordered sets.

From-SVN: r178249

10 files changed, 123 insertions, 51 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 00c9e10..b2f77e1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+	* impunit.adb, exp_ch4.adb, s-finmas.adb: Minor reformatting.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_dist.adb (TC_Rec_Add_Process_Element): For a choice with multiple
+	values, we generate multiple triples of parameters in the TypeCode.
+	Bump Choice_Index for each such triple so that a subsequent default
+	choice is associated with the correct index in the typecode.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-cdlili.adb (Iterate): Initialize properly an iterator over a null
+	container.
+	(First, Last): Handle properly an iterator over a null container.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* sem_ch10.adb (Analyze_With_Clause,Install_Withed_Unit): Abandon
+	processing if we run across a node with no Scope. This can happen if
+	we're with-ing an library-level instance, and that instance got errors
+	that caused "instantiation abandoned".
+	* sem_util.adb (Unit_Declaration_Node): Make it more robust, by raising
+	an exception instead of using Assert, so it won't go into an infinite
+	loop, even when assertions are turned off.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* a-coorse.adb: Proper handling of empty ordered sets.
+
 2011-08-29  Johannes Kanig  <kanig@adacore.com>
 
 	* debug.adb: Add comments.
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb
index 4682ffb..ef02e46 100644
--- a/gcc/ada/a-cdlili.adb
+++ b/gcc/ada/a-cdlili.adb
@@ -412,9 +412,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
    end First;
 
    function First (Object : Iterator) return Cursor is
-      C : constant Cursor := (Object.Container, Object.Container.First);
    begin
-      return C;
+      if Object.Container = null then
+         return No_Element;
+      else
+         return (Object.Container, Object.Container.First);
+      end if;
    end First;
 
    -------------------
@@ -819,9 +822,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
    function Iterate (Container : List)
      return List_Iterator_Interfaces.Reversible_Iterator'class
    is
-      It : constant Iterator := (Container'Unchecked_Access, Container.First);
    begin
-      return It;
+      if Container.Length = 0 then
+         return Iterator'(null, null);
+      else
+         return Iterator'(Container'Unchecked_Access, Container.First);
+      end if;
    end Iterate;
 
    function Iterate (Container : List; Start : Cursor)
@@ -846,9 +852,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
    end Last;
 
    function Last (Object : Iterator) return Cursor is
-      C : constant Cursor := (Object.Container, Object.Container.Last);
    begin
-      return C;
+      if Object.Container = null then
+         return No_Element;
+      else
+         return (Object.Container, Object.Container.Last);
+      end if;
    end Last;
 
    ------------------
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb
index 5ebd2a9..849cb53 100644
--- a/gcc/ada/a-cidlli.adb
+++ b/gcc/ada/a-cidlli.adb
@@ -451,7 +451,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function First (Object : Iterator) return Cursor is
    begin
-      return Cursor'(Object.Container, Object.Container.First);
+      if Object.Container = null then
+         return No_Element;
+      else
+         return Cursor'(Object.Container, Object.Container.First);
+      end if;
    end First;
 
    -------------------
@@ -847,9 +851,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Container : List)
       return List_Iterator_Interfaces.Reversible_Iterator'class
    is
-      It : constant Iterator := (Container'Unchecked_Access, Container.First);
    begin
-      return It;
+      if Container.Length = 0 then
+         return Iterator'(null, null);
+      else
+         return Iterator'(Container'Unchecked_Access, Container.First);
+      end if;
    end Iterate;
 
    function Iterate
@@ -877,11 +884,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Last (Object : Iterator) return Cursor is
    begin
-      if Object.Container.Last = null then
+      if Object.Container = null then
          return No_Element;
+      else
+         return Cursor'(Object.Container, Object.Container.Last);
       end if;
-
-      return Cursor'(Object.Container, Object.Container.Last);
    end Last;
 
    ------------------
diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb
index b7d9d45..668bd73 100644
--- a/gcc/ada/a-coorse.adb
+++ b/gcc/ada/a-coorse.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -532,8 +532,13 @@ package body Ada.Containers.Ordered_Sets is
 
    function First (Object : Iterator) return Cursor is
    begin
-      return Cursor'(
-       Object.Container.all'Unrestricted_Access, Object.Container.Tree.First);
+      if Object.Container = null then
+         return No_Element;
+      else
+         return Cursor'(
+          Object.Container.all'Unrestricted_Access,
+            Object.Container.Tree.First);
+      end if;
    end First;
 
    -------------------
@@ -1142,10 +1147,12 @@ package body Ada.Containers.Ordered_Sets is
    function Iterate (Container : Set)
      return Ordered_Set_Iterator_Interfaces.Reversible_Iterator'class
    is
-      It : constant Iterator :=
-             (Container'Unchecked_Access, Container.Tree.First);
    begin
-      return It;
+      if Container.Length = 0 then
+         return Iterator'(null, null);
+      else
+         return Iterator'(Container'Unchecked_Access, Container.Tree.First);
+      end if;
    end Iterate;
 
    function Iterate (Container : Set; Start : Cursor)
@@ -1171,7 +1178,7 @@ package body Ada.Containers.Ordered_Sets is
 
    function Last (Object : Iterator) return Cursor is
    begin
-      if Object.Container.Tree.Last = null then
+      if Object.Container = null then
          return No_Element;
       end if;
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 4824df0..e3f9412 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -664,6 +664,8 @@ package body Exp_Ch4 is
    --  Start of processing for Expand_Allocator_Expression
 
    begin
+      --  WOuld be nice to comment the branches of this very long if ???
+
       if Is_Tagged_Type (T)
         or else Needs_Finalization (T)
       then
@@ -1136,6 +1138,7 @@ package body Exp_Ch4 is
 
             Rewrite (Exp, New_Copy (Expression (Exp)));
          end if;
+
       else
          Build_Allocate_Deallocate_Proc (N, True);
 
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index df6ead3..1f59c7a 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -2084,8 +2084,7 @@ package body Exp_Dist is
    is
       N : constant Name_Id := Chars (Def);
 
-      Overload_Order : constant Int :=
-                         Overload_Counter_Table.Get (N) + 1;
+      Overload_Order : constant Int := Overload_Counter_Table.Get (N) + 1;
 
    begin
       Overload_Counter_Table.Set (N, Overload_Order);
@@ -10429,7 +10428,7 @@ package body Exp_Dist is
 
                   --  A variant part
 
-                  declare
+                  Variant_Part : declare
                      Disc_Type : constant Entity_Id := Etype (Name (Field));
 
                      Is_Enum : constant Boolean :=
@@ -10451,6 +10450,8 @@ package body Exp_Dist is
                      Dummy_Counter : Int := 0;
 
                      Choice_Index : Int := 0;
+                     --  Index of current choice in TypeCode, used to identify
+                     --  it as the default choice if it is a "when others".
 
                      procedure Add_Params_For_Variant_Components;
                      --  Add a struct TypeCode and a corresponding member name
@@ -10489,6 +10490,8 @@ package body Exp_Dist is
                         Add_String_Parameter (Name_Str, Union_TC_Params);
                      end Add_Params_For_Variant_Components;
 
+                  --  Start of processing for Variant_Part
+
                   begin
                      Get_Name_String (U_Name);
                      Name_Str := String_From_Name_Buffer;
@@ -10547,6 +10550,8 @@ package body Exp_Dist is
                                        Add_Params_For_Variant_Components;
                                        J := J + Uint_1;
                                     end loop;
+                                    Choice_Index :=
+                                      Choice_Index + UI_To_Int (H - L) + 1;
                                  end;
 
                               when N_Others_Choice =>
@@ -10556,26 +10561,16 @@ package body Exp_Dist is
                                  --  current choice index. This parameter is by
                                  --  construction the 4th in Union_TC_Params.
 
-                                 declare
-                                    Default_Node : constant Node_Id :=
-                                                     Pick (Union_TC_Params, 4);
-
-                                    New_Default_Node : constant Node_Id :=
-                                      Make_Function_Call (Loc,
-                                       Name =>
-                                         New_Occurrence_Of
-                                           (RTE (RE_TA_I32), Loc),
-                                       Parameter_Associations =>
-                                         New_List (
-                                           Make_Integer_Literal (Loc,
-                                             Intval => Choice_Index)));
-
-                                 begin
-                                    Insert_Before
-                                      (Default_Node, New_Default_Node);
-
-                                    Remove (Default_Node);
-                                 end;
+                                 Replace
+                                   (Pick (Union_TC_Params, 4),
+                                    Make_Function_Call (Loc,
+                                      Name =>
+                                        New_Occurrence_Of
+                                          (RTE (RE_TA_I32), Loc),
+                                      Parameter_Associations =>
+                                        New_List (
+                                          Make_Integer_Literal (Loc,
+                                            Intval => Choice_Index))));
 
                                  --  Add a placeholder member label for the
                                  --  default case, which must have the
@@ -10594,6 +10589,7 @@ package body Exp_Dist is
                                  end;
 
                                  Add_Params_For_Variant_Components;
+                                 Choice_Index := Choice_Index + 1;
 
                               when others =>
 
@@ -10608,15 +10604,15 @@ package body Exp_Dist is
                                  end;
 
                                  Add_Params_For_Variant_Components;
+                                 Choice_Index := Choice_Index + 1;
                            end case;
 
                            Next (Choice);
-                           Choice_Index := Choice_Index + 1;
                         end loop;
 
                         Next_Non_Pragma (Variant);
                      end loop;
-                  end;
+                  end Variant_Part;
                end if;
             end TC_Rec_Add_Process_Element;
 
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index 9aa86d5..87498d8 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -524,9 +524,9 @@ package body Impunit is
      "a-synbar",    -- Ada.Synchronous_Barriers
      "a-undesu",    -- Ada.Unchecked_Deallocate_Subpool
 
-   -----------------------------------------
-   -- GNAT Defined Additions to Ada 20012 --
-   -----------------------------------------
+   ----------------------------------------
+   -- GNAT Defined Additions to Ada 2012 --
+   ----------------------------------------
 
      "a-cofove",    -- Ada.Containers.Formal_Vectors
      "a-cfdlli",    -- Ada.Containers.Formal_Doubly_Linked_Lists
diff --git a/gcc/ada/s-finmas.adb b/gcc/ada/s-finmas.adb
index 72b87df..a08bb08 100644
--- a/gcc/ada/s-finmas.adb
+++ b/gcc/ada/s-finmas.adb
@@ -29,7 +29,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Exceptions;          use Ada.Exceptions;
+with Ada.Exceptions; use Ada.Exceptions;
+
 with System.Address_Image;
 with System.HTable;           use System.HTable;
 with System.IO;               use System.IO;
@@ -241,12 +242,10 @@ package body System.Finalization_Masters is
      (Obj : System.Address) return Finalize_Address_Ptr
    is
       Result : Finalize_Address_Ptr;
-
    begin
       Lock_Task.all;
       Result := Finalize_Address_Table.Get (Obj);
       Unlock_Task.all;
-
       return Result;
    end Finalize_Address;
 
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 59ec7a4..2ab7084 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -2585,6 +2585,13 @@ package body Sem_Ch10 is
             if Par_Name /= Standard_Standard then
                Par_Name := Scope (Par_Name);
             end if;
+
+            --  Abandon processing in case of previous errors
+
+            if No (Par_Name) then
+               pragma Assert (Serious_Errors_Detected /= 0);
+               return;
+            end if;
          end loop;
 
          if Present (Entity (Pref))
@@ -5034,6 +5041,13 @@ package body Sem_Ch10 is
               ("instantiation depends on itself", Name (With_Clause));
 
          elsif not Is_Visible_Child_Unit (Uname) then
+            --  Abandon processing in case of previous errors
+
+            if No (Scope (Uname)) then
+               pragma Assert (Serious_Errors_Detected /= 0);
+               return;
+            end if;
+
             Set_Is_Visible_Child_Unit (Uname);
 
             --  If the child unit appears in the context of its parent, it is
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b51719d..eab20bf 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -12638,7 +12638,13 @@ package body Sem_Util is
         and then Nkind (N) not in N_Generic_Renaming_Declaration
       loop
          N := Parent (N);
-         pragma Assert (Present (N));
+
+         --  We don't use Assert here, because that causes an infinite loop
+         --  when assertions are turned off. Better to crash.
+
+         if No (N) then
+            raise Program_Error;
+         end if;
       end loop;
 
       return N;