]>
Commit | Line | Data |
---|---|---|
fbf5a39b AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- T E M P D I R -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 2003-2020, Free Software Foundation, Inc. -- |
fbf5a39b AC |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
fbf5a39b AC |
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 -- | |
b5c84c3c RD |
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. -- | |
fbf5a39b AC |
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 | ||
98d68cf1 VC |
28 | with Opt; use Opt; |
29 | with Output; use Output; | |
fbf5a39b AC |
30 | |
31 | package body Tempdir is | |
32 | ||
33 | Tmpdir_Needs_To_Be_Displayed : Boolean := True; | |
34 | ||
62883e6b AC |
35 | Tmpdir : constant String := "TMPDIR"; |
36 | Temp_Dir : String_Access := new String'(""); | |
fbf5a39b | 37 | |
39f4e199 VC |
38 | ---------------------- |
39 | -- Create_Temp_File -- | |
40 | ---------------------- | |
41 | ||
fbf5a39b AC |
42 | procedure Create_Temp_File |
43 | (FD : out File_Descriptor; | |
39f4e199 | 44 | Name : out Path_Name_Type) |
fbf5a39b | 45 | is |
77a03520 | 46 | File_Name : String_Access; |
fbf5a39b AC |
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; | |
fbf5a39b AC |
60 | else |
61 | return Current_Dir; | |
62 | end if; | |
63 | end Directory; | |
64 | ||
704228bd | 65 | -- Start of processing for Create_Temp_File |
fbf5a39b AC |
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 | |
a52fefe6 | 93 | Write_Line ("could not create temporary file in " & Directory); |
39f4e199 | 94 | Name := No_Path; |
fbf5a39b AC |
95 | |
96 | else | |
97 | declare | |
98 | Path_Name : constant String := | |
39f4e199 VC |
99 | Normalize_Pathname |
100 | (Directory & Directory_Separator & File_Name.all); | |
fbf5a39b AC |
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 | ||
77a03520 AC |
110 | ------------------ |
111 | -- Use_Temp_Dir -- | |
112 | ------------------ | |
fbf5a39b | 113 | |
77a03520 | 114 | procedure Use_Temp_Dir (Status : Boolean) is |
98d68cf1 | 115 | Dir : String_Access; |
fbf5a39b AC |
116 | |
117 | begin | |
77a03520 | 118 | if Status then |
62883e6b | 119 | Dir := Getenv (Tmpdir); |
98d68cf1 VC |
120 | end if; |
121 | ||
77a03520 AC |
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) | |
1c9e0120 | 128 | then |
fbf5a39b | 129 | Temp_Dir := new String'(Normalize_Pathname (Dir.all)); |
77a03520 AC |
130 | else |
131 | Temp_Dir := new String'(""); | |
fbf5a39b AC |
132 | end if; |
133 | ||
134 | Free (Dir); | |
77a03520 AC |
135 | end Use_Temp_Dir; |
136 | ||
137 | -- Start of elaboration for package Tempdir | |
138 | ||
139 | begin | |
140 | Use_Temp_Dir (Status => True); | |
fbf5a39b | 141 | end Tempdir; |