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