1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1996-2019, Free Software Foundation, Inc. --
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 ------------------------------------------------------------------------------
27 with Namet; use Namet;
29 with Osint; use Osint;
30 with Output; use Output;
31 with Switch; use Switch;
35 with Ada.Characters.Handling; use Ada.Characters.Handling;
36 with Ada.Command_Line; use Ada.Command_Line;
37 with Ada.Text_IO; use Ada.Text_IO;
39 with GNAT.OS_Lib; use GNAT.OS_Lib;
42 Gprbuild : constant String := "gprbuild";
43 Gprclean : constant String := "gprclean";
44 Gprname : constant String := "gprname";
45 Gprls : constant String := "gprls";
47 Ada_Help_Switch : constant String := "--help-ada";
48 -- Flag to display available build switches
50 Error_Exit : exception;
51 -- Raise this exception if error detected
75 subtype Real_Command_Type is Command_Type range Bind .. Xref;
76 -- All real command types (excludes only Undefined).
78 type Alternate_Command is (Comp, Ls, Kr, Pp, Prep);
79 -- Alternate command label
81 Corresponding_To : constant array (Alternate_Command) of Command_Type :=
87 -- Mapping of alternate commands to commands
89 package First_Switches is new Table.Table
90 (Table_Component_Type => String_Access,
91 Table_Index_Type => Integer,
94 Table_Increment => 100,
95 Table_Name => "Gnatcmd.First_Switches");
96 -- A table to keep the switches from the project file
98 package Last_Switches is new Table.Table
99 (Table_Component_Type => String_Access,
100 Table_Index_Type => Integer,
101 Table_Low_Bound => 1,
103 Table_Increment => 100,
104 Table_Name => "Gnatcmd.Last_Switches");
106 ----------------------------------
107 -- Declarations for GNATCMD use --
108 ----------------------------------
110 The_Command : Command_Type;
111 -- The command specified in the invocation of the GNAT driver
113 Command_Arg : Positive := 1;
114 -- The index of the command in the arguments of the GNAT driver
116 My_Exit_Status : Exit_Status := Success;
117 -- The exit status of the spawned tool
119 type Command_Entry is record
120 Cname : String_Access;
121 -- Command name for GNAT xxx command
123 Unixcmd : String_Access;
124 -- Corresponding Unix command
126 Unixsws : Argument_List_Access;
127 -- List of switches to be used with the Unix command
130 Command_List : constant array (Real_Command_Type) of Command_Entry :=
132 (Cname => new String'("BIND"),
133 Unixcmd => new String'("gnatbind"),
137 (Cname => new String'("CHOP"),
138 Unixcmd => new String'("gnatchop"),
142 (Cname => new String'("CLEAN"),
143 Unixcmd => new String'("gnatclean"),
147 (Cname => new String'("COMPILE"),
148 Unixcmd => new String'("gnatmake"),
149 Unixsws => new Argument_List'(1 => new String'("-f"),
150 2 => new String'("-u"),
151 3 => new String'("-c"))),
154 (Cname => new String'("CHECK"),
155 Unixcmd => new String'("gnatcheck"),
159 (Cname => new String'("ELIM"),
160 Unixcmd => new String'("gnatelim"),
164 (Cname => new String'("FIND"),
165 Unixcmd => new String'("gnatfind"),
169 (Cname => new String'("KRUNCH"),
170 Unixcmd => new String'("gnatkr"),
174 (Cname => new String'("LINK"),
175 Unixcmd => new String'("gnatlink"),
179 (Cname => new String'("LIST"),
180 Unixcmd => new String'("gnatls"),
184 (Cname => new String'("MAKE"),
185 Unixcmd => new String'("gnatmake"),
189 (Cname => new String'("METRIC"),
190 Unixcmd => new String'("gnatmetric"),
194 (Cname => new String'("NAME"),
195 Unixcmd => new String'("gnatname"),
199 (Cname => new String'("PREPROCESS"),
200 Unixcmd => new String'("gnatprep"),
204 (Cname => new String'("PRETTY"),
205 Unixcmd => new String'("gnatpp"),
209 (Cname => new String'("STACK"),
210 Unixcmd => new String'("gnatstack"),
214 (Cname => new String'("STUB"),
215 Unixcmd => new String'("gnatstub"),
219 (Cname => new String'("TEST"),
220 Unixcmd => new String'("gnattest"),
224 (Cname => new String'("XREF"),
225 Unixcmd => new String'("gnatxref"),
229 -----------------------
230 -- Local Subprograms --
231 -----------------------
233 procedure Output_Version;
234 -- Output the version of this program
236 procedure GNATCmd_Usage;
243 procedure Output_Version is
246 Put_Line (Gnatvsn.Gnat_Version_String);
247 Put_Line ("Copyright 1996-" & Gnatvsn.Current_Year
248 & ", Free Software Foundation, Inc.");
255 procedure GNATCmd_Usage is
259 Put_Line ("To list Ada build switches use " & Ada_Help_Switch);
261 Put_Line ("List of available commands");
264 for C in Command_List'Range loop
266 Put (To_Lower (Command_List (C).Cname.all));
268 Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
271 Sws : Argument_List_Access renames Command_List (C).Unixsws;
274 for J in Sws'Range loop
287 procedure Check_Version_And_Help
288 is new Check_Version_And_Help_G (GNATCmd_Usage);
290 -- Start of processing for GNATCmd
293 -- All output from GNATCmd is debugging or error output: send to stderr
300 Last_Switches.Set_Last (0);
303 First_Switches.Set_Last (0);
305 -- Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
306 -- so that the spawned tool may know the way the GNAT driver was invoked.
309 Add_Str_To_Name_Buffer (Command_Name);
311 for J in 1 .. Argument_Count loop
312 Add_Char_To_Name_Buffer (' ');
313 Add_Str_To_Name_Buffer (Argument (J));
316 Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
318 -- Add the directory where the GNAT driver is invoked in front of the path,
319 -- if the GNAT driver is invoked with directory information.
322 Command : constant String := Command_Name;
325 for Index in reverse Command'Range loop
326 if Command (Index) = Directory_Separator then
328 Absolute_Dir : constant String :=
329 Normalize_Pathname (Command (Command'First .. Index));
330 PATH : constant String :=
331 Absolute_Dir & Path_Separator & Getenv ("PATH").all;
333 Setenv ("PATH", PATH);
341 -- Scan the command line
343 -- First, scan to detect --version and/or --help
345 Check_Version_And_Help ("GNAT", "1996");
349 if Command_Arg <= Argument_Count
350 and then Argument (Command_Arg) = "-v"
352 Verbose_Mode := True;
353 Command_Arg := Command_Arg + 1;
355 elsif Command_Arg <= Argument_Count
356 and then Argument (Command_Arg) = "-dn"
358 Keep_Temporary_Files := True;
359 Command_Arg := Command_Arg + 1;
361 elsif Command_Arg <= Argument_Count
362 and then Argument (Command_Arg) = Ada_Help_Switch
365 Exit_Program (E_Success);
372 -- If there is no command, just output the usage
374 if Command_Arg > Argument_Count then
377 -- Add the following so that output is consistent with or without the
380 Write_Line ("Report bugs to report@adacore.com");
384 The_Command := Real_Command_Type'Value (Argument (Command_Arg));
387 when Constraint_Error =>
389 -- Check if it is an alternate command
392 Alternate : Alternate_Command;
395 Alternate := Alternate_Command'Value (Argument (Command_Arg));
396 The_Command := Corresponding_To (Alternate);
399 when Constraint_Error =>
401 Fail ("unknown command: " & Argument (Command_Arg));
405 -- Get the arguments from the command line and from the eventual
406 -- argument file(s) specified on the command line.
408 for Arg in Command_Arg + 1 .. Argument_Count loop
410 The_Arg : constant String := Argument (Arg);
413 -- Check if an argument file is specified
415 if The_Arg'Length > 0 and then The_Arg (The_Arg'First) = '@' then
417 Arg_File : Ada.Text_IO.File_Type;
418 Line : String (1 .. 256);
422 -- Open the file and fail if the file cannot be found
425 Open (Arg_File, In_File,
426 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
430 Put (Standard_Error, "Cannot open argument file """);
432 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
433 Put_Line (Standard_Error, """");
437 -- Read line by line and put the content of each non-
438 -- empty line in the Last_Switches table.
440 while not End_Of_File (Arg_File) loop
441 Get_Line (Arg_File, Line, Last);
444 Last_Switches.Increment_Last;
445 Last_Switches.Table (Last_Switches.Last) :=
446 new String'(Line (1 .. Last));
453 elsif The_Arg'Length > 0 then
454 -- It is not an argument file; just put the argument in
455 -- the Last_Switches table.
457 Last_Switches.Increment_Last;
458 Last_Switches.Table (Last_Switches.Last) := new String'(The_Arg);
464 Program : String_Access;
465 Exec_Path : String_Access;
466 Get_Target : Boolean := False;
469 if The_Command = Stack then
471 -- Never call gnatstack with a prefix
473 Program := new String'(Command_List (The_Command).Unixcmd.all);
477 Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
479 -- If we want to invoke gnatmake/gnatclean with -P, then check if
480 -- gprbuild/gprclean is available; if it is, use gprbuild/gprclean
481 -- instead of gnatmake/gnatclean.
482 -- Ditto for gnatname -> gprname and gnatls -> gprls.
484 if The_Command = Make
485 or else The_Command = Compile
486 or else The_Command = Bind
487 or else The_Command = Link
488 or else The_Command = Clean
489 or else The_Command = Name
490 or else The_Command = List
493 Switch : String_Access;
494 Call_GPR_Tool : Boolean := False;
496 for J in 1 .. Last_Switches.Last loop
497 Switch := Last_Switches.Table (J);
499 if Switch'Length >= 2
500 and then Switch (Switch'First .. Switch'First + 1) = "-P"
502 Call_GPR_Tool := True;
507 if Call_GPR_Tool then
514 if Locate_Exec_On_Path (Gprbuild) /= null then
515 Program := new String'(Gprbuild);
518 if The_Command = Bind then
519 First_Switches.Append (new String'("-b"));
520 elsif The_Command = Link then
521 First_Switches.Append (new String'("-l"));
524 elsif The_Command = Bind then
526 ("'gnat bind -P' is no longer supported;" &
527 " use 'gprbuild -b' instead.");
529 elsif The_Command = Link then
531 ("'gnat Link -P' is no longer supported;" &
532 " use 'gprbuild -l' instead.");
536 if Locate_Exec_On_Path (Gprclean) /= null then
537 Program := new String'(Gprclean);
542 if Locate_Exec_On_Path (Gprname) /= null then
543 Program := new String'(Gprname);
548 if Locate_Exec_On_Path (Gprls) /= null then
549 Program := new String'(Gprls);
561 First_Switches.Append
563 ("--target=" & Name_Buffer (1 .. Name_Len - 5)));
571 -- Locate the executable for the command
573 Exec_Path := Locate_Exec_On_Path (Program.all);
575 if Exec_Path = null then
576 Put_Line (Standard_Error, "could not locate " & Program.all);
580 -- If there are switches for the executable, put them as first switches
582 if Command_List (The_Command).Unixsws /= null then
583 for J in Command_List (The_Command).Unixsws'Range loop
584 First_Switches.Increment_Last;
585 First_Switches.Table (First_Switches.Last) :=
586 Command_List (The_Command).Unixsws (J);
590 -- For FIND and XREF, look for switch -P. If it is specified, then
591 -- report an error indicating that the command is no longer supporting
594 if The_Command = Find or else The_Command = Xref then
596 Argv : String_Access;
598 for Arg_Num in 1 .. Last_Switches.Last loop
599 Argv := Last_Switches.Table (Arg_Num);
601 if Argv'Length >= 2 and then
602 Argv (Argv'First .. Argv'First + 1) = "-P"
604 if The_Command = Find then
605 Fail ("'gnat find -P' is no longer supported;");
607 Fail ("'gnat xref -P' is no longer supported;");
614 -- Gather all the arguments and invoke the executable
617 The_Args : Argument_List
618 (1 .. First_Switches.Last + Last_Switches.Last);
619 Arg_Num : Natural := 0;
622 for J in 1 .. First_Switches.Last loop
623 Arg_Num := Arg_Num + 1;
624 The_Args (Arg_Num) := First_Switches.Table (J);
627 for J in 1 .. Last_Switches.Last loop
628 Arg_Num := Arg_Num + 1;
629 The_Args (Arg_Num) := Last_Switches.Table (J);
635 for Arg in The_Args'Range loop
636 Put (" " & The_Args (Arg).all);
642 My_Exit_Status := Exit_Status (Spawn (Exec_Path.all, The_Args));
644 Set_Exit_Status (My_Exit_Status);
650 Set_Exit_Status (Failure);