gcc/ada/tempdir.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              T E M P D I R                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2003-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  28
  29 with Opt;    use Opt;
  30 with Output; use Output;
  31
  32 package body Tempdir is
  33
  34    Tmpdir_Needs_To_Be_Displayed : Boolean := True;
  35
  36    Tmpdir   : constant String := "TMPDIR";
  37    No_Dir   : aliased String  := "";
  38    Temp_Dir : String_Access   := No_Dir'Access;
  39
  40    ----------------------
  41    -- Create_Temp_File --
  42    ----------------------
  43
  44    procedure Create_Temp_File
  45      (FD   : out File_Descriptor;
  46       Name : out Path_Name_Type)
  47    is
  48       File_Name : String_Access;
  49       Current_Dir : constant String := Get_Current_Dir;
  50
  51       function Directory return String;
  52       --  Returns Temp_Dir.all if not empty, else return current directory
  53
  54       ---------------
  55       -- Directory --
  56       ---------------
  57
  58       function Directory return String is
  59       begin
  60          if Temp_Dir'Length /= 0 then
  61             return Temp_Dir.all;
  62
  63          else
  64             return Current_Dir;
  65          end if;
  66       end Directory;
  67
  68    --  Start of processing Tempdir
  69
  70    begin
  71       if Temp_Dir'Length /= 0 then
  72
  73          --  In verbose mode, display once the value of TMPDIR, so that
  74          --  if temp files cannot be created, it is easier to understand
  75          --  where temp files are supposed to be created.
  76
  77          if Verbose_Mode and then Tmpdir_Needs_To_Be_Displayed then
  78             Write_Str ("TMPDIR = """);
  79             Write_Str (Temp_Dir.all);
  80             Write_Line ("""");
  81             Tmpdir_Needs_To_Be_Displayed := False;
  82          end if;
  83
  84          --  Change directory to TMPDIR before creating the temp file,
  85          --  then change back immediately to the previous directory.
  86
  87          Change_Dir (Temp_Dir.all);
  88          Create_Temp_File (FD, File_Name);
  89          Change_Dir (Current_Dir);
  90
  91       else
  92          Create_Temp_File (FD, File_Name);
  93       end if;
  94
  95       if FD = Invalid_FD then
  96          Name := No_Path;
  97
  98       else
  99          declare
 100             Path_Name : constant String :=
 101                           Normalize_Pathname
 102                             (Directory & Directory_Separator & File_Name.all);
 103
 104          begin
 105             Name_Len := Path_Name'Length;
 106             Name_Buffer (1 .. Name_Len) := Path_Name;
 107             Name := Name_Find;
 108             Free (File_Name);
 109          end;
 110       end if;
 111    end Create_Temp_File;
 112
 113 --  Start of elaboration for package Tempdir
 114
 115 begin
 116    declare
 117       Dir : String_Access := Getenv (Tmpdir);
 118
 119    begin
 120       if Dir'Length > 0 and then
 121         Is_Absolute_Path (Dir.all) and then
 122         Is_Directory (Dir.all)
 123       then
 124          Temp_Dir := new String'(Normalize_Pathname (Dir.all));
 125       end if;
 126
 127       Free (Dir);
 128    end;
 129 end Tempdir;