-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
------------------------------------------------------------------------------
with Atree; use Atree;
+with Errout; use Errout;
with Sinfo; use Sinfo;
with Fname.UF; use Fname.UF;
with Lib; use Lib;
-- Ada 95 Units --
------------------
- -- The following is a giant string list containing the names of all
- -- non-implementation internal files, i.e. the complete list of files for
+ -- The following is a giant string list containing the names of all non-
+ -- implementation internal files, i.e. the complete list of files for
-- internal units which a program may legitimately WITH when operating in
-- either Ada 95 or Ada 05 mode.
-- Note that this list should match the list of units documented in the
- -- "GNAT Library" section of the GNAT Reference Manual.
+ -- "GNAT Library" section of the GNAT Reference Manual. A unit listed here
+ -- must either be documented in that section or described in the Ada RM.
Non_Imp_File_Names_95 : constant File_List := (
-- GNAT Defined Additions to Ada --
-----------------------------------
+ "a-calcon", -- Ada.Calendar.Conversions
"a-chlat9", -- Ada.Characters.Latin_9
"a-clrefi", -- Ada.Command_Line.Response_File
"a-colien", -- Ada.Command_Line.Environment
"a-ssicst", -- Ada.Streams.Stream_IO.C_Streams
"a-suteio", -- Ada.Strings.Unbounded.Text_IO
"a-swuwti", -- Ada.Strings.Wide_Unbounded.Wide_Text_IO
- "a-taidim", -- Ada.Task_Identification.Image
"a-tiocst", -- Ada.Text_IO.C_Streams
"a-wtcstr", -- Ada.Wide_Text_IO.C_Streams
-- GNAT Special IO Units --
---------------------------
- -- As further explained elsewhere (see Sem_Ch10), the internal
- -- packages of Text_IO and Wide_Text_IO are actually implemented
- -- as separate children, but this fact is intended to be hidden
- -- from the user completely. Any attempt to WITH one of these
- -- units will be diagnosed as an error later on, but for now we
- -- do not consider these internal implementation units (if we did,
- -- then we would get a junk warning which would be confusing and
- -- unecessary, given that we generate a clear error message).
+ -- As further explained elsewhere (see Sem_Ch10), the internal packages of
+ -- Text_IO and Wide_Text_IO are actually implemented as separate children,
+ -- but this fact is intended to be hidden from the user completely. Any
+ -- attempt to WITH one of these units will be diagnosed as an error later
+ -- on, but for now we do not consider these internal implementation units
+ -- (if we did, then we would get a junk warning which would be confusing
+ -- and unnecessary, given that we generate a clear error message).
"a-tideio", -- Ada.Text_IO.Decimal_IO
"a-tienio", -- Ada.Text_IO.Enumeration_IO
"g-regist", -- GNAT.Registry
"g-regpat", -- GNAT.Regpat
"g-semaph", -- GNAT.Semaphores
+ "g-sercom", -- GNAT.Serial_Communications
"g-sestin", -- GNAT.Secondary_Stack_Info
"g-sha1 ", -- GNAT.SHA1
+ "g-sha224", -- GNAT.SHA224
+ "g-sha256", -- GNAT.SHA256
+ "g-sha384", -- GNAT.SHA384
+ "g-sha512", -- GNAT.SHA512
"g-signal", -- GNAT.Signals
"g-socket", -- GNAT.Sockets
"g-souinf", -- GNAT.Source_Info
"g-sptavs", -- GNAT.Spitbol.Table_Vstring
"g-string", -- GNAT.Strings
"g-strspl", -- GNAT.String_Split
+ "g-sse ", -- GNAT.SSE
+ "g-ssvety", -- GNAT.SSE.Vector_Types
"g-table ", -- GNAT.Table
"g-tasloc", -- GNAT.Task_Lock
"g-thread", -- GNAT.Threads
+ "g-timsta", -- GNAT.Time_Stamp
"g-traceb", -- GNAT.Traceback
"g-trasym", -- GNAT.Traceback.Symbolic
"g-utf_32", -- GNAT.UTF_32
"g-u3spch", -- GNAT.UTF_32_Spelling_Checker
"g-wispch", -- GNAT.Wide_Spelling_Checker
"g-wistsp", -- GNAT.Wide_String_Split
- "g-zspche", -- GNAT.Wide_Wide_Spelling_Checker
- "g-zstspl", -- GNAT.Wide_Wide_String_Split
-----------------------------------------------------
-- Interface Hierarchy Units from Reference Manual --
------------------------------------------
"i-cexten", -- Interfaces.C.Extensions
+ "i-cil ", -- Interfaces.CIL
+ "i-cilobj", -- Interfaces.CIL.Object
"i-cpp ", -- Interfaces.CPP
"i-cstrea", -- Interfaces.C.Streams
"i-java ", -- Interfaces.Java
+ "i-javjni", -- Interfaces.Java.JNI
"i-pacdec", -- Interfaces.Packed_Decimal
"i-vxwoio", -- Interfaces.VxWorks.IO
"i-vxwork", -- Interfaces.VxWorks
"s-addima", -- System.Address_Image
"s-assert", -- System.Assertions
"s-memory", -- System.Memory
- "s-os_lib", -- System.Os_Lib
"s-parint", -- System.Partition_Interface
"s-pooglo", -- System.Pool_Global
"s-pooloc", -- System.Pool_Local
"s-restri", -- System.Restrictions
"s-rident", -- System.Rident
+ "s-ststop", -- System.Strings.Stream_Ops
"s-tasinf", -- System.Task_Info
"s-wchcnv", -- System.Wch_Cnv
"s-wchcon"); -- System.Wch_Con
"a-coteio", -- Ada.Complex_Text_IO
"a-direct", -- Ada.Directories
"a-diroro", -- Ada.Dispatching.Round_Robin
+ "a-disedf", -- Ada.Dispatching.EDF
"a-dispat", -- Ada.Dispatching
"a-envvar", -- Ada.Environment_Variables
"a-exetim", -- Ada.Execution_Time
"g-zspche", -- GNAT.Wide_Wide_Spelling_Checker
"g-zstspl"); -- GNAT.Wide_Wide_String_Split
+ -----------------------
+ -- Alternative Units --
+ -----------------------
+
+ -- For some implementation units, there is a unit in the GNAT library
+ -- that has identical functionality that is usable. If we have such a
+ -- case we record the appropriate Unit name in Error_Msg_String.
+
+ type Aunit_Record is record
+ Fname : String (1 .. 6);
+ Aname : String_Ptr;
+ end record;
+
+ -- Array of alternative unit names
+
+ Scasuti : aliased String := "GNAT.Case_Util";
+ Sos_lib : aliased String := "GNAT.OS_Lib";
+ Sregexp : aliased String := "GNAT.Regexp";
+ Sregpat : aliased String := "GNAT.Regpat";
+ Sstring : aliased String := "GNAT.Strings";
+ Sstusta : aliased String := "GNAT.Task_Stack_Usage";
+ Stasloc : aliased String := "GNAT.Task_Lock";
+ Sutf_32 : aliased String := "GNAT.UTF_32";
+
+ -- Array giving mapping
+
+ Map_Array : constant array (1 .. 8) of Aunit_Record := (
+ ("casuti", Scasuti'Access),
+ ("os_lib", Sos_lib'Access),
+ ("regexp", Sregexp'Access),
+ ("regpat", Sregpat'Access),
+ ("string", Sstring'Access),
+ ("stusta", Sstusta'Access),
+ ("tasloc", Stasloc'Access),
+ ("utf_32", Sutf_32'Access));
+
----------------------
-- Get_Kind_Of_Unit --
----------------------
Fname : constant File_Name_Type := Unit_File_Name (U);
begin
+ Error_Msg_Strlen := 0;
+
-- If length of file name is greater than 12, not predefined.
-- The value 12 here is an 8 char name with extension .ads.
return Ada_95_Unit;
end if;
- -- All tests failed, this is definitely an implementation unit
+ -- All tests failed, this is definitely an implementation unit. See if
+ -- we have an alternative name.
+
+ Get_Name_String (Fname);
+
+ if Name_Len = 12
+ and then Name_Buffer (1 .. 2) = "s-"
+ and then Name_Buffer (9 .. 12) = ".ads"
+ then
+ for J in Map_Array'Range loop
+ if Name_Buffer (3 .. 8) = Map_Array (J).Fname then
+ Error_Msg_Strlen := Map_Array (J).Aname'Length;
+ Error_Msg_String (1 .. Error_Msg_Strlen) :=
+ Map_Array (J).Aname.all;
+ end if;
+ end loop;
+ end if;
return Implementation_Unit;
end Get_Kind_Of_Unit;
OSDN Git Service
