[multiple changes]

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

	* exp_attr.adb (Rewrite_Stream_Proc_Call): Use
	an unchecked type conversion when performing a view conversion
	to/from a private type. In all other cases use a regular type
	conversion to ensure that any relevant checks are properly
	installed.

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

	* sem_prag.adb, sem_ch8.adb: Minor reformatting.

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

	* sem_case.adb (Explain_Non_Static_Bound): Suppress cascaded
	error on case expression that is an entity, when coverage is
	incomplete and entity has a static value obtained by local
	propagation.
	(Handle_Static_Predicate): New procedure, subsidiary of
	Check_Choices, to handle case alternatives that are either
	subtype names or subtype indications involving subtypes that
	have static predicates.

2017-01-06  Thomas Quinot  <quinot@adacore.com>

	* s-oscons-tmplt.c, g-socket.adb, g-socket.ads, g-sothco.ads:
	(GNAT.Socket): Add support for Busy_Polling and Generic_Option

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

	* sem_elab.adb (Activate_Elaborate_All_Desirable): Don't add
	Elaborate_All(P) to P itself. That could happen in obscure cases,
	and always introduced a cycle (P body must be elaborated before
	P body).
	* lib-writ.ads: Comment clarification.
	* ali-util.ads: Minor comment fix.
	* ali.adb: Minor reformatting.

2017-01-06  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr-gcc.adb: Improve comment.

From-SVN: r244125

14 files changed, 267 insertions, 95 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fae89b9..7150bc2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_attr.adb (Rewrite_Stream_Proc_Call): Use
+	an unchecked type conversion when performing a view conversion
+	to/from a private type. In all other cases use a regular type
+	conversion to ensure that any relevant checks are properly
+	installed.
+
+2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb, sem_ch8.adb: Minor reformatting.
+
+2017-01-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_case.adb (Explain_Non_Static_Bound): Suppress cascaded
+	error on case expression that is an entity, when coverage is
+	incomplete and entity has a static value obtained by local
+	propagation.
+	(Handle_Static_Predicate): New procedure, subsidiary of
+	Check_Choices, to handle case alternatives that are either
+	subtype names or subtype indications involving subtypes that
+	have static predicates.
+
+2017-01-06  Thomas Quinot  <quinot@adacore.com>
+
+	* s-oscons-tmplt.c, g-socket.adb, g-socket.ads, g-sothco.ads:
+	(GNAT.Socket): Add support for Busy_Polling and Generic_Option
+
+2017-01-06  Bob Duff  <duff@adacore.com>
+
+	* sem_elab.adb (Activate_Elaborate_All_Desirable): Don't add
+	Elaborate_All(P) to P itself. That could happen in obscure cases,
+	and always introduced a cycle (P body must be elaborated before
+	P body).
+	* lib-writ.ads: Comment clarification.
+	* ali-util.ads: Minor comment fix.
+	* ali.adb: Minor reformatting.
+
+2017-01-06  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr-gcc.adb: Improve comment.
+
 2017-01-03  James Cowgill  <James.Cowgill@imgtec.com>
 
 	* s-linux-mips.ads: Use correct signal and errno constants.
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index 3208027..91fb5f5 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -115,7 +115,8 @@ package body Exception_Propagation is
       GCC_Exception : not null GCC_Exception_Access);
    pragma Export
      (C, Set_Exception_Parameter, "__gnat_set_exception_parameter");
-   --  Called inserted by gigi to initialize the exception parameter
+   --  Called inserted by gigi to set the exception choice parameter from the
+   --  gcc occurrence.
 
    procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address);
    --  Utility routine to initialize occurrence Excep from a foreign exception
diff --git a/gcc/ada/ali-util.ads b/gcc/ada/ali-util.ads
index 251f3e7..c9abc5c 100644
--- a/gcc/ada/ali-util.ads
+++ b/gcc/ada/ali-util.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -24,7 +24,7 @@
 ------------------------------------------------------------------------------
 
 --  This child unit provides utility data structures and procedures used
---  for manipulation of ALI data by the gnatbind and gnatmake.
+--  for manipulation of ALI data by gnatbind and gnatmake.
 
 package ALI.Util is
 
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index d07b3df..7508e81 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -2056,8 +2056,7 @@ package body ALI is
                         --  Store AD indication unless ignore required
 
                         if not Ignore_ED then
-                           Withs.Table (Withs.Last).Elab_All_Desirable :=
-                             True;
+                           Withs.Table (Withs.Last).Elab_All_Desirable := True;
                         end if;
 
                      elsif Nextc = 'E' then
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 04929b5..9e77ae0 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1568,9 +1568,10 @@ package body Exp_Attr is
 
       procedure Rewrite_Stream_Proc_Call (Pname : Entity_Id) is
          Item       : constant Node_Id   := Next (First (Exprs));
+         Item_Typ   : constant Entity_Id := Etype (Item);
          Formal     : constant Entity_Id := Next_Formal (First_Formal (Pname));
          Formal_Typ : constant Entity_Id := Etype (Formal);
-         Is_Written : constant Boolean   := (Ekind (Formal) /= E_In_Parameter);
+         Is_Written : constant Boolean   := Ekind (Formal) /= E_In_Parameter;
 
       begin
          --  The expansion depends on Item, the second actual, which is
@@ -1583,7 +1584,7 @@ package body Exp_Attr is
 
          if Nkind (Item) = N_Indexed_Component
            and then Is_Packed (Base_Type (Etype (Prefix (Item))))
-           and then Base_Type (Etype (Item)) /= Base_Type (Formal_Typ)
+           and then Base_Type (Item_Typ) /= Base_Type (Formal_Typ)
            and then Is_Written
          then
             declare
@@ -1595,23 +1596,22 @@ package body Exp_Attr is
                Decl :=
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Temp,
-                   Object_Definition    =>
-                     New_Occurrence_Of (Formal_Typ, Loc));
+                   Object_Definition   => New_Occurrence_Of (Formal_Typ, Loc));
                Set_Etype (Temp, Formal_Typ);
 
                Assn :=
                  Make_Assignment_Statement (Loc,
-                   Name => New_Copy_Tree (Item),
+                   Name       => New_Copy_Tree (Item),
                    Expression =>
                      Unchecked_Convert_To
-                       (Etype (Item), New_Occurrence_Of (Temp, Loc)));
+                       (Item_Typ, New_Occurrence_Of (Temp, Loc)));
 
                Rewrite (Item, New_Occurrence_Of (Temp, Loc));
                Insert_Actions (N,
                  New_List (
                    Decl,
                    Make_Procedure_Call_Statement (Loc,
-                     Name => New_Occurrence_Of (Pname, Loc),
+                     Name                   => New_Occurrence_Of (Pname, Loc),
                      Parameter_Associations => Exprs),
                    Assn));
 
@@ -1626,17 +1626,25 @@ package body Exp_Attr is
          --  operation is not inherited), we are all set, and can use the
          --  argument unchanged.
 
-         --  For all other cases we do an unchecked conversion of the second
-         --  parameter to the type of the formal of the procedure we are
-         --  calling. This deals with the private type cases, and with going
-         --  to the root type as required in elementary type case.
-
          if not Is_Class_Wide_Type (Entity (Pref))
            and then not Is_Class_Wide_Type (Etype (Item))
-           and then Base_Type (Etype (Item)) /= Base_Type (Formal_Typ)
+           and then Base_Type (Item_Typ) /= Base_Type (Formal_Typ)
          then
-            Rewrite (Item,
-              Unchecked_Convert_To (Formal_Typ, Relocate_Node (Item)));
+            --  Perform a view conversion when either the argument or the
+            --  formal parameter are of a private type.
+
+            if Is_Private_Type (Formal_Typ)
+              or else Is_Private_Type (Item_Typ)
+            then
+               Rewrite (Item,
+                 Unchecked_Convert_To (Formal_Typ, Relocate_Node (Item)));
+
+            --  Otherwise perform a regular type conversion to ensure that all
+            --  relevant checks are installed.
+
+            else
+               Rewrite (Item, Convert_To (Formal_Typ, Relocate_Node (Item)));
+            end if;
 
             --  For untagged derived types set Assignment_OK, to prevent
             --  copies from being created when the unchecked conversion
@@ -1665,7 +1673,7 @@ package body Exp_Attr is
 
          Rewrite (N,
            Make_Procedure_Call_Statement (Loc,
-             Name => New_Occurrence_Of (Pname, Loc),
+             Name                   => New_Occurrence_Of (Pname, Loc),
              Parameter_Associations => Exprs));
 
          Analyze (N);
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 75dc58d..29ede34 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -50,8 +50,6 @@ package body GNAT.Sockets is
 
    package C renames Interfaces.C;
 
-   use type C.int;
-
    ENOERROR : constant := 0;
 
    Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
@@ -82,7 +80,7 @@ package body GNAT.Sockets is
                 (Non_Blocking_IO => SOSC.FIONBIO,
                  N_Bytes_To_Read => SOSC.FIONREAD);
 
-   Options : constant array (Option_Name) of C.int :=
+   Options : constant array (Specific_Option_Name) of C.int :=
                (Keep_Alive          => SOSC.SO_KEEPALIVE,
                 Reuse_Address       => SOSC.SO_REUSEADDR,
                 Broadcast           => SOSC.SO_BROADCAST,
@@ -98,7 +96,8 @@ package body GNAT.Sockets is
                 Multicast_Loop      => SOSC.IP_MULTICAST_LOOP,
                 Receive_Packet_Info => SOSC.IP_PKTINFO,
                 Send_Timeout        => SOSC.SO_SNDTIMEO,
-                Receive_Timeout     => SOSC.SO_RCVTIMEO);
+                Receive_Timeout     => SOSC.SO_RCVTIMEO,
+                Busy_Polling        => SOSC.SO_BUSY_POLL);
    --  ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO,
    --  but for Linux compatibility this constant is the same as IP_PKTINFO.
 
@@ -1140,9 +1139,10 @@ package body GNAT.Sockets is
    -----------------------
 
    function Get_Socket_Option
-     (Socket : Socket_Type;
-      Level  : Level_Type := Socket_Level;
-      Name   : Option_Name) return Option_Type
+     (Socket  : Socket_Type;
+      Level   : Level_Type := Socket_Level;
+      Name    : Option_Name;
+      Optname : Interfaces.C.int := -1) return Option_Type
    is
       use SOSC;
       use type C.unsigned_char;
@@ -1155,8 +1155,19 @@ package body GNAT.Sockets is
       Add : System.Address;
       Res : C.int;
       Opt : Option_Type (Name);
+      Onm : Interfaces.C.int;
 
    begin
+      if Name in Specific_Option_Name then
+         Onm := Options (Name);
+
+      elsif Optname = -1 then
+         raise Socket_Error with "optname must be specified";
+
+      else
+         Onm := Optname;
+      end if;
+
       case Name is
          when Multicast_Loop      |
               Multicast_TTL       |
@@ -1164,14 +1175,16 @@ package body GNAT.Sockets is
             Len := V1'Size / 8;
             Add := V1'Address;
 
-         when Keep_Alive      |
-              Reuse_Address   |
-              Broadcast       |
-              No_Delay        |
-              Send_Buffer     |
-              Receive_Buffer  |
-              Multicast_If    |
-              Error           =>
+         when Generic_Option |
+              Keep_Alive     |
+              Reuse_Address  |
+              Broadcast      |
+              No_Delay       |
+              Send_Buffer    |
+              Receive_Buffer |
+              Multicast_If   |
+              Error          |
+              Busy_Polling   =>
             Len := V4'Size / 8;
             Add := V4'Address;
 
@@ -1203,7 +1216,7 @@ package body GNAT.Sockets is
         C_Getsockopt
           (C.int (Socket),
            Levels (Level),
-           Options (Name),
+           Onm,
            Add, Len'Access);
 
       if Res = Failure then
@@ -1211,12 +1224,19 @@ package body GNAT.Sockets is
       end if;
 
       case Name is
-         when Keep_Alive      |
-              Reuse_Address   |
-              Broadcast       |
-              No_Delay        =>
+         when Generic_Option =>
+            Opt.Optname := Onm;
+            Opt.Optval  := V4;
+
+         when Keep_Alive    |
+              Reuse_Address |
+              Broadcast     |
+              No_Delay      =>
             Opt.Enabled := (V4 /= 0);
 
+         when Busy_Polling =>
+            Opt.Microseconds := Natural (V4);
+
          when Linger          =>
             Opt.Enabled := (V8 (V8'First) /= 0);
             Opt.Seconds := Natural (V8 (V8'Last));
@@ -2267,17 +2287,28 @@ package body GNAT.Sockets is
       Len : C.int;
       Add : System.Address := Null_Address;
       Res : C.int;
+      Onm : C.int;
 
    begin
       case Option.Name is
-         when Keep_Alive      |
-              Reuse_Address   |
-              Broadcast       |
-              No_Delay        =>
+         when Generic_Option =>
+            V4  := Option.Optval;
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
+         when Keep_Alive    |
+              Reuse_Address |
+              Broadcast     |
+              No_Delay      =>
             V4  := C.int (Boolean'Pos (Option.Enabled));
             Len := V4'Size / 8;
             Add := V4'Address;
 
+         when Busy_Polling =>
+            V4  := C.int (Option.Microseconds);
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
          when Linger          =>
             V8 (V8'First) := C.int (Boolean'Pos (Option.Enabled));
             V8 (V8'Last)  := C.int (Option.Seconds);
@@ -2347,10 +2378,20 @@ package body GNAT.Sockets is
 
       end case;
 
+      if Option.Name in Specific_Option_Name then
+         Onm := Options (Option.Name);
+
+      elsif Option.Optname = -1 then
+         raise Socket_Error with "optname must be specified";
+
+      else
+         Onm := Option.Optname;
+      end if;
+
       Res := C_Setsockopt
         (C.int (Socket),
          Levels (Level),
-         Options (Option.Name),
+         Onm,
          Add, Len);
 
       if Res = Failure then
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index 9957e2c..d80f0ad 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -373,6 +373,9 @@ package GNAT.Sockets is
    --  entities declared therein are not meant for direct access by users,
    --  including through this renaming.
 
+   use type Interfaces.C.int;
+   --  Need visibility on "-" operator so that we can write -1
+
    procedure Initialize;
    pragma Obsolescent
      (Entity  => Initialize,
@@ -676,7 +679,8 @@ package GNAT.Sockets is
    --  a boolean to enable or disable this option.
 
    type Option_Name is
-     (Keep_Alive,          -- Enable sending of keep-alive messages
+     (Generic_Option,
+      Keep_Alive,          -- Enable sending of keep-alive messages
       Reuse_Address,       -- Allow bind to reuse local address
       Broadcast,           -- Enable datagram sockets to recv/send broadcasts
       Send_Buffer,         -- Set/get the maximum socket send buffer in bytes
@@ -691,10 +695,17 @@ package GNAT.Sockets is
       Multicast_Loop,      -- Sent multicast packets are looped to local socket
       Receive_Packet_Info, -- Receive low level packet info as ancillary data
       Send_Timeout,        -- Set timeout value for output
-      Receive_Timeout);    -- Set timeout value for input
+      Receive_Timeout,     -- Set timeout value for input
+      Busy_Polling);       -- Set busy polling mode
+   subtype Specific_Option_Name is
+     Option_Name range Keep_Alive .. Option_Name'Last;
 
    type Option_Type (Name : Option_Name := Keep_Alive) is record
       case Name is
+         when Generic_Option =>
+            Optname : Interfaces.C.int := -1;
+            Optval  : Interfaces.C.int;
+
          when Keep_Alive          |
               Reuse_Address       |
               Broadcast           |
@@ -711,6 +722,9 @@ package GNAT.Sockets is
                   null;
             end case;
 
+         when Busy_Polling    =>
+            Microseconds : Natural;
+
          when Send_Buffer     |
               Receive_Buffer  =>
             Size : Natural;
@@ -876,10 +890,12 @@ package GNAT.Sockets is
    --  No_Sock_Addr on error (e.g. socket closed or not locally bound).
 
    function Get_Socket_Option
-     (Socket : Socket_Type;
-      Level  : Level_Type := Socket_Level;
-      Name   : Option_Name) return Option_Type;
-   --  Get the options associated with a socket. Raises Socket_Error on error
+     (Socket  : Socket_Type;
+      Level   : Level_Type := Socket_Level;
+      Name    : Option_Name;
+      Optname : Interfaces.C.int := -1) return Option_Type;
+   --  Get the options associated with a socket. Raises Socket_Error on error.
+   --  Optname identifies specific option when Name is Generic_Option.
 
    procedure Listen_Socket
      (Socket : Socket_Type;
diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads
index 0d77dd7..c25f4ed 100644
--- a/gcc/ada/g-sothco.ads
+++ b/gcc/ada/g-sothco.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2008-2014, AdaCore                     --
+--                     Copyright (C) 2008-2016, 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- --
@@ -41,9 +41,6 @@ package GNAT.Sockets.Thin_Common is
 
    package C renames Interfaces.C;
 
-   use type C.int;
-   --  This is so we can declare the Failure constant below
-
    Success : constant C.int :=  0;
    Failure : constant C.int := -1;
 
diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads
index dce65f0..b38003b 100644
--- a/gcc/ada/lib-writ.ads
+++ b/gcc/ada/lib-writ.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -649,8 +649,10 @@ package Lib.Writ is
    --        AD  Elaborate_All_Desirable set for this unit, which means that
    --            there is no Elaborate_All, but the analysis suggests that
    --            Program_Error may be raised if the Elaborate_All conditions
-   --            cannot be satisfied. The binder will attempt to treat AD as
-   --            EA if it can.
+   --            cannot be satisfied. In dynamic elaboration mode, the binder
+   --            will attempt to treat AD as EA if it can. In static
+   --            elaboration mode, the binder will treat AD as EA, even if it
+   --            introduces cycles.
 
    --      The parameter source-name and lib-name are omitted for the case of a
    --      generic unit compiled with earlier versions of GNAT which did not
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index d1b522d..2614017 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-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2016, 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- --
@@ -1264,6 +1264,11 @@ CND(SO_RCVTIMEO, "Reception timeout")
 #endif
 CND(SO_ERROR, "Get/clear error status")
 
+#ifndef SO_BUSY_POLL
+# define SO_BUSY_POLL -1
+#endif
+CND(SO_BUSY_POLL, "Busy polling")
+
 #ifndef IP_MULTICAST_IF
 # define IP_MULTICAST_IF -1
 #endif
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index f836853..9a220bb 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -628,9 +628,11 @@ package body Sem_Case is
 
          --  Otherwise the expression is not static, even if the bounds of the
          --  type are, or else there are missing alternatives. If both, the
-         --  additional information may be redundant but harmless.
+         --  additional information may be redundant but harmless. Examine
+         --  whether original node is an entity, because it may have been
+         --  constant-folded to a literal if value is known.
 
-         elsif not Is_Entity_Name (Expr) then
+         elsif not Is_Entity_Name (Original_Node (Expr)) then
             Error_Msg_N
               ("subtype of expression is not static, "
                & "alternatives must cover base type!", Expr);
@@ -1362,6 +1364,15 @@ package body Sem_Case is
          --  later entry into the choices table so that they can be sorted
          --  later on.
 
+         procedure Handle_Static_Predicate
+           (Typ : Entity_Id;
+            Lo  : Node_Id;
+            Hi  : Node_Id);
+         --  If the type of the alternative has predicates, we must examine
+         --  each subset of the predicate rather than the bounds of the
+         --  type itself. This is relevant when the choice is a subtype mark
+         --  or a subtype indication.
+
          -----------
          -- Check --
          -----------
@@ -1474,6 +1485,56 @@ package body Sem_Case is
             Num_Choices := Num_Choices + 1;
          end Check;
 
+         -----------------------------
+         -- Handle_Static_Predicate --
+         -----------------------------
+
+         procedure Handle_Static_Predicate
+           (Typ : Entity_Id;
+            Lo  : Node_Id;
+            Hi  : Node_Id)
+         is
+            P : Node_Id;
+            C : Node_Id;
+
+         begin
+            --  Loop through entries in predicate list, checking each entry.
+            --  Note that if the list is empty, corresponding to a False
+            --  predicate, then no choices are checked. If the choice comes
+            --  from a subtype indication, the given range may have bounds
+            --  that narrow the predicate choices themselves, so we must
+            --  consider only those entries within the range of the given
+            --  subtype indication..
+
+            P := First (Static_Discrete_Predicate (Typ));
+            while Present (P) loop
+
+               --  Check that part of the predicate choice is included in
+               --  the given bounds.
+
+               if Expr_Value (High_Bound (P)) >= Expr_Value (Lo)
+                 and then Expr_Value (Low_Bound (P)) <= Expr_Value (Hi)
+               then
+                  C := New_Copy (P);
+                  Set_Sloc (C, Sloc (Choice));
+
+                  if Expr_Value (Low_Bound (C)) < Expr_Value (Lo) then
+                     Set_Low_Bound (C, Lo);
+                  end if;
+
+                  if Expr_Value (High_Bound (C)) > Expr_Value (Hi) then
+                     Set_High_Bound (C, Hi);
+                  end if;
+
+                  Check (C, Low_Bound (C), High_Bound (C));
+               end if;
+
+               Next (P);
+            end loop;
+
+            Set_Has_SP_Choice (Alt);
+         end Handle_Static_Predicate;
+
       --  Start of processing for Check_Choices
 
       begin
@@ -1582,29 +1643,12 @@ package body Sem_Case is
                                  & "predicate as case alternative",
                                  Choice, E, Suggest_Static => True);
 
-                           --  Static predicate case
+                           --  Static predicate case. The bounds are
+                           --  those of the given subtype.
 
                            else
-                              declare
-                                 P : Node_Id;
-                                 C : Node_Id;
-
-                              begin
-                                 --  Loop through entries in predicate list,
-                                 --  checking each entry. Note that if the
-                                 --  list is empty, corresponding to a False
-                                 --  predicate, then no choices are checked.
-
-                                 P := First (Static_Discrete_Predicate (E));
-                                 while Present (P) loop
-                                    C := New_Copy (P);
-                                    Set_Sloc (C, Sloc (Choice));
-                                    Check (C, Low_Bound (C), High_Bound (C));
-                                    Next (P);
-                                 end loop;
-                              end;
-
-                              Set_Has_SP_Choice (Alt);
+                              Handle_Static_Predicate (E,
+                                Type_Low_Bound (E), Type_High_Bound (E));
                            end if;
 
                         --  Not predicated subtype case
@@ -1658,7 +1702,16 @@ package body Sem_Case is
                                  end if;
                               end if;
 
-                              Check (Choice, L, H);
+                              if Has_Static_Predicate (E) then
+
+                              --  Check applicable predicate values within the
+                              --  bounds of the given range.
+
+                                 Handle_Static_Predicate (E, L, H);
+
+                              else
+                                 Check (Choice, L, H);
+                              end if;
                            end if;
                         end;
                      end if;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 54fca50..f9b4698 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -7744,9 +7744,9 @@ package body Sem_Ch8 is
             New_T := Etype (New_F);
             Old_T := Etype (Old_F);
 
-            --  If the new type is a renaming of the old one, as is the
-            --  case for actuals in instances, retain its name, to simplify
-            --  later disambiguation.
+            --  If the new type is a renaming of the old one, as is the case
+            --  for actuals in instances, retain its name, to simplify later
+            --  disambiguation.
 
             if Nkind (Parent (New_T)) = N_Subtype_Declaration
               and then Is_Entity_Name (Subtype_Indication (Parent (New_T)))
@@ -7760,6 +7760,7 @@ package body Sem_Ch8 is
             Next_Formal (New_F);
             Next_Formal (Old_F);
          end loop;
+
          pragma Assert (No (Old_F));
 
          if Ekind_In (Old_S, E_Function, E_Enumeration_Literal) then
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 66eaca7..7fa4845 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -446,6 +446,15 @@ package body Sem_Elab is
          return;
       end if;
 
+      --  If an instance of a generic package contains a controlled object (so
+      --  we're calling Initialize at elaboration time), and the instance is in
+      --  a package body P that says "with P;", then we need to return without
+      --  adding "pragma Elaborate_All (P);" to P.
+
+      if U = Main_Unit_Entity then
+         return;
+      end if;
+
       Itm := First (CI);
       while Present (Itm) loop
          if Nkind (Itm) = N_With_Clause then
@@ -495,10 +504,8 @@ package body Sem_Elab is
       end if;
 
       --  Here if we do not find with clause on spec or body. We just ignore
-      --  this case, it means that the elaboration involves some other unit
+      --  this case; it means that the elaboration involves some other unit
       --  than the unit being compiled, and will be caught elsewhere.
-
-      null;
    end Activate_Elaborate_All_Desirable;
 
    ------------------
@@ -528,7 +535,7 @@ package body Sem_Elab is
        --  Generate a call to Error_Msg_NE with parameters Msg_D or Msg_S (for
        --  dynamic or static elaboration model), N and Ent. Msg_D is a real
        --  warning (output if Msg_D is non-null and Elab_Warnings is set),
-       --  Msg_S is an info message (output if Elab_Info_Messages is set.
+       --  Msg_S is an info message (output if Elab_Info_Messages is set).
 
       function Find_W_Scope return Entity_Id;
       --  Find top-level scope for called entity (not following renamings
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 4351f32..3e4fe0a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -24599,7 +24599,7 @@ package body Sem_Prag is
       In_Out_Items   : Elist_Id := No_Elist;
       Out_Items      : Elist_Id := No_Elist;
       Proof_In_Items : Elist_Id := No_Elist;
-      --  These list contain the entities of all Input, In_Out, Output and
+      --  These lists contain the entities of all Input, In_Out, Output and
       --  Proof_In items defined in the corresponding Global pragma.
 
       Repeat_Items : Elist_Id := No_Elist;
@@ -24656,7 +24656,7 @@ package body Sem_Prag is
       procedure Collect_Global_Items
         (List : Node_Id;
          Mode : Name_Id := Name_Input);
-      --  Gather all input, in out, output and Proof_In items from node List
+      --  Gather all Input, In_Out, Output and Proof_In items from node List
       --  and separate them in lists In_Items, In_Out_Items, Out_Items and
       --  Proof_In_Items. Flags Has_In_State, Has_In_Out_State, Has_Out_State
       --  and Has_Proof_In_State are set when there is at least one abstract