433 lines
12 KiB
Ada
433 lines
12 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P R J . U T I L --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2001 Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
|
-- MA 02111-1307, USA. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Ada.Unchecked_Deallocation;
|
|
|
|
with Namet; use Namet;
|
|
with Osint;
|
|
with Output; use Output;
|
|
with Stringt; use Stringt;
|
|
|
|
package body Prj.Util is
|
|
|
|
procedure Free is new Ada.Unchecked_Deallocation
|
|
(Text_File_Data, Text_File);
|
|
|
|
-----------
|
|
-- Close --
|
|
-----------
|
|
|
|
procedure Close (File : in out Text_File) is
|
|
begin
|
|
if File = null then
|
|
Osint.Fail ("Close attempted on an invalid Text_File");
|
|
end if;
|
|
|
|
Close (File.FD);
|
|
Free (File);
|
|
end Close;
|
|
|
|
-----------------
|
|
-- End_Of_File --
|
|
-----------------
|
|
|
|
function End_Of_File (File : Text_File) return Boolean is
|
|
begin
|
|
if File = null then
|
|
Osint.Fail ("End_Of_File attempted on an invalid Text_File");
|
|
end if;
|
|
|
|
return File.End_Of_File_Reached;
|
|
end End_Of_File;
|
|
|
|
--------------
|
|
-- Get_Line --
|
|
--------------
|
|
|
|
procedure Get_Line
|
|
(File : Text_File;
|
|
Line : out String;
|
|
Last : out Natural)
|
|
is
|
|
C : Character;
|
|
|
|
procedure Advance;
|
|
|
|
-------------
|
|
-- Advance --
|
|
-------------
|
|
|
|
procedure Advance is
|
|
begin
|
|
if File.Cursor = File.Buffer_Len then
|
|
File.Buffer_Len :=
|
|
Read
|
|
(FD => File.FD,
|
|
A => File.Buffer'Address,
|
|
N => File.Buffer'Length);
|
|
|
|
if File.Buffer_Len = 0 then
|
|
File.End_Of_File_Reached := True;
|
|
return;
|
|
else
|
|
File.Cursor := 1;
|
|
end if;
|
|
|
|
else
|
|
File.Cursor := File.Cursor + 1;
|
|
end if;
|
|
end Advance;
|
|
|
|
-- Start of processing for Get_Line
|
|
|
|
begin
|
|
if File = null then
|
|
Osint.Fail ("Get_Line attempted on an invalid Text_File");
|
|
end if;
|
|
|
|
Last := Line'First - 1;
|
|
|
|
if not File.End_Of_File_Reached then
|
|
loop
|
|
C := File.Buffer (File.Cursor);
|
|
exit when C = ASCII.CR or else C = ASCII.LF;
|
|
Last := Last + 1;
|
|
Line (Last) := C;
|
|
Advance;
|
|
|
|
if File.End_Of_File_Reached then
|
|
return;
|
|
end if;
|
|
|
|
exit when Last = Line'Last;
|
|
end loop;
|
|
|
|
if C = ASCII.CR or else C = ASCII.LF then
|
|
Advance;
|
|
|
|
if File.End_Of_File_Reached then
|
|
return;
|
|
end if;
|
|
end if;
|
|
|
|
if C = ASCII.CR
|
|
and then File.Buffer (File.Cursor) = ASCII.LF
|
|
then
|
|
Advance;
|
|
end if;
|
|
end if;
|
|
end Get_Line;
|
|
|
|
--------------
|
|
-- Is_Valid --
|
|
--------------
|
|
|
|
function Is_Valid (File : Text_File) return Boolean is
|
|
begin
|
|
return File /= null;
|
|
end Is_Valid;
|
|
|
|
----------
|
|
-- Open --
|
|
----------
|
|
|
|
procedure Open (File : out Text_File; Name : in String) is
|
|
FD : File_Descriptor;
|
|
File_Name : String (1 .. Name'Length + 1);
|
|
|
|
begin
|
|
File_Name (1 .. Name'Length) := Name;
|
|
File_Name (File_Name'Last) := ASCII.NUL;
|
|
FD := Open_Read (Name => File_Name'Address,
|
|
Fmode => GNAT.OS_Lib.Text);
|
|
if FD = Invalid_FD then
|
|
File := null;
|
|
else
|
|
File := new Text_File_Data;
|
|
File.FD := FD;
|
|
File.Buffer_Len :=
|
|
Read (FD => FD,
|
|
A => File.Buffer'Address,
|
|
N => File.Buffer'Length);
|
|
|
|
if File.Buffer_Len = 0 then
|
|
File.End_Of_File_Reached := True;
|
|
else
|
|
File.Cursor := 1;
|
|
end if;
|
|
end if;
|
|
end Open;
|
|
|
|
--------------
|
|
-- Value_Of --
|
|
--------------
|
|
|
|
function Value_Of
|
|
(Variable : Variable_Value;
|
|
Default : String)
|
|
return String
|
|
is
|
|
begin
|
|
if Variable.Kind /= Single
|
|
or else Variable.Default
|
|
or else Variable.Value = No_String then
|
|
return Default;
|
|
|
|
else
|
|
String_To_Name_Buffer (Variable.Value);
|
|
return Name_Buffer (1 .. Name_Len);
|
|
end if;
|
|
end Value_Of;
|
|
|
|
function Value_Of
|
|
(Index : Name_Id;
|
|
In_Array : Array_Element_Id)
|
|
return Name_Id
|
|
is
|
|
Current : Array_Element_Id := In_Array;
|
|
Element : Array_Element;
|
|
|
|
begin
|
|
while Current /= No_Array_Element loop
|
|
Element := Array_Elements.Table (Current);
|
|
|
|
if Index = Element.Index then
|
|
exit when Element.Value.Kind /= Single;
|
|
exit when String_Length (Element.Value.Value) = 0;
|
|
String_To_Name_Buffer (Element.Value.Value);
|
|
return Name_Find;
|
|
else
|
|
Current := Element.Next;
|
|
end if;
|
|
end loop;
|
|
|
|
return No_Name;
|
|
end Value_Of;
|
|
|
|
function Value_Of
|
|
(Index : Name_Id;
|
|
In_Array : Array_Element_Id)
|
|
return Variable_Value
|
|
is
|
|
Current : Array_Element_Id := In_Array;
|
|
Element : Array_Element;
|
|
|
|
begin
|
|
while Current /= No_Array_Element loop
|
|
Element := Array_Elements.Table (Current);
|
|
|
|
if Index = Element.Index then
|
|
return Element.Value;
|
|
else
|
|
Current := Element.Next;
|
|
end if;
|
|
end loop;
|
|
|
|
return Nil_Variable_Value;
|
|
end Value_Of;
|
|
|
|
function Value_Of
|
|
(Name : Name_Id;
|
|
Attribute_Or_Array_Name : Name_Id;
|
|
In_Package : Package_Id)
|
|
return Variable_Value
|
|
is
|
|
The_Array : Array_Element_Id;
|
|
The_Attribute : Variable_Value := Nil_Variable_Value;
|
|
|
|
begin
|
|
if In_Package /= No_Package then
|
|
|
|
-- First, look if there is an array element that fits
|
|
|
|
The_Array :=
|
|
Value_Of
|
|
(Name => Attribute_Or_Array_Name,
|
|
In_Arrays => Packages.Table (In_Package).Decl.Arrays);
|
|
The_Attribute :=
|
|
Value_Of
|
|
(Index => Name,
|
|
In_Array => The_Array);
|
|
|
|
-- If there is no array element, look for a variable
|
|
|
|
if The_Attribute = Nil_Variable_Value then
|
|
The_Attribute :=
|
|
Value_Of
|
|
(Variable_Name => Attribute_Or_Array_Name,
|
|
In_Variables => Packages.Table (In_Package).Decl.Attributes);
|
|
end if;
|
|
end if;
|
|
|
|
return The_Attribute;
|
|
end Value_Of;
|
|
|
|
function Value_Of
|
|
(Index : Name_Id;
|
|
In_Array : Name_Id;
|
|
In_Arrays : Array_Id)
|
|
return Name_Id
|
|
is
|
|
Current : Array_Id := In_Arrays;
|
|
The_Array : Array_Data;
|
|
|
|
begin
|
|
while Current /= No_Array loop
|
|
The_Array := Arrays.Table (Current);
|
|
if The_Array.Name = In_Array then
|
|
return Value_Of (Index, In_Array => The_Array.Value);
|
|
else
|
|
Current := The_Array.Next;
|
|
end if;
|
|
end loop;
|
|
|
|
return No_Name;
|
|
end Value_Of;
|
|
|
|
function Value_Of
|
|
(Name : Name_Id;
|
|
In_Arrays : Array_Id)
|
|
return Array_Element_Id
|
|
is
|
|
Current : Array_Id := In_Arrays;
|
|
The_Array : Array_Data;
|
|
|
|
begin
|
|
while Current /= No_Array loop
|
|
The_Array := Arrays.Table (Current);
|
|
|
|
if The_Array.Name = Name then
|
|
return The_Array.Value;
|
|
else
|
|
Current := The_Array.Next;
|
|
end if;
|
|
end loop;
|
|
|
|
return No_Array_Element;
|
|
end Value_Of;
|
|
|
|
function Value_Of
|
|
(Name : Name_Id;
|
|
In_Packages : Package_Id)
|
|
return Package_Id
|
|
is
|
|
Current : Package_Id := In_Packages;
|
|
The_Package : Package_Element;
|
|
|
|
begin
|
|
while Current /= No_Package loop
|
|
The_Package := Packages.Table (Current);
|
|
exit when The_Package.Name /= No_Name
|
|
and then The_Package.Name = Name;
|
|
Current := The_Package.Next;
|
|
end loop;
|
|
|
|
return Current;
|
|
end Value_Of;
|
|
|
|
function Value_Of
|
|
(Variable_Name : Name_Id;
|
|
In_Variables : Variable_Id)
|
|
return Variable_Value
|
|
is
|
|
Current : Variable_Id := In_Variables;
|
|
The_Variable : Variable;
|
|
|
|
begin
|
|
while Current /= No_Variable loop
|
|
The_Variable := Variable_Elements.Table (Current);
|
|
|
|
if Variable_Name = The_Variable.Name then
|
|
return The_Variable.Value;
|
|
else
|
|
Current := The_Variable.Next;
|
|
end if;
|
|
end loop;
|
|
|
|
return Nil_Variable_Value;
|
|
end Value_Of;
|
|
|
|
---------------
|
|
-- Write_Str --
|
|
---------------
|
|
|
|
procedure Write_Str
|
|
(S : String;
|
|
Max_Length : Positive;
|
|
Separator : Character)
|
|
is
|
|
First : Positive := S'First;
|
|
Last : Natural := S'Last;
|
|
|
|
begin
|
|
-- Nothing to do for empty strings
|
|
|
|
if S'Length > 0 then
|
|
|
|
-- Start on a new line if current line is already longer than
|
|
-- Max_Length.
|
|
|
|
if Positive (Column) >= Max_Length then
|
|
Write_Eol;
|
|
end if;
|
|
|
|
-- If length of remainder is longer than Max_Length, we need to
|
|
-- cut the remainder in several lines.
|
|
|
|
while Positive (Column) + S'Last - First > Max_Length loop
|
|
|
|
-- Try the maximum length possible
|
|
|
|
Last := First + Max_Length - Positive (Column);
|
|
|
|
-- Look for last Separator in the line
|
|
|
|
while Last >= First and then S (Last) /= Separator loop
|
|
Last := Last - 1;
|
|
end loop;
|
|
|
|
-- If we do not find a separator, we output the maximum length
|
|
-- possible.
|
|
|
|
if Last < First then
|
|
Last := First + Max_Length - Positive (Column);
|
|
end if;
|
|
|
|
Write_Line (S (First .. Last));
|
|
|
|
-- Set the beginning of the new remainder
|
|
|
|
First := Last + 1;
|
|
end loop;
|
|
|
|
-- What is left goes to the buffer, without EOL
|
|
|
|
Write_Str (S (First .. S'Last));
|
|
end if;
|
|
end Write_Str;
|
|
|
|
end Prj.Util;
|