]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/tempdir.adb
[Ada] Bump copyright year
[thirdparty/gcc.git] / gcc / ada / tempdir.adb
CommitLineData
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
26with GNAT.Directory_Operations; use GNAT.Directory_Operations;
27
98d68cf1
VC
28with Opt; use Opt;
29with Output; use Output;
fbf5a39b
AC
30
31package 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
139begin
140 Use_Temp_Dir (Status => True);
fbf5a39b 141end Tempdir;