1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Ada.Unchecked_Deallocation;
30 with Namet; use Namet;
32 with Output; use Output;
33 with Stringt; use Stringt;
35 package body Prj.Util is
37 procedure Free is new Ada.Unchecked_Deallocation
38 (Text_File_Data, Text_File);
44 procedure Close (File : in out Text_File) is
47 Osint.Fail ("Close attempted on an invalid Text_File");
58 function End_Of_File (File : Text_File) return Boolean is
61 Osint.Fail ("End_Of_File attempted on an invalid Text_File");
64 return File.End_Of_File_Reached;
86 if File.Cursor = File.Buffer_Len then
90 A => File.Buffer'Address,
91 N => File.Buffer'Length);
93 if File.Buffer_Len = 0 then
94 File.End_Of_File_Reached := True;
101 File.Cursor := File.Cursor + 1;
105 -- Start of processing for Get_Line
109 Osint.Fail ("Get_Line attempted on an invalid Text_File");
112 Last := Line'First - 1;
114 if not File.End_Of_File_Reached then
116 C := File.Buffer (File.Cursor);
117 exit when C = ASCII.CR or else C = ASCII.LF;
122 if File.End_Of_File_Reached then
126 exit when Last = Line'Last;
129 if C = ASCII.CR or else C = ASCII.LF then
132 if File.End_Of_File_Reached then
138 and then File.Buffer (File.Cursor) = ASCII.LF
149 function Is_Valid (File : Text_File) return Boolean is
158 procedure Open (File : out Text_File; Name : in String) is
159 FD : File_Descriptor;
160 File_Name : String (1 .. Name'Length + 1);
163 File_Name (1 .. Name'Length) := Name;
164 File_Name (File_Name'Last) := ASCII.NUL;
165 FD := Open_Read (Name => File_Name'Address,
166 Fmode => GNAT.OS_Lib.Text);
167 if FD = Invalid_FD then
170 File := new Text_File_Data;
174 A => File.Buffer'Address,
175 N => File.Buffer'Length);
177 if File.Buffer_Len = 0 then
178 File.End_Of_File_Reached := True;
190 (Variable : Variable_Value;
195 if Variable.Kind /= Single
196 or else Variable.Default
197 or else Variable.Value = No_String then
201 String_To_Name_Buffer (Variable.Value);
202 return Name_Buffer (1 .. Name_Len);
208 In_Array : Array_Element_Id)
211 Current : Array_Element_Id := In_Array;
212 Element : Array_Element;
215 while Current /= No_Array_Element loop
216 Element := Array_Elements.Table (Current);
218 if Index = Element.Index then
219 exit when Element.Value.Kind /= Single;
220 exit when String_Length (Element.Value.Value) = 0;
221 String_To_Name_Buffer (Element.Value.Value);
224 Current := Element.Next;
233 In_Array : Array_Element_Id)
234 return Variable_Value
236 Current : Array_Element_Id := In_Array;
237 Element : Array_Element;
240 while Current /= No_Array_Element loop
241 Element := Array_Elements.Table (Current);
243 if Index = Element.Index then
244 return Element.Value;
246 Current := Element.Next;
250 return Nil_Variable_Value;
255 Attribute_Or_Array_Name : Name_Id;
256 In_Package : Package_Id)
257 return Variable_Value
259 The_Array : Array_Element_Id;
260 The_Attribute : Variable_Value := Nil_Variable_Value;
263 if In_Package /= No_Package then
265 -- First, look if there is an array element that fits
269 (Name => Attribute_Or_Array_Name,
270 In_Arrays => Packages.Table (In_Package).Decl.Arrays);
274 In_Array => The_Array);
276 -- If there is no array element, look for a variable
278 if The_Attribute = Nil_Variable_Value then
281 (Variable_Name => Attribute_Or_Array_Name,
282 In_Variables => Packages.Table (In_Package).Decl.Attributes);
286 return The_Attribute;
292 In_Arrays : Array_Id)
295 Current : Array_Id := In_Arrays;
296 The_Array : Array_Data;
299 while Current /= No_Array loop
300 The_Array := Arrays.Table (Current);
301 if The_Array.Name = In_Array then
302 return Value_Of (Index, In_Array => The_Array.Value);
304 Current := The_Array.Next;
313 In_Arrays : Array_Id)
314 return Array_Element_Id
316 Current : Array_Id := In_Arrays;
317 The_Array : Array_Data;
320 while Current /= No_Array loop
321 The_Array := Arrays.Table (Current);
323 if The_Array.Name = Name then
324 return The_Array.Value;
326 Current := The_Array.Next;
330 return No_Array_Element;
335 In_Packages : Package_Id)
338 Current : Package_Id := In_Packages;
339 The_Package : Package_Element;
342 while Current /= No_Package loop
343 The_Package := Packages.Table (Current);
344 exit when The_Package.Name /= No_Name
345 and then The_Package.Name = Name;
346 Current := The_Package.Next;
353 (Variable_Name : Name_Id;
354 In_Variables : Variable_Id)
355 return Variable_Value
357 Current : Variable_Id := In_Variables;
358 The_Variable : Variable;
361 while Current /= No_Variable loop
362 The_Variable := Variable_Elements.Table (Current);
364 if Variable_Name = The_Variable.Name then
365 return The_Variable.Value;
367 Current := The_Variable.Next;
371 return Nil_Variable_Value;
380 Max_Length : Positive;
381 Separator : Character)
383 First : Positive := S'First;
384 Last : Natural := S'Last;
387 -- Nothing to do for empty strings
391 -- Start on a new line if current line is already longer than
394 if Positive (Column) >= Max_Length then
398 -- If length of remainder is longer than Max_Length, we need to
399 -- cut the remainder in several lines.
401 while Positive (Column) + S'Last - First > Max_Length loop
403 -- Try the maximum length possible
405 Last := First + Max_Length - Positive (Column);
407 -- Look for last Separator in the line
409 while Last >= First and then S (Last) /= Separator loop
413 -- If we do not find a separator, we output the maximum length
417 Last := First + Max_Length - Positive (Column);
420 Write_Line (S (First .. Last));
422 -- Set the beginning of the new remainder
427 -- What is left goes to the buffer, without EOL
429 Write_Str (S (First .. S'Last));