1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2004 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 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Namet; use Namet;
29 with Osint; use Osint;
30 with Output; use Output;
31 with Prj.Com; use Prj.Com;
35 with GNAT.OS_Lib; use GNAT.OS_Lib;
37 package body Prj.Env is
39 type Naming_Id is new Nat;
41 Current_Source_Path_File : Name_Id := No_Name;
42 -- Current value of project source path file env var.
43 -- Used to avoid setting the env var to the same value.
45 Current_Object_Path_File : Name_Id := No_Name;
46 -- Current value of project object path file env var.
47 -- Used to avoid setting the env var to the same value.
49 Ada_Path_Buffer : String_Access := new String (1 .. 1024);
50 -- A buffer where values for ADA_INCLUDE_PATH
51 -- and ADA_OBJECTS_PATH are stored.
53 Ada_Path_Length : Natural := 0;
54 -- Index of the last valid character in Ada_Path_Buffer.
56 Ada_Prj_Include_File_Set : Boolean := False;
57 Ada_Prj_Objects_File_Set : Boolean := False;
58 -- These flags are set to True when the corresponding environment variables
59 -- are set and are used to give these environment variables an empty string
60 -- value at the end of the program. This has no practical effect on most
61 -- platforms, except on VMS where the logical names are deassigned, thus
62 -- avoiding the pollution of the environment of the caller.
64 package Namings is new Table.Table
65 (Table_Component_Type => Naming_Data,
66 Table_Index_Type => Naming_Id,
69 Table_Increment => 100,
70 Table_Name => "Prj.Env.Namings");
72 Default_Naming : constant Naming_Id := Namings.First;
74 Fill_Mapping_File : Boolean := True;
76 package Path_Files is new Table.Table
77 (Table_Component_Type => Name_Id,
78 Table_Index_Type => Natural,
81 Table_Increment => 50,
82 Table_Name => "Prj.Env.Path_Files");
83 -- Table storing all the temp path file names.
84 -- Used by Delete_All_Path_Files.
86 type Project_Flags is array (Project_Id range <>) of Boolean;
87 -- A Boolean array type used in Create_Mapping_File to select the projects
88 -- in the closure of a specific project.
90 package Source_Paths is new Table.Table
91 (Table_Component_Type => Name_Id,
92 Table_Index_Type => Natural,
95 Table_Increment => 50,
96 Table_Name => "Prj.Env.Source_Paths");
97 -- A table to store the source dirs before creating the source path file
99 package Object_Paths is new Table.Table
100 (Table_Component_Type => Name_Id,
101 Table_Index_Type => Natural,
102 Table_Low_Bound => 1,
104 Table_Increment => 50,
105 Table_Name => "Prj.Env.Source_Paths");
106 -- A table to store the object dirs, before creating the object path file
108 -----------------------
109 -- Local Subprograms --
110 -----------------------
112 function Body_Path_Name_Of (Unit : Unit_Id) return String;
113 -- Returns the path name of the body of a unit.
114 -- Compute it first, if necessary.
116 function Spec_Path_Name_Of (Unit : Unit_Id) return String;
117 -- Returns the path name of the spec of a unit.
118 -- Compute it first, if necessary.
120 procedure Add_To_Path (Source_Dirs : String_List_Id);
121 -- Add to Ada_Path_Buffer all the source directories in string list
122 -- Source_Dirs, if any. Increment Ada_Path_Length.
124 procedure Add_To_Path (Dir : String);
125 -- If Dir is not already in the global variable Ada_Path_Buffer, add it.
126 -- Increment Ada_Path_Length.
127 -- If Ada_Path_Length /= 0, prepend a Path_Separator character to
130 procedure Add_To_Source_Path (Source_Dirs : String_List_Id);
131 -- Add to Ada_Path_B all the source directories in string list
132 -- Source_Dirs, if any. Increment Ada_Path_Length.
134 procedure Add_To_Object_Path (Object_Dir : Name_Id);
135 -- Add Object_Dir to object path table. Make sure it is not duplicate
136 -- and it is the last one in the current table.
138 procedure Create_New_Path_File
139 (Path_FD : out File_Descriptor;
140 Path_Name : out Name_Id);
141 -- Create a new temporary path file. Get the file name in Path_Name.
142 -- The name is normally obtained by increasing the number in
143 -- Temp_Path_File_Name by 1.
145 procedure Set_Path_File_Var (Name : String; Value : String);
146 -- Call Setenv, after calling To_Host_File_Spec
148 function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id;
149 -- Return a project that is either Project or an extended ancestor of
150 -- Project that itself is not extended.
152 ----------------------
153 -- Ada_Include_Path --
154 ----------------------
156 function Ada_Include_Path (Project : Project_Id) return String_Access is
158 procedure Add (Project : Project_Id);
159 -- Add all the source directories of a project to the path only if
160 -- this project has not been visited. Calls itself recursively for
161 -- projects being extended, and imported projects. Adds the project
162 -- to the list Seen if this is the call to Add for this project.
168 procedure Add (Project : Project_Id) is
170 -- If Seen is empty, then the project cannot have been visited
172 if not Projects.Table (Project).Seen then
173 Projects.Table (Project).Seen := True;
176 Data : constant Project_Data := Projects.Table (Project);
177 List : Project_List := Data.Imported_Projects;
180 -- Add to path all source directories of this project
182 Add_To_Path (Data.Source_Dirs);
184 -- Call Add to the project being extended, if any
186 if Data.Extends /= No_Project then
190 -- Call Add for each imported project, if any
192 while List /= Empty_Project_List loop
193 Add (Project_Lists.Table (List).Project);
194 List := Project_Lists.Table (List).Next;
200 -- Start of processing for Ada_Include_Path
203 -- If it is the first time we call this function for
204 -- this project, compute the source path
206 if Projects.Table (Project).Ada_Include_Path = null then
207 Ada_Path_Length := 0;
209 for Index in 1 .. Projects.Last loop
210 Projects.Table (Index).Seen := False;
214 Projects.Table (Project).Ada_Include_Path :=
215 new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
218 return Projects.Table (Project).Ada_Include_Path;
219 end Ada_Include_Path;
221 ----------------------
222 -- Ada_Include_Path --
223 ----------------------
225 function Ada_Include_Path
226 (Project : Project_Id;
227 Recursive : Boolean) return String
231 return Ada_Include_Path (Project).all;
233 Ada_Path_Length := 0;
234 Add_To_Path (Projects.Table (Project).Source_Dirs);
235 return Ada_Path_Buffer (1 .. Ada_Path_Length);
237 end Ada_Include_Path;
239 ----------------------
240 -- Ada_Objects_Path --
241 ----------------------
243 function Ada_Objects_Path
244 (Project : Project_Id;
245 Including_Libraries : Boolean := True) return String_Access
247 procedure Add (Project : Project_Id);
248 -- Add all the object directories of a project to the path only if
249 -- this project has not been visited. Calls itself recursively for
250 -- projects being extended, and imported projects. Adds the project
251 -- to the list Seen if this is the first call to Add for this project.
257 procedure Add (Project : Project_Id) is
259 -- If this project has not been seen yet
261 if not Projects.Table (Project).Seen then
262 Projects.Table (Project).Seen := True;
265 Data : constant Project_Data := Projects.Table (Project);
266 List : Project_List := Data.Imported_Projects;
269 -- Add to path the object directory of this project
270 -- except if we don't include library project and
271 -- this is a library project.
273 if (Data.Library and then Including_Libraries)
275 (Data.Object_Directory /= No_Name
277 (not Including_Libraries or else not Data.Library))
279 -- For a library project, add the library directory
282 Add_To_Path (Get_Name_String (Data.Library_Dir));
285 -- For a non library project, add the object directory
287 Add_To_Path (Get_Name_String (Data.Object_Directory));
291 -- Call Add to the project being extended, if any
293 if Data.Extends /= No_Project then
297 -- Call Add for each imported project, if any
299 while List /= Empty_Project_List loop
300 Add (Project_Lists.Table (List).Project);
301 List := Project_Lists.Table (List).Next;
308 -- Start of processing for Ada_Objects_Path
311 -- If it is the first time we call this function for
312 -- this project, compute the objects path
314 if Projects.Table (Project).Ada_Objects_Path = null then
315 Ada_Path_Length := 0;
317 for Index in 1 .. Projects.Last loop
318 Projects.Table (Index).Seen := False;
322 Projects.Table (Project).Ada_Objects_Path :=
323 new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
326 return Projects.Table (Project).Ada_Objects_Path;
327 end Ada_Objects_Path;
329 ------------------------
330 -- Add_To_Object_Path --
331 ------------------------
333 procedure Add_To_Object_Path (Object_Dir : Name_Id) is
335 -- Check if the directory is already in the table
337 for Index in 1 .. Object_Paths.Last loop
339 -- If it is, remove it, and add it as the last one
341 if Object_Paths.Table (Index) = Object_Dir then
342 for Index2 in Index + 1 .. Object_Paths.Last loop
343 Object_Paths.Table (Index2 - 1) :=
344 Object_Paths.Table (Index2);
347 Object_Paths.Table (Object_Paths.Last) := Object_Dir;
352 -- The directory is not already in the table, add it
354 Object_Paths.Increment_Last;
355 Object_Paths.Table (Object_Paths.Last) := Object_Dir;
356 end Add_To_Object_Path;
362 procedure Add_To_Path (Source_Dirs : String_List_Id) is
363 Current : String_List_Id := Source_Dirs;
364 Source_Dir : String_Element;
366 while Current /= Nil_String loop
367 Source_Dir := String_Elements.Table (Current);
368 Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
369 Current := Source_Dir.Next;
373 procedure Add_To_Path (Dir : String) is
375 New_Buffer : String_Access;
378 function Is_Present (Path : String; Dir : String) return Boolean;
379 -- Return True if Dir is part of Path
385 function Is_Present (Path : String; Dir : String) return Boolean is
386 Last : constant Integer := Path'Last - Dir'Length + 1;
389 for J in Path'First .. Last loop
391 -- Note: the order of the conditions below is important, since
392 -- it ensures a minimal number of string comparisons.
395 or else Path (J - 1) = Path_Separator)
397 (J + Dir'Length > Path'Last
398 or else Path (J + Dir'Length) = Path_Separator)
399 and then Dir = Path (J .. J + Dir'Length - 1)
408 -- Start of processing for Add_To_Path
411 if Is_Present (Ada_Path_Buffer (1 .. Ada_Path_Length), Dir) then
413 -- Dir is already in the path, nothing to do
418 Min_Len := Ada_Path_Length + Dir'Length;
420 if Ada_Path_Length > 0 then
422 -- Add 1 for the Path_Separator character
424 Min_Len := Min_Len + 1;
427 -- If Ada_Path_Buffer is too small, increase it
429 Len := Ada_Path_Buffer'Last;
431 if Len < Min_Len then
434 exit when Len >= Min_Len;
437 New_Buffer := new String (1 .. Len);
438 New_Buffer (1 .. Ada_Path_Length) :=
439 Ada_Path_Buffer (1 .. Ada_Path_Length);
440 Free (Ada_Path_Buffer);
441 Ada_Path_Buffer := New_Buffer;
444 if Ada_Path_Length > 0 then
445 Ada_Path_Length := Ada_Path_Length + 1;
446 Ada_Path_Buffer (Ada_Path_Length) := Path_Separator;
450 (Ada_Path_Length + 1 .. Ada_Path_Length + Dir'Length) := Dir;
451 Ada_Path_Length := Ada_Path_Length + Dir'Length;
454 ------------------------
455 -- Add_To_Source_Path --
456 ------------------------
458 procedure Add_To_Source_Path (Source_Dirs : String_List_Id) is
459 Current : String_List_Id := Source_Dirs;
460 Source_Dir : String_Element;
464 -- Add each source directory
466 while Current /= Nil_String loop
467 Source_Dir := String_Elements.Table (Current);
470 -- Check if the source directory is already in the table
472 for Index in 1 .. Source_Paths.Last loop
473 -- If it is already, no need to add it
475 if Source_Paths.Table (Index) = Source_Dir.Value then
482 Source_Paths.Increment_Last;
483 Source_Paths.Table (Source_Paths.Last) := Source_Dir.Value;
486 -- Next source directory
488 Current := Source_Dir.Next;
490 end Add_To_Source_Path;
492 -----------------------
493 -- Body_Path_Name_Of --
494 -----------------------
496 function Body_Path_Name_Of (Unit : Unit_Id) return String is
497 Data : Unit_Data := Units.Table (Unit);
500 -- If we don't know the path name of the body of this unit,
501 -- we compute it, and we store it.
503 if Data.File_Names (Body_Part).Path = No_Name then
505 Current_Source : String_List_Id :=
506 Projects.Table (Data.File_Names (Body_Part).Project).Sources;
507 Path : GNAT.OS_Lib.String_Access;
510 -- By default, put the file name
512 Data.File_Names (Body_Part).Path :=
513 Data.File_Names (Body_Part).Name;
515 -- For each source directory
517 while Current_Source /= Nil_String loop
520 (Namet.Get_Name_String
521 (Data.File_Names (Body_Part).Name),
522 Namet.Get_Name_String
523 (String_Elements.Table (Current_Source).Value));
525 -- If the file is in this directory,
526 -- then we store the path, and we are done.
529 Name_Len := Path'Length;
530 Name_Buffer (1 .. Name_Len) := Path.all;
531 Data.File_Names (Body_Part).Path := Name_Enter;
536 String_Elements.Table (Current_Source).Next;
540 Units.Table (Unit) := Data;
544 -- Returned the stored value
546 return Namet.Get_Name_String (Data.File_Names (Body_Part).Path);
547 end Body_Path_Name_Of;
549 --------------------------------
550 -- Create_Config_Pragmas_File --
551 --------------------------------
553 procedure Create_Config_Pragmas_File
554 (For_Project : Project_Id;
555 Main_Project : Project_Id;
556 Include_Config_Files : Boolean := True)
558 pragma Unreferenced (Main_Project);
559 pragma Unreferenced (Include_Config_Files);
561 File_Name : Name_Id := No_Name;
562 File : File_Descriptor := Invalid_FD;
564 Current_Unit : Unit_Id := Units.First;
566 First_Project : Project_List := Empty_Project_List;
568 Current_Project : Project_List;
569 Current_Naming : Naming_Id;
574 procedure Check (Project : Project_Id);
575 -- Recursive procedure that put in the config pragmas file any non
576 -- standard naming schemes, if it is not already in the file, then call
577 -- itself for any imported project.
579 procedure Check_Temp_File;
580 -- Check that a temporary file has been opened.
581 -- If not, create one, and put its name in the project data,
582 -- with the indication that it is a temporary file.
585 (Unit_Name : Name_Id;
587 Unit_Kind : Spec_Or_Body;
589 -- Put an SFN pragma in the temporary file
591 procedure Put (File : File_Descriptor; S : String);
592 procedure Put_Line (File : File_Descriptor; S : String);
593 -- Output procedures, analogous to normal Text_IO procs of same name
599 procedure Check (Project : Project_Id) is
600 Data : constant Project_Data := Projects.Table (Project);
603 if Current_Verbosity = High then
604 Write_Str ("Checking project file """);
605 Write_Str (Namet.Get_Name_String (Data.Name));
610 -- Is this project in the list of the visited project?
612 Current_Project := First_Project;
613 while Current_Project /= Empty_Project_List
614 and then Project_Lists.Table (Current_Project).Project /= Project
616 Current_Project := Project_Lists.Table (Current_Project).Next;
619 -- If it is not, put it in the list, and visit it
621 if Current_Project = Empty_Project_List then
622 Project_Lists.Increment_Last;
623 Project_Lists.Table (Project_Lists.Last) :=
624 (Project => Project, Next => First_Project);
625 First_Project := Project_Lists.Last;
627 -- Is the naming scheme of this project one that we know?
629 Current_Naming := Default_Naming;
630 while Current_Naming <= Namings.Last and then
631 not Same_Naming_Scheme
632 (Left => Namings.Table (Current_Naming),
633 Right => Data.Naming) loop
634 Current_Naming := Current_Naming + 1;
637 -- If we don't know it, add it
639 if Current_Naming > Namings.Last then
640 Namings.Increment_Last;
641 Namings.Table (Namings.Last) := Data.Naming;
643 -- We need a temporary file to be created
647 -- Put the SFN pragmas for the naming scheme
652 (File, "pragma Source_File_Name_Project");
654 (File, " (Spec_File_Name => ""*" &
655 Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) &
658 (File, " Casing => " &
659 Image (Data.Naming.Casing) & ",");
661 (File, " Dot_Replacement => """ &
662 Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
668 (File, "pragma Source_File_Name_Project");
670 (File, " (Body_File_Name => ""*" &
671 Namet.Get_Name_String (Data.Naming.Current_Body_Suffix) &
674 (File, " Casing => " &
675 Image (Data.Naming.Casing) & ",");
677 (File, " Dot_Replacement => """ &
678 Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
681 -- and maybe separate
684 Data.Naming.Current_Body_Suffix /= Data.Naming.Separate_Suffix
687 (File, "pragma Source_File_Name_Project");
689 (File, " (Subunit_File_Name => ""*" &
690 Namet.Get_Name_String (Data.Naming.Separate_Suffix) &
693 (File, " Casing => " &
694 Image (Data.Naming.Casing) &
697 (File, " Dot_Replacement => """ &
698 Namet.Get_Name_String (Data.Naming.Dot_Replacement) &
703 if Data.Extends /= No_Project then
704 Check (Data.Extends);
708 Current : Project_List := Data.Imported_Projects;
711 while Current /= Empty_Project_List loop
712 Check (Project_Lists.Table (Current).Project);
713 Current := Project_Lists.Table (Current).Next;
719 ---------------------
720 -- Check_Temp_File --
721 ---------------------
723 procedure Check_Temp_File is
725 if File = Invalid_FD then
726 Tempdir.Create_Temp_File (File, Name => File_Name);
728 if File = Invalid_FD then
730 ("unable to create temporary configuration pragmas file");
731 elsif Opt.Verbose_Mode then
732 Write_Str ("Creating temp file """);
733 Write_Str (Get_Name_String (File_Name));
744 (Unit_Name : Name_Id;
746 Unit_Kind : Spec_Or_Body;
750 -- A temporary file needs to be open
754 -- Put the pragma SFN for the unit kind (spec or body)
756 Put (File, "pragma Source_File_Name_Project (");
757 Put (File, Namet.Get_Name_String (Unit_Name));
759 if Unit_Kind = Specification then
760 Put (File, ", Spec_File_Name => """);
762 Put (File, ", Body_File_Name => """);
765 Put (File, Namet.Get_Name_String (File_Name));
769 Put (File, ", Index =>");
770 Put (File, Index'Img);
773 Put_Line (File, ");");
776 procedure Put (File : File_Descriptor; S : String) is
780 Last := Write (File, S (S'First)'Address, S'Length);
782 if Last /= S'Length then
783 Prj.Com.Fail ("Disk full");
786 if Current_Verbosity = High then
795 procedure Put_Line (File : File_Descriptor; S : String) is
796 S0 : String (1 .. S'Length + 1);
800 -- Add an ASCII.LF to the string. As this config file is supposed to
801 -- be used only by the compiler, we don't care about the characters
802 -- for the end of line. In fact we could have put a space, but
803 -- it is more convenient to be able to read gnat.adc during
804 -- development, for which the ASCII.LF is fine.
806 S0 (1 .. S'Length) := S;
807 S0 (S0'Last) := ASCII.LF;
808 Last := Write (File, S0'Address, S0'Length);
810 if Last /= S'Length + 1 then
811 Prj.Com.Fail ("Disk full");
814 if Current_Verbosity = High then
819 -- Start of processing for Create_Config_Pragmas_File
822 if not Projects.Table (For_Project).Config_Checked then
824 -- Remove any memory of processed naming schemes, if any
826 Namings.Set_Last (Default_Naming);
828 -- Check the naming schemes
832 -- Visit all the units and process those that need an SFN pragma
834 while Current_Unit <= Units.Last loop
836 Unit : constant Unit_Data :=
837 Units.Table (Current_Unit);
840 if Unit.File_Names (Specification).Needs_Pragma then
842 Unit.File_Names (Specification).Name,
844 Unit.File_Names (Specification).Index);
847 if Unit.File_Names (Body_Part).Needs_Pragma then
849 Unit.File_Names (Body_Part).Name,
851 Unit.File_Names (Body_Part).Index);
854 Current_Unit := Current_Unit + 1;
858 -- If there are no non standard naming scheme, issue the GNAT
859 -- standard naming scheme. This will tell the compiler that
860 -- a project file is used and will forbid any pragma SFN.
862 if File = Invalid_FD then
865 Put_Line (File, "pragma Source_File_Name_Project");
866 Put_Line (File, " (Spec_File_Name => ""*.ads"",");
867 Put_Line (File, " Dot_Replacement => ""-"",");
868 Put_Line (File, " Casing => lowercase);");
870 Put_Line (File, "pragma Source_File_Name_Project");
871 Put_Line (File, " (Body_File_Name => ""*.adb"",");
872 Put_Line (File, " Dot_Replacement => ""-"",");
873 Put_Line (File, " Casing => lowercase);");
876 -- Close the temporary file
878 GNAT.OS_Lib.Close (File, Status);
881 Prj.Com.Fail ("disk full");
884 if Opt.Verbose_Mode then
885 Write_Str ("Closing configuration file """);
886 Write_Str (Get_Name_String (File_Name));
890 Projects.Table (For_Project).Config_File_Name := File_Name;
891 Projects.Table (For_Project).Config_File_Temp := True;
893 Projects.Table (For_Project).Config_Checked := True;
895 end Create_Config_Pragmas_File;
897 -------------------------
898 -- Create_Mapping_File --
899 -------------------------
901 procedure Create_Mapping_File
902 (Project : Project_Id;
905 File : File_Descriptor := Invalid_FD;
906 The_Unit_Data : Unit_Data;
907 Data : File_Name_Data;
912 Present : Project_Flags (No_Project .. Projects.Last) :=
914 -- For each project in the closure of Project, the corresponding flag
915 -- will be set to True;
917 procedure Put_Name_Buffer;
918 -- Put the line contained in the Name_Buffer in the mapping file
920 procedure Put_Data (Spec : Boolean);
921 -- Put the mapping of the spec or body contained in Data in the file
924 procedure Recursive_Flag (Prj : Project_Id);
925 -- Set the flags corresponding to Prj, the projects it imports
926 -- (directly or indirectly) or extends to True. Call itself recursively.
932 procedure Put_Name_Buffer is
936 Name_Len := Name_Len + 1;
937 Name_Buffer (Name_Len) := ASCII.LF;
938 Last := Write (File, Name_Buffer (1)'Address, Name_Len);
940 if Last /= Name_Len then
941 Prj.Com.Fail ("Disk full");
949 procedure Put_Data (Spec : Boolean) is
951 -- Line with the unit name
953 Get_Name_String (The_Unit_Data.Name);
954 Name_Len := Name_Len + 1;
955 Name_Buffer (Name_Len) := '%';
956 Name_Len := Name_Len + 1;
959 Name_Buffer (Name_Len) := 's';
961 Name_Buffer (Name_Len) := 'b';
966 -- Line with the file name
968 Get_Name_String (Data.Name);
971 -- Line with the path name
973 Get_Name_String (Data.Path);
982 procedure Recursive_Flag (Prj : Project_Id) is
983 Imported : Project_List;
987 -- Nothing to do for non existent project or project that has
988 -- already been flagged.
990 if Prj = No_Project or else Present (Prj) then
994 -- Flag the current project
996 Present (Prj) := True;
997 Imported := Projects.Table (Prj).Imported_Projects;
999 -- Call itself for each project directly imported
1001 while Imported /= Empty_Project_List loop
1002 Proj := Project_Lists.Table (Imported).Project;
1003 Imported := Project_Lists.Table (Imported).Next;
1004 Recursive_Flag (Proj);
1007 -- Call itself for an eventual project being extended
1009 Recursive_Flag (Projects.Table (Prj).Extends);
1012 -- Start of processing for Create_Mapping_File
1015 -- Flag the necessary projects
1017 Recursive_Flag (Project);
1019 -- Create the temporary file
1021 Tempdir.Create_Temp_File (File, Name => Name);
1023 if File = Invalid_FD then
1024 Prj.Com.Fail ("unable to create temporary mapping file");
1026 elsif Opt.Verbose_Mode then
1027 Write_Str ("Creating temp mapping file """);
1028 Write_Str (Get_Name_String (Name));
1032 if Fill_Mapping_File then
1033 -- For all units in table Units
1035 for Unit in 1 .. Units.Last loop
1036 The_Unit_Data := Units.Table (Unit);
1038 -- If the unit has a valid name
1040 if The_Unit_Data.Name /= No_Name then
1041 Data := The_Unit_Data.File_Names (Specification);
1043 -- If there is a spec, put it mapping in the file if it is
1044 -- from a project in the closure of Project.
1046 if Data.Name /= No_Name and then Present (Data.Project) then
1047 Put_Data (Spec => True);
1050 Data := The_Unit_Data.File_Names (Body_Part);
1052 -- If there is a body (or subunit) put its mapping in the file
1053 -- if it is from a project in the closure of Project.
1055 if Data.Name /= No_Name and then Present (Data.Project) then
1056 Put_Data (Spec => False);
1063 GNAT.OS_Lib.Close (File, Status);
1066 Prj.Com.Fail ("disk full");
1068 end Create_Mapping_File;
1070 --------------------------
1071 -- Create_New_Path_File --
1072 --------------------------
1074 procedure Create_New_Path_File
1075 (Path_FD : out File_Descriptor;
1076 Path_Name : out Name_Id)
1079 Tempdir.Create_Temp_File (Path_FD, Path_Name);
1081 if Path_Name /= No_Name then
1083 -- Record the name, so that the temp path file will be deleted
1084 -- at the end of the program.
1086 Path_Files.Increment_Last;
1087 Path_Files.Table (Path_Files.Last) := Path_Name;
1089 end Create_New_Path_File;
1091 ---------------------------
1092 -- Delete_All_Path_Files --
1093 ---------------------------
1095 procedure Delete_All_Path_Files is
1096 Disregard : Boolean := True;
1099 for Index in 1 .. Path_Files.Last loop
1100 if Path_Files.Table (Index) /= No_Name then
1102 (Get_Name_String (Path_Files.Table (Index)), Disregard);
1106 -- If any of the environment variables ADA_PRJ_INCLUDE_FILE or
1107 -- ADA_PRJ_OBJECTS_FILE has been set, then reset their value to
1108 -- the empty string. On VMS, this has the effect of deassigning
1109 -- the logical names.
1111 if Ada_Prj_Include_File_Set then
1112 Setenv (Project_Include_Path_File, "");
1113 Ada_Prj_Include_File_Set := False;
1116 if Ada_Prj_Objects_File_Set then
1117 Setenv (Project_Objects_Path_File, "");
1118 Ada_Prj_Objects_File_Set := False;
1120 end Delete_All_Path_Files;
1122 ------------------------------------
1123 -- File_Name_Of_Library_Unit_Body --
1124 ------------------------------------
1126 function File_Name_Of_Library_Unit_Body
1128 Project : Project_Id;
1129 Main_Project_Only : Boolean := True;
1130 Full_Path : Boolean := False) return String
1132 The_Project : Project_Id := Project;
1133 Data : Project_Data := Projects.Table (Project);
1134 Original_Name : String := Name;
1136 Extended_Spec_Name : String :=
1137 Name & Namet.Get_Name_String
1138 (Data.Naming.Current_Spec_Suffix);
1139 Extended_Body_Name : String :=
1140 Name & Namet.Get_Name_String
1141 (Data.Naming.Current_Body_Suffix);
1145 The_Original_Name : Name_Id;
1146 The_Spec_Name : Name_Id;
1147 The_Body_Name : Name_Id;
1150 Canonical_Case_File_Name (Original_Name);
1151 Name_Len := Original_Name'Length;
1152 Name_Buffer (1 .. Name_Len) := Original_Name;
1153 The_Original_Name := Name_Find;
1155 Canonical_Case_File_Name (Extended_Spec_Name);
1156 Name_Len := Extended_Spec_Name'Length;
1157 Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
1158 The_Spec_Name := Name_Find;
1160 Canonical_Case_File_Name (Extended_Body_Name);
1161 Name_Len := Extended_Body_Name'Length;
1162 Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
1163 The_Body_Name := Name_Find;
1165 if Current_Verbosity = High then
1166 Write_Str ("Looking for file name of """);
1170 Write_Str (" Extended Spec Name = """);
1171 Write_Str (Extended_Spec_Name);
1174 Write_Str (" Extended Body Name = """);
1175 Write_Str (Extended_Body_Name);
1180 -- For extending project, search in the extended project
1181 -- if the source is not found. For non extending projects,
1182 -- this loop will be run only once.
1185 -- Loop through units
1186 -- Should have comment explaining reverse ???
1188 for Current in reverse Units.First .. Units.Last loop
1189 Unit := Units.Table (Current);
1193 if not Main_Project_Only
1194 or else Unit.File_Names (Body_Part).Project = The_Project
1197 Current_Name : constant Name_Id :=
1198 Unit.File_Names (Body_Part).Name;
1201 -- Case of a body present
1203 if Current_Name /= No_Name then
1204 if Current_Verbosity = High then
1205 Write_Str (" Comparing with """);
1206 Write_Str (Get_Name_String (Current_Name));
1211 -- If it has the name of the original name,
1212 -- return the original name
1214 if Unit.Name = The_Original_Name
1215 or else Current_Name = The_Original_Name
1217 if Current_Verbosity = High then
1222 return Get_Name_String
1223 (Unit.File_Names (Body_Part).Path);
1226 return Get_Name_String (Current_Name);
1229 -- If it has the name of the extended body name,
1230 -- return the extended body name
1232 elsif Current_Name = The_Body_Name then
1233 if Current_Verbosity = High then
1238 return Get_Name_String
1239 (Unit.File_Names (Body_Part).Path);
1242 return Extended_Body_Name;
1246 if Current_Verbosity = High then
1247 Write_Line (" not good");
1256 if not Main_Project_Only
1257 or else Unit.File_Names (Specification).Project = The_Project
1260 Current_Name : constant Name_Id :=
1261 Unit.File_Names (Specification).Name;
1264 -- Case of spec present
1266 if Current_Name /= No_Name then
1267 if Current_Verbosity = High then
1268 Write_Str (" Comparing with """);
1269 Write_Str (Get_Name_String (Current_Name));
1274 -- If name same as original name, return original name
1276 if Unit.Name = The_Original_Name
1277 or else Current_Name = The_Original_Name
1279 if Current_Verbosity = High then
1284 return Get_Name_String
1285 (Unit.File_Names (Specification).Path);
1287 return Get_Name_String (Current_Name);
1290 -- If it has the same name as the extended spec name,
1291 -- return the extended spec name.
1293 elsif Current_Name = The_Spec_Name then
1294 if Current_Verbosity = High then
1299 return Get_Name_String
1300 (Unit.File_Names (Specification).Path);
1302 return Extended_Spec_Name;
1306 if Current_Verbosity = High then
1307 Write_Line (" not good");
1315 -- If we are not in an extending project, give up
1317 exit when (not Main_Project_Only) or else Data.Extends = No_Project;
1319 -- Otherwise, look in the project we are extending
1321 The_Project := Data.Extends;
1322 Data := Projects.Table (The_Project);
1325 -- We don't know this file name, return an empty string
1328 end File_Name_Of_Library_Unit_Body;
1330 -------------------------
1331 -- For_All_Object_Dirs --
1332 -------------------------
1334 procedure For_All_Object_Dirs (Project : Project_Id) is
1335 Seen : Project_List := Empty_Project_List;
1337 procedure Add (Project : Project_Id);
1338 -- Process a project. Remember the processes visited to avoid
1339 -- processing a project twice. Recursively process an eventual
1340 -- extended project, and all imported projects.
1346 procedure Add (Project : Project_Id) is
1347 Data : constant Project_Data := Projects.Table (Project);
1348 List : Project_List := Data.Imported_Projects;
1351 -- If the list of visited project is empty, then
1352 -- for sure we never visited this project.
1354 if Seen = Empty_Project_List then
1355 Project_Lists.Increment_Last;
1356 Seen := Project_Lists.Last;
1357 Project_Lists.Table (Seen) :=
1358 (Project => Project, Next => Empty_Project_List);
1361 -- Check if the project is in the list
1364 Current : Project_List := Seen;
1368 -- If it is, then there is nothing else to do
1370 if Project_Lists.Table (Current).Project = Project then
1374 exit when Project_Lists.Table (Current).Next =
1376 Current := Project_Lists.Table (Current).Next;
1379 -- This project has never been visited, add it
1382 Project_Lists.Increment_Last;
1383 Project_Lists.Table (Current).Next := Project_Lists.Last;
1384 Project_Lists.Table (Project_Lists.Last) :=
1385 (Project => Project, Next => Empty_Project_List);
1389 -- If there is an object directory, call Action
1392 if Data.Object_Directory /= No_Name then
1393 Get_Name_String (Data.Object_Directory);
1394 Action (Name_Buffer (1 .. Name_Len));
1397 -- If we are extending a project, visit it
1399 if Data.Extends /= No_Project then
1403 -- And visit all imported projects
1405 while List /= Empty_Project_List loop
1406 Add (Project_Lists.Table (List).Project);
1407 List := Project_Lists.Table (List).Next;
1411 -- Start of processing for For_All_Object_Dirs
1414 -- Visit this project, and its imported projects,
1418 end For_All_Object_Dirs;
1420 -------------------------
1421 -- For_All_Source_Dirs --
1422 -------------------------
1424 procedure For_All_Source_Dirs (Project : Project_Id) is
1425 Seen : Project_List := Empty_Project_List;
1427 procedure Add (Project : Project_Id);
1428 -- Process a project. Remember the processes visited to avoid
1429 -- processing a project twice. Recursively process an eventual
1430 -- extended project, and all imported projects.
1436 procedure Add (Project : Project_Id) is
1437 Data : constant Project_Data := Projects.Table (Project);
1438 List : Project_List := Data.Imported_Projects;
1441 -- If the list of visited project is empty, then
1442 -- for sure we never visited this project.
1444 if Seen = Empty_Project_List then
1445 Project_Lists.Increment_Last;
1446 Seen := Project_Lists.Last;
1447 Project_Lists.Table (Seen) :=
1448 (Project => Project, Next => Empty_Project_List);
1451 -- Check if the project is in the list
1454 Current : Project_List := Seen;
1458 -- If it is, then there is nothing else to do
1460 if Project_Lists.Table (Current).Project = Project then
1464 exit when Project_Lists.Table (Current).Next =
1466 Current := Project_Lists.Table (Current).Next;
1469 -- This project has never been visited, add it
1472 Project_Lists.Increment_Last;
1473 Project_Lists.Table (Current).Next := Project_Lists.Last;
1474 Project_Lists.Table (Project_Lists.Last) :=
1475 (Project => Project, Next => Empty_Project_List);
1480 Current : String_List_Id := Data.Source_Dirs;
1481 The_String : String_Element;
1484 -- If there are Ada sources, call action with the name of every
1485 -- source directory.
1487 if Projects.Table (Project).Ada_Sources_Present then
1488 while Current /= Nil_String loop
1489 The_String := String_Elements.Table (Current);
1490 Action (Get_Name_String (The_String.Value));
1491 Current := The_String.Next;
1496 -- If we are extending a project, visit it
1498 if Data.Extends /= No_Project then
1502 -- And visit all imported projects
1504 while List /= Empty_Project_List loop
1505 Add (Project_Lists.Table (List).Project);
1506 List := Project_Lists.Table (List).Next;
1510 -- Start of processing for For_All_Source_Dirs
1513 -- Visit this project, and its imported projects recursively
1516 end For_All_Source_Dirs;
1522 procedure Get_Reference
1523 (Source_File_Name : String;
1524 Project : out Project_Id;
1528 -- Body below could use some comments ???
1530 if Current_Verbosity > Default then
1531 Write_Str ("Getting Reference_Of (""");
1532 Write_Str (Source_File_Name);
1533 Write_Str (""") ... ");
1537 Original_Name : String := Source_File_Name;
1541 Canonical_Case_File_Name (Original_Name);
1543 for Id in Units.First .. Units.Last loop
1544 Unit := Units.Table (Id);
1546 if (Unit.File_Names (Specification).Name /= No_Name
1548 Namet.Get_Name_String
1549 (Unit.File_Names (Specification).Name) = Original_Name)
1550 or else (Unit.File_Names (Specification).Path /= No_Name
1552 Namet.Get_Name_String
1553 (Unit.File_Names (Specification).Path) =
1556 Project := Ultimate_Extension_Of
1557 (Unit.File_Names (Specification).Project);
1558 Path := Unit.File_Names (Specification).Display_Path;
1560 if Current_Verbosity > Default then
1561 Write_Str ("Done: Specification.");
1567 elsif (Unit.File_Names (Body_Part).Name /= No_Name
1569 Namet.Get_Name_String
1570 (Unit.File_Names (Body_Part).Name) = Original_Name)
1571 or else (Unit.File_Names (Body_Part).Path /= No_Name
1572 and then Namet.Get_Name_String
1573 (Unit.File_Names (Body_Part).Path) =
1576 Project := Ultimate_Extension_Of
1577 (Unit.File_Names (Body_Part).Project);
1578 Path := Unit.File_Names (Body_Part).Display_Path;
1580 if Current_Verbosity > Default then
1581 Write_Str ("Done: Body.");
1590 Project := No_Project;
1593 if Current_Verbosity > Default then
1594 Write_Str ("Cannot be found.");
1603 -- This is a place holder for possible required initialization in
1604 -- the future. In the current version no initialization is required.
1606 procedure Initialize is
1611 ------------------------------------
1612 -- Path_Name_Of_Library_Unit_Body --
1613 ------------------------------------
1615 -- Could use some comments in the body here ???
1617 function Path_Name_Of_Library_Unit_Body
1619 Project : Project_Id) return String
1621 Data : constant Project_Data := Projects.Table (Project);
1622 Original_Name : String := Name;
1624 Extended_Spec_Name : String :=
1625 Name & Namet.Get_Name_String
1626 (Data.Naming.Current_Spec_Suffix);
1627 Extended_Body_Name : String :=
1628 Name & Namet.Get_Name_String
1629 (Data.Naming.Current_Body_Suffix);
1631 First : Unit_Id := Units.First;
1636 Canonical_Case_File_Name (Original_Name);
1637 Canonical_Case_File_Name (Extended_Spec_Name);
1638 Canonical_Case_File_Name (Extended_Body_Name);
1640 if Current_Verbosity = High then
1641 Write_Str ("Looking for path name of """);
1645 Write_Str (" Extended Spec Name = """);
1646 Write_Str (Extended_Spec_Name);
1649 Write_Str (" Extended Body Name = """);
1650 Write_Str (Extended_Body_Name);
1655 while First <= Units.Last
1656 and then Units.Table (First).File_Names (Body_Part).Project /= Project
1662 while Current <= Units.Last loop
1663 Unit := Units.Table (Current);
1665 if Unit.File_Names (Body_Part).Project = Project
1666 and then Unit.File_Names (Body_Part).Name /= No_Name
1669 Current_Name : constant String :=
1670 Namet.Get_Name_String (Unit.File_Names (Body_Part).Name);
1672 if Current_Verbosity = High then
1673 Write_Str (" Comparing with """);
1674 Write_Str (Current_Name);
1679 if Current_Name = Original_Name then
1680 if Current_Verbosity = High then
1684 return Body_Path_Name_Of (Current);
1686 elsif Current_Name = Extended_Body_Name then
1687 if Current_Verbosity = High then
1691 return Body_Path_Name_Of (Current);
1694 if Current_Verbosity = High then
1695 Write_Line (" not good");
1700 elsif Unit.File_Names (Specification).Name /= No_Name then
1702 Current_Name : constant String :=
1703 Namet.Get_Name_String
1704 (Unit.File_Names (Specification).Name);
1707 if Current_Verbosity = High then
1708 Write_Str (" Comparing with """);
1709 Write_Str (Current_Name);
1714 if Current_Name = Original_Name then
1715 if Current_Verbosity = High then
1719 return Spec_Path_Name_Of (Current);
1721 elsif Current_Name = Extended_Spec_Name then
1722 if Current_Verbosity = High then
1726 return Spec_Path_Name_Of (Current);
1729 if Current_Verbosity = High then
1730 Write_Line (" not good");
1735 Current := Current + 1;
1739 end Path_Name_Of_Library_Unit_Body;
1745 -- Could use some comments in this body ???
1747 procedure Print_Sources is
1751 Write_Line ("List of Sources:");
1753 for Id in Units.First .. Units.Last loop
1754 Unit := Units.Table (Id);
1756 Write_Line (Namet.Get_Name_String (Unit.Name));
1758 if Unit.File_Names (Specification).Name /= No_Name then
1759 if Unit.File_Names (Specification).Project = No_Project then
1760 Write_Line (" No project");
1763 Write_Str (" Project: ");
1766 (Unit.File_Names (Specification).Project).Path_Name);
1767 Write_Line (Name_Buffer (1 .. Name_Len));
1770 Write_Str (" spec: ");
1772 (Namet.Get_Name_String
1773 (Unit.File_Names (Specification).Name));
1776 if Unit.File_Names (Body_Part).Name /= No_Name then
1777 if Unit.File_Names (Body_Part).Project = No_Project then
1778 Write_Line (" No project");
1781 Write_Str (" Project: ");
1784 (Unit.File_Names (Body_Part).Project).Path_Name);
1785 Write_Line (Name_Buffer (1 .. Name_Len));
1788 Write_Str (" body: ");
1790 (Namet.Get_Name_String
1791 (Unit.File_Names (Body_Part).Name));
1795 Write_Line ("end of List of Sources.");
1804 Main_Project : Project_Id) return Project_Id
1806 Result : Project_Id := No_Project;
1808 Original_Name : String := Name;
1810 Data : constant Project_Data := Projects.Table (Main_Project);
1812 Extended_Spec_Name : String :=
1813 Name & Namet.Get_Name_String
1814 (Data.Naming.Current_Spec_Suffix);
1815 Extended_Body_Name : String :=
1816 Name & Namet.Get_Name_String
1817 (Data.Naming.Current_Body_Suffix);
1821 Current_Name : Name_Id;
1823 The_Original_Name : Name_Id;
1824 The_Spec_Name : Name_Id;
1825 The_Body_Name : Name_Id;
1828 Canonical_Case_File_Name (Original_Name);
1829 Name_Len := Original_Name'Length;
1830 Name_Buffer (1 .. Name_Len) := Original_Name;
1831 The_Original_Name := Name_Find;
1833 Canonical_Case_File_Name (Extended_Spec_Name);
1834 Name_Len := Extended_Spec_Name'Length;
1835 Name_Buffer (1 .. Name_Len) := Extended_Spec_Name;
1836 The_Spec_Name := Name_Find;
1838 Canonical_Case_File_Name (Extended_Body_Name);
1839 Name_Len := Extended_Body_Name'Length;
1840 Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
1841 The_Body_Name := Name_Find;
1843 for Current in reverse Units.First .. Units.Last loop
1844 Unit := Units.Table (Current);
1848 Current_Name := Unit.File_Names (Body_Part).Name;
1850 -- Case of a body present
1852 if Current_Name /= No_Name then
1854 -- If it has the name of the original name or the body name,
1855 -- we have found the project.
1857 if Unit.Name = The_Original_Name
1858 or else Current_Name = The_Original_Name
1859 or else Current_Name = The_Body_Name
1861 Result := Unit.File_Names (Body_Part).Project;
1868 Current_Name := Unit.File_Names (Specification).Name;
1870 if Current_Name /= No_Name then
1872 -- If name same as the original name, or the spec name, we have
1873 -- found the project.
1875 if Unit.Name = The_Original_Name
1876 or else Current_Name = The_Original_Name
1877 or else Current_Name = The_Spec_Name
1879 Result := Unit.File_Names (Specification).Project;
1885 -- Get the ultimate extending project
1887 if Result /= No_Project then
1888 while Projects.Table (Result).Extended_By /= No_Project loop
1889 Result := Projects.Table (Result).Extended_By;
1900 procedure Set_Ada_Paths
1901 (Project : Project_Id;
1902 Including_Libraries : Boolean)
1904 Source_FD : File_Descriptor := Invalid_FD;
1905 Object_FD : File_Descriptor := Invalid_FD;
1907 Process_Source_Dirs : Boolean := False;
1908 Process_Object_Dirs : Boolean := False;
1911 -- For calls to Close
1915 procedure Add (Proj : Project_Id);
1916 -- Add all the source/object directories of a project to the path only
1917 -- if this project has not been visited. Calls an internal procedure
1918 -- recursively for projects being extended, and imported projects.
1924 procedure Add (Proj : Project_Id) is
1926 procedure Recursive_Add (Project : Project_Id);
1927 -- Recursive procedure to add the source/object paths of extended/
1928 -- imported projects.
1934 procedure Recursive_Add (Project : Project_Id) is
1936 -- If Seen is False, then the project has not yet been visited
1938 if not Projects.Table (Project).Seen then
1939 Projects.Table (Project).Seen := True;
1942 Data : constant Project_Data := Projects.Table (Project);
1943 List : Project_List := Data.Imported_Projects;
1946 if Process_Source_Dirs then
1948 -- Add to path all source directories of this project
1949 -- if there are Ada sources.
1951 if Projects.Table (Project).Ada_Sources_Present then
1952 Add_To_Source_Path (Data.Source_Dirs);
1956 if Process_Object_Dirs then
1958 -- Add to path the object directory of this project
1959 -- except if we don't include library project and
1960 -- this is a library project.
1962 if (Data.Library and then Including_Libraries)
1964 (Data.Object_Directory /= No_Name
1966 (not Including_Libraries or else not Data.Library))
1968 -- For a library project, add the library directory
1970 if Data.Library then
1971 Add_To_Object_Path (Data.Library_Dir);
1973 -- For a non-library project, add the object
1974 -- directory, if it is not a virtual project.
1976 elsif not Data.Virtual then
1977 Add_To_Object_Path (Data.Object_Directory);
1982 -- Call Add to the project being extended, if any
1984 if Data.Extends /= No_Project then
1985 Recursive_Add (Data.Extends);
1988 -- Call Add for each imported project, if any
1990 while List /= Empty_Project_List loop
1991 Recursive_Add (Project_Lists.Table (List).Project);
1992 List := Project_Lists.Table (List).Next;
1999 Source_Paths.Set_Last (0);
2000 Object_Paths.Set_Last (0);
2002 for Index in 1 .. Projects.Last loop
2003 Projects.Table (Index).Seen := False;
2006 Recursive_Add (Proj);
2009 -- Start of processing for Set_Ada_Paths
2012 -- If it is the first time we call this procedure for
2013 -- this project, compute the source path and/or the object path.
2015 if Projects.Table (Project).Include_Path_File = No_Name then
2016 Process_Source_Dirs := True;
2017 Create_New_Path_File
2018 (Source_FD, Projects.Table (Project).Include_Path_File);
2021 -- For the object path, we make a distinction depending on
2022 -- Including_Libraries.
2024 if Including_Libraries then
2025 if Projects.Table (Project).Objects_Path_File_With_Libs = No_Name then
2026 Process_Object_Dirs := True;
2027 Create_New_Path_File
2028 (Object_FD, Projects.Table (Project).
2029 Objects_Path_File_With_Libs);
2034 Projects.Table (Project).Objects_Path_File_Without_Libs = No_Name
2036 Process_Object_Dirs := True;
2037 Create_New_Path_File
2038 (Object_FD, Projects.Table (Project).
2039 Objects_Path_File_Without_Libs);
2043 -- If there is something to do, set Seen to False for all projects,
2044 -- then call the recursive procedure Add for Project.
2046 if Process_Source_Dirs or Process_Object_Dirs then
2050 -- Write and close any file that has been created.
2052 if Source_FD /= Invalid_FD then
2053 for Index in 1 .. Source_Paths.Last loop
2054 Get_Name_String (Source_Paths.Table (Index));
2055 Name_Len := Name_Len + 1;
2056 Name_Buffer (Name_Len) := ASCII.LF;
2057 Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len);
2059 if Len /= Name_Len then
2060 Prj.Com.Fail ("disk full");
2064 Close (Source_FD, Status);
2067 Prj.Com.Fail ("disk full");
2071 if Object_FD /= Invalid_FD then
2072 for Index in 1 .. Object_Paths.Last loop
2073 Get_Name_String (Object_Paths.Table (Index));
2074 Name_Len := Name_Len + 1;
2075 Name_Buffer (Name_Len) := ASCII.LF;
2076 Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len);
2078 if Len /= Name_Len then
2079 Prj.Com.Fail ("disk full");
2083 Close (Object_FD, Status);
2086 Prj.Com.Fail ("disk full");
2090 -- Set the env vars, if they need to be changed, and set the
2091 -- corresponding flags.
2093 if Current_Source_Path_File /=
2094 Projects.Table (Project).Include_Path_File
2096 Current_Source_Path_File :=
2097 Projects.Table (Project).Include_Path_File;
2099 (Project_Include_Path_File,
2100 Get_Name_String (Current_Source_Path_File));
2101 Ada_Prj_Include_File_Set := True;
2104 if Including_Libraries then
2105 if Current_Object_Path_File
2106 /= Projects.Table (Project).Objects_Path_File_With_Libs
2108 Current_Object_Path_File :=
2109 Projects.Table (Project).Objects_Path_File_With_Libs;
2111 (Project_Objects_Path_File,
2112 Get_Name_String (Current_Object_Path_File));
2113 Ada_Prj_Objects_File_Set := True;
2117 if Current_Object_Path_File
2118 /= Projects.Table (Project).Objects_Path_File_Without_Libs
2120 Current_Object_Path_File :=
2121 Projects.Table (Project).Objects_Path_File_Without_Libs;
2123 (Project_Objects_Path_File,
2124 Get_Name_String (Current_Object_Path_File));
2125 Ada_Prj_Objects_File_Set := True;
2130 ---------------------------------------------
2131 -- Set_Mapping_File_Initial_State_To_Empty --
2132 ---------------------------------------------
2134 procedure Set_Mapping_File_Initial_State_To_Empty is
2136 Fill_Mapping_File := False;
2137 end Set_Mapping_File_Initial_State_To_Empty;
2139 -----------------------
2140 -- Set_Path_File_Var --
2141 -----------------------
2143 procedure Set_Path_File_Var (Name : String; Value : String) is
2144 Host_Spec : String_Access := To_Host_File_Spec (Value);
2147 if Host_Spec = null then
2149 ("could not convert file name """, Value, """ to host spec");
2151 Setenv (Name, Host_Spec.all);
2154 end Set_Path_File_Var;
2156 -----------------------
2157 -- Spec_Path_Name_Of --
2158 -----------------------
2160 function Spec_Path_Name_Of (Unit : Unit_Id) return String is
2161 Data : Unit_Data := Units.Table (Unit);
2164 if Data.File_Names (Specification).Path = No_Name then
2166 Current_Source : String_List_Id :=
2167 Projects.Table (Data.File_Names (Specification).Project).Sources;
2168 Path : GNAT.OS_Lib.String_Access;
2171 Data.File_Names (Specification).Path :=
2172 Data.File_Names (Specification).Name;
2174 while Current_Source /= Nil_String loop
2175 Path := Locate_Regular_File
2176 (Namet.Get_Name_String
2177 (Data.File_Names (Specification).Name),
2178 Namet.Get_Name_String
2179 (String_Elements.Table (Current_Source).Value));
2181 if Path /= null then
2182 Name_Len := Path'Length;
2183 Name_Buffer (1 .. Name_Len) := Path.all;
2184 Data.File_Names (Specification).Path := Name_Enter;
2188 String_Elements.Table (Current_Source).Next;
2192 Units.Table (Unit) := Data;
2196 return Namet.Get_Name_String (Data.File_Names (Specification).Path);
2197 end Spec_Path_Name_Of;
2199 ---------------------------
2200 -- Ultimate_Extension_Of --
2201 ---------------------------
2203 function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id
2205 Result : Project_Id := Project;
2208 while Projects.Table (Result).Extended_By /= No_Project loop
2209 Result := Projects.Table (Result).Extended_By;
2213 end Ultimate_Extension_Of;
2215 -- Package initialization
2216 -- What is relationshiop to procedure Initialize
2219 Path_Files.Set_Last (0);