1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Output; use Output;
27 with Targparm; use Targparm;
31 ----------------------
32 -- Is_Internal_Unit --
33 ----------------------
35 -- Note: the reason we do not use the Fname package for this function
36 -- is that it would drag too much junk into the binder.
38 function Is_Internal_Unit return Boolean is
40 return Is_Predefined_Unit
42 and then (Name_Buffer (1 .. 5) = "gnat%"
44 Name_Buffer (1 .. 5) = "gnat."))
48 and then (Name_Buffer (1 .. 4) = "dec%"
50 Name_Buffer (1 .. 4) = "dec."));
54 ------------------------
55 -- Is_Predefined_Unit --
56 ------------------------
58 -- Note: the reason we do not use the Fname package for this function
59 -- is that it would drag too much junk into the binder.
61 function Is_Predefined_Unit return Boolean is
64 and then Name_Buffer (1 .. 4) = "ada.")
67 and then Name_Buffer (1 .. 7) = "system.")
69 or else (Name_Len > 10
70 and then Name_Buffer (1 .. 11) = "interfaces.")
73 and then Name_Buffer (1 .. 4) = "ada%")
76 and then Name_Buffer (1 .. 9) = "calendar%")
79 and then Name_Buffer (1 .. 10) = "direct_io%")
81 or else (Name_Len > 10
82 and then Name_Buffer (1 .. 11) = "interfaces%")
84 or else (Name_Len > 13
85 and then Name_Buffer (1 .. 14) = "io_exceptions%")
87 or else (Name_Len > 12
88 and then Name_Buffer (1 .. 13) = "machine_code%")
90 or else (Name_Len > 13
91 and then Name_Buffer (1 .. 14) = "sequential_io%")
94 and then Name_Buffer (1 .. 7) = "system%")
97 and then Name_Buffer (1 .. 8) = "text_io%")
99 or else (Name_Len > 20
100 and then Name_Buffer (1 .. 21) = "unchecked_conversion%")
102 or else (Name_Len > 22
103 and then Name_Buffer (1 .. 23) = "unchecked_deallocation%")
105 or else (Name_Len > 4
106 and then Name_Buffer (1 .. 5) = "gnat%")
108 or else (Name_Len > 4
109 and then Name_Buffer (1 .. 5) = "gnat.");
110 end Is_Predefined_Unit;
116 function Uname_Less (U1, U2 : Unit_Name_Type) return Boolean is
118 Get_Name_String (U1);
121 U1_Name : constant String (1 .. Name_Len) :=
122 Name_Buffer (1 .. Name_Len);
123 Min_Length : Natural;
126 Get_Name_String (U2);
128 if Name_Len < U1_Name'Last then
129 Min_Length := Name_Len;
131 Min_Length := U1_Name'Last;
134 for I in 1 .. Min_Length loop
135 if U1_Name (I) > Name_Buffer (I) then
137 elsif U1_Name (I) < Name_Buffer (I) then
142 return U1_Name'Last < Name_Len;
146 ---------------------
147 -- Write_Unit_Name --
148 ---------------------
150 procedure Write_Unit_Name (U : Unit_Name_Type) is
153 Write_Str (Name_Buffer (1 .. Name_Len - 2));
155 if Name_Buffer (Name_Len) = 's' then
156 Write_Str (" (spec)");
158 Write_Str (" (body)");
161 Name_Len := Name_Len + 5;