diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-10-14 14:58:07 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-10-14 14:58:07 +0200 |
commit | e4691ba99bff054f10be59543a6571fdbabbb427 (patch) | |
tree | 0da9ae3cf125fe15279d8fbab380186d017f8e4e /gcc/ada | |
parent | 0a387eca30eaf0766b8de644dd61bf9cadbbf21d (diff) | |
download | gcc-e4691ba99bff054f10be59543a6571fdbabbb427.zip gcc-e4691ba99bff054f10be59543a6571fdbabbb427.tar.gz gcc-e4691ba99bff054f10be59543a6571fdbabbb427.tar.bz2 |
[multiple changes]
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
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
-rw-r--r-- | gcc/ada/a-exexda.adb | 8 | ||||
-rw-r--r-- | gcc/ada/ali.adb | 112 | ||||
-rw-r--r-- | gcc/ada/exp_prag.adb | 8 | ||||
-rw-r--r-- | gcc/ada/lib-util.adb | 47 | ||||
-rw-r--r-- | gcc/ada/lib-util.ads | 6 | ||||
-rw-r--r-- | gcc/ada/lib-writ.adb | 2 | ||||
-rw-r--r-- | gcc/ada/s-vmexta.ads | 15 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 14 |
9 files changed, 180 insertions, 52 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f11be92..ab038b7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +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. + 2013-10-14 Hristian Kirtchev <kirtchev@adacore.com> * sem_prag.adb (Analyze_Depends_In_Decl_Part, diff --git a/gcc/ada/a-exexda.adb b/gcc/ada/a-exexda.adb index 815afac..a201551 100644 --- a/gcc/ada/a-exexda.adb +++ b/gcc/ada/a-exexda.adb @@ -390,6 +390,7 @@ package body Exception_Data is Ptr : in out Natural) is Load_Address : Address; + begin if X.Num_Tracebacks = 0 then return; @@ -398,6 +399,7 @@ package body Exception_Data is -- The executable load address line Load_Address := Get_Executable_Load_Address; + if Load_Address /= Null_Address then Append_Info_String (LDAD_Header, Info, Ptr); Append_Info_Address (Load_Address, Info, Ptr); @@ -427,9 +429,9 @@ package body Exception_Data is Space_Per_Address : constant := 2 + 16 + 1; -- Space for "0x" + HHHHHHHHHHHHHHHH + " " begin - return LDAD_Header'Length + Space_Per_Address + - BETB_Header'Length + 1 + - X.Num_Tracebacks * Space_Per_Address + 1; + return + LDAD_Header'Length + Space_Per_Address + BETB_Header'Length + 1 + + X.Num_Tracebacks * Space_Per_Address + 1; end Basic_Exception_Tback_Maxlength; --------------------------------------- diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 6c2f818..aff6740 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -186,9 +186,13 @@ package body ALI is 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 @@ package body ALI is 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 @@ package body ALI is -- 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 @@ package body ALI is ------------------- 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 @@ package body ALI is 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 @@ package body ALI is 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 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) /= '"'; + 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,7 +2279,10 @@ package body ALI is -- 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 := diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 35bedf3..3576444 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -642,8 +642,8 @@ package body Exp_Prag is if Exception_Code (Id) /= No_Uint then - -- The code for the exception is present.Create a - -- linker alias to define the symbol. + -- The code for the exception is present. Create a linker + -- alias to define the symbol. Code := Make_Integer_Literal (Loc, @@ -666,8 +666,8 @@ package body Exp_Prag is Store_String_Int (UI_To_Int (Exception_Code (Id)) / 8 * 8); - -- Insert a pragma Linker_Alias to set the value of - -- the dummy object symbol. + -- Insert a pragma Linker_Alias to set the value of the + -- dummy object symbol. Excep_Alias := Make_Pragma (Loc, diff --git a/gcc/ada/lib-util.adb b/gcc/ada/lib-util.adb index 9047690..ae6e204 100644 --- a/gcc/ada/lib-util.adb +++ b/gcc/ada/lib-util.adb @@ -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 @@ package body Lib.Util is 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 -- -------------------- diff --git a/gcc/ada/lib-util.ads b/gcc/ada/lib-util.ads index b34bd27..f4034d6 100644 --- a/gcc/ada/lib-util.ads +++ b/gcc/ada/lib-util.ads @@ -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 @@ package Lib.Util is -- 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 diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index c4b5e50..cb5278c 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -1428,7 +1428,7 @@ package body Lib.Writ is 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 (' '); diff --git a/gcc/ada/s-vmexta.ads b/gcc/ada/s-vmexta.ads index 4bf83de..b6ac23c 100644 --- a/gcc/ada/s-vmexta.ads +++ b/gcc/ada/s-vmexta.ads @@ -41,13 +41,12 @@ package System.VMS_Exception_Table is procedure Register_VMS_Exception (Code : SSL.Exception_Code; E : SSL.Exception_Data_Ptr); - -- Register an exception in the hash table mapping with a VMS - -- condition code. - - -- The table is used by exception code (the personnality routine) to - -- detect wether a VMS exception (aka condition) is known by the Ada code. - -- In that case, the identity of the imported or exported exception is - -- used to create the occurrence. + -- Register an exception in hash table mapping with a VMS condition code. + -- + -- The table is used by exception code (the personnality routine) to detect + -- wether a VMS exception (aka condition) is known by the Ada code. In + -- that case, the identity of the imported or exported exception is used + -- to create the occurrence. -- LOTS more comments needed here regarding the entire scheme ??? @@ -61,6 +60,6 @@ private function Coded_Exception (X : SSL.Exception_Code) return SSL.Exception_Data_Ptr; - -- Given a VMS condition, find and return it's allocated Ada exception + -- Given a VMS condition, find and return its allocated Ada exception end System.VMS_Exception_Table; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0fbb386..308685f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -213,13 +213,13 @@ package body Sem_Prag is Has_In_Out_State : out Boolean; Has_Out_State : out Boolean; Has_Null_State : out Boolean); - -- Subsidiary to the analysis of pragma Refined_Depends and pragma - -- Refined_Global. Prag denotes pragma [Refined_]Global. Gather all input, - -- in out and output items of Prag in lists In_Items, In_Out_Items and - -- Out_Items. Flags Has_In_State, Has_In_Out_State and Has_Out_State are - -- set when there is at least one abstract state with visible refinement - -- available in the corresponding mode. Flag Has_Null_State is set when at - -- least state has a null refinement. + -- Subsidiary to the analysis of pragma Refined_Depends/Refined_Global. + -- Prag denotes pragma [Refined_]Global. Gather all input, in out and + -- output items of Prag in lists In_Items, In_Out_Items and Out_Items. + -- Flags Has_In_State, Has_In_Out_State and Has_Out_State are set when + -- there is at least one abstract state with visible refinement available + -- in the corresponding mode. Flag Has_Null_State is set when at least + -- state has a null refinement. procedure Collect_Subprogram_Inputs_Outputs (Subp_Id : Entity_Id; |