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-2013, 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 3,  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 COPYING3.  If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26with GNAT.Directory_Operations; use GNAT.Directory_Operations;
27
28with Hostparm; use Hostparm;
29with Opt;      use Opt;
30with Output;   use Output;
31
32package body Tempdir is
33
34   Tmpdir_Needs_To_Be_Displayed : Boolean := True;
35
36   Tmpdir    : constant String := "TMPDIR";
37   Gnutmpdir : constant String := "GNUTMPDIR";
38   Temp_Dir  : String_Access   := new String'("");
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         else
63            return Current_Dir;
64         end if;
65      end Directory;
66
67   --  Start of processing Tempdir
68
69   begin
70      if Temp_Dir'Length /= 0 then
71
72         --  In verbose mode, display once the value of TMPDIR, so that
73         --  if temp files cannot be created, it is easier to understand
74         --  where temp files are supposed to be created.
75
76         if Verbose_Mode and then Tmpdir_Needs_To_Be_Displayed then
77            Write_Str ("TMPDIR = """);
78            Write_Str (Temp_Dir.all);
79            Write_Line ("""");
80            Tmpdir_Needs_To_Be_Displayed := False;
81         end if;
82
83         --  Change directory to TMPDIR before creating the temp file,
84         --  then change back immediately to the previous directory.
85
86         Change_Dir (Temp_Dir.all);
87         Create_Temp_File (FD, File_Name);
88         Change_Dir (Current_Dir);
89
90      else
91         Create_Temp_File (FD, File_Name);
92      end if;
93
94      if FD = Invalid_FD then
95         Write_Line ("could not create temporary file in " & Directory);
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         begin
104            Name_Len := Path_Name'Length;
105            Name_Buffer (1 .. Name_Len) := Path_Name;
106            Name := Name_Find;
107            Free (File_Name);
108         end;
109      end if;
110   end Create_Temp_File;
111
112   ------------------
113   -- Use_Temp_Dir --
114   ------------------
115
116   procedure Use_Temp_Dir (Status : Boolean) is
117      Dir : String_Access;
118
119   begin
120      if Status then
121
122         --  On VMS, if GNUTMPDIR is defined, use it
123
124         if OpenVMS then
125            Dir := Getenv (Gnutmpdir);
126
127            --  Otherwise, if GNUTMPDIR is not defined, try TMPDIR
128
129            if Dir'Length = 0 then
130               Dir := Getenv (Tmpdir);
131            end if;
132
133         else
134            Dir := Getenv (Tmpdir);
135         end if;
136      end if;
137
138      Free (Temp_Dir);
139
140      if Dir /= null
141        and then Dir'Length > 0
142        and then Is_Absolute_Path (Dir.all)
143        and then Is_Directory (Dir.all)
144      then
145         Temp_Dir := new String'(Normalize_Pathname (Dir.all));
146      else
147         Temp_Dir := new String'("");
148      end if;
149
150      Free (Dir);
151   end Use_Temp_Dir;
152
153--  Start of elaboration for package Tempdir
154
155begin
156   Use_Temp_Dir (Status => True);
157end Tempdir;
158