?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* dwarf2out.c, fold-const.c, ipa-type-escape.c,
[official-gcc.git] / gcc / ada / lib-load.adb
blob48b5cf25d9a18e0a23796705b023a29730d4cfee
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- L I B . L O A D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2005 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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
27 with Atree; use Atree;
28 with Debug; use Debug;
29 with Einfo; use Einfo;
30 with Errout; use Errout;
31 with Fname; use Fname;
32 with Fname.UF; use Fname.UF;
33 with Namet; use Namet;
34 with Nlists; use Nlists;
35 with Nmake; use Nmake;
36 with Opt; use Opt;
37 with Osint; use Osint;
38 with Osint.C; use Osint.C;
39 with Output; use Output;
40 with Par;
41 with Restrict; use Restrict;
42 with Scn; use Scn;
43 with Sinfo; use Sinfo;
44 with Sinput; use Sinput;
45 with Sinput.L; use Sinput.L;
46 with Stand; use Stand;
47 with Tbuild; use Tbuild;
48 with Uname; use Uname;
49
50 package body Lib.Load is
51
52 -----------------------
53 -- Local Subprograms --
54 -----------------------
55
56 function Spec_Is_Irrelevant
57 (Spec_Unit : Unit_Number_Type;
58 Body_Unit : Unit_Number_Type) return Boolean;
59 -- The Spec_Unit and Body_Unit parameters are the unit numbers of the
60 -- spec file that corresponds to the main unit which is a body. This
61 -- function determines if the spec file is irrelevant and will be
62 -- overridden by the body as described in RM 10.1.4(4). See description
63 -- in "Special Handling of Subprogram Bodies" for further details.
64
65 procedure Write_Dependency_Chain;
66 -- This procedure is used to generate error message info lines that
67 -- trace the current dependency chain when a load error occurs.
68
69 -------------------------------
70 -- Create_Dummy_Package_Unit --
71 -------------------------------
72
73 function Create_Dummy_Package_Unit
74 (With_Node : Node_Id;
75 Spec_Name : Unit_Name_Type) return Unit_Number_Type
76 is
77 Unum : Unit_Number_Type;
78 Cunit_Entity : Entity_Id;
79 Cunit : Node_Id;
80 Du_Name : Node_Or_Entity_Id;
81 End_Lab : Node_Id;
82 Save_CS : constant Boolean := Get_Comes_From_Source_Default;
83
84 begin
85 -- The created dummy package unit does not come from source
86
87 Set_Comes_From_Source_Default (False);
88
89 -- Normal package
90
91 if Nkind (Name (With_Node)) = N_Identifier then
92 Cunit_Entity :=
93 Make_Defining_Identifier (No_Location,
94 Chars => Chars (Name (With_Node)));
95 Du_Name := Cunit_Entity;
96 End_Lab := New_Occurrence_Of (Cunit_Entity, No_Location);
97
98 -- Child package
99
100 else
101 Cunit_Entity :=
102 Make_Defining_Identifier (No_Location,
103 Chars => Chars (Selector_Name (Name (With_Node))));
104 Du_Name :=
105 Make_Defining_Program_Unit_Name (No_Location,
106 Name => New_Copy_Tree (Prefix (Name (With_Node))),
107 Defining_Identifier => Cunit_Entity);
108
109 Set_Is_Child_Unit (Cunit_Entity);
110
111 End_Lab :=
112 Make_Designator (No_Location,
113 Name => New_Copy_Tree (Prefix (Name (With_Node))),
114 Identifier => New_Occurrence_Of (Cunit_Entity, No_Location));
115 end if;
116
117 Set_Scope (Cunit_Entity, Standard_Standard);
118
119 Cunit :=
120 Make_Compilation_Unit (No_Location,
121 Context_Items => Empty_List,
122 Unit =>
123 Make_Package_Declaration (No_Location,
124 Specification =>
125 Make_Package_Specification (No_Location,
126 Defining_Unit_Name => Du_Name,
127 Visible_Declarations => Empty_List,
128 End_Label => End_Lab)),
129 Aux_Decls_Node =>
130 Make_Compilation_Unit_Aux (No_Location));
131
132 -- Mark the dummy package as analyzed to prevent analysis of this
133 -- (non-existent) unit in -gnatQ mode because at the moment the
134 -- structure and attributes of this dummy package does not allow
135 -- a normal analysis of this unit
136
137 Set_Analyzed (Cunit);
138
139 Units.Increment_Last;
140 Unum := Units.Last;
141
142 Units.Table (Unum) := (
143 Cunit => Cunit,
144 Cunit_Entity => Cunit_Entity,
145 Dependency_Num => 0,
146 Dynamic_Elab => False,
147 Error_Location => Sloc (With_Node),
148 Expected_Unit => Spec_Name,
149 Fatal_Error => True,
150 Generate_Code => False,
151 Has_RACW => False,
152 Ident_String => Empty,
153 Loading => False,
154 Main_Priority => Default_Main_Priority,
155 Munit_Index => 0,
156 Serial_Number => 0,
157 Source_Index => No_Source_File,
158 Unit_File_Name => Get_File_Name (Spec_Name, Subunit => False),
159 Unit_Name => Spec_Name,
160 Version => 0);
161
162 Set_Comes_From_Source_Default (Save_CS);
163 Set_Error_Posted (Cunit_Entity);
164 Set_Error_Posted (Cunit);
165 return Unum;
166 end Create_Dummy_Package_Unit;
167
168 ----------------
169 -- Initialize --
170 ----------------
171
172 procedure Initialize is
173 begin
174 Units.Init;
175 Load_Stack.Init;
176 end Initialize;
177
178 ------------------------
179 -- Initialize_Version --
180 ------------------------
181
182 procedure Initialize_Version (U : Unit_Number_Type) is
183 begin
184 Units.Table (U).Version := Source_Checksum (Source_Index (U));
185 end Initialize_Version;
186
187 ----------------------
188 -- Load_Main_Source --
189 ----------------------
190
191 procedure Load_Main_Source is
192 Fname : File_Name_Type;
193
194 begin
195 Load_Stack.Increment_Last;
196 Load_Stack.Table (Load_Stack.Last) := Main_Unit;
197
198 -- Initialize unit table entry for Main_Unit. Note that we don't know
199 -- the unit name yet, that gets filled in when the parser parses the
200 -- main unit, at which time a check is made that it matches the main
201 -- file name, and then the Unit_Name field is set. The Cunit and
202 -- Cunit_Entity fields also get filled in later by the parser.
203
204 Units.Increment_Last;
205 Fname := Next_Main_Source;
206
207 Units.Table (Main_Unit).Unit_File_Name := Fname;
208
209 if Fname /= No_File then
210 Main_Source_File := Load_Source_File (Fname);
211 Current_Error_Source_File := Main_Source_File;
212
213 Units.Table (Main_Unit) := (
214 Cunit => Empty,
215 Cunit_Entity => Empty,
216 Dependency_Num => 0,
217 Dynamic_Elab => False,
218 Error_Location => No_Location,
219 Expected_Unit => No_Name,
220 Fatal_Error => False,
221 Generate_Code => False,
222 Has_RACW => False,
223 Ident_String => Empty,
224 Loading => True,
225 Main_Priority => Default_Main_Priority,
226 Munit_Index => 0,
227 Serial_Number => 0,
228 Source_Index => Main_Source_File,
229 Unit_File_Name => Fname,
230 Unit_Name => No_Name,
231 Version => Source_Checksum (Main_Source_File));
232 end if;
233 end Load_Main_Source;
234
235 ---------------
236 -- Load_Unit --
237 ---------------
238
239 function Load_Unit
240 (Load_Name : Unit_Name_Type;
241 Required : Boolean;
242 Error_Node : Node_Id;
243 Subunit : Boolean;
244 Corr_Body : Unit_Number_Type := No_Unit;
245 Renamings : Boolean := False;
246 From_Limited_With : Boolean := False) return Unit_Number_Type
247 is
248 Calling_Unit : Unit_Number_Type;
249 Uname_Actual : Unit_Name_Type;
250 Unum : Unit_Number_Type;
251 Unump : Unit_Number_Type;
252 Fname : File_Name_Type;
253 Src_Ind : Source_File_Index;
254
255 -- Start of processing for Load_Unit
256
257 begin
258 -- If renamings are allowed and we have a child unit name, then we
259 -- must first load the parent to deal with finding the real name.
260
261 if Renamings and then Is_Child_Name (Load_Name) then
262 Unump :=
263 Load_Unit
264 (Load_Name => Get_Parent_Spec_Name (Load_Name),
265 Required => Required,
266 Subunit => False,
267 Renamings => True,
268 Error_Node => Error_Node);
269
270 if Unump = No_Unit then
271 return No_Unit;
272 end if;
273
274 -- If parent is a renaming, then we use the renamed package as
275 -- the actual parent for the subsequent load operation.
276
277 if Nkind (Parent (Cunit_Entity (Unump))) =
278 N_Package_Renaming_Declaration
279 then
280 Uname_Actual :=
281 New_Child
282 (Load_Name,
283 Get_Unit_Name (Name (Parent (Cunit_Entity (Unump)))));
284
285 -- Save the renaming entity, to establish its visibility when
286 -- installing the context. The implicit with is on this entity,
287 -- not on the package it renames.
288
289 if Nkind (Error_Node) = N_With_Clause
290 and then Nkind (Name (Error_Node)) = N_Selected_Component
291 then
292 declare
293 Par : Node_Id := Name (Error_Node);
294
295 begin
296 while Nkind (Par) = N_Selected_Component
297 and then Chars (Selector_Name (Par)) /=
298 Chars (Cunit_Entity (Unump))
299 loop
300 Par := Prefix (Par);
301 end loop;
302
303 -- Case of some intermediate parent is a renaming
304
305 if Nkind (Par) = N_Selected_Component then
306 Set_Entity (Selector_Name (Par), Cunit_Entity (Unump));
307
308 -- Case where the ultimate parent is a renaming
309
310 else
311 Set_Entity (Par, Cunit_Entity (Unump));
312 end if;
313 end;
314 end if;
315
316 -- If the parent is not a renaming, then get its name (this may
317 -- be different from the parent spec name obtained above because
318 -- of renamings higher up in the hierarchy).
319
320 else
321 Uname_Actual := New_Child (Load_Name, Unit_Name (Unump));
322 end if;
323
324 -- Here if unit to be loaded is not a child unit
325
326 else
327 Uname_Actual := Load_Name;
328 end if;
329
330 Fname := Get_File_Name (Uname_Actual, Subunit);
331
332 if Debug_Flag_L then
333 Write_Eol;
334 Write_Str ("*** Load request for unit: ");
335 Write_Unit_Name (Load_Name);
336
337 if Required then
338 Write_Str (" (Required = True)");
339 else
340 Write_Str (" (Required = False)");
341 end if;
342
343 Write_Eol;
344
345 if Uname_Actual /= Load_Name then
346 Write_Str ("*** Actual unit loaded: ");
347 Write_Unit_Name (Uname_Actual);
348 end if;
349 end if;
350
351 -- Capture error location if it is for the main unit. The idea is to
352 -- post errors on the main unit location, not the most recent unit.
353 -- Note: Unit_Name (Main_Unit) is not set if we are parsing gnat.adc.
354
355 if Present (Error_Node)
356 and then Unit_Name (Main_Unit) /= No_Name
357 then
358 -- It seems like In_Extended_Main_Source_Unit (Error_Node) would
359 -- do the trick here, but that's wrong, it is much too early to
360 -- call this routine. We are still in the parser, and the required
361 -- semantic information is not established yet. So we base the
362 -- judgment on unit names.
363
364 Get_External_Unit_Name_String (Unit_Name (Main_Unit));
365
366 declare
367 Main_Unit_Name : constant String := Name_Buffer (1 .. Name_Len);
368
369 begin
370 Get_External_Unit_Name_String
371 (Unit_Name (Get_Source_Unit (Error_Node)));
372
373 -- If the two names are identical, then for sure we are part
374 -- of the extended main unit
375
376 if Main_Unit_Name = Name_Buffer (1 .. Name_Len) then
377 Load_Msg_Sloc := Sloc (Error_Node);
378
379 -- If the load is called from a with_type clause, the error
380 -- node is correct.
381
382 elsif Nkind (Parent (Error_Node)) = N_With_Type_Clause then
383 Load_Msg_Sloc := Sloc (Error_Node);
384
385 -- Otherwise, check for the subunit case, and if so, consider
386 -- we have a match if one name is a prefix of the other name.
387
388 else
389 if Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
390 or else
391 Nkind (Unit (Cunit (Get_Source_Unit (Error_Node)))) =
392 N_Subunit
393 then
394 Name_Len := Integer'Min (Name_Len, Main_Unit_Name'Length);
395
396 if Name_Buffer (1 .. Name_Len)
397 =
398 Main_Unit_Name (1 .. Name_Len)
399 then
400 Load_Msg_Sloc := Sloc (Error_Node);
401 end if;
402 end if;
403 end if;
404 end;
405 end if;
406
407 -- If we are generating error messages, then capture calling unit
408
409 if Present (Error_Node) then
410 Calling_Unit := Get_Source_Unit (Error_Node);
411 else
412 Calling_Unit := No_Unit;
413 end if;
414
415 -- See if we already have an entry for this unit
416
417 Unum := Main_Unit;
418
419 while Unum <= Units.Last loop
420 exit when Uname_Actual = Units.Table (Unum).Unit_Name;
421 Unum := Unum + 1;
422 end loop;
423
424 -- Whether or not the entry was found, Unum is now the right value,
425 -- since it is one more than Units.Last (i.e. the index of the new
426 -- entry we will create) in the not found case.
427
428 -- A special check is necessary in the unit not found case. If the unit
429 -- is not found, but the file in which it lives has already been loaded,
430 -- then we have the problem that the file does not contain the unit that
431 -- is needed. We simply treat this as a file not found condition.
432
433 -- We skip this test in multiple unit per file mode since in this
434 -- case we can have multiple units from the same source file.
435
436 if Unum > Units.Last and then Multiple_Unit_Index = 0 then
437 for J in Units.First .. Units.Last loop
438 if Fname = Units.Table (J).Unit_File_Name then
439 if Debug_Flag_L then
440 Write_Str (" file does not contain unit, Unit_Number = ");
441 Write_Int (Int (Unum));
442 Write_Eol;
443 Write_Eol;
444 end if;
445
446 if Present (Error_Node) then
447 if Is_Predefined_File_Name (Fname) then
448 Error_Msg_Name_1 := Uname_Actual;
449 Error_Msg
450 ("% is not a language defined unit", Load_Msg_Sloc);
451 else
452 Error_Msg_Name_1 := Fname;
453 Error_Msg_Unit_1 := Uname_Actual;
454 Error_Msg
455 ("File{ does not contain unit$", Load_Msg_Sloc);
456 end if;
457
458 Write_Dependency_Chain;
459 return No_Unit;
460
461 else
462 return No_Unit;
463 end if;
464 end if;
465 end loop;
466 end if;
467
468 -- If we are proceeding with load, then make load stack entry
469
470 Load_Stack.Increment_Last;
471 Load_Stack.Table (Load_Stack.Last) := Unum;
472
473 -- Case of entry already in table
474
475 if Unum <= Units.Last then
476
477 -- Here is where we check for a circular dependency, which is
478 -- an attempt to load a unit which is currently in the process
479 -- of being loaded. We do *not* care about a circular chain that
480 -- leads back to a body, because this kind of circular dependence
481 -- legitimately occurs (e.g. two package bodies that contain
482 -- inlined subprogram referenced by the other).
483
484 -- Ada 2005 (AI-50217): We also ignore limited_with clauses, because
485 -- their purpose is precisely to create legal circular structures.
486
487 if Loading (Unum)
488 and then (Is_Spec_Name (Units.Table (Unum).Unit_Name)
489 or else Acts_As_Spec (Units.Table (Unum).Cunit))
490 and then (Nkind (Error_Node) /= N_With_Clause
491 or else not Limited_Present (Error_Node))
492 and then not From_Limited_With
493 then
494 if Debug_Flag_L then
495 Write_Str (" circular dependency encountered");
496 Write_Eol;
497 end if;
498
499 if Present (Error_Node) then
500 Error_Msg ("circular unit dependency", Load_Msg_Sloc);
501 Write_Dependency_Chain;
502 else
503 Load_Stack.Decrement_Last;
504 end if;
505
506 return No_Unit;
507 end if;
508
509 if Debug_Flag_L then
510 Write_Str (" unit already in file table, Unit_Number = ");
511 Write_Int (Int (Unum));
512 Write_Eol;
513 end if;
514
515 Load_Stack.Decrement_Last;
516 return Unum;
517
518 -- Unit is not already in table, so try to open the file
519
520 else
521 if Debug_Flag_L then
522 Write_Str (" attempt unit load, Unit_Number = ");
523 Write_Int (Int (Unum));
524 Write_Eol;
525 end if;
526
527 Src_Ind := Load_Source_File (Fname);
528
529 -- Make a partial entry in the file table, used even in the file not
530 -- found case to print the dependency chain including the last entry
531
532 Units.Increment_Last;
533 Units.Table (Unum).Unit_Name := Uname_Actual;
534
535 -- File was found
536
537 if Src_Ind /= No_Source_File then
538 Units.Table (Unum) := (
539 Cunit => Empty,
540 Cunit_Entity => Empty,
541 Dependency_Num => 0,
542 Dynamic_Elab => False,
543 Error_Location => Sloc (Error_Node),
544 Expected_Unit => Uname_Actual,
545 Fatal_Error => False,
546 Generate_Code => False,
547 Has_RACW => False,
548 Ident_String => Empty,
549 Loading => True,
550 Main_Priority => Default_Main_Priority,
551 Munit_Index => 0,
552 Serial_Number => 0,
553 Source_Index => Src_Ind,
554 Unit_File_Name => Fname,
555 Unit_Name => Uname_Actual,
556 Version => Source_Checksum (Src_Ind));
557
558 -- Parse the new unit
559
560 declare
561 Save_Index : constant Nat := Multiple_Unit_Index;
562 begin
563 Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
564 Units.Table (Unum).Munit_Index := Multiple_Unit_Index;
565 Initialize_Scanner (Unum, Source_Index (Unum));
566 Discard_List (Par (Configuration_Pragmas => False,
567 From_Limited_With => From_Limited_With));
568 Multiple_Unit_Index := Save_Index;
569 Set_Loading (Unum, False);
570 end;
571
572 -- If spec is irrelevant, then post errors and quit
573
574 if Corr_Body /= No_Unit
575 and then Spec_Is_Irrelevant (Unum, Corr_Body)
576 then
577 Error_Msg_Name_1 := Unit_File_Name (Corr_Body);
578 Error_Msg
579 ("cannot compile subprogram in file {!",
580 Load_Msg_Sloc);
581 Error_Msg_Name_1 := Unit_File_Name (Unum);
582 Error_Msg
583 ("incorrect spec in file { must be removed first!",
584 Load_Msg_Sloc);
585 return No_Unit;
586 end if;
587
588 -- If loaded unit had a fatal error, then caller inherits it!
589
590 if Units.Table (Unum).Fatal_Error
591 and then Present (Error_Node)
592 then
593 Units.Table (Calling_Unit).Fatal_Error := True;
594 end if;
595
596 -- Remove load stack entry and return the entry in the file table
597
598 Load_Stack.Decrement_Last;
599 return Unum;
600
601 -- Case of file not found
602
603 else
604 if Debug_Flag_L then
605 Write_Str (" file was not found, load failed");
606 Write_Eol;
607 end if;
608
609 -- Generate message if unit required
610
611 if Required and then Present (Error_Node) then
612 if Is_Predefined_File_Name (Fname) then
613
614 -- This is a predefined library unit which is not present
615 -- in the run time. If a predefined unit is not available
616 -- it may very likely be the case that there is also pragma
617 -- Restriction forbidding its usage. This is typically the
618 -- case when building a configurable run time, where the
619 -- usage of certain run-time units units is restricted by
620 -- means of both the corresponding pragma Restriction (such
621 -- as No_Calendar), and by not including the unit. Hence,
622 -- we check whether this predefined unit is forbidden, so
623 -- that the message about the restriction violation is
624 -- generated, if needed.
625
626 Check_Restricted_Unit (Load_Name, Error_Node);
627
628 Error_Msg_Name_1 := Uname_Actual;
629 Error_Msg
630 ("% is not a predefined library unit", Load_Msg_Sloc);
631
632 else
633 Error_Msg_Name_1 := Fname;
634 Error_Msg ("file{ not found", Load_Msg_Sloc);
635 end if;
636
637 Write_Dependency_Chain;
638
639 -- Remove unit from stack, to avoid cascaded errors on
640 -- subsequent missing files.
641
642 Load_Stack.Decrement_Last;
643 Units.Decrement_Last;
644
645 -- If unit not required, remove load stack entry and the junk
646 -- file table entry, and return No_Unit to indicate not found,
647
648 else
649 Load_Stack.Decrement_Last;
650 Units.Decrement_Last;
651 end if;
652
653 return No_Unit;
654 end if;
655 end if;
656 end Load_Unit;
657
658 ------------------------
659 -- Make_Instance_Unit --
660 ------------------------
661
662 -- If the unit is an instance, it appears as a package declaration, but
663 -- contains both declaration and body of the instance. The body becomes
664 -- the main unit of the compilation, and the declaration is inserted
665 -- at the end of the unit table. The main unit now has the name of a
666 -- body, which is constructed from the name of the original spec,
667 -- and is attached to the compilation node of the original unit. The
668 -- declaration has been attached to a new compilation unit node, and
669 -- code will have to be generated for it.
670
671 procedure Make_Instance_Unit (N : Node_Id) is
672 Sind : constant Source_File_Index := Source_Index (Main_Unit);
673 begin
674 Units.Increment_Last;
675 Units.Table (Units.Last) := Units.Table (Main_Unit);
676 Units.Table (Units.Last).Cunit := Library_Unit (N);
677 Units.Table (Units.Last).Generate_Code := True;
678 Units.Table (Main_Unit).Cunit := N;
679 Units.Table (Main_Unit).Unit_Name :=
680 Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
681 Units.Table (Main_Unit).Version := Source_Checksum (Sind);
682 end Make_Instance_Unit;
683
684 ------------------------
685 -- Spec_Is_Irrelevant --
686 ------------------------
687
688 function Spec_Is_Irrelevant
689 (Spec_Unit : Unit_Number_Type;
690 Body_Unit : Unit_Number_Type) return Boolean
691 is
692 Sunit : constant Node_Id := Cunit (Spec_Unit);
693 Bunit : constant Node_Id := Cunit (Body_Unit);
694
695 begin
696 -- The spec is irrelevant if the body is a subprogram body, and the
697 -- spec is other than a subprogram spec or generic subprogram spec.
698 -- Note that the names must be the same, we don't need to check that,
699 -- because we already know that from the fact that the file names are
700 -- the same.
701
702 return
703 Nkind (Unit (Bunit)) = N_Subprogram_Body
704 and then Nkind (Unit (Sunit)) /= N_Subprogram_Declaration
705 and then Nkind (Unit (Sunit)) /= N_Generic_Subprogram_Declaration;
706 end Spec_Is_Irrelevant;
707
708 --------------------
709 -- Version_Update --
710 --------------------
711
712 procedure Version_Update (U : Node_Id; From : Node_Id) is
713 Unum : constant Unit_Number_Type := Get_Cunit_Unit_Number (U);
714 Fnum : constant Unit_Number_Type := Get_Cunit_Unit_Number (From);
715 begin
716 if Source_Index (Fnum) /= No_Source_File then
717 Units.Table (Unum).Version :=
718 Units.Table (Unum).Version
719 xor
720 Source_Checksum (Source_Index (Fnum));
721 end if;
722 end Version_Update;
723
724 ----------------------------
725 -- Write_Dependency_Chain --
726 ----------------------------
727
728 procedure Write_Dependency_Chain is
729 begin
730 -- The dependency chain is only written if it is at least two entries
731 -- deep, otherwise it is trivial (the main unit depending on a unit
732 -- that it obviously directly depends on).
733
734 if Load_Stack.Last - 1 > Load_Stack.First then
735 for U in Load_Stack.First .. Load_Stack.Last - 1 loop
736 Error_Msg_Unit_1 := Unit_Name (Load_Stack.Table (U));
737 Error_Msg_Unit_2 := Unit_Name (Load_Stack.Table (U + 1));
738 Error_Msg ("$ depends on $!", Load_Msg_Sloc);
739 end loop;
740 end if;
741 end Write_Dependency_Chain;
742
743 end Lib.Load;
Mirror of the offical gcc git repository hosted at gcc.gnu.org