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 -- The Par.Load procedure loads all units that are definitely required before
27 -- it makes any sense at all to proceed with semantic analysis, including
28 -- with'ed units, corresponding specs for bodies, parents of child specs,
29 -- and parents of subunits. All these units are loaded and pointers installed
30 -- in the tree as described in the spec of package Lib.
32 with Fname.UF; use Fname.UF;
33 with Lib.Load; use Lib.Load;
34 with Uname; use Uname;
35 with Osint; use Osint;
36 with Sinput.L; use Sinput.L;
37 with Stylesw; use Stylesw;
38 with Validsw; use Validsw;
40 with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
45 File_Name : File_Name_Type;
46 -- Name of file for current unit, derived from unit name
48 Cur_Unum : constant Unit_Number_Type := Current_Source_Unit;
49 -- Unit number of unit that we just finished parsing. Note that we need
50 -- to capture this, because Source_Unit will change as we parse new
51 -- source files in the multiple main source file case.
53 Curunit : constant Node_Id := Cunit (Cur_Unum);
54 -- Compilation unit node for current compilation unit
56 Loc : Source_Ptr := Sloc (Curunit);
57 -- Source location for compilation unit node
59 Save_Style_Check : Boolean;
60 Save_Style_Checks : Style_Check_Options;
61 -- Save style check so it can be restored later
63 Save_Validity_Check : Boolean;
64 Save_Validity_Checks : Validity_Check_Options;
65 -- Save validity check so it can be restored later
68 -- Compilation unit node for withed unit
70 Context_Node : Node_Id;
71 -- Next node in context items list
76 Spec_Name : Unit_Name_Type;
77 -- Unit name of required spec
79 Body_Name : Unit_Name_Type;
80 -- Unit name of corresponding body
82 Unum : Unit_Number_Type;
83 -- Unit number of loaded unit
85 Limited_With_Found : Boolean := False;
86 -- We load the context items in two rounds: the first round handles normal
87 -- withed units and the second round handles Ada 2005 limited-withed units.
88 -- This is required to allow the low-level circuitry that detects circular
89 -- dependencies of units the correct notification of errors (see comment
90 -- bellow). This variable is used to indicate that the second round is
93 function Same_File_Name_Except_For_Case
94 (Expected_File_Name : File_Name_Type;
95 Actual_File_Name : File_Name_Type) return Boolean;
96 -- Given an actual file name and an expected file name (the latter being
97 -- derived from the unit name), determine if they are the same except for
98 -- possibly different casing of letters.
100 ------------------------------------
101 -- Same_File_Name_Except_For_Case --
102 ------------------------------------
104 function Same_File_Name_Except_For_Case
105 (Expected_File_Name : File_Name_Type;
106 Actual_File_Name : File_Name_Type) return Boolean
109 Get_Name_String (Actual_File_Name);
110 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
113 Lower_Case_Actual_File_Name : String (1 .. Name_Len);
116 Lower_Case_Actual_File_Name := Name_Buffer (1 .. Name_Len);
117 Get_Name_String (Expected_File_Name);
118 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
119 return Lower_Case_Actual_File_Name = Name_Buffer (1 .. Name_Len);
122 end Same_File_Name_Except_For_Case;
124 -- Start of processing for Load
127 -- Don't do any loads if we already had a fatal error
129 if Fatal_Error (Cur_Unum) then
133 Save_Style_Check_Options (Save_Style_Checks);
134 Save_Style_Check := Opt.Style_Check;
136 Save_Validity_Check_Options (Save_Validity_Checks);
137 Save_Validity_Check := Opt.Validity_Checks_On;
139 -- If main unit, set Main_Unit_Entity (this will get overwritten if
140 -- the main unit has a separate spec, that happens later on in Load)
142 if Cur_Unum = Main_Unit then
143 Main_Unit_Entity := Cunit_Entity (Main_Unit);
146 -- If we have no unit name, things are seriously messed up by previous
147 -- errors, and we should not try to continue compilation.
149 if Unit_Name (Cur_Unum) = No_Unit_Name then
150 raise Unrecoverable_Error;
153 -- Next step, make sure that the unit name matches the file name
154 -- and issue a warning message if not. We only output this for the
155 -- main unit, since for other units it is more serious and is
156 -- caught in a separate test below. We also inhibit the message in
157 -- multiple unit per file mode, because in this case the relation
158 -- between file name and unit name is broken.
162 (Unit_Name (Cur_Unum),
163 Subunit => Nkind (Unit (Cunit (Cur_Unum))) = N_Subunit);
165 if Cur_Unum = Main_Unit
166 and then Multiple_Unit_Index = 0
167 and then File_Name /= Unit_File_Name (Cur_Unum)
168 and then (File_Names_Case_Sensitive
169 or not Same_File_Name_Except_For_Case
170 (File_Name, Unit_File_Name (Cur_Unum)))
172 Error_Msg_File_1 := File_Name;
174 ("?file name does not match unit name, should be{", Sloc (Curunit));
177 -- For units other than the main unit, the expected unit name is set and
178 -- must be the same as the actual unit name, or we are in big trouble, and
179 -- abandon the compilation since there are situations where this really
180 -- gets us into bad trouble (e.g. some subunit situations).
182 if Cur_Unum /= Main_Unit
183 and then Expected_Unit (Cur_Unum) /= Unit_Name (Cur_Unum)
185 Loc := Error_Location (Cur_Unum);
186 Error_Msg_File_1 := Unit_File_Name (Cur_Unum);
187 Get_Name_String (Error_Msg_File_1);
189 -- Check for predefined file case
192 and then Name_Buffer (2) = '-'
193 and then (Name_Buffer (1) = 'a'
195 Name_Buffer (1) = 's'
197 Name_Buffer (1) = 'i'
199 Name_Buffer (1) = 'g')
202 Expect_Name : constant Unit_Name_Type := Expected_Unit (Cur_Unum);
203 Actual_Name : constant Unit_Name_Type := Unit_Name (Cur_Unum);
206 Error_Msg_Unit_1 := Expect_Name;
207 Error_Msg ("$$ is not a predefined library unit!", Loc);
209 -- In the predefined file case, we know the user did not
210 -- construct their own package, but we got the wrong one.
211 -- This means that the name supplied by the user crunched
212 -- to something we recognized, but then the file did not
213 -- contain the unit expected. Most likely this is due to
214 -- a misspelling, e.g.
216 -- with Ada.Calender;
218 -- This crunches to a-calend, which indeed contains the unit
219 -- Ada.Calendar, and we can diagnose the misspelling. This
220 -- is a simple heuristic, but it catches many common cases
221 -- of misspelling of predefined unit names without needing
222 -- a full list of them.
224 -- Before actually issuing the message, we will check that the
225 -- unit name is indeed a plausible misspelling of the one we got.
227 if Is_Bad_Spelling_Of
228 (Found => Get_Name_String (Expect_Name),
229 Expect => Get_Name_String (Actual_Name))
231 Error_Msg_Unit_1 := Actual_Name;
232 Error_Msg ("possible misspelling of $$!", Loc);
236 -- Non-predefined file name case. In this case we generate a message
237 -- and then we quit, because we are in big trouble, and if we try
238 -- to continue compilation, we get into some nasty situations
239 -- (for example in some subunit cases).
242 Error_Msg ("file { does not contain expected unit!", Loc);
243 Error_Msg_Unit_1 := Expected_Unit (Cur_Unum);
244 Error_Msg ("\\expected unit $!", Loc);
245 Error_Msg_Unit_1 := Unit_Name (Cur_Unum);
246 Error_Msg ("\\found unit $!", Loc);
249 -- In both cases, remove the unit if it is the last unit (which it
250 -- normally (always?) will be) so that it is out of the way later.
252 Remove_Unit (Cur_Unum);
255 -- If current unit is a body, load its corresponding spec
257 if Nkind (Unit (Curunit)) = N_Package_Body
258 or else Nkind (Unit (Curunit)) = N_Subprogram_Body
260 Spec_Name := Get_Spec_Name (Unit_Name (Cur_Unum));
263 (Load_Name => Spec_Name,
266 Error_Node => Curunit,
267 Corr_Body => Cur_Unum);
269 -- If we successfully load the unit, then set the spec pointer. Once
270 -- again note that if the loaded unit has a fatal error, Load will
271 -- have set our Fatal_Error flag to propagate this condition.
273 if Unum /= No_Unit then
274 Set_Library_Unit (Curunit, Cunit (Unum));
276 -- If this is a separate spec for the main unit, then we reset
277 -- Main_Unit_Entity to point to the entity for this separate spec
279 if Cur_Unum = Main_Unit then
280 Main_Unit_Entity := Cunit_Entity (Unum);
283 -- If we don't find the spec, then if we have a subprogram body, we
284 -- are still OK, we just have a case of a body acting as its own spec
286 elsif Nkind (Unit (Curunit)) = N_Subprogram_Body then
287 Set_Acts_As_Spec (Curunit, True);
288 Set_Library_Unit (Curunit, Curunit);
290 -- Otherwise we do have an error, repeat the load request for the spec
291 -- with Required set True to generate an appropriate error message.
296 (Load_Name => Spec_Name,
299 Error_Node => Curunit);
303 -- If current unit is a child unit spec, load its parent. If the child unit
304 -- is loaded through a limited with, the parent must be as well.
306 elsif Nkind (Unit (Curunit)) = N_Package_Declaration
307 or else Nkind (Unit (Curunit)) = N_Subprogram_Declaration
308 or else Nkind (Unit (Curunit)) in N_Generic_Declaration
309 or else Nkind (Unit (Curunit)) in N_Generic_Instantiation
310 or else Nkind (Unit (Curunit)) in N_Renaming_Declaration
312 -- Turn style and validity checks off for parent unit
314 if not GNAT_Mode then
315 Reset_Style_Check_Options;
316 Reset_Validity_Check_Options;
319 Spec_Name := Get_Parent_Spec_Name (Unit_Name (Cur_Unum));
321 if Spec_Name /= No_Unit_Name then
324 (Load_Name => Spec_Name,
327 Error_Node => Curunit);
329 if Unum /= No_Unit then
330 Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
334 -- If current unit is a subunit, then load its parent body
336 elsif Nkind (Unit (Curunit)) = N_Subunit then
337 Body_Name := Get_Parent_Body_Name (Unit_Name (Cur_Unum));
340 (Load_Name => Body_Name,
343 Error_Node => Name (Unit (Curunit)));
345 if Unum /= No_Unit then
346 Set_Library_Unit (Curunit, Cunit (Unum));
350 -- Now we load with'ed units, with style/validity checks turned off
352 if not GNAT_Mode then
353 Reset_Style_Check_Options;
354 Reset_Validity_Check_Options;
357 -- Load the context items in two rounds: the first round handles normal
358 -- withed units and the second round handles Ada 2005 limited-withed units.
359 -- This is required to allow the low-level circuitry that detects circular
360 -- dependencies of units the correct notification of the following error:
364 -- package C is ... package D is ...
366 for Round in 1 .. 2 loop
367 Context_Node := First (Context_Items (Curunit));
368 while Present (Context_Node) loop
370 -- During the first round we check if there is some limited-with
371 -- context clause; otherwise the second round will be skipped
373 if Nkind (Context_Node) = N_With_Clause
375 and then Limited_Present (Context_Node)
377 Limited_With_Found := True;
380 if Nkind (Context_Node) = N_With_Clause
381 and then ((Round = 1 and then not Limited_Present (Context_Node))
383 (Round = 2 and then Limited_Present (Context_Node)))
385 With_Node := Context_Node;
386 Spec_Name := Get_Unit_Name (With_Node);
390 (Load_Name => Spec_Name,
393 Error_Node => With_Node,
395 With_Node => Context_Node);
397 -- If we find the unit, then set spec pointer in the N_With_Clause
398 -- to point to the compilation unit for the spec. Remember that
399 -- the Load routine itself sets our Fatal_Error flag if the loaded
400 -- unit gets a fatal error, so we don't need to worry about that.
402 if Unum /= No_Unit then
403 Set_Library_Unit (With_Node, Cunit (Unum));
405 -- If the spec isn't found, then try finding the corresponding
406 -- body, since it is possible that we have a subprogram body
407 -- that is acting as a spec (since no spec is present).
410 Body_Name := Get_Body_Name (Spec_Name);
413 (Load_Name => Body_Name,
416 Error_Node => With_Node,
419 -- If we got a subprogram body, then mark that we are using
420 -- the body as a spec in the file table, and set the spec
421 -- pointer in the N_With_Clause to point to the body entity.
424 and then Nkind (Unit (Cunit (Unum))) = N_Subprogram_Body
426 With_Cunit := Cunit (Unum);
427 Set_Library_Unit (With_Node, With_Cunit);
428 Set_Acts_As_Spec (With_Cunit, True);
429 Set_Library_Unit (With_Cunit, With_Cunit);
431 -- If we couldn't find the body, or if it wasn't a body spec
432 -- then we are in trouble. We make one more call to Load to
433 -- require the spec. We know it will fail of course, the
434 -- purpose is to generate the required error message (we prefer
435 -- that this message refer to the missing spec, not the body)
440 (Load_Name => Spec_Name,
443 Error_Node => With_Node,
446 -- Here we create a dummy package unit for the missing unit
448 Unum := Create_Dummy_Package_Unit (With_Node, Spec_Name);
449 Set_Library_Unit (With_Node, Cunit (Unum));
457 exit when not Limited_With_Found;
460 -- Restore style/validity check mode for main unit
462 Set_Style_Check_Options (Save_Style_Checks);
463 Opt.Style_Check := Save_Style_Check;
464 Set_Validity_Check_Options (Save_Validity_Checks);
465 Opt.Validity_Checks_On := Save_Validity_Check;