2011-11-23 Robert Dewar <dewar@adacore.com>

	* exp_util.adb, par-ch6.adb, sem_res.adb, par-util.adb: Minor
	reformatting.

2011-11-23  Yannick Moy  <moy@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Place error on
	line of precondition/ postcondition/invariant.
2011-11-23  Pascal Obry  <obry@adacore.com>

	* g-exptty.ads, g-exptty.adb, g-tty.ads, g-tty.adb,
	terminals.c: New files.
	Makefile.rtl: Add these new files.
	* gnat_rm.texi: Add documentation for GNAT.Expect.TTY.
	* gcc-interface/Makefile.in: Add g-exptty, g-tty, terminals.o
	* gcc-interface/Make-lang.in: Update dependencies.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181655 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 309 insertions, 0 deletions

diff --git a/gcc/ada/g-exptty.adb b/gcc/ada/g-exptty.adb
new file mode 100644
index 00000000000..7ec04727d07
--- /dev/null
+++ b/gcc/ada/g-exptty.adb
@@ -0,0 +1,309 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                      G N A T . E X P E C T . T T Y                       --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                    Copyright (C) 2000-2011, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with System; use System;
+
+package body GNAT.Expect.TTY is
+
+   On_Windows : constant Boolean := Directory_Separator = '\';
+   --  True when on Windows
+
+   -----------
+   -- Close --
+   -----------
+
+   overriding procedure Close
+     (Descriptor : in out TTY_Process_Descriptor;
+      Status     : out Integer)
+   is
+      procedure Terminate_Process (Process : System.Address);
+      pragma Import (C, Terminate_Process, "__gnat_terminate_process");
+
+      function Waitpid (Process : System.Address) return Integer;
+      pragma Import (C, Waitpid, "__gnat_waitpid");
+      --  Wait for a specific process id, and return its exit code
+
+      procedure Free_Process (Process : System.Address);
+      pragma Import (C, Free_Process, "__gnat_free_process");
+
+      procedure Close_TTY (Process : System.Address);
+      pragma Import (C, Close_TTY, "__gnat_close_tty");
+
+   begin
+      --  If we haven't already closed the process
+
+      if Descriptor.Process = System.Null_Address then
+         Status := -1;
+
+      else
+         if Descriptor.Input_Fd /= Invalid_FD then
+            Close (Descriptor.Input_Fd);
+         end if;
+
+         if Descriptor.Error_Fd /= Descriptor.Output_Fd
+           and then Descriptor.Error_Fd /= Invalid_FD
+         then
+            Close (Descriptor.Error_Fd);
+         end if;
+
+         if Descriptor.Output_Fd /= Invalid_FD then
+            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);
+
+         if not On_Windows then
+            Close_TTY (Descriptor.Process);
+         end if;
+
+         Free_Process (Descriptor.Process'Address);
+         Descriptor.Process := System.Null_Address;
+
+         GNAT.OS_Lib.Free (Descriptor.Buffer);
+         Descriptor.Buffer_Size := 0;
+      end if;
+   end Close;
+
+   overriding procedure Close (Descriptor : in out TTY_Process_Descriptor) is
+      Status : Integer;
+   begin
+      Close (Descriptor, Status);
+   end Close;
+
+   -----------------------------
+   -- Close_Pseudo_Descriptor --
+   -----------------------------
+
+   procedure Close_Pseudo_Descriptor
+     (Descriptor : in out TTY_Process_Descriptor)
+   is
+   begin
+      Descriptor.Buffer_Size := 0;
+      GNAT.OS_Lib.Free (Descriptor.Buffer);
+   end Close_Pseudo_Descriptor;
+
+   ---------------
+   -- Interrupt --
+   ---------------
+
+   overriding procedure Interrupt
+     (Descriptor : in out TTY_Process_Descriptor)
+   is
+      procedure Internal (Process : System.Address);
+      pragma Import (C, Internal, "__gnat_interrupt_process");
+   begin
+      if Descriptor.Process /= System.Null_Address then
+         Internal (Descriptor.Process);
+      end if;
+   end Interrupt;
+
+   procedure Interrupt (Pid : Integer) is
+      procedure Internal (Pid : Integer);
+      pragma Import (C, Internal, "__gnat_interrupt_pid");
+   begin
+      Internal (Pid);
+   end Interrupt;
+
+   -----------------------
+   -- Pseudo_Descriptor --
+   -----------------------
+
+   procedure Pseudo_Descriptor
+     (Descriptor  : out TTY_Process_Descriptor'Class;
+      TTY         : GNAT.TTY.TTY_Handle;
+      Buffer_Size : Natural := 4096) is
+   begin
+      Descriptor.Input_Fd  := GNAT.TTY.TTY_Descriptor (TTY);
+      Descriptor.Output_Fd := Descriptor.Input_Fd;
+
+      --  Create the buffer
+
+      Descriptor.Buffer_Size := Buffer_Size;
+
+      if Buffer_Size /= 0 then
+         Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
+      end if;
+   end Pseudo_Descriptor;
+
+   ----------
+   -- Send --
+   ----------
+
+   overriding procedure Send
+     (Descriptor   : in out TTY_Process_Descriptor;
+      Str          : String;
+      Add_LF       : Boolean := True;
+      Empty_Buffer : Boolean := False)
+   is
+      Header : String (1 .. 5);
+      Length : Natural;
+      Ret    : Natural;
+
+      procedure Internal
+        (Process : System.Address;
+         S       : in out String;
+         Length  : Natural;
+         Ret     : out Natural);
+      pragma Import (C, Internal, "__gnat_send_header");
+
+   begin
+      Length := Str'Length;
+
+      if Add_LF then
+         Length := Length + 1;
+      end if;
+
+      Internal (Descriptor.Process, Header, Length, Ret);
+
+      if Ret = 1 then
+
+         --  Need to use the header
+
+         GNAT.Expect.Send
+           (Process_Descriptor (Descriptor),
+            Header & Str, Add_LF, Empty_Buffer);
+
+      else
+         GNAT.Expect.Send
+           (Process_Descriptor (Descriptor),
+            Str, Add_LF, Empty_Buffer);
+      end if;
+   end Send;
+
+   --------------
+   -- Set_Size --
+   --------------
+
+   procedure Set_Size
+     (Descriptor : in out TTY_Process_Descriptor'Class;
+      Rows       : Natural;
+      Columns    : Natural)
+   is
+      procedure Internal (Process : System.Address; R, C : Integer);
+      pragma Import (C, Internal, "__gnat_setup_winsize");
+   begin
+      if Descriptor.Process /= System.Null_Address then
+         Internal (Descriptor.Process, Rows, Columns);
+      end if;
+   end Set_Size;
+
+   ---------------------------
+   -- Set_Up_Communications --
+   ---------------------------
+
+   overriding procedure Set_Up_Communications
+     (Pid        : in out TTY_Process_Descriptor;
+      Err_To_Out : Boolean;
+      Pipe1      : access Pipe_Type;
+      Pipe2      : access Pipe_Type;
+      Pipe3      : access Pipe_Type)
+   is
+      pragma Unreferenced (Err_To_Out, Pipe1, Pipe2, Pipe3);
+
+      function Internal (Process : System.Address) return Integer;
+      pragma Import (C, Internal, "__gnat_setup_communication");
+
+   begin
+      if Internal (Pid.Process'Address) /= 0 then
+         raise Invalid_Process with "cannot setup communication.";
+      end if;
+   end Set_Up_Communications;
+
+   ---------------------------------
+   -- Set_Up_Child_Communications --
+   ---------------------------------
+
+   overriding procedure Set_Up_Child_Communications
+     (Pid   : in out TTY_Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type;
+      Cmd   : String;
+      Args  : System.Address)
+   is
+      pragma Unreferenced (Pipe1, Pipe2, Pipe3, Cmd);
+      function Internal
+        (Process : System.Address; Argv : System.Address; Use_Pipes : Integer)
+         return Process_Id;
+      pragma Import (C, Internal, "__gnat_setup_child_communication");
+
+   begin
+      Pid.Pid := Internal (Pid.Process, Args, Boolean'Pos (Pid.Use_Pipes));
+   end Set_Up_Child_Communications;
+
+   ----------------------------------
+   -- Set_Up_Parent_Communications --
+   ----------------------------------
+
+   overriding procedure Set_Up_Parent_Communications
+     (Pid   : in out TTY_Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type)
+   is
+      pragma Unreferenced (Pipe1, Pipe2, Pipe3);
+
+      procedure Internal
+        (Process  : System.Address;
+         Inputfp  : out File_Descriptor;
+         Outputfp : out File_Descriptor;
+         Errorfp  : out File_Descriptor;
+         Pid      : out Process_Id);
+      pragma Import (C, Internal, "__gnat_setup_parent_communication");
+
+   begin
+      Internal
+        (Pid.Process, Pid.Input_Fd, Pid.Output_Fd, Pid.Error_Fd, Pid.Pid);
+   end Set_Up_Parent_Communications;
+
+   -------------------
+   -- Set_Use_Pipes --
+   -------------------
+
+   procedure Set_Use_Pipes
+     (Descriptor : in out TTY_Process_Descriptor;
+      Use_Pipes  : Boolean) is
+   begin
+      Descriptor.Use_Pipes := Use_Pipes;
+   end Set_Use_Pipes;
+
+end GNAT.Expect.TTY;