e4691ba99b
2013-10-14 Robert Dewar <dewar@adacore.com> * exp_prag.adb, sem_prag.adb, a-exexda.adb, s-vmexta.ads: Minor reformatting. 2013-10-14 Vincent Celier <celier@adacore.com> * ali.adb (Get_File_Name): New Boolean parameter May_Be_Quoted, defaulted to False. Calls Get_Name with May_Be_Quoted. (Get_Name): New Boolean parameter May_Be_Quoted, defaulted to False. If May_Be_Quoted is True and first non blank charater is '"', unquote the name. (Scan_ALI): For the file/path name on the D line, call Get_File_Name with May_Be_Quoted = True, as it may have been quoted. * lib-util.adb, lib-util.ads (Write_Info_Name_May_Be_Quoted): New procedure to write file/path names that may contain spaces and if they do are quoted. * lib-writ.adb (Write_ALI): Use new procedure Write_Info_Name_May_Be_Quoted to write file/path names on D lines. From-SVN: r203534
338 lines
9.8 KiB
Ada
338 lines
9.8 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- L I B . U T I L --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2013, 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 3, 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 COPYING3. If not, go to --
|
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Hostparm;
|
|
with Osint.C; use Osint.C;
|
|
with Stringt; use Stringt;
|
|
|
|
package body Lib.Util is
|
|
|
|
Max_Line : constant Natural := 2 * Hostparm.Max_Name_Length + 64;
|
|
Max_Buffer : constant Natural := 1000 * Max_Line;
|
|
|
|
Info_Buffer : String (1 .. Max_Buffer);
|
|
-- Info_Buffer used to prepare lines of library output
|
|
|
|
Info_Buffer_Len : Natural := 0;
|
|
-- Number of characters stored in Info_Buffer
|
|
|
|
Info_Buffer_Col : Natural := 1;
|
|
-- Column number of next character to be written.
|
|
-- Can be different from Info_Buffer_Len + 1 because of tab characters
|
|
-- written by Write_Info_Tab.
|
|
|
|
procedure Write_Info_Hex_Byte (J : Natural);
|
|
-- Place two hex digits representing the value J (which is in the range
|
|
-- 0-255) in Info_Buffer, incrementing Info_Buffer_Len by 2. The digits
|
|
-- are output using lower case letters.
|
|
|
|
---------------------
|
|
-- Write_Info_Char --
|
|
---------------------
|
|
|
|
procedure Write_Info_Char (C : Character) is
|
|
begin
|
|
Info_Buffer_Len := Info_Buffer_Len + 1;
|
|
Info_Buffer (Info_Buffer_Len) := C;
|
|
Info_Buffer_Col := Info_Buffer_Col + 1;
|
|
end Write_Info_Char;
|
|
|
|
--------------------------
|
|
-- Write_Info_Char_Code --
|
|
--------------------------
|
|
|
|
procedure Write_Info_Char_Code (Code : Char_Code) is
|
|
begin
|
|
-- 00 .. 7F
|
|
|
|
if Code <= 16#7F# then
|
|
Write_Info_Char (Character'Val (Code));
|
|
|
|
-- 80 .. FF
|
|
|
|
elsif Code <= 16#FF# then
|
|
Write_Info_Char ('U');
|
|
Write_Info_Hex_Byte (Natural (Code));
|
|
|
|
-- 0100 .. FFFF
|
|
|
|
else
|
|
Write_Info_Char ('W');
|
|
Write_Info_Hex_Byte (Natural (Code / 256));
|
|
Write_Info_Hex_Byte (Natural (Code mod 256));
|
|
end if;
|
|
end Write_Info_Char_Code;
|
|
|
|
--------------------
|
|
-- Write_Info_Col --
|
|
--------------------
|
|
|
|
function Write_Info_Col return Positive is
|
|
begin
|
|
return Info_Buffer_Col;
|
|
end Write_Info_Col;
|
|
|
|
--------------------
|
|
-- Write_Info_EOL --
|
|
--------------------
|
|
|
|
procedure Write_Info_EOL is
|
|
begin
|
|
if Hostparm.OpenVMS
|
|
or else Info_Buffer_Len + Max_Line + 1 > Max_Buffer
|
|
then
|
|
Write_Info_Terminate;
|
|
else
|
|
-- Delete any trailing blanks
|
|
|
|
while Info_Buffer_Len > 0
|
|
and then Info_Buffer (Info_Buffer_Len) = ' '
|
|
loop
|
|
Info_Buffer_Len := Info_Buffer_Len - 1;
|
|
end loop;
|
|
|
|
Info_Buffer_Len := Info_Buffer_Len + 1;
|
|
Info_Buffer (Info_Buffer_Len) := ASCII.LF;
|
|
Info_Buffer_Col := 1;
|
|
end if;
|
|
end Write_Info_EOL;
|
|
|
|
-------------------------
|
|
-- Write_Info_Hex_Byte --
|
|
-------------------------
|
|
|
|
procedure Write_Info_Hex_Byte (J : Natural) is
|
|
Hexd : constant array (0 .. 15) of Character := "0123456789abcdef";
|
|
begin
|
|
Write_Info_Char (Hexd (J / 16));
|
|
Write_Info_Char (Hexd (J mod 16));
|
|
end Write_Info_Hex_Byte;
|
|
|
|
-------------------------
|
|
-- Write_Info_Initiate --
|
|
-------------------------
|
|
|
|
procedure Write_Info_Initiate (Key : Character) renames Write_Info_Char;
|
|
|
|
--------------------
|
|
-- Write_Info_Int --
|
|
--------------------
|
|
|
|
procedure Write_Info_Int (N : Int) is
|
|
begin
|
|
if N >= 0 then
|
|
Write_Info_Nat (N);
|
|
|
|
-- Negative numbers, use Write_Info_Uint to avoid problems with largest
|
|
-- negative number.
|
|
|
|
else
|
|
Write_Info_Uint (UI_From_Int (N));
|
|
end if;
|
|
end Write_Info_Int;
|
|
|
|
---------------------
|
|
-- Write_Info_Name --
|
|
---------------------
|
|
|
|
procedure Write_Info_Name (Name : Name_Id) is
|
|
begin
|
|
Get_Name_String (Name);
|
|
Info_Buffer (Info_Buffer_Len + 1 .. Info_Buffer_Len + Name_Len) :=
|
|
Name_Buffer (1 .. Name_Len);
|
|
Info_Buffer_Len := Info_Buffer_Len + Name_Len;
|
|
Info_Buffer_Col := Info_Buffer_Col + Name_Len;
|
|
end Write_Info_Name;
|
|
|
|
procedure Write_Info_Name (Name : File_Name_Type) is
|
|
begin
|
|
Write_Info_Name (Name_Id (Name));
|
|
end Write_Info_Name;
|
|
|
|
procedure Write_Info_Name (Name : Unit_Name_Type) is
|
|
begin
|
|
Write_Info_Name (Name_Id (Name));
|
|
end Write_Info_Name;
|
|
|
|
-----------------------------------
|
|
-- Write_Info_Name_May_Be_Quoted --
|
|
-----------------------------------
|
|
|
|
procedure Write_Info_Name_May_Be_Quoted (Name : File_Name_Type) is
|
|
Quoted : Boolean := False;
|
|
Cur : Positive;
|
|
|
|
begin
|
|
Get_Name_String (Name);
|
|
|
|
-- The file/path name is quoted only if it includes spaces
|
|
|
|
for J in 1 .. Name_Len loop
|
|
if Name_Buffer (J) = ' ' then
|
|
Quoted := True;
|
|
exit;
|
|
end if;
|
|
end loop;
|
|
|
|
-- Deal with quoting string if needed
|
|
|
|
if Quoted then
|
|
Insert_Str_In_Name_Buffer ("""", 1);
|
|
Add_Char_To_Name_Buffer ('"');
|
|
|
|
-- Any character '"' is doubled
|
|
|
|
Cur := 2;
|
|
while Cur < Name_Len loop
|
|
if Name_Buffer (Cur) = '"' then
|
|
Insert_Str_In_Name_Buffer ("""", Cur);
|
|
Cur := Cur + 2;
|
|
else
|
|
Cur := Cur + 1;
|
|
end if;
|
|
end loop;
|
|
end if;
|
|
|
|
Info_Buffer (Info_Buffer_Len + 1 .. Info_Buffer_Len + Name_Len) :=
|
|
Name_Buffer (1 .. Name_Len);
|
|
Info_Buffer_Len := Info_Buffer_Len + Name_Len;
|
|
Info_Buffer_Col := Info_Buffer_Col + Name_Len;
|
|
end Write_Info_Name_May_Be_Quoted;
|
|
|
|
--------------------
|
|
-- Write_Info_Nat --
|
|
--------------------
|
|
|
|
procedure Write_Info_Nat (N : Nat) is
|
|
begin
|
|
if N > 9 then
|
|
Write_Info_Nat (N / 10);
|
|
end if;
|
|
|
|
Write_Info_Char (Character'Val (N mod 10 + Character'Pos ('0')));
|
|
end Write_Info_Nat;
|
|
|
|
---------------------
|
|
-- Write_Info_Slit --
|
|
---------------------
|
|
|
|
procedure Write_Info_Slit (S : String_Id) is
|
|
C : Character;
|
|
|
|
begin
|
|
Write_Info_Str ("""");
|
|
|
|
for J in 1 .. String_Length (S) loop
|
|
C := Get_Character (Get_String_Char (S, J));
|
|
|
|
if C in Character'Val (16#20#) .. Character'Val (16#7E#)
|
|
and then C /= '{'
|
|
then
|
|
Write_Info_Char (C);
|
|
|
|
if C = '"' then
|
|
Write_Info_Char (C);
|
|
end if;
|
|
|
|
else
|
|
Write_Info_Char ('{');
|
|
Write_Info_Hex_Byte (Character'Pos (C));
|
|
Write_Info_Char ('}');
|
|
end if;
|
|
end loop;
|
|
|
|
Write_Info_Char ('"');
|
|
end Write_Info_Slit;
|
|
|
|
--------------------
|
|
-- Write_Info_Str --
|
|
--------------------
|
|
|
|
procedure Write_Info_Str (Val : String) is
|
|
begin
|
|
Info_Buffer (Info_Buffer_Len + 1 .. Info_Buffer_Len + Val'Length)
|
|
:= Val;
|
|
Info_Buffer_Len := Info_Buffer_Len + Val'Length;
|
|
Info_Buffer_Col := Info_Buffer_Col + Val'Length;
|
|
end Write_Info_Str;
|
|
|
|
--------------------
|
|
-- Write_Info_Tab --
|
|
--------------------
|
|
|
|
procedure Write_Info_Tab (Col : Positive) is
|
|
Next_Tab : Positive;
|
|
|
|
begin
|
|
if Col <= Info_Buffer_Col then
|
|
Write_Info_Str (" ");
|
|
else
|
|
loop
|
|
Next_Tab := 8 * ((Info_Buffer_Col - 1) / 8) + 8 + 1;
|
|
exit when Col < Next_Tab;
|
|
Write_Info_Char (ASCII.HT);
|
|
Info_Buffer_Col := Next_Tab;
|
|
end loop;
|
|
|
|
while Info_Buffer_Col < Col loop
|
|
Write_Info_Char (' ');
|
|
end loop;
|
|
end if;
|
|
end Write_Info_Tab;
|
|
|
|
--------------------------
|
|
-- Write_Info_Terminate --
|
|
--------------------------
|
|
|
|
procedure Write_Info_Terminate is
|
|
begin
|
|
-- Delete any trailing blanks
|
|
|
|
while Info_Buffer_Len > 0
|
|
and then Info_Buffer (Info_Buffer_Len) = ' '
|
|
loop
|
|
Info_Buffer_Len := Info_Buffer_Len - 1;
|
|
end loop;
|
|
|
|
-- Write_Library_Info adds the EOL
|
|
|
|
Write_Library_Info (Info_Buffer (1 .. Info_Buffer_Len));
|
|
|
|
Info_Buffer_Len := 0;
|
|
Info_Buffer_Col := 1;
|
|
end Write_Info_Terminate;
|
|
|
|
---------------------
|
|
-- Write_Info_Uint --
|
|
---------------------
|
|
|
|
procedure Write_Info_Uint (N : Uint) is
|
|
begin
|
|
UI_Image (N, Decimal);
|
|
Write_Info_Str (UI_Image_Buffer (1 .. UI_Image_Length));
|
|
end Write_Info_Uint;
|
|
|
|
end Lib.Util;
|