1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Hostparm; use Hostparm;
29 with Namet; use Namet;
30 with Output; use Output;
34 --------------------------
35 -- Get_Unit_Name_String --
36 --------------------------
38 procedure Get_Unit_Name_String (U : Unit_Name_Type) is
42 if Name_Buffer (Name_Len) = 's' then
43 Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (spec)";
45 Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (body)";
48 Name_Len := Name_Len + 5;
49 end Get_Unit_Name_String;
51 ----------------------
52 -- Is_Internal_Unit --
53 ----------------------
55 -- Note: the reason we do not use the Fname package for this function
56 -- is that it would drag too much junk into the binder.
58 function Is_Internal_Unit return Boolean is
60 return Is_Predefined_Unit
62 and then (Name_Buffer (1 .. 5) = "gnat%"
64 Name_Buffer (1 .. 5) = "gnat."))
68 and then (Name_Buffer (1 .. 4) = "dec%"
70 Name_Buffer (1 .. 4) = "dec."));
74 ------------------------
75 -- Is_Predefined_Unit --
76 ------------------------
78 -- Note: the reason we do not use the Fname package for this function
79 -- is that it would drag too much junk into the binder.
81 function Is_Predefined_Unit return Boolean is
84 and then Name_Buffer (1 .. 4) = "ada.")
87 and then Name_Buffer (1 .. 7) = "system.")
89 or else (Name_Len > 10
90 and then Name_Buffer (1 .. 11) = "interfaces.")
93 and then Name_Buffer (1 .. 4) = "ada%")
96 and then Name_Buffer (1 .. 9) = "calendar%")
99 and then Name_Buffer (1 .. 10) = "direct_io%")
101 or else (Name_Len > 10
102 and then Name_Buffer (1 .. 11) = "interfaces%")
104 or else (Name_Len > 13
105 and then Name_Buffer (1 .. 14) = "io_exceptions%")
107 or else (Name_Len > 12
108 and then Name_Buffer (1 .. 13) = "machine_code%")
110 or else (Name_Len > 13
111 and then Name_Buffer (1 .. 14) = "sequential_io%")
113 or else (Name_Len > 6
114 and then Name_Buffer (1 .. 7) = "system%")
116 or else (Name_Len > 7
117 and then Name_Buffer (1 .. 8) = "text_io%")
119 or else (Name_Len > 20
120 and then Name_Buffer (1 .. 21) = "unchecked_conversion%")
122 or else (Name_Len > 22
123 and then Name_Buffer (1 .. 23) = "unchecked_deallocation%")
125 or else (Name_Len > 4
126 and then Name_Buffer (1 .. 5) = "gnat%")
128 or else (Name_Len > 4
129 and then Name_Buffer (1 .. 5) = "gnat.");
130 end Is_Predefined_Unit;
136 function Uname_Less (U1, U2 : Unit_Name_Type) return Boolean is
138 Get_Name_String (U1);
141 U1_Name : constant String (1 .. Name_Len) :=
142 Name_Buffer (1 .. Name_Len);
143 Min_Length : Natural;
146 Get_Name_String (U2);
148 if Name_Len < U1_Name'Last then
149 Min_Length := Name_Len;
151 Min_Length := U1_Name'Last;
154 for I in 1 .. Min_Length loop
155 if U1_Name (I) > Name_Buffer (I) then
157 elsif U1_Name (I) < Name_Buffer (I) then
162 return U1_Name'Last < Name_Len;
166 ---------------------
167 -- Write_Unit_Name --
168 ---------------------
170 procedure Write_Unit_Name (U : Unit_Name_Type) is
173 Write_Str (Name_Buffer (1 .. Name_Len - 2));
175 if Name_Buffer (Name_Len) = 's' then
176 Write_Str (" (spec)");
178 Write_Str (" (body)");
181 Name_Len := Name_Len + 5;