diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/g-exptty.adb')
| -rw-r--r-- | gcc-4.7/gcc/ada/g-exptty.adb | 309 |
1 files changed, 0 insertions, 309 deletions
diff --git a/gcc-4.7/gcc/ada/g-exptty.adb b/gcc-4.7/gcc/ada/g-exptty.adb deleted file mode 100644 index 7ec04727d..000000000 --- a/gcc-4.7/gcc/ada/g-exptty.adb +++ /dev/null @@ -1,309 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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; |