[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

gcc/ada/ChangeLog

+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,

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,8 +429,8 @@ 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 +
+      return
+        LDAD_Header'Length + Space_Per_Address + BETB_Header'Length + 1 +
           X.Num_Tracebacks * Space_Per_Address + 1;
    end Basic_Exception_Tback_Maxlength;
 

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,6 +503,43 @@ package body ALI is
             end if;
          end if;
 
+         Char := Getc;
+
+         --  Deal with quoted characters
+
+         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;
+
+               Char := Getc;
+
+               if Char = '"' then
+                  if At_Eol then
+                     exit;
+
+                  else
+                     Char := Getc;
+
+                     if Char /= '"' then
+                        P := P - 1;
+                        exit;
+                     end if;
+                  end if;
+               end if;
+
+               Add_Char_To_Name_Buffer (Char);
+            end loop;
+
+         --  Other than case of quoted character
+
+         else
+            P := P - 1;
             loop
                Add_Char_To_Name_Buffer (Getc);
 
@@ -496,7 +547,8 @@ package body ALI is
 
                if not Ignore_Special then
                   if Name_Buffer (1) = '"' then
-                  exit when Name_Len > 1 and then Name_Buffer (Name_Len) = '"';
+                     exit when Name_Len > 1
+                               and then Name_Buffer (Name_Len) = '"';
 
                   else
                      --  Terminate on parens or angle brackets or equal sign
@@ -510,17 +562,20 @@ package body ALI is
 
                      exit when Nextc = ',';
 
-                  --  Terminate if left bracket not part of wide char sequence
-                  --  Note that we only recognize brackets notation so far ???
+                     --  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
+                     --  Terminate if right bracket not part of wide char
+                     --  sequence.
 
                      exit when Nextc = ']' and then T (P - 1) /= '"';
                   end if;
                end if;
             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 :=

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,

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 --
    --------------------

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
 

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 (' ');

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;

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;