|
111
|
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-2015, 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
|
|
|
26 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
|
|
27
|
|
|
28 with Opt; use Opt;
|
|
|
29 with Output; use Output;
|
|
|
30
|
|
|
31 package body Tempdir is
|
|
|
32
|
|
|
33 Tmpdir_Needs_To_Be_Displayed : Boolean := True;
|
|
|
34
|
|
|
35 Tmpdir : constant String := "TMPDIR";
|
|
|
36 Temp_Dir : String_Access := new String'("");
|
|
|
37
|
|
|
38 ----------------------
|
|
|
39 -- Create_Temp_File --
|
|
|
40 ----------------------
|
|
|
41
|
|
|
42 procedure Create_Temp_File
|
|
|
43 (FD : out File_Descriptor;
|
|
|
44 Name : out Path_Name_Type)
|
|
|
45 is
|
|
|
46 File_Name : String_Access;
|
|
|
47 Current_Dir : constant String := Get_Current_Dir;
|
|
|
48
|
|
|
49 function Directory return String;
|
|
|
50 -- Returns Temp_Dir.all if not empty, else return current directory
|
|
|
51
|
|
|
52 ---------------
|
|
|
53 -- Directory --
|
|
|
54 ---------------
|
|
|
55
|
|
|
56 function Directory return String is
|
|
|
57 begin
|
|
|
58 if Temp_Dir'Length /= 0 then
|
|
|
59 return Temp_Dir.all;
|
|
|
60 else
|
|
|
61 return Current_Dir;
|
|
|
62 end if;
|
|
|
63 end Directory;
|
|
|
64
|
|
|
65 -- Start of processing for Create_Temp_File
|
|
|
66
|
|
|
67 begin
|
|
|
68 if Temp_Dir'Length /= 0 then
|
|
|
69
|
|
|
70 -- In verbose mode, display once the value of TMPDIR, so that
|
|
|
71 -- if temp files cannot be created, it is easier to understand
|
|
|
72 -- where temp files are supposed to be created.
|
|
|
73
|
|
|
74 if Verbose_Mode and then Tmpdir_Needs_To_Be_Displayed then
|
|
|
75 Write_Str ("TMPDIR = """);
|
|
|
76 Write_Str (Temp_Dir.all);
|
|
|
77 Write_Line ("""");
|
|
|
78 Tmpdir_Needs_To_Be_Displayed := False;
|
|
|
79 end if;
|
|
|
80
|
|
|
81 -- Change directory to TMPDIR before creating the temp file,
|
|
|
82 -- then change back immediately to the previous directory.
|
|
|
83
|
|
|
84 Change_Dir (Temp_Dir.all);
|
|
|
85 Create_Temp_File (FD, File_Name);
|
|
|
86 Change_Dir (Current_Dir);
|
|
|
87
|
|
|
88 else
|
|
|
89 Create_Temp_File (FD, File_Name);
|
|
|
90 end if;
|
|
|
91
|
|
|
92 if FD = Invalid_FD then
|
|
|
93 Write_Line ("could not create temporary file in " & Directory);
|
|
|
94 Name := No_Path;
|
|
|
95
|
|
|
96 else
|
|
|
97 declare
|
|
|
98 Path_Name : constant String :=
|
|
|
99 Normalize_Pathname
|
|
|
100 (Directory & Directory_Separator & File_Name.all);
|
|
|
101 begin
|
|
|
102 Name_Len := Path_Name'Length;
|
|
|
103 Name_Buffer (1 .. Name_Len) := Path_Name;
|
|
|
104 Name := Name_Find;
|
|
|
105 Free (File_Name);
|
|
|
106 end;
|
|
|
107 end if;
|
|
|
108 end Create_Temp_File;
|
|
|
109
|
|
|
110 ------------------
|
|
|
111 -- Use_Temp_Dir --
|
|
|
112 ------------------
|
|
|
113
|
|
|
114 procedure Use_Temp_Dir (Status : Boolean) is
|
|
|
115 Dir : String_Access;
|
|
|
116
|
|
|
117 begin
|
|
|
118 if Status then
|
|
|
119 Dir := Getenv (Tmpdir);
|
|
|
120 end if;
|
|
|
121
|
|
|
122 Free (Temp_Dir);
|
|
|
123
|
|
|
124 if Dir /= null
|
|
|
125 and then Dir'Length > 0
|
|
|
126 and then Is_Absolute_Path (Dir.all)
|
|
|
127 and then Is_Directory (Dir.all)
|
|
|
128 then
|
|
|
129 Temp_Dir := new String'(Normalize_Pathname (Dir.all));
|
|
|
130 else
|
|
|
131 Temp_Dir := new String'("");
|
|
|
132 end if;
|
|
|
133
|
|
|
134 Free (Dir);
|
|
|
135 end Use_Temp_Dir;
|
|
|
136
|
|
|
137 -- Start of elaboration for package Tempdir
|
|
|
138
|
|
|
139 begin
|
|
|
140 Use_Temp_Dir (Status => True);
|
|
|
141 end Tempdir;
|
