1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2003-2009, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
28 with Hostparm; use Hostparm;
30 with Output; use Output;
32 package body Tempdir is
34 Tmpdir_Needs_To_Be_Displayed : Boolean := True;
36 Tmpdir : constant String := "TMPDIR";
37 Gnutmpdir : constant String := "GNUTMPDIR";
38 No_Dir : aliased String := "";
39 Temp_Dir : String_Access := No_Dir'Access;
41 ----------------------
42 -- Create_Temp_File --
43 ----------------------
45 procedure Create_Temp_File
46 (FD : out File_Descriptor;
47 Name : out Path_Name_Type)
49 File_Name : String_Access;
50 Current_Dir : constant String := Get_Current_Dir;
52 function Directory return String;
53 -- Returns Temp_Dir.all if not empty, else return current directory
59 function Directory return String is
61 if Temp_Dir'Length /= 0 then
69 -- Start of processing Tempdir
72 if Temp_Dir'Length /= 0 then
74 -- In verbose mode, display once the value of TMPDIR, so that
75 -- if temp files cannot be created, it is easier to understand
76 -- where temp files are supposed to be created.
78 if Verbose_Mode and then Tmpdir_Needs_To_Be_Displayed then
79 Write_Str ("TMPDIR = """);
80 Write_Str (Temp_Dir.all);
82 Tmpdir_Needs_To_Be_Displayed := False;
85 -- Change directory to TMPDIR before creating the temp file,
86 -- then change back immediately to the previous directory.
88 Change_Dir (Temp_Dir.all);
89 Create_Temp_File (FD, File_Name);
90 Change_Dir (Current_Dir);
93 Create_Temp_File (FD, File_Name);
96 if FD = Invalid_FD then
97 Write_Line ("could not create temporary file in " & Directory);
102 Path_Name : constant String :=
104 (Directory & Directory_Separator & File_Name.all);
107 Name_Len := Path_Name'Length;
108 Name_Buffer (1 .. Name_Len) := Path_Name;
113 end Create_Temp_File;
115 -- Start of elaboration for package Tempdir
122 -- On VMS, if GNUTMPDIR is defined, use it
125 Dir := Getenv (Gnutmpdir);
127 -- Otherwise, if GNUTMPDIR is not defined, try TMPDIR
129 if Dir'Length = 0 then
130 Dir := Getenv (Tmpdir);
134 Dir := Getenv (Tmpdir);
137 if Dir'Length > 0 and then
138 Is_Absolute_Path (Dir.all) and then
139 Is_Directory (Dir.all)
141 Temp_Dir := new String'(Normalize_Pathname (Dir.all));