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