1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R J . U T I L -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2001-2012, 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-- Utilities for use in processing project files 27 28package Prj.Util is 29 30 function Executable_Of 31 (Project : Project_Id; 32 Shared : Shared_Project_Tree_Data_Access; 33 Main : File_Name_Type; 34 Index : Int; 35 Ada_Main : Boolean := True; 36 Language : String := ""; 37 Include_Suffix : Boolean := True) return File_Name_Type; 38 -- Return the value of the attribute Builder'Executable for file Main in 39 -- the project Project, if it exists. If there is no attribute Executable 40 -- for Main, remove the suffix from Main; then, if the attribute 41 -- Executable_Suffix is specified, add this suffix, otherwise add the 42 -- standard executable suffix for the platform. 43 -- 44 -- If Include_Suffix is true, then the ".exe" suffix (or any suffix defined 45 -- in the config) will be added. The suffix defined by the user in his own 46 -- project file is always taken into account. Otherwise, such a suffix is 47 -- not added. In particular, the prefix should not be added if you are 48 -- potentially testing for cross-platforms, since the suffix might not be 49 -- known (its default value comes from the ...-gnatmake prefix). 50 -- 51 -- What is Ada_Main??? 52 -- What is Language??? 53 54 procedure Put 55 (Into_List : in out Name_List_Index; 56 From_List : String_List_Id; 57 In_Tree : Project_Tree_Ref; 58 Lower_Case : Boolean := False); 59 -- Append a name list to a string list 60 -- Describe parameters??? 61 62 procedure Duplicate 63 (This : in out Name_List_Index; 64 Shared : Shared_Project_Tree_Data_Access); 65 -- Duplicate a name list 66 67 function Value_Of 68 (Variable : Variable_Value; 69 Default : String) return String; 70 -- Get the value of a single string variable. If Variable is a string list, 71 -- is Nil_Variable_Value,or is defaulted, return Default. 72 73 function Value_Of 74 (Index : Name_Id; 75 In_Array : Array_Element_Id; 76 Shared : Shared_Project_Tree_Data_Access) return Name_Id; 77 -- Get a single string array component. Returns No_Name if there is no 78 -- component Index, if In_Array is null, or if the component is a String 79 -- list. Depending on the attribute (only attributes may be associative 80 -- arrays) the index may or may not be case sensitive. If the index is not 81 -- case sensitive, it is first set to lower case before the search in the 82 -- associative array. 83 84 function Value_Of 85 (Index : Name_Id; 86 Src_Index : Int := 0; 87 In_Array : Array_Element_Id; 88 Shared : Shared_Project_Tree_Data_Access; 89 Force_Lower_Case_Index : Boolean := False; 90 Allow_Wildcards : Boolean := False) return Variable_Value; 91 -- Get a string array component (single String or String list). Returns 92 -- Nil_Variable_Value if no component Index or if In_Array is null. 93 -- 94 -- Depending on the attribute (only attributes may be associative arrays) 95 -- the index may or may not be case sensitive. If the index is not case 96 -- sensitive, it is first set to lower case before the search in the 97 -- associative array. 98 99 function Value_Of 100 (Name : Name_Id; 101 Index : Int := 0; 102 Attribute_Or_Array_Name : Name_Id; 103 In_Package : Package_Id; 104 Shared : Shared_Project_Tree_Data_Access; 105 Force_Lower_Case_Index : Boolean := False; 106 Allow_Wildcards : Boolean := False) return Variable_Value; 107 -- In a specific package: 108 -- - if there exists an array Attribute_Or_Array_Name with an index Name, 109 -- returns the corresponding component (depending on the attribute, the 110 -- index may or may not be case sensitive, see previous function), 111 -- - otherwise if there is a single attribute Attribute_Or_Array_Name, 112 -- returns this attribute, 113 -- - otherwise, returns Nil_Variable_Value. 114 -- If In_Package is null, returns Nil_Variable_Value. 115 116 function Value_Of 117 (Index : Name_Id; 118 In_Array : Name_Id; 119 In_Arrays : Array_Id; 120 Shared : Shared_Project_Tree_Data_Access) return Name_Id; 121 -- Get a string array component in an array of an array list. Returns 122 -- No_Name if there is no component Index, if In_Arrays is null, if 123 -- In_Array is not found in In_Arrays or if the component is a String list. 124 125 function Value_Of 126 (Name : Name_Id; 127 In_Arrays : Array_Id; 128 Shared : Shared_Project_Tree_Data_Access) return Array_Element_Id; 129 -- Returns a specified array in an array list. Returns No_Array_Element 130 -- if In_Arrays is null or if Name is not the name of an array in 131 -- In_Arrays. The caller must ensure that Name is in lower case. 132 133 function Value_Of 134 (Name : Name_Id; 135 In_Packages : Package_Id; 136 Shared : Shared_Project_Tree_Data_Access) return Package_Id; 137 -- Returns a specified package in a package list. Returns No_Package 138 -- if In_Packages is null or if Name is not the name of a package in 139 -- Package_List. The caller must ensure that Name is in lower case. 140 141 function Value_Of 142 (Variable_Name : Name_Id; 143 In_Variables : Variable_Id; 144 Shared : Shared_Project_Tree_Data_Access) return Variable_Value; 145 -- Returns a specified variable in a variable list. Returns null if 146 -- In_Variables is null or if Variable_Name is not the name of a 147 -- variable in In_Variables. Caller must ensure that Name is lower case. 148 149 procedure Write_Str 150 (S : String; 151 Max_Length : Positive; 152 Separator : Character); 153 -- Output string S using Output.Write_Str. If S is too long to fit in one 154 -- line of Max_Length, cut it in several lines, using Separator as the last 155 -- character of each line, if possible. 156 157 type Text_File is limited private; 158 -- Represents a text file (default is invalid text file) 159 160 function Is_Valid (File : Text_File) return Boolean; 161 -- Returns True if File designates an open text file that has not yet been 162 -- closed. 163 164 procedure Open (File : out Text_File; Name : String); 165 -- Open a text file to read (File is invalid if text file cannot be opened) 166 167 procedure Create (File : out Text_File; Name : String); 168 -- Create a text file to write (File is invalid if text file cannot be 169 -- created). 170 171 function End_Of_File (File : Text_File) return Boolean; 172 -- Returns True if the end of the text file File has been reached. Fails if 173 -- File is invalid. Return True if File is an out file. 174 175 procedure Get_Line 176 (File : Text_File; 177 Line : out String; 178 Last : out Natural); 179 -- Reads a line from an open text file (fails if File is invalid or in an 180 -- out file). 181 182 procedure Put (File : Text_File; S : String); 183 procedure Put_Line (File : Text_File; Line : String); 184 -- Output a string or a line to an out text file (fails if File is invalid 185 -- or in an in file). 186 187 procedure Close (File : in out Text_File); 188 -- Close an open text file. File becomes invalid. Fails if File is already 189 -- invalid or if an out file cannot be closed successfully. 190 191 ----------------------- 192 -- Source info files -- 193 ----------------------- 194 195 procedure Write_Source_Info_File (Tree : Project_Tree_Ref); 196 -- Create a new source info file, with the path name specified in the 197 -- project tree data. Issue a warning if it is not possible to create 198 -- the new file. 199 200 procedure Read_Source_Info_File (Tree : Project_Tree_Ref); 201 -- Check if there is a source info file specified for the project Tree. If 202 -- so, attempt to read it. If the file exists and is successfully read, set 203 -- the flag Source_Info_File_Exists to True for the tree. 204 205 type Source_Info_Data is record 206 Project : Name_Id; 207 Language : Name_Id; 208 Kind : Source_Kind; 209 Display_Path_Name : Name_Id; 210 Path_Name : Name_Id; 211 Unit_Name : Name_Id := No_Name; 212 Index : Int := 0; 213 Naming_Exception : Naming_Exception_Type := No; 214 end record; 215 -- Data read from a source info file for a single source 216 217 type Source_Info is access all Source_Info_Data; 218 No_Source_Info : constant Source_Info := null; 219 220 type Source_Info_Iterator is private; 221 -- Iterator to get the sources for a single project 222 223 procedure Initialize 224 (Iter : out Source_Info_Iterator; 225 For_Project : Name_Id); 226 -- Initialize Iter for the project 227 228 function Source_Info_Of (Iter : Source_Info_Iterator) return Source_Info; 229 -- Get the source info for the source corresponding to the current value of 230 -- the iterator. Returns No_Source_Info if there is no source corresponding 231 -- to the iterator. 232 233 procedure Next (Iter : in out Source_Info_Iterator); 234 -- Advance the iterator to the next source in the project 235 236 generic 237 with procedure Action (Source : Source_Id); 238 procedure For_Interface_Sources 239 (Tree : Project_Tree_Ref; 240 Project : Project_Id); 241 -- Call Action for every sources that are needed to use Project. This is 242 -- either the sources corresponding to the units in attribute Interfaces 243 -- or all sources of the project. Note that only the bodies that are 244 -- needed (because the unit is generic or contains some inline pragmas) 245 -- are handled. This routine must be called only when the project has 246 -- been built successfully. 247 248private 249 type Text_File_Data is record 250 FD : File_Descriptor := Invalid_FD; 251 Out_File : Boolean := False; 252 Buffer : String (1 .. 1_000); 253 Buffer_Len : Natural := 0; 254 Cursor : Natural := 0; 255 End_Of_File_Reached : Boolean := False; 256 end record; 257 258 type Text_File is access Text_File_Data; 259 260 type Source_Info_Iterator is record 261 Info : Source_Info; 262 Next : Natural; 263 end record; 264 265end Prj.Util; 266