-- Appends Suffix to Name and returns the new name
function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
- -- Convert OS format time to GNAT format time stamp.
- -- Returns Empty_Time_Stamp if T is Invalid_Time
+ -- Convert OS format time to GNAT format time stamp. If T is Invalid_Time,
+ -- then returns Empty_Time_Stamp.
function Executable_Prefix return String_Ptr;
-- Returns the name of the root directory where the executable is stored.
-- "/foo/bar/". Return "" if location is not recognized as described above.
function Update_Path (Path : String_Ptr) return String_Ptr;
- -- Update the specified path to replace the prefix with the location
- -- where GNAT is installed. See the file prefix.c in GCC for details.
+ -- Update the specified path to replace the prefix with the location where
+ -- GNAT is installed. See the file prefix.c in GCC for details.
procedure Locate_File
(N : File_Name_Type;
-- if T = Source, Dir is an index into the Src_Search_Directories table.
-- Returns the File_Name_Type of the full file name if file found, or
-- No_File if not found.
+ --
-- On exit, Found is set to the file that was found, and Attr to a cache of
-- its attributes (at least those that have been computed so far). Reusing
-- the cache will save some system calls.
+ --
-- Attr is always reset in this call to Unknown_Attributes, even in case of
-- failure
Path_Len : Integer) return String_Access;
-- Converts a C String to an Ada String. Are we doing this to avoid withing
-- Interfaces.C.Strings ???
+ -- Caller must free result.
function Include_Dir_Default_Prefix return String_Access;
-- Same as exported version, except returns a String_Access
File : File_Name_Type;
Attr : aliased File_Attributes;
end record;
+
No_File_Info_Cache : constant File_Info_Cache :=
- (No_File, Unknown_Attributes);
+ (No_File, Unknown_Attributes);
package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => File_Hash_Num,
Fail ("missing library directory name");
end if;
- Lib_Search_Directories.Increment_Last;
- Lib_Search_Directories.Table (Lib_Search_Directories.Last) :=
- Normalize_Directory_Name (Dir);
+ declare
+ Norm : String_Ptr := Normalize_Directory_Name (Dir);
+
+ begin
+ -- Do nothing if the directory is already in the list. This saves
+ -- system calls and avoid unneeded work
+
+ for D in Lib_Search_Directories.First ..
+ Lib_Search_Directories.Last
+ loop
+ if Lib_Search_Directories.Table (D).all = Norm.all then
+ Free (Norm);
+ return;
+ end if;
+ end loop;
+
+ Lib_Search_Directories.Increment_Last;
+ Lib_Search_Directories.Table (Lib_Search_Directories.Last) := Norm;
+ end;
end Add_Lib_Search_Dir;
---------------------
-- Executable_Name --
---------------------
- function Executable_Name (Name : File_Name_Type) return File_Name_Type is
+ function Executable_Name
+ (Name : File_Name_Type;
+ Only_If_No_Suffix : Boolean := False) return File_Name_Type
+ is
Exec_Suffix : String_Access;
+ Add_Suffix : Boolean;
begin
if Name = No_File then
Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
end if;
- Get_Name_String (Name);
-
if Exec_Suffix'Length /= 0 then
- declare
- Buffer : String := Name_Buffer (1 .. Name_Len);
-
- begin
- -- Get the file name in canonical case to accept as is names
- -- ending with ".EXE" on VMS and Windows.
-
- Canonical_Case_File_Name (Buffer);
+ Get_Name_String (Name);
+
+ Add_Suffix := True;
+ if Only_If_No_Suffix then
+ for J in reverse 1 .. Name_Len loop
+ if Name_Buffer (J) = '.' then
+ Add_Suffix := False;
+ exit;
+
+ elsif Name_Buffer (J) = '/' or else
+ Name_Buffer (J) = Directory_Separator
+ then
+ exit;
+ end if;
+ end loop;
+ end if;
- -- If Executable does not end with the executable suffix, add it
+ if Add_Suffix then
+ declare
+ Buffer : String := Name_Buffer (1 .. Name_Len);
- if Buffer'Length <= Exec_Suffix'Length
- or else
- Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
- /= Exec_Suffix.all
- then
- Name_Buffer (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
- Exec_Suffix.all;
- Name_Len := Name_Len + Exec_Suffix'Length;
- Free (Exec_Suffix);
- return Name_Find;
- end if;
- end;
+ begin
+ -- Get the file name in canonical case to accept as is names
+ -- ending with ".EXE" on VMS and Windows.
+
+ Canonical_Case_File_Name (Buffer);
+
+ -- If Executable does not end with the executable suffix, add
+ -- it.
+
+ if Buffer'Length <= Exec_Suffix'Length
+ or else
+ Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
+ /= Exec_Suffix.all
+ then
+ Name_Buffer
+ (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
+ Exec_Suffix.all;
+ Name_Len := Name_Len + Exec_Suffix'Length;
+ Free (Exec_Suffix);
+ return Name_Find;
+ end if;
+ end;
+ end if;
end if;
Free (Exec_Suffix);
return Name;
end Executable_Name;
- function Executable_Name (Name : String) return String is
+ function Executable_Name
+ (Name : String;
+ Only_If_No_Suffix : Boolean := False) return String
+ is
Exec_Suffix : String_Access;
+ Add_Suffix : Boolean;
Canonical_Name : String := Name;
begin
Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
end if;
- declare
- Suffix : constant String := Exec_Suffix.all;
-
- begin
+ if Exec_Suffix'Length = 0 then
Free (Exec_Suffix);
- Canonical_Case_File_Name (Canonical_Name);
+ return Name;
+
+ else
+ declare
+ Suffix : constant String := Exec_Suffix.all;
- if Suffix'Length /= 0
- and then
- (Canonical_Name'Length <= Suffix'Length
+ begin
+ Free (Exec_Suffix);
+ Canonical_Case_File_Name (Canonical_Name);
+
+ Add_Suffix := True;
+ if Only_If_No_Suffix then
+ for J in reverse Canonical_Name'Range loop
+ if Canonical_Name (J) = '.' then
+ Add_Suffix := False;
+ exit;
+
+ elsif Canonical_Name (J) = '/' or else
+ Canonical_Name (J) = Directory_Separator
+ then
+ exit;
+ end if;
+ end loop;
+ end if;
+
+ if Add_Suffix and then
+ (Canonical_Name'Length <= Suffix'Length
or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
- .. Canonical_Name'Last) /= Suffix)
- then
- declare
- Result : String (1 .. Name'Length + Suffix'Length);
- begin
- Result (1 .. Name'Length) := Name;
- Result (Name'Length + 1 .. Result'Last) := Suffix;
- return Result;
- end;
- else
- return Name;
- end if;
- end;
+ .. Canonical_Name'Last) /= Suffix)
+ then
+ declare
+ Result : String (1 .. Name'Length + Suffix'Length);
+ begin
+ Result (1 .. Name'Length) := Name;
+ Result (Name'Length + 1 .. Result'Last) := Suffix;
+ return Result;
+ end;
+ else
+ return Name;
+ end if;
+ end;
+ end if;
end Executable_Name;
-----------------------
-----------------
function File_Length
- (Name : C_File_Name; Attr : access File_Attributes) return Long_Integer
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Long_Integer
is
function Internal
- (F : Integer; N : C_File_Name; A : System.Address) return Long_Integer;
+ (F : Integer;
+ N : C_File_Name;
+ A : System.Address) return Long_Integer;
pragma Import (C, Internal, "__gnat_file_length_attr");
begin
return Internal (-1, Name, Attr.all'Address);
---------------------
function File_Time_Stamp
- (Name : C_File_Name; Attr : access File_Attributes) return OS_Time
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return OS_Time
is
function Internal (N : C_File_Name; A : System.Address) return OS_Time;
pragma Import (C, Internal, "__gnat_file_time_name_attr");
return Internal (Name, Attr.all'Address);
end File_Time_Stamp;
+ function File_Time_Stamp
+ (Name : Path_Name_Type;
+ Attr : access File_Attributes) return Time_Stamp_Type
+ is
+ begin
+ if Name = No_Path then
+ return Empty_Time_Stamp;
+ end if;
+
+ Get_Name_String (Name);
+ Name_Buffer (Name_Len + 1) := ASCII.NUL;
+ return OS_Time_To_GNAT_Time
+ (File_Time_Stamp (Name_Buffer'Address, Attr));
+ end File_Time_Stamp;
+
----------------
-- File_Stamp --
----------------
Get_Name_String (Name);
- -- File_Time_Stamp will always return Invalid_Time if the file does not
- -- exist, and that OS_Time_To_GNAT_Time will convert that to
- -- Empty_Time_Stamp. Therefore we do not need to first test whether the
- -- file actually exists, which saves a system call
+ -- File_Time_Stamp will always return Invalid_Time if the file does
+ -- not exist, and OS_Time_To_GNAT_Time will convert this value to
+ -- Empty_Time_Stamp. Therefore we do not need to first test whether
+ -- the file actually exists, which saves a system call.
return OS_Time_To_GNAT_Time
- (File_Time_Stamp (Name_Buffer (1 .. Name_Len)));
+ (File_Time_Stamp (Name_Buffer (1 .. Name_Len)));
end File_Stamp;
function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type is
begin
-- If we are looking for a config file, look only in the current
- -- directory, i.e. return input argument unchanged. Also look
- -- only in the current directory if we are looking for a .dg
- -- file (happens in -gnatD mode).
+ -- directory, i.e. return input argument unchanged. Also look only in
+ -- the curren directory if we are looking for a .dg file (happens in
+ -- -gnatD mode).
if T = Config
or else (Debug_Generated_Code
elsif T = Library then
Dir_Name := Lib_Search_Directories.Table (Dir);
- else pragma Assert (T /= Config);
+ else
+ pragma Assert (T /= Config);
Dir_Name := Src_Search_Directories.Table (Dir);
end if;
if Opt.Check_Object_Consistency then
-- On most systems, this does not result in an extra system call
- Current_Full_Lib_Stamp := OS_Time_To_GNAT_Time
- (File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr));
+
+ Current_Full_Lib_Stamp :=
+ OS_Time_To_GNAT_Time
+ (File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr));
-- ??? One system call here
+
Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
if Current_Full_Obj_Stamp (1) = ' ' then
is
File : File_Name_Type;
Attr : aliased File_Attributes;
+
begin
if not File_Cache_Enabled then
Find_File (N, T, File, Attr'Access);
else
Get_Name_String (File);
Name_Buffer (Name_Len + 1) := ASCII.NUL;
- return OS_Time_To_GNAT_Time
- (File_Time_Stamp (Name_Buffer'Address, Attr'Access));
+ return
+ OS_Time_To_GNAT_Time
+ (File_Time_Stamp (Name_Buffer'Address, Attr'Access));
end if;
end Smart_File_Stamp;
begin
if not File_Cache_Enabled then
Find_File (N, T, Info.File, Info.Attr'Access);
+
else
Info := File_Name_Hash_Table.Get (N);
+
if Info.File = No_File then
Find_File (N, T, Info.File, Info.Attr'Access);
File_Name_Hash_Table.Set (N, Info);
if Is_Directory_Separator (Name_Buffer (J)) then
- -- Return the part of Name that follows this last directory
- -- separator.
+ -- Return part of Name that follows this last directory separator
Name_Buffer (1 .. Name_Len - J) := Name_Buffer (J + 1 .. Name_Len);
Name_Len := Name_Len - J;
Prefix_Flag : Integer) return Address;
pragma Import (C, To_Canonical_Dir_Spec, "__gnat_to_canonical_dir_spec");
- C_Host_Dir : String (1 .. Host_Dir'Length + 1);
+ C_Host_Dir : String (1 .. Host_Dir'Length + 1);
Canonical_Dir_Addr : Address;
Canonical_Dir_Len : Integer;
else
Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 0);
end if;
+
Canonical_Dir_Len := C_String_Length (Canonical_Dir_Addr);
if Canonical_Dir_Len = 0 then
----------------------------
procedure Reset_File_Attributes (Attr : System.Address);
- pragma Import (C, Reset_File_Attributes, "reset_attributes");
+ pragma Import (C, Reset_File_Attributes, "__gnat_reset_attributes");
begin
Initialization : declare
Sizeof_File_Attributes : Integer;
pragma Import (C, Sizeof_File_Attributes,
- "size_of_file_attributes");
+ "__gnat_size_of_file_attributes");
begin
pragma Assert (Sizeof_File_Attributes <= File_Attributes_Size);
OSDN Git Service
