1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2015, 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 ------------------------------------------------------------------------------
27 with Osint; use Osint;
28 with Output; use Output;
31 with Prj.Err; use Prj.Err;
32 with Snames; use Snames;
33 with Uintp; use Uintp;
35 with Ada.Characters.Handling; use Ada.Characters.Handling;
36 with Ada.Containers.Ordered_Sets;
37 with Ada.Unchecked_Deallocation;
39 with GNAT.Case_Util; use GNAT.Case_Util;
40 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
46 type Restricted_Lang_Access is access Restricted_Lang;
47 type Restricted_Lang is record
49 Next : Restricted_Lang_Access;
52 Restricted_Languages : Restricted_Lang_Access := null;
53 -- When null, all languages are allowed, otherwise only the languages in
54 -- the list are allowed.
56 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
57 -- File suffix for object files
59 Initial_Buffer_Size : constant := 100;
60 -- Initial size for extensible buffer used in Add_To_Buffer
62 The_Empty_String : Name_Id := No_Name;
63 The_Dot_String : Name_Id := No_Name;
65 Debug_Level : Integer := 0;
66 -- Current indentation level for debug traces
68 type Cst_String_Access is access constant String;
70 All_Lower_Case_Image : aliased constant String := "lowercase";
71 All_Upper_Case_Image : aliased constant String := "UPPERCASE";
72 Mixed_Case_Image : aliased constant String := "MixedCase";
74 The_Casing_Images : constant array (Known_Casing) of Cst_String_Access :=
75 (All_Lower_Case => All_Lower_Case_Image'Access,
76 All_Upper_Case => All_Upper_Case_Image'Access,
77 Mixed_Case => Mixed_Case_Image'Access);
79 package Name_Id_Set is
80 new Ada.Containers.Ordered_Sets (Element_Type => Name_Id);
82 procedure Free (Project : in out Project_Id);
83 -- Free memory allocated for Project
85 procedure Free_List (Languages : in out Language_Ptr);
86 procedure Free_List (Source : in out Source_Id);
87 procedure Free_List (Languages : in out Language_List);
88 -- Free memory allocated for the list of languages or sources
90 procedure Reset_Units_In_Table (Table : in out Units_Htable.Instance);
91 -- Resets all Units to No_Unit_Index Unit.File_Names (Spec).Unit &
92 -- Unit.File_Names (Impl).Unit in the given table.
94 procedure Free_Units (Table : in out Units_Htable.Instance);
95 -- Free memory allocated for unit information in the project
97 procedure Language_Changed (Iter : in out Source_Iterator);
98 procedure Project_Changed (Iter : in out Source_Iterator);
99 -- Called when a new project or language was selected for this iterator
101 function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
102 -- Return True if there is at least one ALI file in the directory Dir
104 -----------------------------
105 -- Add_Restricted_Language --
106 -----------------------------
108 procedure Add_Restricted_Language (Name : String) is
109 N : String (1 .. Name'Length) := Name;
113 Add_Str_To_Name_Buffer (N);
114 Restricted_Languages :=
115 new Restricted_Lang'(Name => Name_Find, Next => Restricted_Languages);
116 end Add_Restricted_Language;
118 -------------------------------------
119 -- Remove_All_Restricted_Languages --
120 -------------------------------------
122 procedure Remove_All_Restricted_Languages is
124 Restricted_Languages := null;
125 end Remove_All_Restricted_Languages;
131 procedure Add_To_Buffer
133 To : in out String_Access;
134 Last : in out Natural)
138 To := new String (1 .. Initial_Buffer_Size);
142 -- If Buffer is too small, double its size
144 while Last + S'Length > To'Last loop
146 New_Buffer : constant String_Access :=
147 new String (1 .. 2 * To'Length);
149 New_Buffer (1 .. Last) := To (1 .. Last);
155 To (Last + 1 .. Last + S'Length) := S;
156 Last := Last + S'Length;
159 ---------------------------------
160 -- Current_Object_Path_File_Of --
161 ---------------------------------
163 function Current_Object_Path_File_Of
164 (Shared : Shared_Project_Tree_Data_Access) return Path_Name_Type
167 return Shared.Private_Part.Current_Object_Path_File;
168 end Current_Object_Path_File_Of;
170 ---------------------------------
171 -- Current_Source_Path_File_Of --
172 ---------------------------------
174 function Current_Source_Path_File_Of
175 (Shared : Shared_Project_Tree_Data_Access)
176 return Path_Name_Type is
178 return Shared.Private_Part.Current_Source_Path_File;
179 end Current_Source_Path_File_Of;
181 ---------------------------
182 -- Delete_Temporary_File --
183 ---------------------------
185 procedure Delete_Temporary_File
186 (Shared : Shared_Project_Tree_Data_Access := null;
187 Path : Path_Name_Type)
190 pragma Warnings (Off, Dont_Care);
193 if not Opt.Keep_Temporary_Files then
194 if Current_Verbosity = High then
195 Write_Line ("Removing temp file: " & Get_Name_String (Path));
198 Delete_File (Get_Name_String (Path), Dont_Care);
200 if Shared /= null then
202 1 .. Temp_Files_Table.Last (Shared.Private_Part.Temp_Files)
204 if Shared.Private_Part.Temp_Files.Table (Index) = Path then
205 Shared.Private_Part.Temp_Files.Table (Index) := No_Path;
210 end Delete_Temporary_File;
212 ------------------------------
213 -- Delete_Temp_Config_Files --
214 ------------------------------
216 procedure Delete_Temp_Config_Files (Project_Tree : Project_Tree_Ref) is
218 pragma Warnings (Off, Success);
223 if not Opt.Keep_Temporary_Files then
224 if Project_Tree /= null then
225 Proj := Project_Tree.Projects;
226 while Proj /= null loop
227 if Proj.Project.Config_File_Temp then
228 Delete_Temporary_File
229 (Project_Tree.Shared, Proj.Project.Config_File_Name);
231 -- Make sure that we don't have a config file for this
232 -- project, in case there are several mains. In this case,
233 -- we will recreate another config file: we cannot reuse the
234 -- one that we just deleted.
236 Proj.Project.Config_Checked := False;
237 Proj.Project.Config_File_Name := No_Path;
238 Proj.Project.Config_File_Temp := False;
245 end Delete_Temp_Config_Files;
247 ---------------------------
248 -- Delete_All_Temp_Files --
249 ---------------------------
251 procedure Delete_All_Temp_Files
252 (Shared : Shared_Project_Tree_Data_Access)
255 pragma Warnings (Off, Dont_Care);
257 Path : Path_Name_Type;
260 if not Opt.Keep_Temporary_Files then
262 1 .. Temp_Files_Table.Last (Shared.Private_Part.Temp_Files)
264 Path := Shared.Private_Part.Temp_Files.Table (Index);
266 if Path /= No_Path then
267 if Current_Verbosity = High then
268 Write_Line ("Removing temp file: "
269 & Get_Name_String (Path));
272 Delete_File (Get_Name_String (Path), Dont_Care);
276 Temp_Files_Table.Free (Shared.Private_Part.Temp_Files);
277 Temp_Files_Table.Init (Shared.Private_Part.Temp_Files);
280 -- If any of the environment variables ADA_PRJ_INCLUDE_FILE or
281 -- ADA_PRJ_OBJECTS_FILE has been set, then reset their value to
284 if Shared.Private_Part.Current_Source_Path_File /= No_Path then
285 Setenv (Project_Include_Path_File, "");
288 if Shared.Private_Part.Current_Object_Path_File /= No_Path then
289 Setenv (Project_Objects_Path_File, "");
291 end Delete_All_Temp_Files;
293 ---------------------
294 -- Dependency_Name --
295 ---------------------
297 function Dependency_Name
298 (Source_File_Name : File_Name_Type;
299 Dependency : Dependency_File_Kind) return File_Name_Type
307 return Extend_Name (Source_File_Name, Makefile_Dependency_Suffix);
309 when ALI_File | ALI_Closure =>
310 return Extend_Name (Source_File_Name, ALI_Dependency_Suffix);
318 function Dot_String return Name_Id is
320 return The_Dot_String;
327 function Empty_File return File_Name_Type is
329 return File_Name_Type (The_Empty_String);
336 function Empty_Project
337 (Qualifier : Project_Qualifier) return Project_Data
340 Prj.Initialize (Tree => No_Project_Tree);
343 Data : Project_Data (Qualifier => Qualifier);
346 -- Only the fields for which no default value could be provided in
347 -- prj.ads are initialized below.
349 Data.Config := Default_Project_Config;
358 function Empty_String return Name_Id is
360 return The_Empty_String;
367 procedure Expect (The_Token : Token_Type; Token_Image : String) is
369 if Token /= The_Token then
371 -- ??? Should pass user flags here instead
373 Error_Msg (Gnatmake_Flags, Token_Image & " expected", Token_Ptr);
382 (File : File_Name_Type;
383 With_Suffix : String) return File_Name_Type
388 Get_Name_String (File);
389 Last := Name_Len + 1;
391 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
392 Name_Len := Name_Len - 1;
395 if Name_Len <= 1 then
399 for J in With_Suffix'Range loop
400 Name_Buffer (Name_Len) := With_Suffix (J);
401 Name_Len := Name_Len + 1;
404 Name_Len := Name_Len - 1;
408 -------------------------
409 -- Is_Allowed_Language --
410 -------------------------
412 function Is_Allowed_Language (Name : Name_Id) return Boolean is
413 R : Restricted_Lang_Access := Restricted_Languages;
414 Lang : constant String := Get_Name_String (Name);
422 if Get_Name_String (R.Name) = Lang then
431 end Is_Allowed_Language;
433 ---------------------
434 -- Project_Changed --
435 ---------------------
437 procedure Project_Changed (Iter : in out Source_Iterator) is
439 if Iter.Project /= null then
440 Iter.Language := Iter.Project.Project.Languages;
441 Language_Changed (Iter);
445 ----------------------
446 -- Language_Changed --
447 ----------------------
449 procedure Language_Changed (Iter : in out Source_Iterator) is
451 Iter.Current := No_Source;
453 if Iter.Language_Name /= No_Name then
454 while Iter.Language /= null
455 and then Iter.Language.Name /= Iter.Language_Name
457 Iter.Language := Iter.Language.Next;
461 -- If there is no matching language in this project, move to next
463 if Iter.Language = No_Language_Index then
464 if Iter.All_Projects then
466 Iter.Project := Iter.Project.Next;
467 exit when Iter.Project = null
468 or else Iter.Encapsulated_Libs
469 or else not Iter.Project.From_Encapsulated_Lib;
472 Project_Changed (Iter);
474 Iter.Project := null;
478 Iter.Current := Iter.Language.First_Source;
480 if Iter.Current = No_Source then
481 Iter.Language := Iter.Language.Next;
482 Language_Changed (Iter);
484 elsif not Iter.Locally_Removed
485 and then Iter.Current.Locally_Removed
490 end Language_Changed;
492 ---------------------
493 -- For_Each_Source --
494 ---------------------
496 function For_Each_Source
497 (In_Tree : Project_Tree_Ref;
498 Project : Project_Id := No_Project;
499 Language : Name_Id := No_Name;
500 Encapsulated_Libs : Boolean := True;
501 Locally_Removed : Boolean := True) return Source_Iterator
503 Iter : Source_Iterator;
505 Iter := Source_Iterator'
507 Project => In_Tree.Projects,
508 All_Projects => Project = No_Project,
509 Language_Name => Language,
510 Language => No_Language_Index,
511 Current => No_Source,
512 Encapsulated_Libs => Encapsulated_Libs,
513 Locally_Removed => Locally_Removed);
515 if Project /= null then
516 while Iter.Project /= null
517 and then Iter.Project.Project /= Project
519 Iter.Project := Iter.Project.Next;
523 while not Iter.Encapsulated_Libs
524 and then Iter.Project.From_Encapsulated_Lib
526 Iter.Project := Iter.Project.Next;
530 Project_Changed (Iter);
539 function Element (Iter : Source_Iterator) return Source_Id is
548 procedure Next (Iter : in out Source_Iterator) is
551 Iter.Current := Iter.Current.Next_In_Lang;
553 exit when Iter.Locally_Removed
554 or else Iter.Current = No_Source
555 or else not Iter.Current.Locally_Removed;
558 if Iter.Current = No_Source then
559 Iter.Language := Iter.Language.Next;
560 Language_Changed (Iter);
564 --------------------------------
565 -- For_Every_Project_Imported --
566 --------------------------------
568 procedure For_Every_Project_Imported_Context
570 Tree : Project_Tree_Ref;
571 With_State : in out State;
572 Include_Aggregated : Boolean := True;
573 Imported_First : Boolean := False)
575 use Project_Boolean_Htable;
577 procedure Recursive_Check_Context
578 (Project : Project_Id;
579 Tree : Project_Tree_Ref;
580 In_Aggregate_Lib : Boolean;
581 From_Encapsulated_Lib : Boolean);
582 -- Recursively handle the project tree creating a new context for
583 -- keeping track about already handled projects.
585 -----------------------------
586 -- Recursive_Check_Context --
587 -----------------------------
589 procedure Recursive_Check_Context
590 (Project : Project_Id;
591 Tree : Project_Tree_Ref;
592 In_Aggregate_Lib : Boolean;
593 From_Encapsulated_Lib : Boolean)
595 package Name_Id_Set is
596 new Ada.Containers.Ordered_Sets (Element_Type => Path_Name_Type);
598 Seen_Name : Name_Id_Set.Set;
599 -- This set is needed to ensure that we do not handle the same
600 -- project twice in the context of aggregate libraries.
601 -- Since duplicate project names are possible in the context of
602 -- aggregated projects, we need to check the full paths.
604 procedure Recursive_Check
605 (Project : Project_Id;
606 Tree : Project_Tree_Ref;
607 In_Aggregate_Lib : Boolean;
608 From_Encapsulated_Lib : Boolean);
609 -- Check if project has already been seen. If not, mark it as Seen,
610 -- Call Action, and check all its imported and aggregated projects.
612 ---------------------
613 -- Recursive_Check --
614 ---------------------
616 procedure Recursive_Check
617 (Project : Project_Id;
618 Tree : Project_Tree_Ref;
619 In_Aggregate_Lib : Boolean;
620 From_Encapsulated_Lib : Boolean)
623 function Has_Sources (P : Project_Id) return Boolean;
624 -- Returns True if P has sources
626 function Get_From_Tree (P : Project_Id) return Project_Id;
627 -- Get project P from Tree. If P has no sources get another
628 -- instance of this project with sources. If P has sources,
635 function Has_Sources (P : Project_Id) return Boolean is
640 while Lang /= No_Language_Index loop
641 if Lang.First_Source /= No_Source then
655 function Get_From_Tree (P : Project_Id) return Project_Id is
656 List : Project_List := Tree.Projects;
659 if not Has_Sources (P) then
660 while List /= null loop
661 if List.Project.Name = P.Name
662 and then Has_Sources (List.Project)
678 -- Start of processing for Recursive_Check
681 if not Seen_Name.Contains (Project.Path.Name) then
683 -- Even if a project is aggregated multiple times in an
684 -- aggregated library, we will only return it once.
686 Seen_Name.Include (Project.Path.Name);
688 if not Imported_First then
690 (Get_From_Tree (Project),
692 Project_Context'(In_Aggregate_Lib, From_Encapsulated_Lib),
696 -- Visit all extended projects
698 if Project.Extends /= No_Project then
700 (Project.Extends, Tree,
701 In_Aggregate_Lib, From_Encapsulated_Lib);
704 -- Visit all imported projects
706 List := Project.Imported_Projects;
707 while List /= null loop
711 From_Encapsulated_Lib
712 or else Project.Standalone_Library = Encapsulated);
716 -- Visit all aggregated projects
718 if Include_Aggregated
719 and then Project.Qualifier in Aggregate_Project
722 Agg : Aggregated_Project_List;
725 Agg := Project.Aggregated_Projects;
726 while Agg /= null loop
727 pragma Assert (Agg.Project /= No_Project);
729 -- For aggregated libraries, the tree must be the one
730 -- of the aggregate library.
732 if Project.Qualifier = Aggregate_Library then
736 From_Encapsulated_Lib
738 Project.Standalone_Library = Encapsulated);
741 -- Use a new context as we want to returns the same
742 -- project in different project tree for aggregated
745 Recursive_Check_Context
746 (Agg.Project, Agg.Tree, False, False);
754 if Imported_First then
756 (Get_From_Tree (Project),
758 Project_Context'(In_Aggregate_Lib, From_Encapsulated_Lib),
764 -- Start of processing for Recursive_Check_Context
768 (Project, Tree, In_Aggregate_Lib, From_Encapsulated_Lib);
769 end Recursive_Check_Context;
771 -- Start of processing for For_Every_Project_Imported
774 Recursive_Check_Context
777 In_Aggregate_Lib => False,
778 From_Encapsulated_Lib => False);
779 end For_Every_Project_Imported_Context;
781 procedure For_Every_Project_Imported
783 Tree : Project_Tree_Ref;
784 With_State : in out State;
785 Include_Aggregated : Boolean := True;
786 Imported_First : Boolean := False)
789 (Project : Project_Id;
790 Tree : Project_Tree_Ref;
791 Context : Project_Context;
792 With_State : in out State);
793 -- Action wrapper for handling the context
800 (Project : Project_Id;
801 Tree : Project_Tree_Ref;
802 Context : Project_Context;
803 With_State : in out State)
805 pragma Unreferenced (Context);
807 Action (Project, Tree, With_State);
810 procedure For_Projects is
811 new For_Every_Project_Imported_Context (State, Internal);
814 For_Projects (By, Tree, With_State, Include_Aggregated, Imported_First);
815 end For_Every_Project_Imported;
822 (In_Tree : Project_Tree_Ref;
823 Project : Project_Id;
824 In_Imported_Only : Boolean := False;
825 In_Extended_Only : Boolean := False;
826 Base_Name : File_Name_Type;
827 Index : Int := 0) return Source_Id
829 Result : Source_Id := No_Source;
831 procedure Look_For_Sources
833 Tree : Project_Tree_Ref;
834 Src : in out Source_Id);
835 -- Look for Base_Name in the sources of Proj
837 ----------------------
838 -- Look_For_Sources --
839 ----------------------
841 procedure Look_For_Sources
843 Tree : Project_Tree_Ref;
844 Src : in out Source_Id)
846 Iterator : Source_Iterator;
849 Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
850 while Element (Iterator) /= No_Source loop
851 if Element (Iterator).File = Base_Name
852 and then (Index = 0 or else Element (Iterator).Index = Index)
854 Src := Element (Iterator);
856 -- If the source has been excluded, continue looking. We will
857 -- get the excluded source only if there is no other source
858 -- with the same base name that is not locally removed.
860 if not Element (Iterator).Locally_Removed then
867 end Look_For_Sources;
869 procedure For_Imported_Projects is new For_Every_Project_Imported
870 (State => Source_Id, Action => Look_For_Sources);
874 -- Start of processing for Find_Source
877 if In_Extended_Only then
879 while Proj /= No_Project loop
880 Look_For_Sources (Proj, In_Tree, Result);
881 exit when Result /= No_Source;
883 Proj := Proj.Extends;
886 elsif In_Imported_Only then
887 Look_For_Sources (Project, In_Tree, Result);
889 if Result = No_Source then
890 For_Imported_Projects
893 Include_Aggregated => False,
894 With_State => Result);
898 Look_For_Sources (No_Project, In_Tree, Result);
904 ----------------------
905 -- Find_All_Sources --
906 ----------------------
908 function Find_All_Sources
909 (In_Tree : Project_Tree_Ref;
910 Project : Project_Id;
911 In_Imported_Only : Boolean := False;
912 In_Extended_Only : Boolean := False;
913 Base_Name : File_Name_Type;
914 Index : Int := 0) return Source_Ids
916 Result : Source_Ids (1 .. 1_000);
919 type Empty_State is null record;
920 No_State : Empty_State;
921 -- This is needed for the State parameter of procedure Look_For_Sources
922 -- below, because of the instantiation For_Imported_Projects of generic
923 -- procedure For_Every_Project_Imported. As procedure Look_For_Sources
924 -- does not modify parameter State, there is no need to give its type
925 -- more than one value.
927 procedure Look_For_Sources
929 Tree : Project_Tree_Ref;
930 State : in out Empty_State);
931 -- Look for Base_Name in the sources of Proj
933 ----------------------
934 -- Look_For_Sources --
935 ----------------------
937 procedure Look_For_Sources
939 Tree : Project_Tree_Ref;
940 State : in out Empty_State)
942 Iterator : Source_Iterator;
948 Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
949 while Element (Iterator) /= No_Source loop
950 if Element (Iterator).File = Base_Name
953 (Element (Iterator).Unit /= No_Unit_Index
955 Element (Iterator).Index = Index))
957 Src := Element (Iterator);
959 -- If the source has been excluded, continue looking. We will
960 -- get the excluded source only if there is no other source
961 -- with the same base name that is not locally removed.
963 if not Element (Iterator).Locally_Removed then
965 Result (Last) := Src;
971 end Look_For_Sources;
973 procedure For_Imported_Projects is new For_Every_Project_Imported
974 (State => Empty_State, Action => Look_For_Sources);
978 -- Start of processing for Find_All_Sources
981 if In_Extended_Only then
983 while Proj /= No_Project loop
984 Look_For_Sources (Proj, In_Tree, No_State);
986 Proj := Proj.Extends;
989 elsif In_Imported_Only then
990 Look_For_Sources (Project, In_Tree, No_State);
993 For_Imported_Projects
996 Include_Aggregated => False,
997 With_State => No_State);
1001 Look_For_Sources (No_Project, In_Tree, No_State);
1004 return Result (1 .. Last);
1005 end Find_All_Sources;
1011 function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num);
1012 -- Used in implementation of other functions Hash below
1018 function Hash (Name : File_Name_Type) return Header_Num is
1020 return Hash (Get_Name_String (Name));
1023 function Hash (Name : Name_Id) return Header_Num is
1025 return Hash (Get_Name_String (Name));
1028 function Hash (Name : Path_Name_Type) return Header_Num is
1030 return Hash (Get_Name_String (Name));
1033 function Hash (Project : Project_Id) return Header_Num is
1035 if Project = No_Project then
1036 return Header_Num'First;
1038 return Hash (Get_Name_String (Project.Name));
1046 function Image (The_Casing : Casing_Type) return String is
1048 return The_Casing_Images (The_Casing).all;
1051 -----------------------------
1052 -- Is_Standard_GNAT_Naming --
1053 -----------------------------
1055 function Is_Standard_GNAT_Naming
1056 (Naming : Lang_Naming_Data) return Boolean
1059 return Get_Name_String (Naming.Spec_Suffix) = ".ads"
1060 and then Get_Name_String (Naming.Body_Suffix) = ".adb"
1061 and then Get_Name_String (Naming.Dot_Replacement) = "-";
1062 end Is_Standard_GNAT_Naming;
1068 procedure Initialize (Tree : Project_Tree_Ref) is
1070 if The_Empty_String = No_Name then
1073 The_Empty_String := Name_Find;
1076 Name_Buffer (1) := '.';
1077 The_Dot_String := Name_Find;
1079 Prj.Attr.Initialize;
1081 -- Make sure that new reserved words after Ada 95 may be used as
1084 Opt.Ada_Version := Opt.Ada_95;
1085 Opt.Ada_Version_Pragma := Empty;
1087 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
1088 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
1089 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
1091 (Name_External_As_List, Token_Type'Pos (Tok_External_As_List));
1094 if Tree /= No_Project_Tree then
1103 function Is_Extending
1104 (Extending : Project_Id;
1105 Extended : Project_Id) return Boolean
1111 while Proj /= No_Project loop
1112 if Proj = Extended then
1116 Proj := Proj.Extends;
1126 function Object_Name
1127 (Source_File_Name : File_Name_Type;
1128 Object_File_Suffix : Name_Id := No_Name) return File_Name_Type
1131 if Object_File_Suffix = No_Name then
1133 (Source_File_Name, Object_Suffix);
1136 (Source_File_Name, Get_Name_String (Object_File_Suffix));
1140 function Object_Name
1141 (Source_File_Name : File_Name_Type;
1143 Index_Separator : Character;
1144 Object_File_Suffix : Name_Id := No_Name) return File_Name_Type
1146 Index_Img : constant String := Source_Index'Img;
1150 Get_Name_String (Source_File_Name);
1153 while Last > 1 and then Name_Buffer (Last) /= '.' loop
1158 Name_Len := Last - 1;
1161 Add_Char_To_Name_Buffer (Index_Separator);
1162 Add_Str_To_Name_Buffer (Index_Img (2 .. Index_Img'Last));
1164 if Object_File_Suffix = No_Name then
1165 Add_Str_To_Name_Buffer (Object_Suffix);
1167 Add_Str_To_Name_Buffer (Get_Name_String (Object_File_Suffix));
1173 ----------------------
1174 -- Record_Temp_File --
1175 ----------------------
1177 procedure Record_Temp_File
1178 (Shared : Shared_Project_Tree_Data_Access;
1179 Path : Path_Name_Type)
1182 Temp_Files_Table.Append (Shared.Private_Part.Temp_Files, Path);
1183 end Record_Temp_File;
1189 procedure Free (List : in out Aggregated_Project_List) is
1190 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1191 (Aggregated_Project, Aggregated_Project_List);
1192 Tmp : Aggregated_Project_List;
1194 while List /= null loop
1199 Unchecked_Free (List);
1204 ----------------------------
1205 -- Add_Aggregated_Project --
1206 ----------------------------
1208 procedure Add_Aggregated_Project
1209 (Project : Project_Id;
1210 Path : Path_Name_Type)
1212 Aggregated : Aggregated_Project_List;
1215 -- Check if the project is already in the aggregated project list. If it
1216 -- is, do not add it again.
1218 Aggregated := Project.Aggregated_Projects;
1219 while Aggregated /= null loop
1220 if Path = Aggregated.Path then
1223 Aggregated := Aggregated.Next;
1227 Project.Aggregated_Projects := new Aggregated_Project'
1229 Project => No_Project,
1231 Next => Project.Aggregated_Projects);
1232 end Add_Aggregated_Project;
1238 procedure Free (Project : in out Project_Id) is
1239 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1240 (Project_Data, Project_Id);
1243 if Project /= null then
1244 Free (Project.Ada_Include_Path);
1245 Free (Project.Objects_Path);
1246 Free (Project.Ada_Objects_Path);
1247 Free (Project.Ada_Objects_Path_No_Libs);
1248 Free_List (Project.Imported_Projects, Free_Project => False);
1249 Free_List (Project.All_Imported_Projects, Free_Project => False);
1250 Free_List (Project.Languages);
1252 case Project.Qualifier is
1253 when Aggregate | Aggregate_Library =>
1254 Free (Project.Aggregated_Projects);
1260 Unchecked_Free (Project);
1268 procedure Free_List (Languages : in out Language_List) is
1269 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1270 (Language_List_Element, Language_List);
1271 Tmp : Language_List;
1273 while Languages /= null loop
1274 Tmp := Languages.Next;
1275 Unchecked_Free (Languages);
1284 procedure Free_List (Source : in out Source_Id) is
1285 procedure Unchecked_Free is new
1286 Ada.Unchecked_Deallocation (Source_Data, Source_Id);
1291 while Source /= No_Source loop
1292 Tmp := Source.Next_In_Lang;
1293 Free_List (Source.Alternate_Languages);
1295 if Source.Unit /= null
1296 and then Source.Kind in Spec_Or_Body
1298 Source.Unit.File_Names (Source.Kind) := null;
1301 Unchecked_Free (Source);
1311 (List : in out Project_List;
1312 Free_Project : Boolean)
1314 procedure Unchecked_Free is new
1315 Ada.Unchecked_Deallocation (Project_List_Element, Project_List);
1320 while List /= null loop
1323 if Free_Project then
1324 Free (List.Project);
1327 Unchecked_Free (List);
1336 procedure Free_List (Languages : in out Language_Ptr) is
1337 procedure Unchecked_Free is new
1338 Ada.Unchecked_Deallocation (Language_Data, Language_Ptr);
1343 while Languages /= null loop
1344 Tmp := Languages.Next;
1345 Free_List (Languages.First_Source);
1346 Unchecked_Free (Languages);
1351 --------------------------
1352 -- Reset_Units_In_Table --
1353 --------------------------
1355 procedure Reset_Units_In_Table (Table : in out Units_Htable.Instance) is
1359 Unit := Units_Htable.Get_First (Table);
1360 while Unit /= No_Unit_Index loop
1361 if Unit.File_Names (Spec) /= null then
1362 Unit.File_Names (Spec).Unit := No_Unit_Index;
1365 if Unit.File_Names (Impl) /= null then
1366 Unit.File_Names (Impl).Unit := No_Unit_Index;
1369 Unit := Units_Htable.Get_Next (Table);
1371 end Reset_Units_In_Table;
1377 procedure Free_Units (Table : in out Units_Htable.Instance) is
1378 procedure Unchecked_Free is new
1379 Ada.Unchecked_Deallocation (Unit_Data, Unit_Index);
1384 Unit := Units_Htable.Get_First (Table);
1385 while Unit /= No_Unit_Index loop
1387 -- We cannot reset Unit.File_Names (Impl or Spec).Unit here as
1388 -- Source_Data buffer is freed by the following instruction
1389 -- Free_List (Tree.Projects, Free_Project => True);
1391 Unchecked_Free (Unit);
1392 Unit := Units_Htable.Get_Next (Table);
1395 Units_Htable.Reset (Table);
1402 procedure Free (Tree : in out Project_Tree_Ref) is
1403 procedure Unchecked_Free is new
1404 Ada.Unchecked_Deallocation
1405 (Project_Tree_Data, Project_Tree_Ref);
1407 procedure Unchecked_Free is new
1408 Ada.Unchecked_Deallocation
1409 (Project_Tree_Appdata'Class, Project_Tree_Appdata_Access);
1412 if Tree /= null then
1413 if Tree.Is_Root_Tree then
1414 Name_List_Table.Free (Tree.Shared.Name_Lists);
1415 Number_List_Table.Free (Tree.Shared.Number_Lists);
1416 String_Element_Table.Free (Tree.Shared.String_Elements);
1417 Variable_Element_Table.Free (Tree.Shared.Variable_Elements);
1418 Array_Element_Table.Free (Tree.Shared.Array_Elements);
1419 Array_Table.Free (Tree.Shared.Arrays);
1420 Package_Table.Free (Tree.Shared.Packages);
1421 Temp_Files_Table.Free (Tree.Shared.Private_Part.Temp_Files);
1424 if Tree.Appdata /= null then
1425 Free (Tree.Appdata.all);
1426 Unchecked_Free (Tree.Appdata);
1429 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
1430 Source_Files_Htable.Reset (Tree.Source_Files_HT);
1432 Reset_Units_In_Table (Tree.Units_HT);
1433 Free_List (Tree.Projects, Free_Project => True);
1434 Free_Units (Tree.Units_HT);
1436 Unchecked_Free (Tree);
1444 procedure Reset (Tree : Project_Tree_Ref) is
1448 if Tree.Is_Root_Tree then
1450 -- We cannot use 'Access here:
1451 -- "illegal attribute for discriminant-dependent component"
1452 -- However, we know this is valid since Shared and Shared_Data have
1453 -- the same lifetime and will always exist concurrently.
1455 Tree.Shared := Tree.Shared_Data'Unrestricted_Access;
1456 Name_List_Table.Init (Tree.Shared.Name_Lists);
1457 Number_List_Table.Init (Tree.Shared.Number_Lists);
1458 String_Element_Table.Init (Tree.Shared.String_Elements);
1459 Variable_Element_Table.Init (Tree.Shared.Variable_Elements);
1460 Array_Element_Table.Init (Tree.Shared.Array_Elements);
1461 Array_Table.Init (Tree.Shared.Arrays);
1462 Package_Table.Init (Tree.Shared.Packages);
1464 -- Create Dot_String_List
1466 String_Element_Table.Append
1467 (Tree.Shared.String_Elements,
1469 (Value => The_Dot_String,
1471 Display_Value => The_Dot_String,
1472 Location => No_Location,
1474 Next => Nil_String));
1475 Tree.Shared.Dot_String_List :=
1476 String_Element_Table.Last (Tree.Shared.String_Elements);
1478 -- Private part table
1480 Temp_Files_Table.Init (Tree.Shared.Private_Part.Temp_Files);
1482 Tree.Shared.Private_Part.Current_Source_Path_File := No_Path;
1483 Tree.Shared.Private_Part.Current_Object_Path_File := No_Path;
1486 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
1487 Source_Files_Htable.Reset (Tree.Source_Files_HT);
1488 Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
1490 Tree.Replaced_Source_Number := 0;
1492 Reset_Units_In_Table (Tree.Units_HT);
1493 Free_List (Tree.Projects, Free_Project => True);
1494 Free_Units (Tree.Units_HT);
1497 -------------------------------------
1498 -- Set_Current_Object_Path_File_Of --
1499 -------------------------------------
1501 procedure Set_Current_Object_Path_File_Of
1502 (Shared : Shared_Project_Tree_Data_Access;
1503 To : Path_Name_Type)
1506 Shared.Private_Part.Current_Object_Path_File := To;
1507 end Set_Current_Object_Path_File_Of;
1509 -------------------------------------
1510 -- Set_Current_Source_Path_File_Of --
1511 -------------------------------------
1513 procedure Set_Current_Source_Path_File_Of
1514 (Shared : Shared_Project_Tree_Data_Access;
1515 To : Path_Name_Type)
1518 Shared.Private_Part.Current_Source_Path_File := To;
1519 end Set_Current_Source_Path_File_Of;
1521 -----------------------
1522 -- Set_Path_File_Var --
1523 -----------------------
1525 procedure Set_Path_File_Var (Name : String; Value : String) is
1526 Host_Spec : String_Access := To_Host_File_Spec (Value);
1528 if Host_Spec = null then
1530 ("could not convert file name """ & Value & """ to host spec");
1532 Setenv (Name, Host_Spec.all);
1535 end Set_Path_File_Var;
1541 function Switches_Name
1542 (Source_File_Name : File_Name_Type) return File_Name_Type
1545 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1552 function Value (Image : String) return Casing_Type is
1554 for Casing in The_Casing_Images'Range loop
1555 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1560 raise Constraint_Error;
1563 ---------------------
1564 -- Has_Ada_Sources --
1565 ---------------------
1567 function Has_Ada_Sources (Data : Project_Id) return Boolean is
1568 Lang : Language_Ptr;
1571 Lang := Data.Languages;
1572 while Lang /= No_Language_Index loop
1573 if Lang.Name = Name_Ada then
1574 return Lang.First_Source /= No_Source;
1580 end Has_Ada_Sources;
1582 ------------------------
1583 -- Contains_ALI_Files --
1584 ------------------------
1586 function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is
1587 Dir_Name : constant String := Get_Name_String (Dir);
1589 Name : String (1 .. 1_000);
1591 Result : Boolean := False;
1594 Open (Direct, Dir_Name);
1596 -- For each file in the directory, check if it is an ALI file
1599 Read (Direct, Name, Last);
1601 Canonical_Case_File_Name (Name (1 .. Last));
1602 Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali";
1610 -- If there is any problem, close the directory if open and return True.
1611 -- The library directory will be added to the path.
1614 if Is_Open (Direct) then
1619 end Contains_ALI_Files;
1621 --------------------------
1622 -- Get_Object_Directory --
1623 --------------------------
1625 function Get_Object_Directory
1626 (Project : Project_Id;
1627 Including_Libraries : Boolean;
1628 Only_If_Ada : Boolean := False) return Path_Name_Type
1631 if (Project.Library and then Including_Libraries)
1633 (Project.Object_Directory /= No_Path_Information
1634 and then (not Including_Libraries or else not Project.Library))
1636 -- For a library project, add the library ALI directory if there is
1637 -- no object directory or if the library ALI directory contains ALI
1638 -- files; otherwise add the object directory.
1640 if Project.Library then
1641 if Project.Object_Directory = No_Path_Information
1643 (Including_Libraries
1645 Contains_ALI_Files (Project.Library_ALI_Dir.Display_Name))
1647 return Project.Library_ALI_Dir.Display_Name;
1649 return Project.Object_Directory.Display_Name;
1652 -- For a non-library project, add object directory if it is not a
1653 -- virtual project, and if there are Ada sources in the project or
1654 -- one of the projects it extends. If there are no Ada sources,
1655 -- adding the object directory could disrupt the order of the
1656 -- object dirs in the path.
1658 elsif not Project.Virtual then
1660 Add_Object_Dir : Boolean;
1664 Add_Object_Dir := not Only_If_Ada;
1666 while not Add_Object_Dir and then Prj /= No_Project loop
1667 if Has_Ada_Sources (Prj) then
1668 Add_Object_Dir := True;
1674 if Add_Object_Dir then
1675 return Project.Object_Directory.Display_Name;
1682 end Get_Object_Directory;
1684 -----------------------------------
1685 -- Ultimate_Extending_Project_Of --
1686 -----------------------------------
1688 function Ultimate_Extending_Project_Of
1689 (Proj : Project_Id) return Project_Id
1695 while Prj /= null and then Prj.Extended_By /= No_Project loop
1696 Prj := Prj.Extended_By;
1700 end Ultimate_Extending_Project_Of;
1702 -----------------------------------
1703 -- Compute_All_Imported_Projects --
1704 -----------------------------------
1706 procedure Compute_All_Imported_Projects
1707 (Root_Project : Project_Id;
1708 Tree : Project_Tree_Ref)
1710 procedure Analyze_Tree
1711 (Local_Root : Project_Id;
1712 Local_Tree : Project_Tree_Ref;
1713 Context : Project_Context);
1714 -- Process Project and all its aggregated project to analyze their own
1715 -- imported projects.
1721 procedure Analyze_Tree
1722 (Local_Root : Project_Id;
1723 Local_Tree : Project_Tree_Ref;
1724 Context : Project_Context)
1726 pragma Unreferenced (Local_Root);
1728 Project : Project_Id;
1730 procedure Recursive_Add
1732 Tree : Project_Tree_Ref;
1733 Context : Project_Context;
1734 Dummy : in out Boolean);
1735 -- Recursively add the projects imported by project Project, but not
1736 -- those that are extended.
1742 procedure Recursive_Add
1744 Tree : Project_Tree_Ref;
1745 Context : Project_Context;
1746 Dummy : in out Boolean)
1748 pragma Unreferenced (Tree);
1750 List : Project_List;
1754 -- A project is not importing itself
1756 Prj2 := Ultimate_Extending_Project_Of (Prj);
1758 if Project /= Prj2 then
1760 -- Check that the project is not already in the list. We know
1761 -- the one passed to Recursive_Add have never been visited
1762 -- before, but the one passed it are the extended projects.
1764 List := Project.All_Imported_Projects;
1765 while List /= null loop
1766 if List.Project = Prj2 then
1773 -- Add it to the list
1775 Project.All_Imported_Projects :=
1776 new Project_List_Element'
1778 From_Encapsulated_Lib =>
1779 Context.From_Encapsulated_Lib
1780 or else Analyze_Tree.Context.From_Encapsulated_Lib,
1781 Next => Project.All_Imported_Projects);
1785 procedure For_All_Projects is
1786 new For_Every_Project_Imported_Context (Boolean, Recursive_Add);
1788 Dummy : Boolean := False;
1789 List : Project_List;
1792 List := Local_Tree.Projects;
1793 while List /= null loop
1794 Project := List.Project;
1796 (Project.All_Imported_Projects, Free_Project => False);
1798 (Project, Local_Tree, Dummy, Include_Aggregated => False);
1803 procedure For_Aggregates is
1804 new For_Project_And_Aggregated_Context (Analyze_Tree);
1806 -- Start of processing for Compute_All_Imported_Projects
1809 For_Aggregates (Root_Project, Tree);
1810 end Compute_All_Imported_Projects;
1816 function Is_Compilable (Source : Source_Id) return Boolean is
1818 case Source.Compilable is
1820 if Source.Language.Config.Compiler_Driver /= No_File
1822 Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0
1823 and then not Source.Locally_Removed
1824 and then (Source.Language.Config.Kind /= File_Based
1825 or else Source.Kind /= Spec)
1827 -- Do not modify Source.Compilable before the source record
1828 -- has been initialized.
1830 if Source.Source_TS /= Empty_Time_Stamp then
1831 Source.Compilable := Yes;
1837 if Source.Source_TS /= Empty_Time_Stamp then
1838 Source.Compilable := No;
1852 ------------------------------
1853 -- Object_To_Global_Archive --
1854 ------------------------------
1856 function Object_To_Global_Archive (Source : Source_Id) return Boolean is
1858 return Source.Language.Config.Kind = File_Based
1859 and then Source.Kind = Impl
1860 and then Source.Language.Config.Objects_Linked
1861 and then Is_Compilable (Source)
1862 and then Source.Language.Config.Object_Generated;
1863 end Object_To_Global_Archive;
1865 ----------------------------
1866 -- Get_Language_From_Name --
1867 ----------------------------
1869 function Get_Language_From_Name
1870 (Project : Project_Id;
1871 Name : String) return Language_Ptr
1874 Result : Language_Ptr;
1877 Name_Len := Name'Length;
1878 Name_Buffer (1 .. Name_Len) := Name;
1879 To_Lower (Name_Buffer (1 .. Name_Len));
1882 Result := Project.Languages;
1883 while Result /= No_Language_Index loop
1884 if Result.Name = N then
1888 Result := Result.Next;
1891 return No_Language_Index;
1892 end Get_Language_From_Name;
1898 function Other_Part (Source : Source_Id) return Source_Id is
1900 if Source.Unit /= No_Unit_Index then
1903 return Source.Unit.File_Names (Spec);
1905 return Source.Unit.File_Names (Impl);
1918 function Create_Flags
1919 (Report_Error : Error_Handler;
1920 When_No_Sources : Error_Warning;
1921 Require_Sources_Other_Lang : Boolean := True;
1922 Allow_Duplicate_Basenames : Boolean := True;
1923 Compiler_Driver_Mandatory : Boolean := False;
1924 Error_On_Unknown_Language : Boolean := True;
1925 Require_Obj_Dirs : Error_Warning := Error;
1926 Allow_Invalid_External : Error_Warning := Error;
1927 Missing_Source_Files : Error_Warning := Error;
1928 Ignore_Missing_With : Boolean := False)
1929 return Processing_Flags
1932 return Processing_Flags'
1933 (Report_Error => Report_Error,
1934 When_No_Sources => When_No_Sources,
1935 Require_Sources_Other_Lang => Require_Sources_Other_Lang,
1936 Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
1937 Error_On_Unknown_Language => Error_On_Unknown_Language,
1938 Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
1939 Require_Obj_Dirs => Require_Obj_Dirs,
1940 Allow_Invalid_External => Allow_Invalid_External,
1941 Missing_Source_Files => Missing_Source_Files,
1942 Ignore_Missing_With => Ignore_Missing_With,
1943 Incomplete_Withs => False);
1951 (Table : Name_List_Table.Instance;
1952 List : Name_List_Index) return Natural
1954 Count : Natural := 0;
1955 Tmp : Name_List_Index;
1959 while Tmp /= No_Name_List loop
1961 Tmp := Table.Table (Tmp).Next;
1971 procedure Debug_Output (Str : String) is
1973 if Current_Verbosity > Default then
1975 Write_Line ((1 .. Debug_Level * 2 => ' ') & Str);
1976 Set_Standard_Output;
1984 procedure Debug_Indent is
1986 if Current_Verbosity = High then
1988 Write_Str ((1 .. Debug_Level * 2 => ' '));
1989 Set_Standard_Output;
1997 procedure Debug_Output (Str : String; Str2 : Name_Id) is
1999 if Current_Verbosity > Default then
2004 if Str2 = No_Name then
2005 Write_Line (" <no_name>");
2007 Write_Line (" """ & Get_Name_String (Str2) & '"');
2010 Set_Standard_Output;
2014 ---------------------------
2015 -- Debug_Increase_Indent --
2016 ---------------------------
2018 procedure Debug_Increase_Indent
2019 (Str : String := ""; Str2 : Name_Id := No_Name)
2022 if Str2 /= No_Name then
2023 Debug_Output (Str, Str2);
2027 Debug_Level := Debug_Level + 1;
2028 end Debug_Increase_Indent;
2030 ---------------------------
2031 -- Debug_Decrease_Indent --
2032 ---------------------------
2034 procedure Debug_Decrease_Indent (Str : String := "") is
2036 if Debug_Level > 0 then
2037 Debug_Level := Debug_Level - 1;
2043 end Debug_Decrease_Indent;
2049 function Debug_Name (Tree : Project_Tree_Ref) return Name_Id is
2054 Add_Str_To_Name_Buffer ("Tree [");
2057 while P /= null loop
2058 if P /= Tree.Projects then
2059 Add_Char_To_Name_Buffer (',');
2062 Add_Str_To_Name_Buffer (Get_Name_String (P.Project.Name));
2067 Add_Char_To_Name_Buffer (']');
2076 procedure Free (Tree : in out Project_Tree_Appdata) is
2077 pragma Unreferenced (Tree);
2082 --------------------------------
2083 -- For_Project_And_Aggregated --
2084 --------------------------------
2086 procedure For_Project_And_Aggregated
2087 (Root_Project : Project_Id;
2088 Root_Tree : Project_Tree_Ref)
2090 Agg : Aggregated_Project_List;
2093 Action (Root_Project, Root_Tree);
2095 if Root_Project.Qualifier in Aggregate_Project then
2096 Agg := Root_Project.Aggregated_Projects;
2097 while Agg /= null loop
2098 For_Project_And_Aggregated (Agg.Project, Agg.Tree);
2102 end For_Project_And_Aggregated;
2104 ----------------------------------------
2105 -- For_Project_And_Aggregated_Context --
2106 ----------------------------------------
2108 procedure For_Project_And_Aggregated_Context
2109 (Root_Project : Project_Id;
2110 Root_Tree : Project_Tree_Ref)
2113 procedure Recursive_Process
2114 (Project : Project_Id;
2115 Tree : Project_Tree_Ref;
2116 Context : Project_Context);
2117 -- Process Project and all aggregated projects recursively
2119 -----------------------
2120 -- Recursive_Process --
2121 -----------------------
2123 procedure Recursive_Process
2124 (Project : Project_Id;
2125 Tree : Project_Tree_Ref;
2126 Context : Project_Context)
2128 Agg : Aggregated_Project_List;
2129 Ctx : Project_Context;
2132 Action (Project, Tree, Context);
2134 if Project.Qualifier in Aggregate_Project then
2136 (In_Aggregate_Lib => Project.Qualifier = Aggregate_Library,
2137 From_Encapsulated_Lib =>
2138 Context.From_Encapsulated_Lib
2139 or else Project.Standalone_Library = Encapsulated);
2141 Agg := Project.Aggregated_Projects;
2142 while Agg /= null loop
2143 Recursive_Process (Agg.Project, Agg.Tree, Ctx);
2147 end Recursive_Process;
2149 -- Start of processing for For_Project_And_Aggregated_Context
2153 (Root_Project, Root_Tree, Project_Context'(False, False));
2154 end For_Project_And_Aggregated_Context;
2156 -----------------------------
2157 -- Set_Ignore_Missing_With --
2158 -----------------------------
2160 procedure Set_Ignore_Missing_With
2161 (Flags : in out Processing_Flags;
2165 Flags.Ignore_Missing_With := Value;
2166 end Set_Ignore_Missing_With;
2168 -- Package initialization for Prj
2171 -- Make sure that the standard config and user project file extensions are
2172 -- compatible with canonical case file naming.
2174 Canonical_Case_File_Name (Config_Project_File_Extension);
2175 Canonical_Case_File_Name (Project_File_Extension);