1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- I M P U N I T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- 10-- -- 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Lib; use Lib; 28with Namet; use Namet; 29with Opt; use Opt; 30 31package body Impunit is 32 33 subtype File_Name_8 is String (1 .. 8); 34 type File_List is array (Nat range <>) of File_Name_8; 35 36 -- The following is a giant string containing the concenated names 37 -- of all non-implementation internal files, i.e. the complete list 38 -- of files for internal units which a program may legitimately WITH. 39 40 -- Note that this list should match the list of units documented in 41 -- the "GNAT Library" section of the GNAT Reference Manual. 42 43 Non_Imp_File_Names : constant File_List := ( 44 45 ----------------------------------------------- 46 -- Ada Hierarchy Units from Reference Manual -- 47 ----------------------------------------------- 48 49 "a-astaco", -- Ada.Asynchronous_Task_Control 50 "a-calend", -- Ada.Calendar 51 "a-chahan", -- Ada.Characters.Handling 52 "a-charac", -- Ada.Characters 53 "a-chlat1", -- Ada.Characters.Latin_1 54 "a-comlin", -- Ada.Command_Line 55 "a-decima", -- Ada.Decimal 56 "a-direio", -- Ada.Direct_IO 57 "a-dynpri", -- Ada.Dynamic_Priorities 58 "a-except", -- Ada.Exceptions 59 "a-finali", -- Ada.Finalization 60 "a-flteio", -- Ada.Float_Text_IO 61 "a-fwteio", -- Ada.Float_Wide_Text_IO 62 "a-inteio", -- Ada.Integer_Text_IO 63 "a-interr", -- Ada.Interrupts 64 "a-intnam", -- Ada.Interrupts.Names 65 "a-ioexce", -- Ada.IO_Exceptions 66 "a-iwteio", -- Ada.Integer_Wide_Text_IO 67 "a-ncelfu", -- Ada.Numerics.Complex_Elementary_Functions 68 "a-ngcefu", -- Ada.Numerics.Generic_Complex_Elementary_Functions 69 "a-ngcoty", -- Ada.Numerics.Generic_Complex_Types 70 "a-ngelfu", -- Ada.Numerics.Generic_Elementary_Functions 71 "a-nucoty", -- Ada.Numerics.Complex_Types 72 "a-nudira", -- Ada.Numerics.Discrete_Random 73 "a-nuelfu", -- Ada.Numerics.Elementary_Functions 74 "a-nuflra", -- Ada.Numerics.Float_Random 75 "a-numeri", -- Ada.Numerics 76 "a-reatim", -- Ada.Real_Time 77 "a-sequio", -- Ada.Sequential_IO 78 "a-stmaco", -- Ada.Strings.Maps.Constants 79 "a-storio", -- Ada.Storage_IO 80 "a-strbou", -- Ada.Strings.Bounded 81 "a-stream", -- Ada.Streams 82 "a-strfix", -- Ada.Strings.Fixed 83 "a-string", -- Ada.Strings 84 "a-strmap", -- Ada.Strings.Maps 85 "a-strunb", -- Ada.Strings.Unbounded 86 "a-ststio", -- Ada.Streams.Stream_IO 87 "a-stwibo", -- Ada.Strings.Wide_Bounded 88 "a-stwifi", -- Ada.Strings.Wide_Fixed 89 "a-stwima", -- Ada.Strings.Wide_Maps 90 "a-stwiun", -- Ada.Strings.Wide_Unbounded 91 "a-swmwco", -- Ada.Strings.Wide_Maps.Wide_Constants 92 "a-sytaco", -- Ada.Synchronous_Task_Control 93 "a-tags ", -- Ada.Tags 94 "a-tasatt", -- Ada.Task_Attributes 95 "a-taside", -- Ada.Task_Identification 96 "a-teioed", -- Ada.Text_IO.Editing 97 "a-textio", -- Ada.Text_IO 98 "a-ticoio", -- Ada.Text_IO.Complex_IO 99 "a-titest", -- Ada.Text_IO.Text_Streams 100 "a-unccon", -- Ada.Unchecked_Conversion 101 "a-uncdea", -- Ada.Unchecked_Deallocation 102 "a-witeio", -- Ada.Wide_Text_IO 103 "a-wtcoio", -- Ada.Wide_Text_IO.Complex_IO 104 "a-wtedit", -- Ada.Wide_Text_IO.Editing 105 "a-wttest", -- Ada.Wide_Text_IO.Text_Streams 106 107 ------------------------------------------------- 108 -- RM Required Additions to Ada for GNAT Types -- 109 ------------------------------------------------- 110 111 "a-lfteio", -- Ada.Long_Float_Text_IO 112 "a-lfwtio", -- Ada.Long_Float_Wide_Text_IO 113 "a-liteio", -- Ada.Long_Integer_Text_IO 114 "a-liwtio", -- Ada.Long_Integer_Wide_Text_IO 115 "a-llftio", -- Ada.Long_Long_Float_Text_IO 116 "a-llfwti", -- Ada.Long_Long_Float_Wide_Text_IO 117 "a-llitio", -- Ada.Long_Long_Integer_Text_IO 118 "a-lliwti", -- Ada.Long_Long_Integer_Wide_Text_IO 119 "a-nlcefu", -- Ada.Long_Complex_Elementary_Functions 120 "a-nlcoty", -- Ada.Numerics.Long_Complex_Types 121 "a-nlelfu", -- Ada.Numerics.Long_Elementary_Functions 122 "a-nllcef", -- Ada.Long_Long_Complex_Elementary_Functions 123 "a-nllefu", -- Ada.Numerics.Long_Long_Elementary_Functions 124 "a-nltcty", -- Ada.Numerics.Long_Long_Complex_Types 125 "a-nscefu", -- Ada.Short_Complex_Elementary_Functions 126 "a-nscoty", -- Ada.Numerics.Short_Complex_Types 127 "a-nselfu", -- Ada.Numerics.Short_Elementary_Functions 128 "a-sfteio", -- Ada.Short_Float_Text_IO 129 "a-sfwtio", -- Ada.Short_Float_Wide_Text_IO 130 "a-siteio", -- Ada.Short_Integer_Text_IO 131 "a-siwtio", -- Ada.Short_Integer_Wide_Text_IO 132 "a-ssitio", -- Ada.Short_Short_Integer_Text_IO 133 "a-ssiwti", -- Ada.Short_Short_Integer_Wide_Text_IO 134 135 ----------------------------------- 136 -- GNAT Defined Additions to Ada -- 137 ----------------------------------- 138 139 "a-chlat9", -- Ada.Characters.Latin_9 140 "a-colien", -- Ada.Command_Line.Environment 141 "a-colire", -- Ada.Command_Line.Remove 142 "a-cwila1", -- Ada.Characters.Wide_Latin_1 143 "a-cwila9", -- Ada.Characters.Wide_Latin_9 144 "a-diocst", -- Ada.Direct_IO.C_Streams 145 "a-einuoc", -- Ada.Exceptions.Is_Null_Occurrence 146 "a-exctra", -- Ada.Exceptions.Traceback 147 "a-siocst", -- Ada.Sequential_IO.C_Streams 148 "a-ssicst", -- Ada.Streams.Stream_IO.C_Streams 149 "a-suteio", -- Ada.Strings.Unbounded.Text_IO 150 "a-swuwti", -- Ada.Strings.Wide_Unbounded.Wide_Text_IO 151 "a-taidim", -- Ada.Task_Identification.Image 152 "a-tiocst", -- Ada.Text_IO.C_Streams 153 "a-wtcstr", -- Ada.Wide_Text_IO.C_Streams 154 155 --------------------------- 156 -- GNAT Special IO Units -- 157 --------------------------- 158 159 -- As further explained elsewhere (see Sem_Ch10), the internal 160 -- packages of Text_IO and Wide_Text_IO are actually implemented 161 -- as separate children, but this fact is intended to be hidden 162 -- from the user completely. Any attempt to WITH one of these 163 -- units will be diagnosed as an error later on, but for now we 164 -- do not consider these internal implementation units (if we did, 165 -- then we would get a junk warning which would be confusing and 166 -- unecessary, given that we generate a clear error message). 167 168 "a-tideio", -- Ada.Text_IO.Decimal_IO 169 "a-tienio", -- Ada.Text_IO.Enumeration_IO 170 "a-tifiio", -- Ada.Text_IO.Fixed_IO 171 "a-tiflio", -- Ada.Text_IO.Float_IO 172 "a-tiinio", -- Ada.Text_IO.Integer_IO 173 "a-tiinio", -- Ada.Text_IO.Integer_IO 174 "a-timoio", -- Ada.Text_IO.Modular_IO 175 "a-wtdeio", -- Ada.Wide_Text_IO.Decimal_IO 176 "a-wtenio", -- Ada.Wide_Text_IO.Enumeration_IO 177 "a-wtfiio", -- Ada.Wide_Text_IO.Fixed_IO 178 "a-wtflio", -- Ada.Wide_Text_IO.Float_IO 179 "a-wtinio", -- Ada.Wide_Text_IO.Integer_IO 180 "a-wtmoio", -- Ada.Wide_Text_IO.Modular_IO 181 182 ------------------------ 183 -- GNAT Library Units -- 184 ------------------------ 185 186 "g-arrspl", -- GNAT.Array_Split 187 "g-awk ", -- GNAT.AWK 188 "g-boubuf", -- GNAT.Bounded_Buffers 189 "g-boumai", -- GNAT.Bounded_Mailboxes 190 "g-bubsor", -- GNAT.Bubble_Sort 191 "g-busora", -- GNAT.Bubble_Sort_A 192 "g-busorg", -- GNAT.Bubble_Sort_G 193 "g-calend", -- GNAT.Calendar 194 "g-casuti", -- GNAT.Case_Util 195 "g-catiio", -- GNAT.Calendar.Time_IO 196 "g-cgi ", -- GNAT.CGI 197 "g-cgicoo", -- GNAT.CGI.Cookie 198 "g-cgideb", -- GNAT.CGI.Debug 199 "g-comlin", -- GNAT.Command_Line 200 "g-comver", -- GNAT.Compiler_Version 201 "g-crc32 ", -- GNAT.CRC32 202 "g-ctrl_c", -- GNAT.Ctrl_C 203 "g-curexc", -- GNAT.Current_Exception 204 "g-debpoo", -- GNAT.Debug_Pools 205 "g-debuti", -- GNAT.Debug_Utilities 206 "g-diopit", -- GNAT.Directory_Operations.Iteration 207 "g-dirope", -- GNAT.Directory_Operations 208 "g-dynhta", -- GNAT.Dynamic_HTables 209 "g-dyntab", -- GNAT.Dynamic_Tables 210 "g-excact", -- GNAT.Exception_Actions 211 "g-except", -- GNAT.Exceptions 212 "g-exctra", -- GNAT.Exception_Traces 213 "g-expect", -- GNAT.Expect 214 "g-flocon", -- GNAT.Float_Control 215 "g-heasor", -- GNAT.Heap_Sort 216 "g-hesora", -- GNAT.Heap_Sort_A 217 "g-hesorg", -- GNAT.Heap_Sort_G 218 "g-htable", -- GNAT.Htable 219 "g-io ", -- GNAT.IO 220 "g-io_aux", -- GNAT.IO_Aux 221 "g-locfil", -- GNAT.Lock_Files 222 "g-md5 ", -- GNAT.MD5 223 "g-memdum", -- GNAT.Memory_Dump 224 "g-moreex", -- GNAT.Most_Recent_Exception 225 "g-os_lib", -- GNAT.Os_Lib 226 "g-pehage", -- GNAT.Perfect_Hash.Generators 227 "g-perhas", -- GNAT.Perfect_Hash 228 "g-regexp", -- GNAT.Regexp 229 "g-regist", -- GNAT.Registry 230 "g-regpat", -- GNAT.Regpat 231 "g-semaph", -- GNAT.Semaphores 232 "g-sestin", -- GNAT.Secondary_Stack_Info 233 "g-signal", -- GNAT.Signals 234 "g-socket", -- GNAT.Sockets 235 "g-souinf", -- GNAT.Source_Info 236 "g-speche", -- GNAT.Spell_Checker 237 "g-spipat", -- GNAT.Spitbol.Patterns 238 "g-spitbo", -- GNAT.Spitbol 239 "g-sptabo", -- GNAT.Spitbol.Table_Boolean 240 "g-sptain", -- GNAT.Spitbol.Table_Integer 241 "g-sptavs", -- GNAT.Spitbol.Table_Vstring 242 "g-string", -- GNAT.Strings 243 "g-strspl", -- GNAT.String_Split 244 "g-table ", -- GNAT.Table 245 "g-tasloc", -- GNAT.Task_Lock 246 "g-thread", -- GNAT.Threads 247 "g-traceb", -- GNAT.Traceback 248 "g-trasym", -- GNAT.Traceback.Symbolic 249 "g-wistsp", -- GNAT.Wide_String_Split 250 251 ----------------------------------------------------- 252 -- Interface Hierarchy Units from Reference Manual -- 253 ----------------------------------------------------- 254 255 "i-c ", -- Interfaces.C 256 "i-cobol ", -- Interfaces.Cobol 257 "i-cpoint", -- Interfaces.C.Pointers 258 "i-cstrin", -- Interfaces.C.Strings 259 "i-fortra", -- Interfaces.Fortran 260 261 ------------------------------------------ 262 -- GNAT Defined Additions to Interfaces -- 263 ------------------------------------------ 264 265 "i-cexten", -- Interfaces.C.Extensions 266 "i-cpp ", -- Interfaces.CPP 267 "i-cstrea", -- Interfaces.C.Streams 268 "i-jalaob", -- Interfaces.Java.Lang.Object 269 "i-jalasy", -- Interfaces.Java.Lang.System 270 "i-jalath", -- Interfaces.Java.Lang.Thread 271 "i-java ", -- Interfaces.Java 272 "i-javlan", -- Interfaces.Java.Lang 273 "i-os2err", -- Interfaces.Os2lib.Errors 274 "i-os2lib", -- Interfaces.Os2lib 275 "i-os2syn", -- Interfaces.Os2lib.Synchronization 276 "i-os2thr", -- Interfaces.Os2lib.Threads 277 "i-pacdec", -- Interfaces.Packed_Decimal 278 "i-vthrea", -- Interfaces.Vthreads 279 "i-vxwoio", -- Interfaces.VxWorks.IO 280 "i-vxwork", -- Interfaces.VxWorks 281 282 -------------------------------------------------- 283 -- System Hierarchy Units from Reference Manual -- 284 -------------------------------------------------- 285 286 "s-atacco", -- System.Address_To_Access_Conversions 287 "s-maccod", -- System.Machine_Code 288 "s-rpc ", -- System.Rpc 289 "s-stoele", -- System.Storage_Elements 290 "s-stopoo", -- System.Storage_Pools 291 292 -------------------------------------- 293 -- GNAT Defined Additions to System -- 294 -------------------------------------- 295 296 "s-addima", -- System.Address_Image 297 "s-assert", -- System.Assertions 298 "s-memory", -- System.Memory 299 "s-parint", -- System.Partition_Interface 300 "s-tasinf", -- System.Task_Info 301 "s-wchcnv", -- System.Wch_Cnv 302 "s-wchcon"); -- System.Wch_Con 303 304 ------------------------- 305 -- Implementation_Unit -- 306 ------------------------- 307 308 function Implementation_Unit (U : Unit_Number_Type) return Boolean is 309 Fname : constant File_Name_Type := Unit_File_Name (U); 310 311 begin 312 -- All units are OK in GNAT mode 313 314 if GNAT_Mode then 315 return False; 316 end if; 317 318 -- If length of file name is greater than 12, definitely OK! 319 -- The value 12 here is an 8 char name with extension .ads. 320 321 if Length_Of_Name (Fname) > 12 then 322 return False; 323 end if; 324 325 -- Otherwise test file name 326 327 Get_Name_String (Fname); 328 329 -- Definitely OK if file name does not start with a- g- s- i- 330 331 if Name_Len < 3 332 or else Name_Buffer (2) /= '-' 333 or else (Name_Buffer (1) /= 'a' 334 and then 335 Name_Buffer (1) /= 'g' 336 and then 337 Name_Buffer (1) /= 'i' 338 and then 339 Name_Buffer (1) /= 's') 340 then 341 return False; 342 end if; 343 344 -- Definitely OK if file name does not end in .ads. This can 345 -- happen when non-standard file names are being used. 346 347 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then 348 return False; 349 end if; 350 351 -- Otherwise normalize file name to 8 characters 352 353 Name_Len := Name_Len - 4; 354 while Name_Len < 8 loop 355 Name_Len := Name_Len + 1; 356 Name_Buffer (Name_Len) := ' '; 357 end loop; 358 359 -- Definitely OK if name is in list 360 361 for J in Non_Imp_File_Names'Range loop 362 if Name_Buffer (1 .. 8) = Non_Imp_File_Names (J) then 363 return False; 364 end if; 365 end loop; 366 367 -- Only remaining special possibilities are children of 368 -- System.RPC and System.Garlic and special files of the 369 -- form System.Aux... 370 371 Get_Name_String (Unit_Name (U)); 372 373 if Name_Len > 12 374 and then Name_Buffer (1 .. 11) = "system.rpc." 375 then 376 return False; 377 end if; 378 379 if Name_Len > 15 380 and then Name_Buffer (1 .. 14) = "system.garlic." 381 then 382 return False; 383 end if; 384 385 if Name_Len > 11 386 and then Name_Buffer (1 .. 10) = "system.aux" 387 then 388 return False; 389 end if; 390 391 -- All tests failed, this is definitely an implementation unit 392 393 return True; 394 395 end Implementation_Unit; 396 397end Impunit; 398