Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/tempdir.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
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; |