1 |
281 |
jeremybenn |
------------------------------------------------------------------------------
|
2 |
|
|
-- --
|
3 |
|
|
-- GNAT COMPILER COMPONENTS --
|
4 |
|
|
-- --
|
5 |
|
|
-- M A K E U T L --
|
6 |
|
|
-- --
|
7 |
|
|
-- S p e c --
|
8 |
|
|
-- --
|
9 |
|
|
-- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
|
10 |
|
|
-- --
|
11 |
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
12 |
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
13 |
|
|
-- ware Foundation; either version 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. --
|
20 |
|
|
-- --
|
21 |
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
22 |
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
23 |
|
|
-- --
|
24 |
|
|
------------------------------------------------------------------------------
|
25 |
|
|
|
26 |
|
|
with ALI;
|
27 |
|
|
with Namet; use Namet;
|
28 |
|
|
with Opt;
|
29 |
|
|
with Osint;
|
30 |
|
|
with Prj; use Prj;
|
31 |
|
|
with Prj.Tree;
|
32 |
|
|
with Types; use Types;
|
33 |
|
|
|
34 |
|
|
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
35 |
|
|
|
36 |
|
|
package Makeutl is
|
37 |
|
|
|
38 |
|
|
type Fail_Proc is access procedure (S : String);
|
39 |
|
|
Do_Fail : Fail_Proc := Osint.Fail'Access;
|
40 |
|
|
-- Failing procedure called from procedure Test_If_Relative_Path below. May
|
41 |
|
|
-- be redirected.
|
42 |
|
|
|
43 |
|
|
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
|
44 |
|
|
-- The project tree
|
45 |
|
|
|
46 |
|
|
Subdirs_Option : constant String := "--subdirs=";
|
47 |
|
|
-- Switch used to indicate that the real directories (object, exec,
|
48 |
|
|
-- library, ...) are subdirectories of those in the project file.
|
49 |
|
|
|
50 |
|
|
procedure Add
|
51 |
|
|
(Option : String_Access;
|
52 |
|
|
To : in out String_List_Access;
|
53 |
|
|
Last : in out Natural);
|
54 |
|
|
procedure Add
|
55 |
|
|
(Option : String;
|
56 |
|
|
To : in out String_List_Access;
|
57 |
|
|
Last : in out Natural);
|
58 |
|
|
-- Add a string to a list of strings
|
59 |
|
|
|
60 |
|
|
function Create_Name (Name : String) return File_Name_Type;
|
61 |
|
|
function Create_Name (Name : String) return Name_Id;
|
62 |
|
|
function Create_Name (Name : String) return Path_Name_Type;
|
63 |
|
|
-- Get an id for a name
|
64 |
|
|
|
65 |
|
|
function Base_Name_Index_For
|
66 |
|
|
(Main : String;
|
67 |
|
|
Main_Index : Int;
|
68 |
|
|
Index_Separator : Character) return File_Name_Type;
|
69 |
|
|
-- Returns the base name of Main, without the extension, followed by the
|
70 |
|
|
-- Index_Separator followed by the Main_Index if it is non-zero.
|
71 |
|
|
|
72 |
|
|
function Executable_Prefix_Path return String;
|
73 |
|
|
-- Return the absolute path parent directory of the directory where the
|
74 |
|
|
-- current executable resides, if its directory is named "bin", otherwise
|
75 |
|
|
-- return an empty string. When a directory is returned, it is guaranteed
|
76 |
|
|
-- to end with a directory separator.
|
77 |
|
|
|
78 |
|
|
procedure Inform (N : Name_Id := No_Name; Msg : String);
|
79 |
|
|
procedure Inform (N : File_Name_Type; Msg : String);
|
80 |
|
|
-- Prints out the program name followed by a colon, N and S
|
81 |
|
|
|
82 |
|
|
function File_Not_A_Source_Of
|
83 |
|
|
(Uname : Name_Id;
|
84 |
|
|
Sfile : File_Name_Type) return Boolean;
|
85 |
|
|
-- Check that file name Sfile is one of the source of unit Uname. Returns
|
86 |
|
|
-- True if the unit is in one of the project file, but the file name is not
|
87 |
|
|
-- one of its source. Returns False otherwise.
|
88 |
|
|
|
89 |
|
|
function Check_Source_Info_In_ALI (The_ALI : ALI.ALI_Id) return Boolean;
|
90 |
|
|
-- Check whether all file references in ALI are still valid (i.e. the
|
91 |
|
|
-- source files are still associated with the same units). Return True
|
92 |
|
|
-- if everything is still valid.
|
93 |
|
|
|
94 |
|
|
function Is_External_Assignment
|
95 |
|
|
(Tree : Prj.Tree.Project_Node_Tree_Ref;
|
96 |
|
|
Argv : String) return Boolean;
|
97 |
|
|
-- Verify that an external assignment switch is syntactically correct
|
98 |
|
|
--
|
99 |
|
|
-- Correct forms are:
|
100 |
|
|
--
|
101 |
|
|
-- -Xname=value
|
102 |
|
|
-- -X"name=other value"
|
103 |
|
|
--
|
104 |
|
|
-- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
|
105 |
|
|
--
|
106 |
|
|
-- When this function returns True, the external assignment has been
|
107 |
|
|
-- entered by a call to Prj.Ext.Add, so that in a project file, External
|
108 |
|
|
-- ("name") will return "value".
|
109 |
|
|
|
110 |
|
|
procedure Verbose_Msg
|
111 |
|
|
(N1 : Name_Id;
|
112 |
|
|
S1 : String;
|
113 |
|
|
N2 : Name_Id := No_Name;
|
114 |
|
|
S2 : String := "";
|
115 |
|
|
Prefix : String := " -> ";
|
116 |
|
|
Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
|
117 |
|
|
procedure Verbose_Msg
|
118 |
|
|
(N1 : File_Name_Type;
|
119 |
|
|
S1 : String;
|
120 |
|
|
N2 : File_Name_Type := No_File;
|
121 |
|
|
S2 : String := "";
|
122 |
|
|
Prefix : String := " -> ";
|
123 |
|
|
Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
|
124 |
|
|
-- If the verbose flag (Verbose_Mode) is set and the verbosity level is at
|
125 |
|
|
-- least equal to Minimum_Verbosity, then print Prefix to standard output
|
126 |
|
|
-- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
|
127 |
|
|
-- is printed last. Both N1 and N2 are printed in quotation marks. The two
|
128 |
|
|
-- forms differ only in taking Name_Id or File_name_Type arguments.
|
129 |
|
|
|
130 |
|
|
function Linker_Options_Switches
|
131 |
|
|
(Project : Project_Id;
|
132 |
|
|
In_Tree : Project_Tree_Ref) return String_List;
|
133 |
|
|
-- Collect the options specified in the Linker'Linker_Options attributes
|
134 |
|
|
-- of project Project, in project tree In_Tree, and in the projects that
|
135 |
|
|
-- it imports directly or indirectly, and returns the result.
|
136 |
|
|
|
137 |
|
|
-- Package Mains is used to store the mains specified on the command line
|
138 |
|
|
-- and to retrieve them when a project file is used, to verify that the
|
139 |
|
|
-- files exist and that they belong to a project file.
|
140 |
|
|
|
141 |
|
|
function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
|
142 |
|
|
-- Find the index of a unit in a source file. Return zero if the file is
|
143 |
|
|
-- not a multi-unit source file.
|
144 |
|
|
|
145 |
|
|
procedure Test_If_Relative_Path
|
146 |
|
|
(Switch : in out String_Access;
|
147 |
|
|
Parent : String;
|
148 |
|
|
Including_L_Switch : Boolean := True;
|
149 |
|
|
Including_Non_Switch : Boolean := True;
|
150 |
|
|
Including_RTS : Boolean := False);
|
151 |
|
|
-- Test if Switch is a relative search path switch. If it is, fail if
|
152 |
|
|
-- Parent is the empty string, otherwise prepend the path with Parent.
|
153 |
|
|
-- This subprogram is only called when using project files. For gnatbind
|
154 |
|
|
-- switches, Including_L_Switch is False, because the argument of the -L
|
155 |
|
|
-- switch is not a path. If Including_RTS is True, process also switches
|
156 |
|
|
-- --RTS=.
|
157 |
|
|
|
158 |
|
|
function Path_Or_File_Name (Path : Path_Name_Type) return String;
|
159 |
|
|
-- Returns a file name if -df is used, otherwise return a path name
|
160 |
|
|
|
161 |
|
|
-----------
|
162 |
|
|
-- Mains --
|
163 |
|
|
-----------
|
164 |
|
|
|
165 |
|
|
-- Mains are stored in a table. An index is used to retrieve the mains
|
166 |
|
|
-- from the table.
|
167 |
|
|
|
168 |
|
|
package Mains is
|
169 |
|
|
|
170 |
|
|
procedure Add_Main (Name : String);
|
171 |
|
|
-- Add one main to the table
|
172 |
|
|
|
173 |
|
|
procedure Set_Index (Index : Int);
|
174 |
|
|
|
175 |
|
|
procedure Set_Location (Location : Source_Ptr);
|
176 |
|
|
-- Set the location of the last main added. By default, the location is
|
177 |
|
|
-- No_Location.
|
178 |
|
|
|
179 |
|
|
procedure Delete;
|
180 |
|
|
-- Empty the table
|
181 |
|
|
|
182 |
|
|
procedure Reset;
|
183 |
|
|
-- Reset the index to the beginning of the table
|
184 |
|
|
|
185 |
|
|
function Next_Main return String;
|
186 |
|
|
-- Increase the index and return the next main. If table is exhausted,
|
187 |
|
|
-- return an empty string.
|
188 |
|
|
|
189 |
|
|
function Get_Index return Int;
|
190 |
|
|
|
191 |
|
|
function Get_Location return Source_Ptr;
|
192 |
|
|
-- Get the location of the current main
|
193 |
|
|
|
194 |
|
|
procedure Update_Main (Name : String);
|
195 |
|
|
-- Update the file name of the current main
|
196 |
|
|
|
197 |
|
|
function Number_Of_Mains return Natural;
|
198 |
|
|
-- Returns the number of mains added with Add_Main since the last call
|
199 |
|
|
-- to Delete.
|
200 |
|
|
|
201 |
|
|
end Mains;
|
202 |
|
|
|
203 |
|
|
----------------------
|
204 |
|
|
-- Marking Routines --
|
205 |
|
|
----------------------
|
206 |
|
|
|
207 |
|
|
procedure Mark (Source_File : File_Name_Type; Index : Int := 0);
|
208 |
|
|
-- Mark a unit, identified by its source file and, when Index is not 0, the
|
209 |
|
|
-- index of the unit in the source file. Marking is used to signal that the
|
210 |
|
|
-- unit has already been inserted in the Q.
|
211 |
|
|
|
212 |
|
|
function Is_Marked
|
213 |
|
|
(Source_File : File_Name_Type;
|
214 |
|
|
Index : Int := 0) return Boolean;
|
215 |
|
|
-- Returns True if the unit was previously marked
|
216 |
|
|
|
217 |
|
|
procedure Delete_All_Marks;
|
218 |
|
|
-- Remove all file/index couples marked
|
219 |
|
|
|
220 |
|
|
end Makeutl;
|