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