Dead
[official-gcc.git] / gomp-20050608-branch / gcc / ada / tempdir.adb
bloba0b8adacac76fc4d0a23b206eb10a827bb04d508
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-2005 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
27 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
29 with Namet; use Namet;
30 with Opt; use Opt;
31 with Output; use Output;
33 package body Tempdir is
35 Tmpdir_Needs_To_Be_Displayed : Boolean := True;
37 Tmpdir : constant String := "TMPDIR";
38 No_Dir : aliased String := "";
39 Temp_Dir : String_Access := No_Dir'Access;
41 procedure Create_Temp_File
42 (FD : out File_Descriptor;
43 Name : out Name_Id)
45 File_Name : String_Access;
46 Current_Dir : constant String := Get_Current_Dir;
48 function Directory return String;
49 -- Returns Temp_Dir.all if not empty, else return current directory
51 ---------------
52 -- Directory --
53 ---------------
55 function Directory return String is
56 begin
57 if Temp_Dir'Length /= 0 then
58 return Temp_Dir.all;
60 else
61 return Current_Dir;
62 end if;
63 end Directory;
65 -- Start of processing Tempdir
67 begin
68 if Temp_Dir'Length /= 0 then
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.
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;
81 -- Change directory to TMPDIR before creating the temp file,
82 -- then change back immediately to the previous directory.
84 Change_Dir (Temp_Dir.all);
85 Create_Temp_File (FD, File_Name);
86 Change_Dir (Current_Dir);
88 else
89 Create_Temp_File (FD, File_Name);
90 end if;
92 if FD = Invalid_FD then
93 Name := No_Name;
95 else
96 declare
97 Path_Name : constant String :=
98 Normalize_Pathname
99 (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;
110 -- Start of elaboration for package Tempdir
112 begin
113 declare
114 Dir : String_Access := Getenv (Tmpdir);
116 begin
117 if Dir'Length > 0 and then
118 Is_Absolute_Path (Dir.all) and then
119 Is_Directory (Dir.all)
120 then
121 Temp_Dir := new String'(Normalize_Pathname (Dir.all));
122 end if;
124 Free (Dir);
125 end;
126 end Tempdir;