[multiple changes]

2014-07-31  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): New
	predicate Discriminated_Size, to distinguish between private
	components that depend on discriminants from those whose size
	depends on some other non-static expression.

2014-07-31  Nicolas Setton  <setton@adacore.com>

	* g-exptty.adb (Close): Fix binding to Waitpid: use the
	tty version.

From-SVN: r213341

3 files changed, 111 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c4d668a..8daa4dc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,17 @@
 2014-07-31  Ed Schonberg  <schonberg@adacore.com>
 
+	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): New
+	predicate Discriminated_Size, to distinguish between private
+	components that depend on discriminants from those whose size
+	depends on some other non-static expression.
+
+2014-07-31  Nicolas Setton  <setton@adacore.com>
+
+	* g-exptty.adb (Close): Fix binding to Waitpid: use the
+	tty version.
+
+2014-07-31  Ed Schonberg  <schonberg@adacore.com>
+
 	* sem_ch3.adb (Make_Index): Reject properly the use of 'Length
 	in a discrete range, when 'range was probably intended.
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index b3a4542..cbd522e 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -8877,6 +8877,12 @@ package body Exp_Ch9 is
       --  to the internal body, for possible inlining later on. The source
       --  operation is invisible to the back-end and is never actually called.
 
+      function Discriminated_Size (Comp : Entity_Id) return Boolean;
+      --  If a component size is not static then a warning will be emitted
+      --  in Ravenscar or other restricted contexts. When a component is non-
+      --  static because of a discriminant constraint we can specialize the
+      --  warning by mentioning discriminants explicitly.
+
       procedure Expand_Entry_Declaration (Comp : Entity_Id);
       --  Create the subprograms for the barrier and for the body, and append
       --  then to Entry_Bodies_Array.
@@ -8904,9 +8910,65 @@ package body Exp_Ch9 is
          end if;
       end Check_Inlining;
 
-      ---------------------------------
-      -- Check_Static_Component_Size --
-      ---------------------------------
+      ------------------------
+      -- Discriminated_Size --
+      ------------------------
+
+      function Discriminated_Size (Comp : Entity_Id) return Boolean
+      is
+         Typ   : constant Entity_Id := Etype (Comp);
+         Index : Node_Id;
+
+         function Non_Static_Bound (Bound : Node_Id) return Boolean;
+         --  Check whether the bound of an index is non-static and does
+         --  denote a discriminant, in which case any protected object of
+         --  the type will have a non-static size.
+
+         ----------------------
+         -- Non_Static_Bound --
+         ----------------------
+
+         function Non_Static_Bound (Bound : Node_Id) return Boolean is
+         begin
+            if Is_Static_Expression (Bound) then
+               return False;
+
+            elsif Is_Entity_Name (Bound)
+               and then Present (Discriminal_Link (Entity (Bound)))
+            then
+               return False;
+
+            else
+               return True;
+            end if;
+         end Non_Static_Bound;
+
+      begin
+         if not Is_Array_Type (Typ) then
+            return False;
+         end if;
+
+         if Ekind (Typ) = E_Array_Subtype then
+            Index := First_Index (Typ);
+            while Present (Index) loop
+               if Non_Static_Bound (Low_Bound (Index))
+                 or else Non_Static_Bound (High_Bound (Index))
+               then
+                  return False;
+               end if;
+
+               Next_Index (Index);
+            end loop;
+
+            return True;
+         end if;
+
+         return False;
+      end Discriminated_Size;
+
+      ---------------------------
+      -- Static_Component_Size --
+      ---------------------------
 
       function Static_Component_Size (Comp : Entity_Id) return Boolean is
          Typ : constant Entity_Id := Etype (Comp);
@@ -9100,11 +9162,26 @@ package body Exp_Ch9 is
                      Check_Restriction (No_Implicit_Heap_Allocations, Priv);
 
                   elsif Restriction_Active (No_Implicit_Heap_Allocations) then
-                     Error_Msg_N ("component has non-static size??", Priv);
-                     Error_Msg_NE
-                       ("\creation of protected object of type& will violate"
-                        & " restriction No_Implicit_Heap_Allocations??",
-                        Priv, Prot_Typ);
+                     if not Discriminated_Size (Defining_Identifier (Priv))
+                     then
+
+                        --  Any object of the type will be  non-static.
+
+                        Error_Msg_N ("component has non-static size??", Priv);
+                        Error_Msg_NE
+                          ("\creation of protected object of type& will"
+                           & " violate restriction "
+                           & "No_Implicit_Heap_Allocations??", Priv, Prot_Typ);
+                     else
+
+                        --  Object will be non-static if discriminants are.
+
+                        Error_Msg_NE
+                          ("creation of protected object of type& with "
+                           &  "non-static discriminants  will violate"
+                           & " restriction No_Implicit_Heap_Allocations??",
+                           Priv, Prot_Typ);
+                     end if;
                   end if;
                end if;
 
diff --git a/gcc/ada/g-exptty.adb b/gcc/ada/g-exptty.adb
index 7ec0472..3e78193 100644
--- a/gcc/ada/g-exptty.adb
+++ b/gcc/ada/g-exptty.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                    Copyright (C) 2000-2011, AdaCore                      --
+--                    Copyright (C) 2000-2014, 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- --
@@ -50,7 +50,7 @@ package body GNAT.Expect.TTY is
       pragma Import (C, Terminate_Process, "__gnat_terminate_process");
 
       function Waitpid (Process : System.Address) return Integer;
-      pragma Import (C, Waitpid, "__gnat_waitpid");
+      pragma Import (C, Waitpid, "__gnat_tty_waitpid");
       --  Wait for a specific process id, and return its exit code
 
       procedure Free_Process (Process : System.Address);
@@ -66,6 +66,18 @@ package body GNAT.Expect.TTY is
          Status := -1;
 
       else
+         --  Send a Ctrl-C to the process first. This way, if the
+         --  launched process is a "sh" or "cmd", the child processes
+         --  will get terminated as well. Otherwise, terminating the
+         --  main process brutally will leave the children running.
+         --
+         --  Note: special characters are sent to the terminal to generate
+         --  the signal, so this needs to be done while the file descriptors
+         --  are still open.
+
+         Interrupt (Descriptor);
+         delay (0.05);
+
          if Descriptor.Input_Fd /= Invalid_FD then
             Close (Descriptor.Input_Fd);
          end if;
@@ -80,14 +92,6 @@ package body GNAT.Expect.TTY is
             Close (Descriptor.Output_Fd);
          end if;
 
-         --  Send a Ctrl-C to the process first. This way, if the
-         --  launched process is a "sh" or "cmd", the child processes
-         --  will get terminated as well. Otherwise, terminating the
-         --  main process brutally will leave the children running.
-
-         Interrupt (Descriptor);
-         delay 0.05;
-
          Terminate_Process (Descriptor.Process);
          Status := Waitpid (Descriptor.Process);