[multiple changes]

2013-04-23  Yannick Moy  <moy@adacore.com>

	* einfo.ads: Minor typo fix.
	* sem_ch13.adb (Build_Predicate_Functions): Reject cases where
	Static_Predicate is applied to a non-scalar or non-static type.
	* sem_prag.adb: Minor typo fix.

2013-04-23  Doug Rupp  <rupp@adacore.com>

	* init.c (GNAT$STOP) [VMS]: New function.

2013-04-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb: Add exp_pakd to context.
	(Constrain_Component_Type): If the component of the parent is
	packed, and the record subtype being built is already frozen,
	as is the case for an itype, the component type itself will not
	be frozen, and the packed array type for it must be constructed
	explicitly.

2013-04-23  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb, g-socket.ads (Set_Close_On_Exec): New subprogram.

From-SVN: r198196

gcc/ada/ChangeLog

 2013-04-23  Yannick Moy  <moy@adacore.com>
 
+	* einfo.ads: Minor typo fix.
+	* sem_ch13.adb (Build_Predicate_Functions): Reject cases where
+	Static_Predicate is applied to a non-scalar or non-static type.
+	* sem_prag.adb: Minor typo fix.
+
+2013-04-23  Doug Rupp  <rupp@adacore.com>
+
+	* init.c (GNAT$STOP) [VMS]: New function.
+
+2013-04-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb: Add exp_pakd to context.
+	(Constrain_Component_Type): If the component of the parent is
+	packed, and the record subtype being built is already frozen,
+	as is the case for an itype, the component type itself will not
+	be frozen, and the packed array type for it must be constructed
+	explicitly.
+
+2013-04-23  Thomas Quinot  <quinot@adacore.com>
+
+	* g-socket.adb, g-socket.ads (Set_Close_On_Exec): New subprogram.
+
+2013-04-23  Yannick Moy  <moy@adacore.com>
+
 	* err_vars.ads (Error_Msg_Qual_Level): Set variable to zero
 	at declaration.
 	* opt.ads (Multiple_Unit_Index): Set variable to zero at declaration.

gcc/ada/einfo.ads

@@ -2544,7 +2544,7 @@ package Einfo is
 --       entirely synthesized, by looking at the bounds, and the immediate
 --       subtype parent. However, this method does not work for some Itypes
 --       that have no parent set (and the only way to find the immediate
---       subtype parent is to go through the tree). For now, this flay is set
+--       subtype parent is to go through the tree). For now, this flag is set
 --       conservatively, i.e. if it is set then for sure the subtype is non-
 --       static, but if it is not set, then the type may or may not be static.
 --       Thus the test for a static subtype is that this flag is clear AND that

gcc/ada/g-socket.adb

@@ -2211,6 +2211,24 @@ package body GNAT.Sockets is
       Insert_Socket_In_Set (Item.Set'Access, C.int (Socket));
    end Set;
 
+   -----------------------
+   -- Set_Close_On_Exec --
+   -----------------------
+
+   procedure Set_Close_On_Exec
+     (Socket        : Socket_Type;
+      Close_On_Exec : Boolean;
+      Status        : out Boolean)
+   is
+      function C_Set_Close_On_Exec
+        (Socket : Socket_Type; Close_On_Exec : C.int)
+         return C.int;
+      pragma Import (C, C_Set_Close_On_Exec, "__gnat_set_close_on_exec");
+
+   begin
+      Status := C_Set_Close_On_Exec (Socket, Boolean'Pos (Close_On_Exec)) = 0;
+   end Set_Close_On_Exec;
+
    ----------------------
    -- Set_Forced_Flags --
    ----------------------

gcc/ada/g-socket.ads

@@ -979,6 +979,17 @@ package GNAT.Sockets is
    --  socket. Count is set to the count of transmitted stream elements. Flags
    --  allow control over transmission.
 
+   procedure Set_Close_On_Exec
+     (Socket        : Socket_Type;
+      Close_On_Exec : Boolean;
+      Status        : out Boolean);
+   --  When Close_On_Exec is True, mark Socket to be closed automatically when
+   --  a new program is executed by the calling process (i.e. prevent Socket
+   --  from being inherited by child processes). When Close_On_Exec is False,
+   --  mark Socket to not be closed on exec (i.e. allow it to be inherited).
+   --  Status is False if the operation could not be performed, or is not
+   --  supported on the target platform.
+
    procedure Set_Socket_Option
      (Socket : Socket_Type;
       Level  : Level_Type := Socket_Level;

gcc/ada/init.c

@@ -1286,6 +1286,22 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
   Raise_From_Signal_Handler (exception, msg);
 }
 
+#if defined (IN_RTS) && defined (__IA64)
+/* Called only from adasigio.b32.  This is a band aid to avoid going
+   through the VMS signal handling code which results in a 0x8000 per
+   handled exception memory leak in P2 space (see VMS source listing
+   sys/lis/exception.lis) due to the allocation of working space that
+   is expected to be deallocated upon return from the condition handler,
+   which doesn't return in GNAT compiled code.  */
+void
+GNAT$STOP (int *sigargs)
+{
+   /* Note that there are no mechargs. We rely on the fact that condtions
+      raised from DEClib I/O do not require an "adjust".  */
+   __gnat_handle_vms_condition (sigargs, 0);
+}
+#endif
+
 void
 __gnat_install_handler (void)
 {

gcc/ada/sem_ch13.adb

@@ -980,7 +980,7 @@ package body Sem_Ch13 is
             --  Perform analysis of the External_Name or Link_Name aspects
 
             procedure Analyze_Aspect_Implicit_Dereference;
-            --  Perform  analysis of the Implicit_Dereference aspects
+            --  Perform analysis of the Implicit_Dereference aspects
 
             procedure Make_Aitem_Pragma
               (Pragma_Argument_Associations : List_Id;
@@ -1082,8 +1082,8 @@ package body Sem_Ch13 is
                      Pragma_Argument_Associations,
                    Pragma_Identifier =>
                      Make_Identifier (Sloc (Id), Pragma_Name),
-                     Class_Present     => Class_Present (Aspect),
-                     Split_PPC         => Split_PPC (Aspect));
+                   Class_Present     => Class_Present (Aspect),
+                   Split_PPC         => Split_PPC (Aspect));
 
                --  Set additional semantic fields
 
@@ -5707,7 +5707,7 @@ package body Sem_Ch13 is
    -- Build_Predicate_Functions --
    -------------------------------
 
-   --  The procedures that are constructed here has the form:
+   --  The procedures that are constructed here have the form:
 
    --    function typPredicate (Ixxx : typ) return Boolean is
    --    begin
@@ -5725,8 +5725,8 @@ package body Sem_Ch13 is
    --  use this function even if checks are off, e.g. for membership tests.
 
    --  If the expression has at least one Raise_Expression, then we also build
-   --  the typPredicateM version of the function, in which any occurence of a
-   --  Raise_Expressioon is converted to "return False".
+   --  the typPredicateM version of the function, in which any occurrence of a
+   --  Raise_Expression is converted to "return False".
 
    procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (Typ);
@@ -6216,22 +6216,48 @@ package body Sem_Ch13 is
 
          --  Deal with static predicate case
 
-         if Ekind_In (Typ, E_Enumeration_Subtype,
-                           E_Modular_Integer_Subtype,
-                           E_Signed_Integer_Subtype)
+         --  ??? We don't currently deal with real types
+         --  ??? Why requiring that Typ is static?
+
+         if Ekind (Typ) in Discrete_Kind
            and then Is_Static_Subtype (Typ)
            and then not Dynamic_Predicate_Present
          then
-            Build_Static_Predicate (Typ, Expr, Object_Name);
+            --  Only build the predicate for subtypes
 
-            if Present (Static_Predicate_Present)
-              and No (Static_Predicate (Typ))
+            if Ekind_In (Typ, E_Enumeration_Subtype,
+                              E_Modular_Integer_Subtype,
+                              E_Signed_Integer_Subtype)
             then
-               Error_Msg_F
-                 ("expression does not have required form for "
-                  & "static predicate",
-                  Next (First (Pragma_Argument_Associations
-                                (Static_Predicate_Present))));
+               Build_Static_Predicate (Typ, Expr, Object_Name);
+
+               if Present (Static_Predicate_Present)
+                 and No (Static_Predicate (Typ))
+               then
+                  Error_Msg_F
+                    ("expression does not have required form for "
+                     & "static predicate",
+                     Next (First (Pragma_Argument_Associations
+                                   (Static_Predicate_Present))));
+               end if;
+            end if;
+
+         --  If a Static_Predicate applies on other types, that's an error:
+         --  either the type is scalar but non-static, or it's not even a
+         --  scalar type. We do not issue an error on generated types, as these
+         --  would be duplicates of the same error on a source type.
+
+         elsif Present (Static_Predicate_Present)
+           and then Comes_From_Source (Typ)
+         then
+            if Is_Scalar_Type (Typ) then
+               Error_Msg_FE
+                 ("static predicate not allowed for non-static type&",
+                  Typ, Typ);
+            else
+               Error_Msg_FE
+                 ("static predicate not allowed for non-scalar type&",
+                  Typ, Typ);
             end if;
          end if;
       end if;

gcc/ada/sem_ch3.adb

@@ -35,6 +35,7 @@ with Exp_Ch3;  use Exp_Ch3;
 with Exp_Ch9;  use Exp_Ch9;
 with Exp_Disp; use Exp_Disp;
 with Exp_Dist; use Exp_Dist;
+with Exp_Pakd; use Exp_Pakd;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Fname;    use Fname;
@@ -11113,6 +11114,7 @@ package body Sem_Ch3 is
    is
       Loc         : constant Source_Ptr := Sloc (Constrained_Typ);
       Compon_Type : constant Entity_Id := Etype (Comp);
+      Array_Comp  : Node_Id;
 
       function Build_Constrained_Array_Type
         (Old_Type : Entity_Id) return Entity_Id;
@@ -11510,7 +11512,19 @@ package body Sem_Ch3 is
          return Compon_Type;
 
       elsif Is_Array_Type (Compon_Type) then
-         return Build_Constrained_Array_Type (Compon_Type);
+         Array_Comp := Build_Constrained_Array_Type (Compon_Type);
+
+         --  If the component of the parent is packed, and the record type is
+         --  already frozen, as is the case for an itype, the component type
+         --  itself will not be frozen, and the packed array type for it must
+         --  be constructed explicitly.
+
+         if Is_Packed (Compon_Type)
+           and then Is_Frozen (Current_Scope)
+         then
+            Create_Packed_Array_Type (Array_Comp);
+         end if;
+         return Array_Comp;
 
       elsif Has_Discriminants (Compon_Type) then
          return Build_Constrained_Discriminated_Type (Compon_Type);

gcc/ada/sem_prag.adb

@@ -8121,8 +8121,8 @@ package body Sem_Prag is
             --  Set Check_On to indicate check status
 
             --  If this comes from an aspect, we have already taken care of
-            --  the policy active when the aspect was analyzed, and Is_Ignore
-            --  is set appriately already.
+            --  the policy active when the aspect was analyzed, and Is_Ignored
+            --  is set appropriately already.
 
             if From_Aspect_Specification (N) then
                Check_On := not Is_Ignored (N);