[multiple changes]

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* lib-xref-spark_specific.adb, par-ch13.adb, sem_prag.adb, sem_prag.ads,
	sem_ch12.adb, sem_attr.adb, sem_ch6.adb, sem_ch13.adb, a-sequio.adb,
	s-atocou-builtin.adb: Minor reformatting.

2013-10-10  Thomas Quinot  <quinot@adacore.com>

	* s-oscons-tmplt.c (NEED_PTHREAD_CONDATTR_SETCLOCK): This
	constant needs to be output to s-oscons.h, as it is tested
	by init.c.

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Expand_N_Variant_Part): Don't expand choices, too early
	* exp_ch5.adb (Expand_N_Case_Statement): Use new Has_SP_Choice
	flag to avoid expanding choices when not necessary.
	* exp_util.adb: Minor reformatting
	* freeze.adb (Freeze_Record_Type): Redo expansion of variants
	* sem_aggr.adb: Minor reformatting
	* sem_case.ads, sem_case.adb: Major rewrite, separating Analysis and
	Checking of choices.
	* sem_ch3.adb (Analyze_Variant_Part): Rewrite to call new
	Analyze_Choices.
	* sem_ch4.adb (Analyze_Case_Expression): Call Analyze_Choices
	and Check_Choices
	* sem_ch5.adb (Analyze_Case_Statement): Call Analyze_Choices
	and Check_Choices
	* sem_util.adb: Minor reformatting
	* sinfo.ads, sinfo.adb (Has_SP_Choice): New flag.

2013-10-10  Vincent Celier  <celier@adacore.com>

	* mlib-prj.adb (Build_Library): Do not issue link dynamic
	libraries with an Rpath, if switch -R was used.

2013-10-10  Tristan Gingold  <gingold@adacore.com>

	* s-stalib.ads (Image_Index_Table_8, Image_Index_Table_16,
	Image_Index_Table_32): Remove as not used.
	* s-imgint.adb (Image_Integer): Call Set_Image_Integer and
	remove duplicated code.

From-SVN: r203358

28 files changed, 684 insertions, 292 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index df6f31c..97642d5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,46 @@
+2013-10-10  Robert Dewar  <dewar@adacore.com>
+
+	* lib-xref-spark_specific.adb, par-ch13.adb, sem_prag.adb, sem_prag.ads,
+	sem_ch12.adb, sem_attr.adb, sem_ch6.adb, sem_ch13.adb, a-sequio.adb,
+	s-atocou-builtin.adb: Minor reformatting.
+
+2013-10-10  Thomas Quinot  <quinot@adacore.com>
+
+	* s-oscons-tmplt.c (NEED_PTHREAD_CONDATTR_SETCLOCK): This
+	constant needs to be output to s-oscons.h, as it is tested
+	by init.c.
+
+2013-10-10  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Variant_Part): Don't expand choices, too early
+	* exp_ch5.adb (Expand_N_Case_Statement): Use new Has_SP_Choice
+	flag to avoid expanding choices when not necessary.
+	* exp_util.adb: Minor reformatting
+	* freeze.adb (Freeze_Record_Type): Redo expansion of variants
+	* sem_aggr.adb: Minor reformatting
+	* sem_case.ads, sem_case.adb: Major rewrite, separating Analysis and
+	Checking of choices.
+	* sem_ch3.adb (Analyze_Variant_Part): Rewrite to call new
+	Analyze_Choices.
+	* sem_ch4.adb (Analyze_Case_Expression): Call Analyze_Choices
+	and Check_Choices
+	* sem_ch5.adb (Analyze_Case_Statement): Call Analyze_Choices
+	and Check_Choices
+	* sem_util.adb: Minor reformatting
+	* sinfo.ads, sinfo.adb (Has_SP_Choice): New flag.
+
+2013-10-10  Vincent Celier  <celier@adacore.com>
+
+	* mlib-prj.adb (Build_Library): Do not issue link dynamic
+	libraries with an Rpath, if switch -R was used.
+
+2013-10-10  Tristan Gingold  <gingold@adacore.com>
+
+	* s-stalib.ads (Image_Index_Table_8, Image_Index_Table_16,
+	Image_Index_Table_32): Remove as not used.
+	* s-imgint.adb (Image_Integer): Call Set_Image_Integer and
+	remove duplicated code.
+
 2013-10-10  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Analyze_Pragma): Provide a
diff --git a/gcc/ada/a-sequio.adb b/gcc/ada/a-sequio.adb
index b9442e9..b842528 100644
--- a/gcc/ada/a-sequio.adb
+++ b/gcc/ada/a-sequio.adb
@@ -35,13 +35,15 @@
 --  (for specialized Sequential_IO functions)
 
 with Ada.Unchecked_Conversion;
+
 with System;
+with System.Byte_Swapping;
 with System.CRTL;
 with System.File_Control_Block;
 with System.File_IO;
 with System.Storage_Elements;
+
 with Interfaces.C_Streams; use Interfaces.C_Streams;
-with GNAT.Byte_Swapping;
 
 package body Ada.Sequential_IO is
 
@@ -69,11 +71,11 @@ package body Ada.Sequential_IO is
    ---------------
 
    procedure Byte_Swap (Siz : in out size_t) is
-      use GNAT.Byte_Swapping;
+      use System.Byte_Swapping;
    begin
       case Siz'Size is
-         when 32     => Swap4 (Siz'Address);
-         when 64     => Swap8 (Siz'Address);
+         when 32     => Siz := size_t (Bswap_32 (U32 (Siz)));
+         when 64     => Siz := size_t (Bswap_64 (U64 (Siz)));
          when others => raise Program_Error;
       end case;
    end Byte_Swap;
@@ -189,6 +191,9 @@ package body Ada.Sequential_IO is
          FIO.Read_Buf
            (AP (File), Rsiz'Address, size_t'Size / System.Storage_Unit);
 
+         --  If item read has non-default scalar storage order, then the size
+         --  will have been written with that same order, so byte swap it.
+
          if Element_Type'Scalar_Storage_Order /= System.Default_Bit_Order then
             Byte_Swap (Rsiz);
          end if;
@@ -288,6 +293,9 @@ package body Ada.Sequential_IO is
       if not Element_Type'Definite
         or else Element_Type'Has_Discriminants
       then
+         --  If item written has non-default scalar storage order, then the
+         --  size is written with that same order, so byte swap it.
+
          if Element_Type'Scalar_Storage_Order /= System.Default_Bit_Order then
             Byte_Swap (Swapped_Siz);
          end if;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index bc4557d..8e1124a 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5849,7 +5849,6 @@ package body Exp_Ch3 is
    procedure Expand_N_Variant_Part (N : Node_Id) is
       Last_Var    : constant Node_Id := Last_Non_Pragma (Variants (N));
       Others_Node : Node_Id;
-      Variant     : Node_Id;
 
    begin
       --  If the last variant does not contain the Others choice, replace it
@@ -5866,15 +5865,12 @@ package body Exp_Ch3 is
          Set_Discrete_Choices (Last_Var, New_List (Others_Node));
       end if;
 
-      --  Deal with any static predicates in the variant choices. Note that we
-      --  don't have to look at the last variant, since we know it is an others
-      --  choice, because we just rewrote it that way if necessary.
+      --  We have one more expansion activity, which is to deal with static
+      --  predicates in the variant choices. But we have to defer that to
+      --  the freeze point, because the statically predicated subtype won't
+      --  be fully processed till then, so this expansion activity is carried
+      --  out in Freeze_Record_Type.
 
-      Variant := First_Non_Pragma (Variants (N));
-      while Variant /= Last_Var loop
-         Expand_Static_Predicates_In_Choices (Variant);
-         Next_Non_Pragma (Variant);
-      end loop;
    end Expand_N_Variant_Part;
 
    ---------------------------------
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index b8b4038..f166ff4 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2627,7 +2627,11 @@ package body Exp_Ch5 is
          Alt := First_Non_Pragma (Alternatives (N));
          while Present (Alt) loop
             Process_Statements_For_Controlled_Objects (Alt);
-            Expand_Static_Predicates_In_Choices (Alt);
+
+            if Has_SP_Choice (Alt) then
+               Expand_Static_Predicates_In_Choices (Alt);
+            end if;
+
             Next_Non_Pragma (Alt);
          end loop;
       end;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index a958b9f..d2955e5 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1991,7 +1991,7 @@ package body Exp_Util is
                end if;
 
                --  Change Sloc to referencing choice (rather than the Sloc of
-               --  the predicate declarationo element itself).
+               --  the predicate declaration element itself).
 
                Set_Sloc (C, Sloc (Choice));
                Insert_Before (Choice, C);
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index c161338..ac9f570 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -46,6 +46,7 @@ with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
+with Sem_Case; use Sem_Case;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch7;  use Sem_Ch7;
@@ -846,8 +847,9 @@ package body Freeze is
                  and then Nkind (Type_Definition (Parent (T))) =
                                                N_Record_Definition
                  and then not Null_Present (Type_Definition (Parent (T)))
-                 and then Present (Variant_Part
-                            (Component_List (Type_Definition (Parent (T)))))
+                 and then
+                   Present (Variant_Part
+                              (Component_List (Type_Definition (Parent (T)))))
                then
                   --  If variant part is present, and type is unconstrained,
                   --  then we must have defaulted discriminants, or a size
@@ -2272,7 +2274,7 @@ package body Freeze is
                begin
                   if Present (Alloc) then
 
-                     --  If component is pointer to a classwide type, freeze
+                     --  If component is pointer to a class-wide type, freeze
                      --  the specific type in the expression being allocated.
                      --  The expression may be a subtype indication, in which
                      --  case freeze the subtype mark.
@@ -2367,7 +2369,8 @@ package body Freeze is
 
          if Present (ADC) and then Base_Type (Rec) = Rec then
             if not (Placed_Component or else Is_Packed (Rec)) then
-               Error_Msg_N ("??bit order specification has no effect", ADC);
+               Error_Msg_N
+                 ("??bit order specification has no effect", ADC);
                Error_Msg_N
                  ("\??since no component clauses were specified", ADC);
 
@@ -2443,15 +2446,13 @@ package body Freeze is
          --  remote type here since that is what we are semantically freezing.
          --  This prevents the freeze node for that type in an inner scope.
 
-         --  Also, Check for controlled components and unchecked unions.
-         --  Finally, enforce the restriction that access attributes with a
-         --  current instance prefix can only apply to limited types.
-
          if Ekind (Rec) = E_Record_Type then
             if Present (Corresponding_Remote_Type (Rec)) then
                Freeze_And_Append (Corresponding_Remote_Type (Rec), N, Result);
             end if;
 
+            --  Check for controlled components and unchecked unions.
+
             Comp := First_Component (Rec);
             while Present (Comp) loop
 
@@ -2459,18 +2460,18 @@ package body Freeze is
                --  equivalent type. See Make_CW_Equivalent_Type.
 
                if not Is_Class_Wide_Equivalent_Type (Rec)
-                 and then (Has_Controlled_Component (Etype (Comp))
-                            or else (Chars (Comp) /= Name_uParent
-                                      and then Is_Controlled (Etype (Comp)))
-                            or else (Is_Protected_Type (Etype (Comp))
-                                      and then
-                                        Present
-                                          (Corresponding_Record_Type
-                                             (Etype (Comp)))
-                                      and then
-                                        Has_Controlled_Component
-                                          (Corresponding_Record_Type
-                                             (Etype (Comp)))))
+                 and then
+                   (Has_Controlled_Component (Etype (Comp))
+                     or else
+                       (Chars (Comp) /= Name_uParent
+                         and then Is_Controlled (Etype (Comp)))
+                     or else
+                       (Is_Protected_Type (Etype (Comp))
+                         and then
+                           Present (Corresponding_Record_Type (Etype (Comp)))
+                         and then
+                           Has_Controlled_Component
+                             (Corresponding_Record_Type (Etype (Comp)))))
                then
                   Set_Has_Controlled_Component (Rec);
                end if;
@@ -2490,11 +2491,17 @@ package body Freeze is
             end loop;
          end if;
 
+         --  Enforce the restriction that access attributes with a current
+         --  instance prefix can only apply to limited types. This comment
+         --  is floating here, but does not seem to belong here???
+
+         --  Set component alignment if not otherwise already set
+
          Set_Component_Alignment_If_Not_Set (Rec);
 
          --  For first subtypes, check if there are any fixed-point fields with
          --  component clauses, where we must check the size. This is not done
-         --  till the freeze point, since for fixed-point types, we do not know
+         --  till the freeze point since for fixed-point types, we do not know
          --  the size until the type is frozen. Similar processing applies to
          --  bit packed arrays.
 
@@ -2613,6 +2620,142 @@ package body Freeze is
                end;
             end if;
          end if;
+
+         --  All done if not a full record definition
+
+         if Ekind (Rec) /= E_Record_Type then
+            return;
+         end if;
+
+         --  Finallly we need to check the variant part to make sure that
+         --  the set of choices for each variant covers the corresponding
+         --  discriminant. This check has to be delayed to the freeze point
+         --  because we may have statically predicated subtypes, whose choice
+         --  list is not known till the subtype is frozen.
+
+         Check_Variant_Part : declare
+            D : constant Node_Id := Declaration_Node (Rec);
+            T : Node_Id;
+            C : Node_Id;
+            V : Node_Id;
+
+            Others_Present            : Boolean;
+            pragma Warnings (Off, Others_Present);
+            --  Indicates others present, not used in this case
+
+            procedure Non_Static_Choice_Error (Choice : Node_Id);
+            --  Error routine invoked by the generic instantiation below when
+            --  the variant part has a non static choice.
+
+            procedure Process_Declarations (Variant : Node_Id);
+            --  Processes declarations associated with a variant. We analyzed
+            --  the declarations earlier (in Sem_Ch3.Analyze_Variant_Part),
+            --  but we still need the recursive call to Check_Choices for any
+            --  nested variant to get its choices properly processed. This is
+            --  also where we expand out the choices if expansion is active.
+
+            package Variant_Choices_Processing is new
+              Generic_Check_Choices
+                (Process_Empty_Choice      => No_OP,
+                 Process_Non_Static_Choice => Non_Static_Choice_Error,
+                 Process_Associated_Node   => Process_Declarations);
+            use Variant_Choices_Processing;
+
+            -----------------------------
+            -- Non_Static_Choice_Error --
+            -----------------------------
+
+            procedure Non_Static_Choice_Error (Choice : Node_Id) is
+            begin
+               Flag_Non_Static_Expr
+                 ("choice given in variant part is not static!", Choice);
+            end Non_Static_Choice_Error;
+
+            --------------------------
+            -- Process_Declarations --
+            --------------------------
+
+            procedure Process_Declarations (Variant : Node_Id) is
+               CL : constant Node_Id := Component_List (Variant);
+               VP : Node_Id;
+
+            begin
+               --  Check for static predicate present in this variant
+
+               if Has_SP_Choice (Variant) then
+
+                  --  Here we expand. You might expect to find this call in
+                  --  Expand_N_Variant_Part, but that is called when we first
+                  --  see the variant part, and we cannot do this expansion
+                  --  earlier than the freeze point, since for statically
+                  --  predicated subtypes, the predicate is not known till
+                  --  the freeze point.
+
+                  --  Furthermore, we do this expansion even if the expander
+                  --  is not active, because other semantic processing, e.g.
+                  --  for aggregates, requires the expanded list of choices.
+
+                  --  If the expander is not active, then we can't just clobber
+                  --  the list since it would invalidate the ASIS -gnatct tree.
+                  --  So we have to rewrite the variant part with a Rewrite
+                  --  call that replaces it with a copy and clobber the copy.
+
+                  if not Expander_Active then
+                     declare
+                        NewV : constant Node_Id := New_Copy (Variant);
+                     begin
+                        Set_Discrete_Choices
+                          (NewV, New_Copy_List (Discrete_Choices (Variant)));
+                        Rewrite (Variant, NewV);
+                     end;
+                  end if;
+
+                  Expand_Static_Predicates_In_Choices (Variant);
+               end if;
+
+               --  We don't need to worry about the declarations in the variant
+               --  (since they were analyzed by Analyze_Choices when we first
+               --  encountered the variant), but we do need to take care of
+               --  expansion of any nested variants.
+
+               if not Null_Present (CL) then
+                  VP := Variant_Part (CL);
+
+                  if Present (VP) then
+                     Check_Choices
+                       (VP, Variants (VP), Etype (Name (VP)), Others_Present);
+                  end if;
+               end if;
+            end Process_Declarations;
+
+         --  Start of processing for Check_Variant_Part
+
+         begin
+            --  Find component list
+
+            C := Empty;
+
+            if Nkind (D) = N_Full_Type_Declaration then
+               T := Type_Definition (D);
+
+               if Nkind (T) = N_Record_Definition then
+                  C := Component_List (T);
+
+               elsif Nkind (T) = N_Derived_Type_Definition
+                 and then Present (Record_Extension_Part (T))
+               then
+                  C := Component_List (Record_Extension_Part (T));
+               end if;
+            end if;
+
+            --  If we have a variant part, check choices
+
+            if Present (C) and then Present (Variant_Part (C)) then
+               V := Variant_Part (C);
+               Check_Choices
+                 (V, Variants (V), Etype (Name (V)), Others_Present);
+            end if;
+         end Check_Variant_Part;
       end Freeze_Record_Type;
 
    --  Start of processing for Freeze_Entity
diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index e5a007b..849ff0e 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/gcc/ada/lib-xref-spark_specific.adb
@@ -1022,11 +1022,10 @@ package body SPARK_Specific is
 
             when N_Pragma =>
 
-               --  The enclosing subprogram for a precondition, a
-               --  postcondition, or a contract case should be the subprogram
-               --  to which the pragma is attached, which can be found by
-               --  following previous elements in the list to which the
-               --  pragma belongs.
+               --  The enclosing subprogram for a precondition, postcondition,
+               --  or contract case should be the subprogram to which the
+               --  pragma is attached, which can be found by following
+               --  previous elements in the list to which the pragma belongs.
 
                if Get_Pragma_Id (Result) = Pragma_Precondition
                     or else
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 3101354..4105901 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2011, AdaCore                     --
+--                     Copyright (C) 2001-2013, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -1651,7 +1651,7 @@ package body MLib.Prj is
          --  content of Rpath. As Rpath contains at least libgnat directory
          --  path name, it is guaranteed that it is not null.
 
-         if Path_Option /= null then
+         if Opt.Run_Path_Option and then Path_Option /= null then
             Opts.Increment_Last;
             Opts.Table (Opts.Last) :=
               new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index 0fadd30..18c63a3 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -88,9 +88,9 @@ package body Ch13 is
             Result := True;
          else
             Scan; -- past identifier
-            Result := Token = Tok_Arrow
-                         or else Token = Tok_Comma
-                         or else Token = Tok_Semicolon;
+            Result := Token = Tok_Arrow or else
+                      Token = Tok_Comma or else
+                      Token = Tok_Semicolon;
          end if;
 
       --  If earlier than Ada 2012, check for valid aspect identifier (possibly
@@ -113,9 +113,7 @@ package body Ch13 is
             --  defaulted True value. Further checks when analyzing aspect
             --  specification, which may include further aspects.
 
-            elsif Token = Tok_Comma
-              or else Token = Tok_Semicolon
-            then
+            elsif Token = Tok_Comma or else Token = Tok_Semicolon then
                Result := True;
 
             elsif Token = Tok_Apostrophe then
diff --git a/gcc/ada/s-atocou-builtin.adb b/gcc/ada/s-atocou-builtin.adb
index a8ead62..55436aa 100644
--- a/gcc/ada/s-atocou-builtin.adb
+++ b/gcc/ada/s-atocou-builtin.adb
@@ -64,8 +64,8 @@ package body System.Atomic_Counters is
 
    procedure Increment (Item : in out Atomic_Counter) is
    begin
-      --  Note: the use of Unrestricted_Access here is required because we
-      --  are obtaining an access-to-volatile pointer to a non-volatile object.
+      --  Note: the use of Unrestricted_Access here is required because we are
+      --  obtaining an access-to-volatile pointer to a non-volatile object.
       --  This is not allowed for [Unchecked_]Access, but is safe in this case
       --  because we know that no aliases are being created.
 
diff --git a/gcc/ada/s-imgint.adb b/gcc/ada/s-imgint.adb
index 12bc0f2..88dc584 100644
--- a/gcc/ada/s-imgint.adb
+++ b/gcc/ada/s-imgint.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -42,39 +42,15 @@ package body System.Img_Int is
    is
       pragma Assert (S'First = 1);
 
-      procedure Set_Digits (T : Integer);
-      --  Set digits of absolute value of T, which is zero or negative. We work
-      --  with the negative of the value so that the largest negative number is
-      --  not a special case.
-
-      ----------------
-      -- Set_Digits --
-      ----------------
-
-      procedure Set_Digits (T : Integer) is
-      begin
-         if T <= -10 then
-            Set_Digits (T / 10);
-            P := P + 1;
-            S (P) := Character'Val (48 - (T rem 10));
-         else
-            P := P + 1;
-            S (P) := Character'Val (48 - T);
-         end if;
-      end Set_Digits;
-
-   --  Start of processing for Image_Integer
-
    begin
-      P := 1;
-
       if V >= 0 then
-         S (P) := ' ';
-         Set_Digits (-V);
+         S (1) := ' ';
+         P := 1;
       else
-         S (P) := '-';
-         Set_Digits (V);
+         P := 0;
       end if;
+
+      Set_Image_Integer (V, S, P);
    end Image_Integer;
 
    -----------------------
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 0964886..d3b0ef4 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2013, 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- --
@@ -1420,7 +1420,7 @@ CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
  ** appropriately (see thread.c).
  **/
 # define CLOCK_RT_Ada "CLOCK_MONOTONIC"
-# define NEED_PTHREAD_CONDATTR_SETCLOCK
+# define NEED_PTHREAD_CONDATTR_SETCLOCK 1
 
 #elif defined(HAVE_CLOCK_REALTIME)
 /* By default use CLOCK_REALTIME */
@@ -1430,6 +1430,9 @@ CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
 #ifdef CLOCK_RT_Ada
 CNS(CLOCK_RT_Ada, "")
 #endif
+#ifdef NEED_PTHREAD_CONDATTR_SETCLOCK
+CND(NEED_PTHREAD_CONDATTR_SETCLOCK, "")
+#endif
 
 #if defined (__APPLE__) || defined (__linux__) || defined (DUMMY)
 /*
diff --git a/gcc/ada/s-stalib.ads b/gcc/ada/s-stalib.ads
index f9a28e0..2cb6cd1 100644
--- a/gcc/ada/s-stalib.ads
+++ b/gcc/ada/s-stalib.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -74,26 +74,6 @@ package System.Standard_Library is
    function To_Ptr is
      new Ada.Unchecked_Conversion (System.Address, Big_String_Ptr);
 
-   ---------------------------------------------
-   -- Type For Enumeration Image Index Tables --
-   ---------------------------------------------
-
-   --  Note: these types are declared at the start of this unit, since
-   --  they must appear before any enumeration types declared in this
-   --  unit. Note that the spec of system is already elaborated at
-   --  this point (since we are a child of system), which means that
-   --  enumeration types in package System cannot use these types.
-
-   type Image_Index_Table_8 is
-     array (Integer range <>) of Short_Short_Integer;
-   type Image_Index_Table_16 is
-     array (Integer range <>) of Short_Integer;
-   type Image_Index_Table_32 is
-     array (Integer range <>) of Integer;
-   --  These types are used to generate the index vector used for enumeration
-   --  type image tables. See spec of Exp_Imgv in the main GNAT sources for a
-   --  full description of the data structures that are used here.
-
    -------------------------------------
    -- Exception Declarations and Data --
    -------------------------------------
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 9d7d7b7..404242f 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3416,6 +3416,7 @@ package body Sem_Aggr is
 
    begin
       --  A record aggregate is restricted in SPARK:
+
       --    Each named association can have only a single choice.
       --    OTHERS cannot be used.
       --    Positional and named associations cannot be mixed.
@@ -3758,6 +3759,8 @@ package body Sem_Aggr is
             end loop;
          end Find_Private_Ancestor;
 
+      --  Start of processing for Step_5
+
       begin
          if Is_Derived_Type (Typ) and then Is_Tagged_Type (Typ) then
             Parent_Typ_List := New_Elmt_List;
@@ -3822,11 +3825,12 @@ package body Sem_Aggr is
 
                if Nkind (Dnode) = N_Full_Type_Declaration then
                   Record_Def := Type_Definition (Dnode);
-                  Gather_Components (Base_Type (Typ),
-                    Component_List (Record_Def),
-                    Governed_By   => New_Assoc_List,
-                    Into          => Components,
-                    Report_Errors => Errors_Found);
+                  Gather_Components
+                    (Base_Type (Typ),
+                     Component_List (Record_Def),
+                     Governed_By   => New_Assoc_List,
+                     Into          => Components,
+                     Report_Errors => Errors_Found);
                end if;
             end if;
 
@@ -3915,19 +3919,20 @@ package body Sem_Aggr is
                null;
 
             elsif not Has_Unknown_Discriminants (Typ) then
-               Gather_Components (Base_Type (Typ),
-                 Component_List (Record_Def),
-                 Governed_By   => New_Assoc_List,
-                 Into          => Components,
-                 Report_Errors => Errors_Found);
+               Gather_Components
+                 (Base_Type (Typ),
+                  Component_List (Record_Def),
+                  Governed_By   => New_Assoc_List,
+                  Into          => Components,
+                  Report_Errors => Errors_Found);
 
             else
                Gather_Components
                  (Base_Type (Underlying_Record_View (Typ)),
-                 Component_List (Record_Def),
-                 Governed_By   => New_Assoc_List,
-                 Into          => Components,
-                 Report_Errors => Errors_Found);
+                  Component_List (Record_Def),
+                  Governed_By   => New_Assoc_List,
+                  Into          => Components,
+                  Report_Errors => Errors_Found);
             end if;
          end if;
 
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index bc5139f..53f66b0 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5041,7 +5041,8 @@ package body Sem_Attr is
 
       when Attribute_Scalar_Storage_Order => Scalar_Storage_Order :
       declare
-         Ent : Entity_Id := Empty;
+            Ent : Entity_Id := Empty;
+
       begin
          Check_E0;
          Check_Type;
@@ -5053,7 +5054,7 @@ package body Sem_Attr is
             --  the default bit order for the target.
 
             if not (GNAT_Mode and then Is_Generic_Type (P_Type))
-                  and then not In_Instance
+                     and then not In_Instance
             then
                Error_Attr_P
                  ("prefix of % attribute must be record or array type");
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 27a5c67..6701776 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -26,6 +26,8 @@
 with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
+with Exp_Util; use Exp_Util;
+with Freeze;   use Freeze;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -65,7 +67,7 @@ package body Sem_Case is
    -- Local Subprograms --
    -----------------------
 
-   procedure Check_Choices
+   procedure Check_Choice_Set
      (Choice_Table   : in out Choice_Table_Type;
       Bounds_Type    : Entity_Id;
       Subtyp         : Entity_Id;
@@ -95,7 +97,7 @@ package body Sem_Case is
      (Case_Table     : Choice_Table_Type;
       Others_Choice  : Node_Id;
       Choice_Type    : Entity_Id);
-   --  The case table is the table generated by a call to Analyze_Choices
+   --  The case table is the table generated by a call to Check_Choices
    --  (with just 1 .. Last_Choice entries present). Others_Choice is a
    --  pointer to the N_Others_Choice node (this routine is only called if
    --  an others choice is present), and Choice_Type is the discrete type
@@ -103,11 +105,11 @@ package body Sem_Case is
    --  determine the set of values covered by others. This choice list is
    --  set in the Others_Discrete_Choices field of the N_Others_Choice node.
 
-   -------------------
-   -- Check_Choices --
-   -------------------
+   ----------------------
+   -- Check_Choice_Set --
+   ----------------------
 
-   procedure Check_Choices
+   procedure Check_Choice_Set
      (Choice_Table   : in out Choice_Table_Type;
       Bounds_Type    : Entity_Id;
       Subtyp         : Entity_Id;
@@ -598,7 +600,7 @@ package body Sem_Case is
       Prev_Lo     : Uint;
       Prev_Hi     : Uint;
 
-   --  Start of processing for Check_Choices
+   --  Start of processing for Check_Choice_Set
 
    begin
       --  Choice_Table must start at 0 which is an unused location used by the
@@ -714,7 +716,7 @@ package body Sem_Case is
             end if;
          end if;
       end if;
-   end Check_Choices;
+   end Check_Choice_Set;
 
    ------------------
    -- Choice_Image --
@@ -799,11 +801,10 @@ package body Sem_Case is
       Previous_Hi : Uint;
 
       function Build_Choice (Value1, Value2 : Uint) return Node_Id;
-      --  Builds a node representing the missing choices given by the
-      --  Value1 and Value2. A N_Range node is built if there is more than
-      --  one literal value missing. Otherwise a single N_Integer_Literal,
-      --  N_Identifier or N_Character_Literal is built depending on what
-      --  Choice_Type is.
+      --  Builds a node representing the missing choices given by Value1 and
+      --  Value2. A N_Range node is built if there is more than one literal
+      --  value missing. Otherwise a single N_Integer_Literal, N_Identifier
+      --  or N_Character_Literal is built depending on what Choice_Type is.
 
       function Lit_Of (Value : Uint) return Node_Id;
       --  Returns the Node_Id for the enumeration literal corresponding to the
@@ -975,11 +976,11 @@ package body Sem_Case is
       null;
    end No_OP;
 
-   --------------------------------
-   -- Generic_Choices_Processing --
-   --------------------------------
+   -----------------------------
+   -- Generic_Analyze_Choices --
+   -----------------------------
 
-   package body Generic_Choices_Processing is
+   package body Generic_Analyze_Choices is
 
       --  The following type is used to gather the entries for the choice
       --  table, so that we can then allocate the right length.
@@ -992,20 +993,143 @@ package body Sem_Case is
          Nxt : Link_Ptr;
       end record;
 
-      procedure Free is new Ada.Unchecked_Deallocation (Link, Link_Ptr);
-
       ---------------------
       -- Analyze_Choices --
       ---------------------
 
       procedure Analyze_Choices
-        (N              : Node_Id;
-         Subtyp         : Entity_Id;
-         Raises_CE      : out Boolean;
-         Others_Present : out Boolean)
+        (Alternatives : List_Id;
+         Subtyp       : Entity_Id)
+      is
+         Choice_Type : constant Entity_Id := Base_Type (Subtyp);
+         --  The actual type against which the discrete choices are resolved.
+         --  Note that this type is always the base type not the subtype of the
+         --  ruling expression, index or discriminant.
+
+         Expected_Type : Entity_Id;
+         --  The expected type of each choice. Equal to Choice_Type, except if
+         --  the expression is universal, in which case the choices can be of
+         --  any integer type.
+
+         Alt : Node_Id;
+         --  A case statement alternative or a variant in a record type
+         --  declaration.
+
+         Choice : Node_Id;
+         Kind   : Node_Kind;
+         --  The node kind of the current Choice
+
+      begin
+         --  Set Expected type (= choice type except for universal integer,
+         --  where we accept any integer type as a choice).
+
+         if Choice_Type = Universal_Integer then
+            Expected_Type := Any_Integer;
+         else
+            Expected_Type := Choice_Type;
+         end if;
+
+         --  Now loop through the case alternatives or record variants
+
+         Alt := First (Alternatives);
+         while Present (Alt) loop
+
+            --  If pragma, just analyze it
+
+            if Nkind (Alt) = N_Pragma then
+               Analyze (Alt);
+
+            --  Otherwise we have an alternative. In most cases the semantic
+            --  processing leaves the list of choices unchanged
+
+            --  Check each choice against its base type
+
+            else
+               Choice := First (Discrete_Choices (Alt));
+               while Present (Choice) loop
+                  Analyze (Choice);
+                  Kind := Nkind (Choice);
+
+                  --  Choice is a Range
+
+                  if Kind = N_Range
+                    or else (Kind = N_Attribute_Reference
+                              and then Attribute_Name (Choice) = Name_Range)
+                  then
+                     Resolve (Choice, Expected_Type);
+
+                  --  Choice is a subtype name, nothing further to do now
+
+                  elsif Is_Entity_Name (Choice)
+                    and then Is_Type (Entity (Choice))
+                  then
+                     null;
+
+                  --  Choice is a subtype indication
+
+                  elsif Kind = N_Subtype_Indication then
+                     Resolve_Discrete_Subtype_Indication
+                       (Choice, Expected_Type);
+
+                  --  Others choice, no analysis needed
+
+                  elsif Kind = N_Others_Choice then
+                     null;
+
+                  --  Only other possibility is an expression
+
+                  else
+                     Resolve (Choice, Expected_Type);
+                  end if;
+
+                  --  Move to next choice
+
+                  Next (Choice);
+               end loop;
+
+               Process_Associated_Node (Alt);
+            end if;
+
+            Next (Alt);
+         end loop;
+      end Analyze_Choices;
+
+   end Generic_Analyze_Choices;
+
+   ---------------------------
+   -- Generic_Check_Choices --
+   ---------------------------
+
+   package body Generic_Check_Choices is
+
+      --  The following type is used to gather the entries for the choice
+      --  table, so that we can then allocate the right length.
+
+      type Link;
+      type Link_Ptr is access all Link;
+
+      type Link is record
+         Val : Choice_Bounds;
+         Nxt : Link_Ptr;
+      end record;
+
+      procedure Free is new Ada.Unchecked_Deallocation (Link, Link_Ptr);
+
+      -------------------
+      -- Check_Choices --
+      -------------------
+
+      procedure Check_Choices
+        (N                        : Node_Id;
+         Alternatives             : List_Id;
+         Subtyp                   : Entity_Id;
+         Others_Present           : out Boolean)
       is
          E : Entity_Id;
 
+         Raises_CE : Boolean;
+         --  Set True if one of the bounds of a choice raises CE
+
          Enode : Node_Id;
          --  This is where we post error messages for bounds out of range
 
@@ -1042,9 +1166,6 @@ package body Sem_Case is
          Kind   : Node_Kind;
          --  The node kind of the current Choice
 
-         Delete_Choice : Boolean;
-         --  Set to True to delete the current choice
-
          Others_Choice : Node_Id := Empty;
          --  Remember others choice if it is present (empty otherwise)
 
@@ -1166,12 +1287,22 @@ package body Sem_Case is
             Num_Choices := Num_Choices + 1;
          end Check;
 
-      --  Start of processing for Analyze_Choices
+      --  Start of processing for Check_Choices
 
       begin
          Raises_CE      := False;
          Others_Present := False;
 
+         --  If Subtyp is not a discrete type or there was some other error,
+         --  then don't try any semantic checking on the choices since we have
+         --  a complete mess.
+
+         if not Is_Discrete_Type (Subtyp)
+           or else Subtyp = Any_Type
+         then
+            return;
+         end if;
+
          --  If Subtyp is not a static subtype Ada 95 requires then we use the
          --  bounds of its base type to determine the values covered by the
          --  discrete choices.
@@ -1210,7 +1341,7 @@ package body Sem_Case is
 
          --  Now loop through the case alternatives or record variants
 
-         Alt := First (Get_Alternatives (N));
+         Alt := First (Alternatives);
          while Present (Alt) loop
 
             --  If pragma, just analyze it
@@ -1226,7 +1357,6 @@ package body Sem_Case is
             else
                Choice := First (Discrete_Choices (Alt));
                while Present (Choice) loop
-                  Delete_Choice := False;
                   Analyze (Choice);
                   Kind := Nkind (Choice);
 
@@ -1244,9 +1374,19 @@ package body Sem_Case is
                   elsif Is_Entity_Name (Choice)
                     and then Is_Type (Entity (Choice))
                   then
+                     --  We have to make sure the subtype is frozen, it must be
+                     --  before we can do the following analyses on choices!
+
+                     Insert_Actions
+                       (N, Freeze_Entity (Entity (Choice), Choice));
+
+                     --  Check for inappropriate type
+
                      if not Covers (Expected_Type, Etype (Choice)) then
                         Wrong_Type (Choice, Choice_Type);
 
+                     --  Type is OK, so check further
+
                      else
                         E := Entity (Choice);
 
@@ -1285,6 +1425,8 @@ package body Sem_Case is
                                     Next (P);
                                  end loop;
                               end;
+
+                              Set_Has_SP_Choice (Alt);
                            end if;
 
                         --  Not predicated subtype case
@@ -1318,7 +1460,8 @@ package body Sem_Case is
 
                            else
                               if Is_OK_Static_Expression (L)
-                                and then Is_OK_Static_Expression (H)
+                                   and then
+                                 Is_OK_Static_Expression (H)
                               then
                                  if Expr_Value (L) > Expr_Value (H) then
                                     Process_Empty_Choice (Choice);
@@ -1348,7 +1491,7 @@ package body Sem_Case is
                   elsif Kind = N_Others_Choice then
                      if not (Choice = First (Discrete_Choices (Alt))
                               and then Choice = Last (Discrete_Choices (Alt))
-                              and then Alt = Last (Get_Alternatives (N)))
+                              and then Alt = Last (Alternatives))
                      then
                         Error_Msg_N
                           ("the choice OTHERS must appear alone and last",
@@ -1366,18 +1509,9 @@ package body Sem_Case is
                      Check (Choice, Choice, Choice);
                   end if;
 
-                  --  Move to next choice, deleting the current one if the
-                  --  flag requesting this deletion is set True.
+                  --  Move to next choice
 
-                  declare
-                     C : constant Node_Id := Choice;
-                  begin
-                     Next (Choice);
-
-                     if Delete_Choice then
-                        Remove (C);
-                     end if;
-                  end;
+                  Next (Choice);
                end loop;
 
                Process_Associated_Node (Alt);
@@ -1407,7 +1541,7 @@ package body Sem_Case is
                end loop;
             end;
 
-            Check_Choices
+            Check_Choice_Set
               (Choice_Table,
                Bounds_Type,
                Subtyp,
@@ -1426,8 +1560,8 @@ package body Sem_Case is
                   Choice_Type   => Bounds_Type);
             end if;
          end;
-      end Analyze_Choices;
+      end Check_Choices;
 
-   end Generic_Choices_Processing;
+   end Generic_Check_Choices;
 
 end Sem_Case;
diff --git a/gcc/ada/sem_case.ads b/gcc/ada/sem_case.ads
index d788afe..c6917f0 100644
--- a/gcc/ada/sem_case.ads
+++ b/gcc/ada/sem_case.ads
@@ -30,52 +30,124 @@
 --  aggregate case, since issues with nested aggregates make that case
 --  substantially different.
 
+--  The following processing is required for such cases:
+
+--    1. Analysis of names of subtypes, constants, expressions appearing within
+--    the choices. This must be done when the construct is encountered to get
+--    proper visibility of names.
+
+--    2. Checking for semantic correctness of the choices. A lot of this could
+--    be done at the time when the construct is encountered, but not all, since
+--    in the case of variants, statically predicated subtypes won't be frozen
+--    (and the choice sets known) till the enclosing record type is frozen. So
+--    at least the check for no overlaps and covering the range must be delayed
+--    till the freeze point in this case.
+
+--    3. Set the Others_Discrete_Choices list for an others choice. This is
+--    used in various ways, e.g. to construct the disriminant checking function
+--    for the case of a variant with an others choice.
+
+--    4. In the case of static predicates, we need to expand out choices that
+--    correspond to the predicate for the back end. This expansion destroys
+--    the list of choices, so it should be delayed to expansion time. We do
+--    not want to mess up the -gnatct ASIS tree, which needs to be able to
+
+--  Step 1 is performed by the generic procedure Analyze_Choices, which is
+--  called when the variant record or case statement/expression is first
+--  encountered.
+
+--  Step 2 is performed by the generic procedure Check_Choices. We decide to
+--  do all semantic checking in that step, since as noted above some of this
+--  has to be deferred to the freeze point in any case for variants. For case
+--  statements and expressions, this procedure can be called at the time the
+--  case construct is encountered (after calling Analyze_Choices).
+
+--  Step 3 is also performed by Check_Choices, since we need the static ranges
+--  for predicated subtypes to accurately construct this.
+
+--  Step 4 is performed by the procedure Expand_Static_Predicates_In_Choices.
+--  For case statements, this call only happens during expansion, so the tree
+--  generated for ASIS does not have this expansion. For the Variant case, the
+--  expansion is done in the ASIS -gnatct case, but with a proper Rewrite call
+--  on the N_Variant node, so ASIS can retrieve the original. The reason we do
+--  the expansion unconditionally for variants is that other processing, for
+--  example for aggregates, relies on having a complete list of choices.
+
+--  Historical note: We used to perform all four of these functions at once in
+--  a single procedure called Analyze_Choices. This routine was called at the
+--  time the construct was first encountered. That seemed to work OK up to Ada
+--  2005, but the introduction of statically predicated subtypes with delayed
+--  evaluation of the static ranges made this completely wrong, both because
+--  the ASIS tree got destroyed by step 4, and steps 2 and 3 were too early
+--  in the variant record case.
+
 with Types; use Types;
 
 package Sem_Case is
 
    procedure No_OP (C : Node_Id);
    --  The no-operation routine. Does absolutely nothing. Can be used
-   --  in the following generic for the parameter Process_Empty_Choice.
+   --  in the following generics for the parameters Process_Empty_Choice,
+   --  or Process_Associated_Node.
 
    generic
-      with function Get_Alternatives (N : Node_Id) return List_Id;
-      --  Function used to get the list of case statement alternatives or
-      --  record variants, from which we can then access the actual lists of
-      --  discrete choices. N is the node for the original construct (case
-      --  statement or a record variant).
+      with procedure Process_Associated_Node (A : Node_Id);
+      --  Associated with each case alternative or record variant A there is
+      --  a node or list of nodes that need additional processing. This routine
+      --  implements that processing.
+
+   package Generic_Analyze_Choices is
+
+      procedure Analyze_Choices
+        (Alternatives : List_Id;
+         Subtyp       : Entity_Id);
+      --  From a case expression, case statement, or record variant, this
+      --  routine analyzes the corresponding list of discrete choices which
+      --  appear in each element of the list Alternatives (for the variant
+      --  part case, this is the variants, for a case expression or statement,
+      --  this is the Alternatives).
+      --
+      --  Subtyp is the subtype of the discrete choices. The type against which
+      --  the discrete choices must be resolved is its base type.
 
+   end Generic_Analyze_Choices;
+
+   generic
       with procedure Process_Empty_Choice (Choice : Node_Id);
       --  Processing to carry out for an empty Choice. Set to No_Op (declared
       --  above) if no such processing is required.
 
       with procedure Process_Non_Static_Choice (Choice : Node_Id);
-      --  Processing to carry out for a non static Choice
+      --  Processing to carry out for a non static Choice (gives an error msg)
 
       with procedure Process_Associated_Node (A : Node_Id);
       --  Associated with each case alternative or record variant A there is
       --  a node or list of nodes that need semantic processing. This routine
       --  implements that processing.
 
-   package Generic_Choices_Processing is
+   package Generic_Check_Choices is
 
-      procedure Analyze_Choices
-        (N              : Node_Id;
-         Subtyp         : Entity_Id;
-         Raises_CE      : out Boolean;
-         Others_Present : out Boolean);
+      procedure Check_Choices
+        (N                        : Node_Id;
+         Alternatives             : List_Id;
+         Subtyp                   : Entity_Id;
+         Others_Present           : out Boolean);
       --  From a case expression, case statement, or record variant N, this
-      --  routine analyzes the corresponding list of discrete choices. Subtyp
-      --  is the subtype of the discrete choices. The type against which the
-      --  discrete choices must be resolved is its base type.
+      --  routine analyzes the corresponding list of discrete choices which
+      --  appear in each element of the list Alternatives (for the variant
+      --  part case, this is the variants, for a case expression or statement,
+      --  this is the Alternatives).
       --
-      --  If one of the bounds of a discrete choice raises a constraint
-      --  error the flag Raise_CE is set.
+      --  Subtyp is the subtype of the discrete choices. The type against which
+      --  the discrete choices must be resolved is its base type.
       --
-      --  Finally Others_Present is set to True if an Others choice is present
-      --  in the list of choices, and in this case the call also sets
-      --  Others_Discrete_Choices in the N_Others_Choice node.
-
-   end Generic_Choices_Processing;
+      --  Others_Present is set to True if an Others choice is present in the
+      --  list of choices, and in this case Others_Discrete_Choices is set in
+      --  the N_Others_Choice node.
+      --
+      --  If a Discrete_Choice list contains at least one instance of a subtype
+      --  with a static predicate, then the Has_SP_Choice flag is set true in
+      --  the parent node (N_Variant, N_Case_Expression/Statement_Alternative).
 
+   end Generic_Check_Choices;
 end Sem_Case;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index f9e5256..df80232 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3717,8 +3717,7 @@ package body Sem_Ch12 is
               (Unit_Requires_Body (Gen_Unit)
                   or else Enclosing_Body_Present
                   or else Present (Corresponding_Body (Gen_Decl)))
-                and then (Is_In_Main_Unit (N)
-                           or else Might_Inline_Subp)
+                and then (Is_In_Main_Unit (N) or else Might_Inline_Subp)
                 and then not Is_Actual_Pack
                 and then not Inline_Now
                 and then (Operating_Mode = Generate_Code
@@ -3728,8 +3727,7 @@ package body Sem_Ch12 is
             --  If front_end_inlining is enabled, do not instantiate body if
             --  within a generic context.
 
-            if (Front_End_Inlining
-                 and then not Expander_Active)
+            if (Front_End_Inlining and then not Expander_Active)
               or else Is_Generic_Unit (Cunit_Entity (Main_Unit))
             then
                Needs_Body := False;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 864d42d..3a2bb22 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7790,7 +7790,7 @@ package body Sem_Ch13 is
               Aspect_Precondition         |
               Aspect_Refined_Pre          |
               Aspect_SPARK_Mode           |
-              Aspect_Test_Case     =>
+              Aspect_Test_Case            =>
             raise Program_Error;
 
       end case;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d230b11..e900cfa 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4590,60 +4590,31 @@ package body Sem_Ch3 is
    --------------------------
 
    procedure Analyze_Variant_Part (N : Node_Id) is
+      Discr_Name : Node_Id;
+      Discr_Type : Entity_Id;
 
-      procedure Non_Static_Choice_Error (Choice : Node_Id);
-      --  Error routine invoked by the generic instantiation below when the
-      --  variant part has a non static choice.
-
-      procedure Process_Declarations (Variant : Node_Id);
-      --  Analyzes all the declarations associated with a Variant. Needed by
-      --  the generic instantiation below.
-
-      package Variant_Choices_Processing is new
-        Generic_Choices_Processing
-          (Get_Alternatives          => Variants,
-           Process_Empty_Choice      => No_OP,
-           Process_Non_Static_Choice => Non_Static_Choice_Error,
-           Process_Associated_Node   => Process_Declarations);
-      use Variant_Choices_Processing;
-      --  Instantiation of the generic choice processing package
+      procedure Process_Variant (A : Node_Id);
+      --  Analyze declarations for a single variant
 
-      -----------------------------
-      -- Non_Static_Choice_Error --
-      -----------------------------
+      package Analyze_Variant_Choices is
+        new Generic_Analyze_Choices (Process_Variant);
+      use Analyze_Variant_Choices;
 
-      procedure Non_Static_Choice_Error (Choice : Node_Id) is
-      begin
-         Flag_Non_Static_Expr
-           ("choice given in variant part is not static!", Choice);
-      end Non_Static_Choice_Error;
-
-      --------------------------
-      -- Process_Declarations --
-      --------------------------
+      ---------------------
+      -- Process_Variant --
+      ---------------------
 
-      procedure Process_Declarations (Variant : Node_Id) is
+      procedure Process_Variant (A : Node_Id) is
+         CL : constant Node_Id := Component_List (A);
       begin
-         if not Null_Present (Component_List (Variant)) then
-            Analyze_Declarations (Component_Items (Component_List (Variant)));
+         if not Null_Present (CL) then
+            Analyze_Declarations (Component_Items (CL));
 
-            if Present (Variant_Part (Component_List (Variant))) then
-               Analyze (Variant_Part (Component_List (Variant)));
+            if Present (Variant_Part (CL)) then
+               Analyze (Variant_Part (CL));
             end if;
          end if;
-      end Process_Declarations;
-
-      --  Local Variables
-
-      Discr_Name : Node_Id;
-      Discr_Type : Entity_Id;
-
-      Dont_Care      : Boolean;
-      Others_Present : Boolean := False;
-
-      pragma Warnings (Off, Dont_Care);
-      pragma Warnings (Off, Others_Present);
-      --  We don't care about the assigned values of any of these
+      end Process_Variant;
 
    --  Start of processing for Analyze_Variant_Part
 
@@ -4672,9 +4643,18 @@ package body Sem_Ch3 is
          return;
       end if;
 
-      --  Call the instantiated Analyze_Choices which does the rest of the work
+      --  Now analyze the choices, which also analyzes the declarations that
+      --  are associated with each choice.
+
+      Analyze_Choices (Variants (N), Discr_Type);
+
+      --  Note: we used to instantiate and call Check_Choices here to check
+      --  that the choices covered the discriminant, but it's too early to do
+      --  that because of statically predicated subtypes, whose analysis may
+      --  be deferred to their freeze point which may be as late as the freeze
+      --  point of the containing record. So this call is now to be found in
+      --  Freeze_Record_Declaration.
 
-      Analyze_Choices (N, Discr_Type, Dont_Care, Others_Present);
    end Analyze_Variant_Part;
 
    ----------------------------
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 0bd5685..bf19a38 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -1315,13 +1315,17 @@ package body Sem_Ch4 is
       --  Error routine invoked by the generic instantiation below when
       --  the case expression has a non static choice.
 
-      package Case_Choices_Processing is new
-        Generic_Choices_Processing
-          (Get_Alternatives          => Alternatives,
-           Process_Empty_Choice      => No_OP,
+      package Case_Choices_Analysis is new
+        Generic_Analyze_Choices
+          (Process_Associated_Node => No_OP);
+      use Case_Choices_Analysis;
+
+      package Case_Choices_Checking is new
+        Generic_Check_Choices
+          (Process_Empty_Choice      => No_OP,
            Process_Non_Static_Choice => Non_Static_Choice_Error,
            Process_Associated_Node   => No_OP);
-      use Case_Choices_Processing;
+      use Case_Choices_Checking;
 
       --------------------------
       -- Has_Static_Predicate --
@@ -1363,8 +1367,8 @@ package body Sem_Ch4 is
       Exp_Type  : Entity_Id;
       Exp_Btype : Entity_Id;
 
-      Dont_Care      : Boolean;
       Others_Present : Boolean;
+      --  Indicates if Others was present
 
    --  Start of processing for Analyze_Case_Expression
 
@@ -1427,9 +1431,7 @@ package body Sem_Ch4 is
 
       --  If error already reported by Resolve, nothing more to do
 
-      if Exp_Btype = Any_Discrete
-        or else Exp_Btype = Any_Type
-      then
+      if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
          return;
 
       elsif Exp_Btype = Any_Character then
@@ -1461,10 +1463,11 @@ package body Sem_Ch4 is
       then
          null;
 
-      --  Call instantiated Analyze_Choices which does the rest of the work
+      --  Call Analyze_Choices and Check_Choices to do the rest of the work
 
       else
-         Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present);
+         Analyze_Choices (Alternatives (N), Exp_Type);
+         Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
       end if;
 
       if Exp_Type = Universal_Integer and then not Others_Present then
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 81d2eec..9e282fd 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1018,12 +1018,12 @@ package body Sem_Ch5 is
       Exp_Type       : Entity_Id;
       Exp_Btype      : Entity_Id;
       Last_Choice    : Nat;
-      Dont_Care      : Boolean;
+
       Others_Present : Boolean;
+      --  Indicates if Others was present
 
       pragma Warnings (Off, Last_Choice);
-      pragma Warnings (Off, Dont_Care);
-      --  Don't care about assigned values
+      --  Don't care about assigned value
 
       Statements_Analyzed : Boolean := False;
       --  Set True if at least some statement sequences get analyzed. If False
@@ -1039,16 +1039,21 @@ package body Sem_Ch5 is
       --  case statement has a non static choice.
 
       procedure Process_Statements (Alternative : Node_Id);
-      --  Analyzes all the statements associated with a case alternative.
-      --  Needed by the generic instantiation below.
-
-      package Case_Choices_Processing is new
-        Generic_Choices_Processing
-          (Get_Alternatives          => Alternatives,
-           Process_Empty_Choice      => No_OP,
+      --  Analyzes the statements associated with a case alternative. Needed
+      --  by instantiation below.
+
+      package Analyze_Case_Choices is new
+        Generic_Analyze_Choices
+          (Process_Associated_Node   => Process_Statements);
+      use Analyze_Case_Choices;
+      --  Instantiation of the generic choice analysis package
+
+      package Check_Case_Choices is new
+        Generic_Check_Choices
+          (Process_Empty_Choice      => No_OP,
            Process_Non_Static_Choice => Non_Static_Choice_Error,
-           Process_Associated_Node   => Process_Statements);
-      use Case_Choices_Processing;
+           Process_Associated_Node   => No_Op);
+      use Check_Case_Choices;
       --  Instantiation of the generic choice processing package
 
       -----------------------------
@@ -1154,9 +1159,7 @@ package body Sem_Ch5 is
 
       --  If error already reported by Resolve, nothing more to do
 
-      if Exp_Btype = Any_Discrete
-        or else Exp_Btype = Any_Type
-      then
+      if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
          return;
 
       elsif Exp_Btype = Any_Character then
@@ -1185,12 +1188,12 @@ package body Sem_Ch5 is
          Exp_Type := Exp_Btype;
       end if;
 
-      --  Call instantiated Analyze_Choices which does the rest of the work
+      --  Call instantiated procedures to analyzwe and check discrete choices
 
-      Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present);
+      Analyze_Choices (Alternatives (N), Exp_Type);
+      Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
 
-      --  A case statement with a single OTHERS alternative is not allowed
-      --  in SPARK.
+      --  Case statement with single OTHERS alternative not allowed in SPARK
 
       if Others_Present and then List_Length (Alternatives (N)) = 1 then
          Check_SPARK_Restriction
@@ -1213,6 +1216,12 @@ package body Sem_Ch5 is
          Unblocked_Exit_Count := Save_Unblocked_Exit_Count;
       end if;
 
+      --  If the expander is active it will detect the case of a statically
+      --  determined single alternative and remove warnings for the case, but
+      --  if we are not doing expansion, that circuit won't be active. Here we
+      --  duplicate the effect of removing warnings in the same way, so that
+      --  we will get the same set of warnings in -gnatc mode.
+
       if not Expander_Active
         and then Compile_Time_Known_Value (Expression (N))
         and then Serious_Errors_Detected = 0
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 4fffb88..b1c5908 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2867,12 +2867,9 @@ package body Sem_Ch6 is
               and then Present (First_Entity (Spec_Id))
               and then Ekind (Etype (First_Entity (Spec_Id))) = E_Record_Type
               and then Is_Tagged_Type (Etype (First_Entity (Spec_Id)))
-              and then
-                Present (Interfaces (Etype (First_Entity (Spec_Id))))
-              and then
-                Present
-                  (Corresponding_Concurrent_Type
-                     (Etype (First_Entity (Spec_Id))))
+              and then Present (Interfaces (Etype (First_Entity (Spec_Id))))
+              and then Present (Corresponding_Concurrent_Type
+                                  (Etype (First_Entity (Spec_Id))))
             then
                declare
                   Typ  : constant Entity_Id := Etype (First_Entity (Spec_Id));
@@ -9131,9 +9128,10 @@ package body Sem_Ch6 is
       ------------------------
 
       function Controlling_Formal (Prim : Entity_Id) return Entity_Id is
-         E : Entity_Id := First_Entity (Prim);
+         E : Entity_Id;
 
       begin
+         E := First_Entity (Prim);
          while Present (E) loop
             if Is_Formal (E) and then Is_Controlling_Formal (E) then
                return E;
@@ -9178,8 +9176,8 @@ package body Sem_Ch6 is
       --  The mode of the controlling formals must match
 
       elsif Present (Iface_Ctrl_F)
-         and then Present (Prim_Ctrl_F)
-         and then Ekind (Iface_Ctrl_F) /= Ekind (Prim_Ctrl_F)
+        and then Present (Prim_Ctrl_F)
+        and then Ekind (Iface_Ctrl_F) /= Ekind (Prim_Ctrl_F)
       then
          return False;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index fa189aa..6f77c95 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -8969,7 +8969,9 @@ package body Sem_Prag is
          --                        Precondition         |
          --                        Predicate            |
          --                        Statement_Assertions
-         --
+
+         --  Shouldn't Refined_Pre be in this list???
+
          --  Note: The RM_ASSERTION_KIND list is language-defined, and the
          --  ID_ASSERTION_KIND list contains implementation-defined additions
          --  recognized by GNAT. The effect is to control the behavior of
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index c01c5f2..13ec1a3 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -32,8 +32,8 @@ with Types;  use Types;
 
 package Sem_Prag is
 
-   --  The following table lists all the user-defined pragmas that may apply to
-   --  a body stub.
+   --  The following table lists all the implementation-defined pragmas that
+   --  may apply to a body stub (no language defined pragmas apply).
 
    Pragma_On_Stub_OK : constant array (Pragma_Id) of Boolean :=
      (Pragma_Refined_Pre  => True,
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 284b0f3..d5681492 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5184,9 +5184,9 @@ package body Sem_Util is
          Discrim := First (Choices (Assoc));
          exit Find_Constraint when Chars (Discrim_Name) = Chars (Discrim)
            or else (Present (Corresponding_Discriminant (Entity (Discrim)))
-                      and then
-                    Chars (Corresponding_Discriminant (Entity (Discrim)))
-                         = Chars  (Discrim_Name))
+                     and then
+                       Chars (Corresponding_Discriminant (Entity (Discrim))) =
+                                                       Chars  (Discrim_Name))
            or else Chars (Original_Record_Component (Entity (Discrim)))
                          = Chars (Discrim_Name);
 
@@ -5274,7 +5274,6 @@ package body Sem_Util is
          Find_Discrete_Value : while Present (Variant) loop
             Discrete_Choice := First (Discrete_Choices (Variant));
             while Present (Discrete_Choice) loop
-
                exit Find_Discrete_Value when
                  Nkind (Discrete_Choice) = N_Others_Choice;
 
@@ -5305,8 +5304,8 @@ package body Sem_Util is
       --  If we have found the corresponding choice, recursively add its
       --  components to the Into list.
 
-      Gather_Components (Empty,
-        Component_List (Variant), Governed_By, Into, Report_Errors);
+      Gather_Components
+        (Empty, Component_List (Variant), Governed_By, Into, Report_Errors);
    end Gather_Components;
 
    ------------------------
@@ -8655,6 +8654,7 @@ package body Sem_Util is
                return Is_Fully_Initialized_Variant (U);
             end if;
          end;
+
       else
          return False;
       end if;
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 4aae39d..a453e12 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1552,6 +1552,16 @@ package body Sinfo is
       return Flag13 (N);
    end Has_Self_Reference;
 
+   function Has_SP_Choice
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Case_Expression_Alternative
+        or else NT (N).Nkind = N_Case_Statement_Alternative
+        or else NT (N).Nkind = N_Variant);
+      return Flag15 (N);
+   end Has_SP_Choice;
+
    function Has_Storage_Size_Pragma
       (N : Node_Id) return Boolean is
    begin
@@ -4680,6 +4690,16 @@ package body Sinfo is
       Set_Flag13 (N, Val);
    end Set_Has_Self_Reference;
 
+   procedure Set_Has_SP_Choice
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Case_Expression_Alternative
+        or else NT (N).Nkind = N_Case_Statement_Alternative
+        or else NT (N).Nkind = N_Variant);
+      Set_Flag15 (N, Val);
+   end Set_Has_SP_Choice;
+
    procedure Set_Has_Storage_Size_Pragma
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 6028b92..149d4c4 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1243,6 +1243,12 @@ package Sinfo is
    --    enclosing type. Such a self-reference can only appear in default-
    --    initialized aggregate for a record type.
 
+   --  Has_SP_Choice (Flag15-Sem)
+   --    Present in all nodes containing a Discrete_Choices field (N_Variant,
+   --    N_Case_Expression_Alternative, N_Case_Statement_Alternative). Set to
+   --    True if the Discrete_Choices list has at least one occurrence of a
+   --    statically predicated subtype.
+
    --  Has_Storage_Size_Pragma (Flag5-Sem)
    --    A flag present in an N_Task_Definition node to flag the presence of a
    --    Storage_Size pragma.
@@ -3061,8 +3067,7 @@ package Sinfo is
 
       --  VARIANT_PART ::=
       --    case discriminant_DIRECT_NAME is
-      --      VARIANT
-      --      {VARIANT}
+      --      VARIANT {VARIANT}
       --    end case;
 
       --  Note: the variants list can contain pragmas as well as variants.
@@ -3088,12 +3093,14 @@ package Sinfo is
       --  Enclosing_Variant (Node2-Sem)
       --  Present_Expr (Uint3-Sem)
       --  Dcheck_Function (Node5-Sem)
+      --  Has_SP_Choice (Flag15-Sem)
 
       --  Note: in the list of Discrete_Choices, the tree passed to the back
       --  end does not have choice entries corresponding to names of statically
       --  predicated subtypes. Such entries are always expanded out to the list
       --  of equivalent values or ranges. The ASIS tree generated in -gnatct
-      --  mode does not have this expansion, and has the original choices.
+      --  mode also has this expansion, but done with a proper Rewrite call on
+      --  the N_Variant node so that ASIS can properly retrieve the original.
 
       ---------------------------------
       -- 3.8.1  Discrete Choice List --
@@ -4078,12 +4085,16 @@ package Sinfo is
       --  Actions (List1)
       --  Discrete_Choices (List4)
       --  Expression (Node3)
+      --  Has_SP_Choice (Flag15-Sem)
 
       --  Note: The Actions field temporarily holds any actions associated with
       --  evaluation of the Expression. During expansion of the case expression
       --  these actions are wrapped into an N_Expressions_With_Actions node
       --  replacing the original expression.
 
+      --  Note: this node never appears in the tree passed to the back end,
+      --  since the expander converts case expressions into case statements.
+
       ---------------------------------
       -- 4.5.9 Quantified Expression --
       ---------------------------------
@@ -4392,6 +4403,7 @@ package Sinfo is
       --  Sloc points to WHEN
       --  Discrete_Choices (List4)
       --  Statements (List3)
+      --  Has_SP_Choice (Flag15-Sem)
 
       --  Note: in the list of Discrete_Choices, the tree passed to the back
       --  end does not have choice entries corresponding to names of statically
@@ -8773,6 +8785,9 @@ package Sinfo is
    function Has_Self_Reference
      (N : Node_Id) return Boolean;    -- Flag13
 
+   function Has_SP_Choice
+     (N : Node_Id) return Boolean;    -- Flag15
+
    function Has_Storage_Size_Pragma
      (N : Node_Id) return Boolean;    -- Flag5
 
@@ -9769,6 +9784,9 @@ package Sinfo is
    procedure Set_Has_Self_Reference
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
+   procedure Set_Has_SP_Choice
+     (N : Node_Id; Val : Boolean := True);    -- Flag15
+
    procedure Set_Has_Storage_Size_Pragma
      (N : Node_Id; Val : Boolean := True);    -- Flag5
 
@@ -12195,6 +12213,7 @@ package Sinfo is
    pragma Inline (Has_Init_Expression);
    pragma Inline (Has_Local_Raise);
    pragma Inline (Has_Self_Reference);
+   pragma Inline (Has_SP_Choice);
    pragma Inline (Has_No_Elaboration_Code);
    pragma Inline (Has_Pragma_Suppress_All);
    pragma Inline (Has_Private_View);
@@ -12528,6 +12547,7 @@ package Sinfo is
    pragma Inline (Set_Has_Private_View);
    pragma Inline (Set_Has_Relative_Deadline_Pragma);
    pragma Inline (Set_Has_Self_Reference);
+   pragma Inline (Set_Has_SP_Choice);
    pragma Inline (Set_Has_Storage_Size_Pragma);
    pragma Inline (Set_Has_Wide_Character);
    pragma Inline (Set_Has_Wide_Wide_Character);