1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This package implements services for Project-aware tools, mostly related
27 -- to the environment (configuration pragma files, path files, mapping files).
29 with GNAT
.Dynamic_HTables
;
34 procedure Initialize
(In_Tree
: Project_Tree_Ref
);
35 -- Initialize global components relative to environment variables
37 procedure Print_Sources
(In_Tree
: Project_Tree_Ref
);
38 -- Output the list of sources, after Project files have been scanned
40 procedure Create_Mapping
(In_Tree
: Project_Tree_Ref
);
41 -- Create in memory mapping from the sources of all the projects (in body
42 -- of package Fmap), so that Osint.Find_File will find the correct path
43 -- corresponding to a source.
45 procedure Create_Temp_File
46 (In_Tree
: Project_Tree_Ref
;
47 Path_FD
: out File_Descriptor
;
48 Path_Name
: out Path_Name_Type
;
50 -- Create temporary file, and fail with an error if it could not be created
52 procedure Create_Mapping_File
53 (Project
: Project_Id
;
55 In_Tree
: Project_Tree_Ref
;
56 Name
: out Path_Name_Type
);
57 -- Create a temporary mapping file for project Project. For each source or
58 -- template of Language in the Project, put the mapping of its file
59 -- name and path name in this file.
61 -- Implementation note: we pass a language name, not a language_index here,
62 -- since the latter would have to match exactly the index of that language
63 -- for the specified project, and that is not information available in
66 -- See fmap for a description of the format of the mapping file
68 procedure Create_Config_Pragmas_File
69 (For_Project
: Project_Id
;
70 In_Tree
: Project_Tree_Ref
);
71 -- If there needs to have SFN pragmas, either for non standard naming
72 -- schemes or for individual units.
74 procedure Create_New_Path_File
75 (In_Tree
: Project_Tree_Ref
;
76 Path_FD
: out File_Descriptor
;
77 Path_Name
: out Path_Name_Type
);
78 -- Create a new temporary path file. Get the file name in Path_Name.
80 function Ada_Include_Path
81 (Project
: Project_Id
;
82 In_Tree
: Project_Tree_Ref
;
83 Recursive
: Boolean := False) return String;
84 -- Get the source search path of a Project file. If Recursive it True, get
85 -- all the source directories of the imported and modified project files
86 -- (recursively). If Recursive is False, just get the path for the source
87 -- directories of Project. Note: the resulting String may be empty if there
88 -- is no source directory in the project file.
90 function Ada_Objects_Path
91 (Project
: Project_Id
;
92 Including_Libraries
: Boolean := True) return String_Access
;
93 -- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute
94 -- it and cache it. When Including_Libraries is False, do not include the
95 -- object directories of the library projects, and do not cache the result.
97 procedure Set_Ada_Paths
98 (Project
: Project_Id
;
99 In_Tree
: Project_Tree_Ref
;
100 Including_Libraries
: Boolean;
101 Include_Path
: Boolean := True;
102 Objects_Path
: Boolean := True);
103 -- Set the environment variables for additional project path files, after
104 -- creating the path files if necessary.
106 function File_Name_Of_Library_Unit_Body
108 Project
: Project_Id
;
109 In_Tree
: Project_Tree_Ref
;
110 Main_Project_Only
: Boolean := True;
111 Full_Path
: Boolean := False) return String;
112 -- Returns the file name of a library unit, in canonical case. Name may or
113 -- may not have an extension (corresponding to the naming scheme of the
114 -- project). If there is no body with this name, but there is a spec, the
115 -- name of the spec is returned.
117 -- If Full_Path is False (the default), the simple file name is returned.
119 -- If Full_Path is True, the absolute path name is returned.
121 -- If neither a body nor a spec can be found, an empty string is returned.
122 -- If Main_Project_Only is True, the unit must be an immediate source of
123 -- Project. If it is False, it may be a source of one of its imported
128 Main_Project
: Project_Id
;
129 In_Tree
: Project_Tree_Ref
) return Project_Id
;
130 -- Get the project of a source. The source file name may be truncated
131 -- (".adb" or ".ads" may be missing). If the source is in a project being
132 -- extended, return the ultimate extending project. If it is not a source
133 -- of any project, return No_Project.
135 procedure Get_Reference
136 (Source_File_Name
: String;
137 In_Tree
: Project_Tree_Ref
;
138 Project
: out Project_Id
;
139 Path
: out Path_Name_Type
);
140 -- Returns the project of a source and its path in displayable form
143 with procedure Action
(Path
: String);
144 procedure For_All_Source_Dirs
145 (Project
: Project_Id
;
146 In_Tree
: Project_Tree_Ref
);
147 -- Iterate through all the source directories of a project, including those
148 -- of imported or modified projects. Only returns those directories that
149 -- potentially contain Ada sources (ie ignore projects that have no Ada
153 with procedure Action
(Path
: String);
154 procedure For_All_Object_Dirs
(Project
: Project_Id
);
155 -- Iterate through all the object directories of a project, including
156 -- those of imported or modified projects.
162 type Project_Search_Path
is private;
163 -- An abstraction of the project path. This object provides subprograms to
164 -- search for projects on the path (and caches the results for more
167 procedure Free
(Self
: in out Project_Search_Path
);
168 -- Free the memory used by Self
170 procedure Add_Directories
171 (Self
: in out Project_Search_Path
;
173 -- Add one or more directories to the path. Directories added with this
174 -- procedure are added in order after the current directory and before the
175 -- path given by the environment variable GPR_PROJECT_PATH. A value of "-"
176 -- will remove the default project directory from the project path.
178 -- Calls to this subprogram must be performed before the first call to
179 -- Find_Project below, or PATH will be added at the end of the search
183 (Self
: in out Project_Search_Path
;
184 Path
: out String_Access
);
185 -- Return the current value of the project path, either the value set
186 -- during elaboration of the package or, if procedure Set_Project_Path has
187 -- been called, the value set by the last call to Set_Project_Path.
188 -- The returned value must not be modified.
191 (Self
: in out Project_Search_Path
; Path
: String);
192 -- Override the value of the project path.
193 -- This also removes the implicit default search directories
195 procedure Find_Project
196 (Self
: in out Project_Search_Path
;
197 Project_File_Name
: String;
199 Path
: out Namet
.Path_Name_Type
);
200 -- Search for a the project with the given name either in Directory (which
201 -- often will be the directory contain the project we are currently parsing
202 -- and which we found a reference to another project), or in the project
203 -- path. Extra_Project_Path contains additional directories to search.
205 -- Project_File_Name can optionally contain directories, and the extension
206 -- (.gpr) for the file name is optional.
208 -- Returns No_Name if no such project was found
211 package Projects_Paths
is new GNAT
.Dynamic_HTables
.Simple_HTable
212 (Header_Num
=> Header_Num
,
213 Element
=> Path_Name_Type
,
214 No_Element
=> No_Path
,
219 type Project_Search_Path
is record
220 Path
: GNAT
.OS_Lib
.String_Access
;
221 -- As a special case, if the first character is '#:" or this variable is
222 -- unset, this means that the PATH has not been fully initialized yet
223 -- (although subprograms above will properly take care of that).
225 Cache
: Projects_Paths
.Instance
;