1------------------------------------------------------------------------------
2--                                                                          --
3--                     ASIS UTILITY LIBRARY COMPONENTS                      --
4--                                                                          --
5--                       A S I S _ U L . C O M M O N                        --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--                    Copyright (C) 2004-2016, AdaCore                      --
10--                                                                          --
11-- Asis Utility Library (ASIS UL) is free software; you can redistribute it --
12-- and/or  modify  it  under  terms  of  the  GNU General Public License as --
13-- published by the Free Software Foundation; either version 3, or (at your --
14-- option)  any later version.  ASIS UL  is distributed in the hope that it --
15-- will  be  useful,  but  WITHOUT  ANY  WARRANTY; without even the implied --
16-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
17-- GNU  General Public License for more details. You should have received a --
18-- copy of the  GNU General Public License  distributed with GNAT; see file --
19-- COPYING3. If not,  go to http://www.gnu.org/licenses for a complete copy --
20-- of the license.                                                          --
21--                                                                          --
22-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
23--                                                                          --
24------------------------------------------------------------------------------
25
26pragma Ada_2012;
27
28with Ada.Characters.Handling;    use Ada.Characters.Handling;
29with Ada.Command_Line;           use Ada.Command_Line;
30with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
31
32with GNAT.Directory_Operations;
33
34with ASIS_UL.Output;             use ASIS_UL.Output;
35with ASIS_UL.Compiler_Options;   use ASIS_UL.Compiler_Options;
36
37package body ASIS_UL.Common is
38
39   -----------------------
40   -- Local subprograms --
41   -----------------------
42
43   procedure Set_Tool_Name_And_Path;
44   --  Reads the tool name from the command line and sets Tool_Name. If the
45   --  tool name contains directory information, adds the directory to the
46   --  path.
47
48   Global_Report_Dir : String_Access := new String'("." & Directory_Separator);
49   --  The name of the directory to place the global results into
50
51   -------------------
52   -- Detect_Target --
53   -------------------
54
55   function Detect_Target return String is
56      use GNAT.Directory_Operations;
57
58      Tgt_Last : constant Natural :=
59        Index (Tool_Name.all, "-", Ada.Strings.Backward);
60      AAMP_Idx : constant Natural := Index (Tool_Name.all, "gnaamp");
61   begin
62
63      if AAMP_Idx = Tool_Name'First then
64         return "AAMP";
65      elsif Tgt_Last > 0 then
66         return Tool_Name (Tool_Name'First .. Tgt_Last);
67      else
68         return "";
69      end if;
70
71   exception
72      when others =>
73         return "";
74
75   end Detect_Target;
76
77   ---------------------------
78   -- Get_Global_Report_Dir --
79   ---------------------------
80
81   function Get_Global_Report_Dir return String is
82   begin
83      return Global_Report_Dir.all;
84   end Get_Global_Report_Dir;
85
86   --------------------------
87   -- Process_Project_File --
88   --------------------------
89
90   procedure Process_Project_File (Project_File_Name : String) is
91   begin
92      --  pragma Assert (False, "???Process_Project_File is not used");
93      --  Actually, it is still used by Ada2java. This should be replaced with
94      --  proper project support as has been done for other ASIS tools.
95
96      if Is_Regular_File (Project_File_Name) then
97         Project_File_Obsolete :=
98           new String'(Normalize_Pathname (Project_File_Name));
99
100         if Project_Support_Type = No_Tmp_Project_File then
101            Store_Option ("-P" & Project_File_Obsolete.all);
102         end if;
103
104      else
105         Error ("the project file " & Project_File_Name & " not found");
106         raise Parameter_Error;
107      end if;
108
109      Gcc_To_Call := Gnatmake_To_Call;
110
111      if Gcc_To_Call /= null then
112         Use_Gnatmake_To_Compile := True;
113      else
114         Error ("can not locate gnatmake to compile with a project file");
115         raise Parameter_Error;
116      end if;
117
118      Use_Project_File_Obsolete := True;
119
120   end Process_Project_File;
121
122   ---------------------------
123   -- Set_Global_Report_Dir --
124   ---------------------------
125
126   procedure Set_Global_Report_Dir (Dir : String) is
127   begin
128      Free (Global_Report_Dir);
129      pragma Assert (Dir /= "");
130      Global_Report_Dir := new String'(Dir & Directory_Separator);
131   end Set_Global_Report_Dir;
132
133   ----------------------------
134   -- Set_Tool_Name_And_Path --
135   ----------------------------
136
137   procedure Set_Tool_Name_And_Path is
138      Full_Tool_Name : constant String := Ada.Command_Line.Command_Name;
139      Exe_Suffix     : String_Access   := Get_Executable_Suffix;
140   begin
141      Tool_Name :=
142        new String'(To_Lower
143                      (GNAT.Directory_Operations.Base_Name
144                         (Full_Tool_Name, Suffix => Exe_Suffix.all)));
145
146      for Index in reverse Full_Tool_Name'Range loop
147         if Full_Tool_Name (Index) = Directory_Separator then
148            declare
149               Absolute_Dir : constant String :=
150                                 Normalize_Pathname
151                                  (Full_Tool_Name
152                                     (Full_Tool_Name'First .. Index));
153
154               PATH : constant String :=
155                 Absolute_Dir & Path_Separator & Getenv ("PATH").all;
156
157            begin
158               Setenv ("PATH", PATH);
159            end;
160
161            exit;
162         end if;
163      end loop;
164
165      Free (Exe_Suffix);
166   end Set_Tool_Name_And_Path;
167
168begin
169   Set_Tool_Name_And_Path;
170
171   --  Detetermine the name of the executables for gcc, gnatmake, and gprbuild
172
173   declare
174      Target        : constant String := Detect_Target;
175      Gcc_Name      : constant String :=
176        (if Target = "AAMP" then "gnaamp" else Target & "gcc");
177      Gnatmake_Name : constant String :=
178        (if Target = "AAMP" then "gnaampmake" else Target & "gnatmake");
179      pragma Unreferenced (Gnatmake_Name);
180      Gprbuild_Name : constant String := "gprbuild";
181   begin
182      Gcc_To_Call      := Locate_Exec_On_Path (Gcc_Name);
183      Gprbuild_To_Call := Locate_Exec_On_Path (Gprbuild_Name);
184      Gnatmake_To_Call := Gprbuild_To_Call;
185   end;
186end ASIS_UL.Common;
187