[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

8 files changed, 130 insertions, 21 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 164c690..b5d5e82 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,29 @@
 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.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 8d7981b..16624d2 100644
--- a/gcc/ada/einfo.ads
+++ b/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
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index e186258..04a4b86 100644
--- a/gcc/ada/g-socket.adb
+++ b/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 --
    ----------------------
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index 4761f3a..c543707 100644
--- a/gcc/ada/g-socket.ads
+++ b/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;
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index f6f5b2a..68b4035 100644
--- a/gcc/ada/init.c
+++ b/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)
 {
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 24970f1..f5c03f2 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/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;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9a687db..0e8e213 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/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);
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 9ffc7b0..6a6d342 100644
--- a/gcc/ada/sem_prag.adb
+++ b/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);