When a source is compiled with automated preprocessing specified by
switch -gnatep= with the full path of the preprocessing data file and
the path name includes spaces, the ALI file is detected as incorrect.
This patch fixes that: path names that include spaces are now quoted in
ALI files.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-10-14 Vincent Celier <cel...@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.
Index: lib-writ.adb
===================================================================
--- lib-writ.adb (revision 203521)
+++ lib-writ.adb (working copy)
@@ -1428,7 +1428,7 @@
Fname := Name_Find;
end if;
- Write_Info_Name (Fname);
+ Write_Info_Name_May_Be_Quoted (Fname);
Write_Info_Tab (25);
Write_Info_Str (String (Time_Stamp (Sind)));
Write_Info_Char (' ');
Index: ali.adb
===================================================================
--- ali.adb (revision 203521)
+++ ali.adb (working copy)
@@ -186,9 +186,13 @@
function Getc return Character;
-- Get next character, bumping P past the character obtained
- function Get_File_Name (Lower : Boolean := False) return File_Name_Type;
+ function Get_File_Name
+ (Lower : Boolean := False;
+ May_Be_Quoted : Boolean := False) return File_Name_Type;
-- Skip blanks, then scan out a file name (name is left in Name_Buffer
-- with length in Name_Len, as well as returning a File_Name_Type value.
+ -- If May_Be_Quoted is True and the first non blank character is '"',
+ -- then remove starting and ending quotes and undoubled internal quotes.
-- If lower is false, the case is unchanged, if Lower is True then the
-- result is forced to all lower case for systems where file names are
-- not case sensitive. This ensures that gnatbind works correctly
@@ -198,7 +202,8 @@
function Get_Name
(Ignore_Spaces : Boolean := False;
- Ignore_Special : Boolean := False) return Name_Id;
+ Ignore_Special : Boolean := False;
+ May_Be_Quoted : Boolean := False) return Name_Id;
-- Skip blanks, then scan out a name (name is left in Name_Buffer with
-- length in Name_Len, as well as being returned in Name_Id form).
-- If Lower is set to True then the Name_Buffer will be converted to
@@ -215,6 +220,10 @@
-- an operator name starting with a double quote which is terminated
-- by another double quote.
--
+ -- If May_Be_Quoted is True and the first non blank character is '"'
+ -- the name is 'unquoted'. In this case Ignore_Special is ignored and
+ -- assumed to be True.
+ --
-- It is an error to set both Ignore_Spaces and Ignore_Special to True.
-- This function handles wide characters properly.
@@ -450,12 +459,14 @@
-------------------
function Get_File_Name
- (Lower : Boolean := False) return File_Name_Type
+ (Lower : Boolean := False;
+ May_Be_Quoted : Boolean := False) return File_Name_Type
is
F : Name_Id;
begin
- F := Get_Name (Ignore_Special => True);
+ F := Get_Name (Ignore_Special => True,
+ May_Be_Quoted => May_Be_Quoted);
-- Convert file name to all lower case if file names are not case
-- sensitive. This ensures that we handle names in the canonical
@@ -475,8 +486,11 @@
function Get_Name
(Ignore_Spaces : Boolean := False;
- Ignore_Special : Boolean := False) return Name_Id
+ Ignore_Special : Boolean := False;
+ May_Be_Quoted : Boolean := False) return Name_Id
is
+ Char : Character;
+
begin
Name_Len := 0;
Skip_Space;
@@ -489,38 +503,79 @@
end if;
end if;
- loop
- Add_Char_To_Name_Buffer (Getc);
+ Char := Getc;
- exit when At_End_Of_Field and then not Ignore_Spaces;
+ -- Deal with quoted characters
- if not Ignore_Special then
- if Name_Buffer (1) = '"' then
- exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"';
+ if May_Be_Quoted and then Char = '"' then
+ loop
+ if At_Eol then
+ if Ignore_Errors then
+ return Error_Name;
+ else
+ Fatal_Error;
+ end if;
+ end if;
- else
- -- Terminate on parens or angle brackets or equal sign
+ Char := Getc;
- exit when Nextc = '(' or else Nextc = ')'
- or else Nextc = '{' or else Nextc = '}'
- or else Nextc = '<' or else Nextc = '>'
- or else Nextc = '=';
+ if Char = '"' then
+ if At_Eol then
+ exit;
- -- Terminate on comma
+ else
+ Char := Getc;
- exit when Nextc = ',';
+ if Char /= '"' then
+ P := P - 1;
+ exit;
+ end if;
+ end if;
+ end if;
- -- Terminate if left bracket not part of wide char sequence
- -- Note that we only recognize brackets notation so far ???
+ Add_Char_To_Name_Buffer (Char);
+ end loop;
- exit when Nextc = '[' and then T (P + 1) /= '"';
+ -- Other than case of quoted character
- -- Terminate if right bracket not part of wide char sequence
+ else
+ P := P - 1;
+ loop
+ Add_Char_To_Name_Buffer (Getc);
- exit when Nextc = ']' and then T (P - 1) /= '"';
+ exit when At_End_Of_Field and then not Ignore_Spaces;
+
+ if not Ignore_Special then
+ if Name_Buffer (1) = '"' then
+ exit when Name_Len > 1
+ and then Name_Buffer (Name_Len) = '"';
+
+ else
+ -- Terminate on parens or angle brackets or equal sign
+
+ exit when Nextc = '(' or else Nextc = ')'
+ or else Nextc = '{' or else Nextc = '}'
+ or else Nextc = '<' or else Nextc = '>'
+ or else Nextc = '=';
+
+ -- Terminate on comma
+
+ exit when Nextc = ',';
+
+ -- Terminate if left bracket not part of wide char
+ -- sequence Note that we only recognize brackets
+ -- notation so far ???
+
+ exit when Nextc = '[' and then T (P + 1) /= '"';
+
+ -- Terminate if right bracket not part of wide char
+ -- sequence.
+
+ exit when Nextc = ']' and then T (P - 1) /= '"';
+ end if;
end if;
- end if;
- end loop;
+ end loop;
+ end if;
return Name_Find;
end Get_Name;
@@ -2224,8 +2279,11 @@
-- In the following call, Lower is not set to True, this is either
-- a bug, or it deserves a special comment as to why this is so???
- Sdep.Table (Sdep.Last).Sfile := Get_File_Name;
+ -- The file/path name may be quoted
+ Sdep.Table (Sdep.Last).Sfile :=
+ Get_File_Name (May_Be_Quoted => True);
+
Sdep.Table (Sdep.Last).Stamp := Get_Stamp;
Sdep.Table (Sdep.Last).Dummy_Entry :=
(Sdep.Table (Sdep.Last).Stamp = Dummy_Time_Stamp);
Index: lib-util.adb
===================================================================
--- lib-util.adb (revision 203521)
+++ lib-util.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- 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- --
@@ -176,6 +176,51 @@
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 --
--------------------
Index: lib-util.ads
===================================================================
--- lib-util.ads (revision 203521)
+++ lib-util.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- 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- --
@@ -65,6 +65,10 @@
-- name is written literally from the names table entry without modifying
-- the case, using simply Get_Name_String.
+ procedure Write_Info_Name_May_Be_Quoted (Name : File_Name_Type);
+ -- Similar to Write_Info_Name, but if Name includes spaces, then it is
+ -- quoted and the '"' are doubled.
+
procedure Write_Info_Slit (S : String_Id);
-- Write string literal value in format required for L/N lines in ali file
