1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with Ada.Unchecked_Deallocation;
31 with Namet; use Namet;
33 with Output; use Output;
34 with Stringt; use Stringt;
36 package body Prj.Util is
38 procedure Free is new Ada.Unchecked_Deallocation
39 (Text_File_Data, Text_File);
45 procedure Close (File : in out Text_File) is
48 Osint.Fail ("Close attempted on an invalid Text_File");
59 function End_Of_File (File : Text_File) return Boolean is
62 Osint.Fail ("End_Of_File attempted on an invalid Text_File");
65 return File.End_Of_File_Reached;
87 if File.Cursor = File.Buffer_Len then
91 A => File.Buffer'Address,
92 N => File.Buffer'Length);
94 if File.Buffer_Len = 0 then
95 File.End_Of_File_Reached := True;
102 File.Cursor := File.Cursor + 1;
106 -- Start of processing for Get_Line
110 Osint.Fail ("Get_Line attempted on an invalid Text_File");
113 Last := Line'First - 1;
115 if not File.End_Of_File_Reached then
117 C := File.Buffer (File.Cursor);
118 exit when C = ASCII.CR or else C = ASCII.LF;
123 if File.End_Of_File_Reached then
127 exit when Last = Line'Last;
130 if C = ASCII.CR or else C = ASCII.LF then
133 if File.End_Of_File_Reached then
139 and then File.Buffer (File.Cursor) = ASCII.LF
150 function Is_Valid (File : Text_File) return Boolean is
159 procedure Open (File : out Text_File; Name : in String) is
160 FD : File_Descriptor;
161 File_Name : String (1 .. Name'Length + 1);
164 File_Name (1 .. Name'Length) := Name;
165 File_Name (File_Name'Last) := ASCII.NUL;
166 FD := Open_Read (Name => File_Name'Address,
167 Fmode => GNAT.OS_Lib.Text);
168 if FD = Invalid_FD then
171 File := new Text_File_Data;
175 A => File.Buffer'Address,
176 N => File.Buffer'Length);
178 if File.Buffer_Len = 0 then
179 File.End_Of_File_Reached := True;
191 (Variable : Variable_Value;
196 if Variable.Kind /= Single
197 or else Variable.Default
198 or else Variable.Value = No_String then
202 String_To_Name_Buffer (Variable.Value);
203 return Name_Buffer (1 .. Name_Len);
209 In_Array : Array_Element_Id)
212 Current : Array_Element_Id := In_Array;
213 Element : Array_Element;
216 while Current /= No_Array_Element loop
217 Element := Array_Elements.Table (Current);
219 if Index = Element.Index then
220 exit when Element.Value.Kind /= Single;
221 exit when String_Length (Element.Value.Value) = 0;
222 String_To_Name_Buffer (Element.Value.Value);
225 Current := Element.Next;
234 In_Array : Array_Element_Id)
235 return Variable_Value
237 Current : Array_Element_Id := In_Array;
238 Element : Array_Element;
241 while Current /= No_Array_Element loop
242 Element := Array_Elements.Table (Current);
244 if Index = Element.Index then
245 return Element.Value;
247 Current := Element.Next;
251 return Nil_Variable_Value;
256 Attribute_Or_Array_Name : Name_Id;
257 In_Package : Package_Id)
258 return Variable_Value
260 The_Array : Array_Element_Id;
261 The_Attribute : Variable_Value := Nil_Variable_Value;
264 if In_Package /= No_Package then
266 -- First, look if there is an array element that fits
270 (Name => Attribute_Or_Array_Name,
271 In_Arrays => Packages.Table (In_Package).Decl.Arrays);
275 In_Array => The_Array);
277 -- If there is no array element, look for a variable
279 if The_Attribute = Nil_Variable_Value then
282 (Variable_Name => Attribute_Or_Array_Name,
283 In_Variables => Packages.Table (In_Package).Decl.Attributes);
287 return The_Attribute;
293 In_Arrays : Array_Id)
296 Current : Array_Id := In_Arrays;
297 The_Array : Array_Data;
300 while Current /= No_Array loop
301 The_Array := Arrays.Table (Current);
302 if The_Array.Name = In_Array then
303 return Value_Of (Index, In_Array => The_Array.Value);
305 Current := The_Array.Next;
314 In_Arrays : Array_Id)
315 return Array_Element_Id
317 Current : Array_Id := In_Arrays;
318 The_Array : Array_Data;
321 while Current /= No_Array loop
322 The_Array := Arrays.Table (Current);
324 if The_Array.Name = Name then
325 return The_Array.Value;
327 Current := The_Array.Next;
331 return No_Array_Element;
336 In_Packages : Package_Id)
339 Current : Package_Id := In_Packages;
340 The_Package : Package_Element;
343 while Current /= No_Package loop
344 The_Package := Packages.Table (Current);
345 exit when The_Package.Name /= No_Name
346 and then The_Package.Name = Name;
347 Current := The_Package.Next;
354 (Variable_Name : Name_Id;
355 In_Variables : Variable_Id)
356 return Variable_Value
358 Current : Variable_Id := In_Variables;
359 The_Variable : Variable;
362 while Current /= No_Variable loop
363 The_Variable := Variable_Elements.Table (Current);
365 if Variable_Name = The_Variable.Name then
366 return The_Variable.Value;
368 Current := The_Variable.Next;
372 return Nil_Variable_Value;
381 Max_Length : Positive;
382 Separator : Character)
384 First : Positive := S'First;
385 Last : Natural := S'Last;
388 -- Nothing to do for empty strings
392 -- Start on a new line if current line is already longer than
395 if Positive (Column) >= Max_Length then
399 -- If length of remainder is longer than Max_Length, we need to
400 -- cut the remainder in several lines.
402 while Positive (Column) + S'Last - First > Max_Length loop
404 -- Try the maximum length possible
406 Last := First + Max_Length - Positive (Column);
408 -- Look for last Separator in the line
410 while Last >= First and then S (Last) /= Separator loop
414 -- If we do not find a separator, we output the maximum length
418 Last := First + Max_Length - Positive (Column);
421 Write_Line (S (First .. Last));
423 -- Set the beginning of the new remainder
428 -- What is left goes to the buffer, without EOL
430 Write_Str (S (First .. S'Last));