1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Ada.Unchecked_Deallocation;
29 with Namet; use Namet;
31 with Output; use Output;
32 with Stringt; use Stringt;
34 package body Prj.Util is
36 procedure Free is new Ada.Unchecked_Deallocation
37 (Text_File_Data, Text_File);
43 procedure Close (File : in out Text_File) is
46 Osint.Fail ("Close attempted on an invalid Text_File");
57 function End_Of_File (File : Text_File) return Boolean is
60 Osint.Fail ("End_Of_File attempted on an invalid Text_File");
63 return File.End_Of_File_Reached;
85 if File.Cursor = File.Buffer_Len then
89 A => File.Buffer'Address,
90 N => File.Buffer'Length);
92 if File.Buffer_Len = 0 then
93 File.End_Of_File_Reached := True;
100 File.Cursor := File.Cursor + 1;
104 -- Start of processing for Get_Line
108 Osint.Fail ("Get_Line attempted on an invalid Text_File");
111 Last := Line'First - 1;
113 if not File.End_Of_File_Reached then
115 C := File.Buffer (File.Cursor);
116 exit when C = ASCII.CR or else C = ASCII.LF;
121 if File.End_Of_File_Reached then
125 exit when Last = Line'Last;
128 if C = ASCII.CR or else C = ASCII.LF then
131 if File.End_Of_File_Reached then
137 and then File.Buffer (File.Cursor) = ASCII.LF
148 function Is_Valid (File : Text_File) return Boolean is
157 procedure Open (File : out Text_File; Name : in String) is
158 FD : File_Descriptor;
159 File_Name : String (1 .. Name'Length + 1);
162 File_Name (1 .. Name'Length) := Name;
163 File_Name (File_Name'Last) := ASCII.NUL;
164 FD := Open_Read (Name => File_Name'Address,
165 Fmode => GNAT.OS_Lib.Text);
166 if FD = Invalid_FD then
169 File := new Text_File_Data;
173 A => File.Buffer'Address,
174 N => File.Buffer'Length);
176 if File.Buffer_Len = 0 then
177 File.End_Of_File_Reached := True;
189 (Variable : Variable_Value;
194 if Variable.Kind /= Single
195 or else Variable.Default
196 or else Variable.Value = No_String then
200 String_To_Name_Buffer (Variable.Value);
201 return Name_Buffer (1 .. Name_Len);
207 In_Array : Array_Element_Id)
210 Current : Array_Element_Id := In_Array;
211 Element : Array_Element;
214 while Current /= No_Array_Element loop
215 Element := Array_Elements.Table (Current);
217 if Index = Element.Index then
218 exit when Element.Value.Kind /= Single;
219 exit when String_Length (Element.Value.Value) = 0;
220 String_To_Name_Buffer (Element.Value.Value);
223 Current := Element.Next;
232 In_Array : Array_Element_Id)
233 return Variable_Value
235 Current : Array_Element_Id := In_Array;
236 Element : Array_Element;
239 while Current /= No_Array_Element loop
240 Element := Array_Elements.Table (Current);
242 if Index = Element.Index then
243 return Element.Value;
245 Current := Element.Next;
249 return Nil_Variable_Value;
254 Attribute_Or_Array_Name : Name_Id;
255 In_Package : Package_Id)
256 return Variable_Value
258 The_Array : Array_Element_Id;
259 The_Attribute : Variable_Value := Nil_Variable_Value;
262 if In_Package /= No_Package then
264 -- First, look if there is an array element that fits
268 (Name => Attribute_Or_Array_Name,
269 In_Arrays => Packages.Table (In_Package).Decl.Arrays);
273 In_Array => The_Array);
275 -- If there is no array element, look for a variable
277 if The_Attribute = Nil_Variable_Value then
280 (Variable_Name => Attribute_Or_Array_Name,
281 In_Variables => Packages.Table (In_Package).Decl.Attributes);
285 return The_Attribute;
291 In_Arrays : Array_Id)
294 Current : Array_Id := In_Arrays;
295 The_Array : Array_Data;
298 while Current /= No_Array loop
299 The_Array := Arrays.Table (Current);
300 if The_Array.Name = In_Array then
301 return Value_Of (Index, In_Array => The_Array.Value);
303 Current := The_Array.Next;
312 In_Arrays : Array_Id)
313 return Array_Element_Id
315 Current : Array_Id := In_Arrays;
316 The_Array : Array_Data;
319 while Current /= No_Array loop
320 The_Array := Arrays.Table (Current);
322 if The_Array.Name = Name then
323 return The_Array.Value;
325 Current := The_Array.Next;
329 return No_Array_Element;
334 In_Packages : Package_Id)
337 Current : Package_Id := In_Packages;
338 The_Package : Package_Element;
341 while Current /= No_Package loop
342 The_Package := Packages.Table (Current);
343 exit when The_Package.Name /= No_Name
344 and then The_Package.Name = Name;
345 Current := The_Package.Next;
352 (Variable_Name : Name_Id;
353 In_Variables : Variable_Id)
354 return Variable_Value
356 Current : Variable_Id := In_Variables;
357 The_Variable : Variable;
360 while Current /= No_Variable loop
361 The_Variable := Variable_Elements.Table (Current);
363 if Variable_Name = The_Variable.Name then
364 return The_Variable.Value;
366 Current := The_Variable.Next;
370 return Nil_Variable_Value;
379 Max_Length : Positive;
380 Separator : Character)
382 First : Positive := S'First;
383 Last : Natural := S'Last;
386 -- Nothing to do for empty strings
390 -- Start on a new line if current line is already longer than
393 if Positive (Column) >= Max_Length then
397 -- If length of remainder is longer than Max_Length, we need to
398 -- cut the remainder in several lines.
400 while Positive (Column) + S'Last - First > Max_Length loop
402 -- Try the maximum length possible
404 Last := First + Max_Length - Positive (Column);
406 -- Look for last Separator in the line
408 while Last >= First and then S (Last) /= Separator loop
412 -- If we do not find a separator, we output the maximum length
416 Last := First + Max_Length - Positive (Column);
419 Write_Line (S (First .. Last));
421 -- Set the beginning of the new remainder
426 -- What is left goes to the buffer, without EOL
428 Write_Str (S (First .. S'Last));