1------------------------------------------------------------------------------ 2-- -- 3-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS -- 4-- -- 5-- A 4 G . D E F A U L T S -- 6-- -- 7-- Copyright (C) 1995-2014, Free Software Foundation, Inc. -- 8-- -- 9-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it -- 10-- under terms of the GNU General Public License as published by the Free -- 11-- Software Foundation; either version 2, or (at your option) any later -- 12-- version. ASIS-for-GNAT is distributed in the hope that it will be use- -- 13-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- 14-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- 15-- Public License for more details. You should have received a copy of the -- 16-- GNU General Public License distributed with ASIS-for-GNAT; see file -- 17-- COPYING. If not, write to the Free Software Foundation, 51 Franklin -- 18-- Street, Fifth Floor, Boston, MA 02110-1301, USA. -- 19-- -- 20-- -- 21-- -- 22-- -- 23-- -- 24-- -- 25-- -- 26-- -- 27-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the -- 28-- Software Engineering Laboratory of the Swiss Federal Institute of -- 29-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the -- 30-- Scientific Research Computer Center of Moscow State University (SRCC -- 31-- MSU), Russia, with funding partially provided by grants from the Swiss -- 32-- National Science Foundation and the Swiss Academy of Engineering -- 33-- Sciences. ASIS-for-GNAT is now maintained by AdaCore -- 34-- (http://www.adacore.com). -- 35-- -- 36------------------------------------------------------------------------------ 37 38with Unchecked_Deallocation; 39 40with A4G.A_Osint; use A4G.A_Osint; 41with A4G.U_Conv; use A4G.U_Conv; 42 43with Output; use Output; 44 45package body A4G.Defaults is 46 47 procedure Free_String is new Unchecked_Deallocation 48 (String, String_Access); 49 50 procedure Add_Src_Search_Dir (Dir : String); 51 -- Add Dir at the end of the default source file search path. 52 53 procedure Add_Lib_Search_Dir (Dir : String); 54 -- Add Dir at the end of the default library (=object+ALI) file search 55 -- path. 56 57 ------------------------ 58 -- Add_Lib_Search_Dir -- 59 ------------------------ 60 61 procedure Add_Lib_Search_Dir (Dir : String) is 62 begin 63 ASIS_Lib_Search_Directories.Increment_Last; 64 ASIS_Lib_Search_Directories.Table (ASIS_Lib_Search_Directories.Last) := 65 new String'(Normalize_Directory_Name (Dir)); 66 end Add_Lib_Search_Dir; 67 68 ------------------------ 69 -- Add_Src_Search_Dir -- 70 ------------------------ 71 72 procedure Add_Src_Search_Dir (Dir : String) is 73 begin 74 ASIS_Src_Search_Directories.Increment_Last; 75 ASIS_Src_Search_Directories.Table (ASIS_Src_Search_Directories.Last) := 76 new String'(Normalize_Directory_Name (Dir)); 77 end Add_Src_Search_Dir; 78 79 -------------- 80 -- Finalize -- 81 -------------- 82 83 procedure Finalize is 84 begin 85 -- finalise ASIS_Src_Search_Directories: 86 for I in First_Dir_Id .. ASIS_Src_Search_Directories.Last loop 87 Free_String (ASIS_Src_Search_Directories.Table (I)); 88 end loop; 89 90 -- finalize ASIS_Lib_Search_Directories: 91 for I in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop 92 Free_String (ASIS_Lib_Search_Directories.Table (I)); 93 end loop; 94 95 -- finalize ASIS_Tree_Search_Directories 96 for I in First_Dir_Id .. ASIS_Tree_Search_Directories.Last loop 97 Free_String (ASIS_Tree_Search_Directories.Table (I)); 98 end loop; 99 end Finalize; 100 101 ---------------- 102 -- Initialize -- 103 ---------------- 104 105 procedure Initialize is 106 Search_Path : String_Access; 107 begin 108 -- just in case: 109 Finalize; 110 111 ASIS_Src_Search_Directories.Init; 112 ASIS_Lib_Search_Directories.Init; 113 ASIS_Tree_Search_Directories.Init; 114 115 -- stroring the defaults for: the code is stolen from Osint 116 -- (body, rev. 1.147) and then adjusted 117 118 for Dir_kind in Search_Dir_Kinds loop 119 120 case Dir_kind is 121 when Source => 122 Search_Path := Getenv ("ADA_INCLUDE_PATH"); 123 when Object => 124 Search_Path := Getenv ("ADA_OBJECTS_PATH"); 125 when Tree => 126 -- There is no environment variable for separate 127 -- tree path at the moment; 128 exit; 129 end case; 130 131 if Search_Path'Length > 0 then 132 declare 133 Lower_Bound : Positive := 1; 134 Upper_Bound : Positive; 135 136 begin 137 loop 138 while Lower_Bound <= Search_Path'Last 139 and then Search_Path.all (Lower_Bound) = 140 Path_Separator 141 loop 142 Lower_Bound := Lower_Bound + 1; 143 end loop; 144 145 exit when Lower_Bound > Search_Path'Last; 146 147 Upper_Bound := Lower_Bound; 148 while Upper_Bound <= Search_Path'Last 149 and then Search_Path.all (Upper_Bound) /= 150 Path_Separator 151 loop 152 Upper_Bound := Upper_Bound + 1; 153 end loop; 154 155 case Dir_kind is 156 when Source => 157 Add_Src_Search_Dir 158 (Search_Path.all (Lower_Bound .. Upper_Bound - 1)); 159 when Object => 160 Add_Lib_Search_Dir 161 (Search_Path.all (Lower_Bound .. Upper_Bound - 1)); 162 when Tree => 163 exit; -- non implemented yet; 164 end case; 165 166 Lower_Bound := Upper_Bound + 1; 167 end loop; 168 end; 169 end if; 170 end loop; 171 172 -- ??? TEMPORARY SOLUTION: the default objects search path 173 -- is also used as the default tree path 174 175 for J in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop 176 177 ASIS_Tree_Search_Directories.Increment_Last; 178 179 ASIS_Tree_Search_Directories.Table 180 (ASIS_Tree_Search_Directories.Last) := 181 new String'(ASIS_Lib_Search_Directories.Table (J).all); 182 183 end loop; 184 185 Free (Search_Path); 186 187 end Initialize; 188 189 ------------------------- 190 -- Locate_Default_File -- 191 ------------------------- 192 193 function Locate_Default_File 194 (File_Name : String_Access; 195 Dir_Kind : Search_Dir_Kinds) 196 return String_Access 197 is 198 function Is_Here_In_Src (File_Name : String_Access; Dir : Dir_Id) 199 return Boolean; 200 function Is_Here_In_Lib (File_Name : String_Access; Dir : Dir_Id) 201 return Boolean; 202 -- funtion Is_Here_In_Tree (File_Name : String_Access; Dir : Dir_Id) 203 -- return Boolean; 204 205 function Is_Here_In_Src (File_Name : String_Access; Dir : Dir_Id) 206 return Boolean 207 is 208 begin 209 return Is_Regular_File (ASIS_Src_Search_Directories.Table (Dir).all 210 & To_String (File_Name)); 211 end Is_Here_In_Src; 212 213 function Is_Here_In_Lib (File_Name : String_Access; Dir : Dir_Id) 214 return Boolean 215 is 216 begin 217 return Is_Regular_File (ASIS_Lib_Search_Directories.Table (Dir).all 218 & To_String (File_Name)); 219 end Is_Here_In_Lib; 220 221 begin 222 case Dir_Kind is 223 224 when Source => 225 for Dir in First_Dir_Id .. ASIS_Src_Search_Directories.Last loop 226 if Is_Here_In_Src (File_Name, Dir) then 227 return new String' 228 (ASIS_Src_Search_Directories.Table (Dir).all 229 & File_Name.all); 230 end if; 231 end loop; 232 233 when Object => 234 for Dir in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop 235 if Is_Here_In_Lib (File_Name, Dir) then 236 return new String' 237 (ASIS_Lib_Search_Directories.Table (Dir).all 238 & File_Name.all); 239 end if; 240 end loop; 241 when Tree => 242 null; -- non implemented yet; 243 end case; 244 245 return null; 246 end Locate_Default_File; 247 248 ------------------------ 249 -- Print_Lib_Defaults -- 250 ------------------------ 251 252 procedure Print_Lib_Defaults is 253 begin 254 if ASIS_Lib_Search_Directories.Last < First_Dir_Id then 255 Write_Str (" No default library files search path"); 256 Write_Eol; 257 else 258 for Dir in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop 259 Write_Str (" " & ASIS_Lib_Search_Directories.Table (Dir).all); 260 Write_Eol; 261 end loop; 262 end if; 263 end Print_Lib_Defaults; 264 265 --------------------------- 266 -- Print_Source_Defaults -- 267 --------------------------- 268 269 procedure Print_Source_Defaults is 270 begin 271 if ASIS_Src_Search_Directories.Last < First_Dir_Id then 272 Write_Str (" No default source search path"); 273 Write_Eol; 274 else 275 for Dir in First_Dir_Id .. ASIS_Src_Search_Directories.Last loop 276 Write_Str (" " & ASIS_Src_Search_Directories.Table (Dir).all); 277 Write_Eol; 278 end loop; 279 end if; 280 end Print_Source_Defaults; 281 282 ------------------------- 283 -- Print_Tree_Defaults -- 284 ------------------------- 285 286 procedure Print_Tree_Defaults is 287 begin 288 if ASIS_Tree_Search_Directories.Last < First_Dir_Id then 289 Write_Str (" No default tree files search path"); 290 Write_Eol; 291 else 292 for Dir in First_Dir_Id .. ASIS_Tree_Search_Directories.Last loop 293 Write_Str (" " & ASIS_Tree_Search_Directories.Table (Dir).all); 294 Write_Eol; 295 end loop; 296 end if; 297 end Print_Tree_Defaults; 298 299end A4G.Defaults; 300