1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2018, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
28 with Ada
.Command_Line
;
29 with Ada
.Strings
.Unbounded
; use Ada
.Strings
.Unbounded
;
32 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
33 with GNAT
.Expect
; use GNAT
.Expect
;
34 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
36 package body VxLink
is
38 Target_Triplet
: Unbounded_String
:= Null_Unbounded_String
;
39 Verbose
: Boolean := False;
40 Error_State
: Boolean := False;
42 function Triplet
return String;
45 function Which
(Exe
: String) return String;
52 function Triplet
return String is
54 if Target_Triplet
= Null_Unbounded_String
then
56 Exe
: constant String := File_Name
(Ada
.Command_Line
.Command_Name
);
58 for J
in reverse Exe
'Range loop
60 Target_Triplet
:= To_Unbounded_String
(Exe
(Exe
'First .. J
));
67 return To_String
(Target_Triplet
);
74 function Which
(Exe
: String) return String is
75 Suffix
: GNAT
.OS_Lib
.String_Access
:= Get_Executable_Suffix
;
76 Basename
: constant String := Exe
& Suffix
.all;
77 Path
: GNAT
.OS_Lib
.String_Access
:= Getenv
("PATH");
78 Last
: Natural := Path
'First;
83 for J
in Path
'Range loop
84 if Path
(J
) = Path_Separator
then
86 Full
: constant String := Normalize_Pathname
88 Directory
=> Path
(Last
.. J
- 1),
89 Resolve_Links
=> False,
90 Case_Sensitive
=> True);
92 if Is_Executable_File
(Full
) then
112 procedure Set_Verbose
(Value
: Boolean) is
121 function Is_Verbose
return Boolean is
126 ---------------------
127 -- Set_Error_State --
128 ---------------------
130 procedure Set_Error_State
(Message
: String) is
132 Log_Error
("Error: " & Message
);
134 Ada
.Command_Line
.Set_Exit_Status
(1);
141 function Is_Error_State
return Boolean is
150 procedure Log_Info
(S
: String) is
153 Ada
.Text_IO
.Put_Line
(S
);
161 procedure Log_Error
(S
: String) is
163 Ada
.Text_IO
.Put_Line
(Ada
.Text_IO
.Standard_Error
, S
);
170 procedure Run
(Arguments
: Arguments_List
) is
171 Output
: constant String := Run
(Arguments
);
173 if not Is_Error_State
then
174 -- In case of erroneous execution, the function version of run will
175 -- have already displayed the output
176 Ada
.Text_IO
.Put
(Output
);
184 function Run
(Arguments
: Arguments_List
) return String is
185 Args
: GNAT
.OS_Lib
.Argument_List_Access
:=
186 new GNAT
.OS_Lib
.Argument_List
187 (1 .. Natural (Arguments
.Length
) - 1);
188 Base
: constant String := Base_Name
(Arguments
.First_Element
);
190 Debug_Line
: Unbounded_String
;
191 Add_Quotes
: Boolean;
195 Append
(Debug_Line
, Base
);
198 for J
in Arguments
.First_Index
+ 1 .. Arguments
.Last_Index
loop
200 Arg
: String renames Arguments
.Element
(J
);
202 Args
(J
- 1) := new String'(Arg);
207 for K in Arg'Range loop
208 if Arg (K) = ' ' then
214 Append (Debug_Line, ' ');
217 Append (Debug_Line, '"' & Arg & '"');
219 Append (Debug_Line, Arg);
226 Ada.Text_IO.Put_Line (To_String (Debug_Line));
230 Status : aliased Integer := 0;
231 Ret : constant String :=
233 (Command => Arguments.First_Element,
234 Arguments => Args.all,
236 Status => Status'Access,
240 GNAT.OS_Lib.Free (Args);
243 Ada.Text_IO.Put_Line (Ret);
245 (Base_Name (Arguments.First_Element) &
246 " returned" & Status'Image);
257 function Gcc return String is
259 return Which (Triplet & "gcc");
266 function Gxx return String is
268 return Which (Triplet & "g++");
275 function Nm return String is
277 return Which (Triplet & "nm");