PR ada/52494

[pf3gnuchains/gcc-fork.git] / gcc / ada / gnatcmd.adb

diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 0fd1d94..8798399 100644 (file)
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2012, 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- --
@@ -34,7 +34,7 @@ with MLib.Fil;
 with Namet;    use Namet;
 with Opt;      use Opt;
 with Osint;    use Osint;
-with Output;
+with Output;   use Output;
 with Prj;      use Prj;
 with Prj.Env;
 with Prj.Ext;  use Prj.Ext;
@@ -202,6 +202,9 @@ procedure GNATCmd is
    --  indicate that the underlying tool (gnatcheck, gnatpp or gnatmetric)
    --  should be invoked for all sources of all projects.
 
+   Max_OpenVMS_Logical_Length : constant Integer := 255;
+   --  The maximum length of OpenVMS logicals
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -927,11 +930,20 @@ procedure GNATCmd is
             end if;
          end loop;
 
-         if not Keep_Temporary_Files then
-            Delete (File);
-         else
-            Close (File);
-         end if;
+         begin
+            if not Keep_Temporary_Files then
+               Delete (File);
+            else
+               Close (File);
+            end if;
+
+         --  Don't crash if it is not possible to delete or close the file,
+         --  just ignore the situation.
+
+         exception
+            when others =>
+               null;
+         end;
       end if;
    end Get_Closure;
 
@@ -1363,6 +1375,10 @@ procedure GNATCmd is
 --  Start of processing for GNATCmd
 
 begin
+   --  All output from GNATCmd is debugging or error output: send to stderr
+
+   Set_Standard_Error;
+
    --  Initializations
 
    Csets.Initialize;
@@ -1411,6 +1427,15 @@ begin
       Add_Str_To_Name_Buffer (Argument (J));
    end loop;
 
+   --  On OpenVMS, setenv creates a logical whose length is limited to
+   --  255 bytes.
+
+   if OpenVMS and then Name_Len > Max_OpenVMS_Logical_Length then
+      Name_Buffer (Max_OpenVMS_Logical_Length - 2
+                     .. Max_OpenVMS_Logical_Length) := "...";
+      Name_Len := Max_OpenVMS_Logical_Length;
+   end if;
+
    Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
 
    --  Add the directory where the GNAT driver is invoked in front of the path,
@@ -1880,6 +1905,10 @@ begin
             Env               => Root_Environment,
             Packages_To_Check => Packages_To_Check);
 
+         --  Prj.Pars.Parse calls Set_Standard_Output, reset to stderr
+
+         Set_Standard_Error;
+
          if Project = Prj.No_Project then
             Fail ("""" & Project_File.all & """ processing failed");
          end if;
@@ -2062,7 +2091,7 @@ begin
             begin
                if Pkg /= No_Package then
 
-                  --  First, check if there is a single main specified.
+                  --  First, check if there is a single main specified
 
                   for J in 1  .. Last_Switches.Last loop
                      if Last_Switches.Table (J) (1) /= '-' then