diff options
Diffstat (limited to 'gcc/ada/g-dirope.adb')
| -rw-r--r-- | gcc/ada/g-dirope.adb | 172 |
1 files changed, 140 insertions, 32 deletions
diff --git a/gcc/ada/g-dirope.adb b/gcc/ada/g-dirope.adb index 1967d236d63..ca200ebf843 100644 --- a/gcc/ada/g-dirope.adb +++ b/gcc/ada/g-dirope.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2001 Ada Core Technologies, Inc. -- +-- Copyright (C) 1998-2003 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -26,7 +26,8 @@ -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- --- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ @@ -47,6 +48,9 @@ package body GNAT.Directory_Operations is -- This is the low-level address directory structure as returned by the C -- opendir routine. + Filename_Max : constant Integer := 1024; + -- 1024 is the value of FILENAME_MAX in stdio.h + procedure Free is new Unchecked_Deallocation (Dir_Type_Value, Dir_Type); @@ -140,9 +144,12 @@ package body GNAT.Directory_Operations is -- Start processing for Base_Name begin + if Path'Length <= Suffix'Length then + return Path; + end if; + if Case_Sensitive_File_Name then return Basename (Path, Suffix); - else return Basename (Characters.Handling.To_Lower (Path), @@ -155,7 +162,7 @@ package body GNAT.Directory_Operations is ---------------- procedure Change_Dir (Dir_Name : Dir_Name_Str) is - C_Dir_Name : String := Dir_Name & ASCII.NUL; + C_Dir_Name : constant String := Dir_Name & ASCII.NUL; function chdir (Dir_Name : String) return Integer; pragma Import (C, chdir, "chdir"); @@ -176,6 +183,7 @@ package body GNAT.Directory_Operations is pragma Import (C, closedir, "closedir"); Discard : Integer; + pragma Warnings (Off, Discard); begin if not Is_Open (Dir) then @@ -211,7 +219,13 @@ package body GNAT.Directory_Operations is -- Expand_Path -- ----------------- - function Expand_Path (Path : Path_Name) return String is + function Expand_Path + (Path : Path_Name; + Mode : Environment_Style := System_Default) + return Path_Name + is + Environment_Variable_Char : Character; + pragma Import (C, Environment_Variable_Char, "__gnat_environment_char"); Result : OS_Lib.String_Access := new String (1 .. 200); Result_Last : Natural := 0; @@ -223,6 +237,9 @@ package body GNAT.Directory_Operations is procedure Double_Result_Size; -- Reallocate Result, doubling its size + function Is_Var_Prefix (C : Character) return Boolean; + pragma Inline (Is_Var_Prefix); + procedure Read (K : in out Positive); -- Update Result while reading current Path starting at position K. If -- a variable is found, call Var below. @@ -269,38 +286,52 @@ package body GNAT.Directory_Operations is Result := New_Result; end Double_Result_Size; + ------------------- + -- Is_Var_Prefix -- + ------------------- + + function Is_Var_Prefix (C : Character) return Boolean is + begin + return (C = Environment_Variable_Char and then Mode = System_Default) + or else + (C = '$' and then (Mode = UNIX or else Mode = Both)) + or else + (C = '%' and then (Mode = DOS or else Mode = Both)); + end Is_Var_Prefix; + ---------- -- Read -- ---------- procedure Read (K : in out Positive) is + P : Character; begin For_All_Characters : loop - if Path (K) = '$' then + if Is_Var_Prefix (Path (K)) then + P := Path (K); -- Could be a variable if K < Path'Last then - if Path (K + 1) = '$' then + if Path (K + 1) = P then - -- Not a variable after all, this is a double $, just - -- insert one in the result string. + -- Not a variable after all, this is a double $ or %, + -- just insert one in the result string. - Append ('$'); + Append (P); K := K + 1; else -- Let's parse the variable - K := K + 1; Var (K); end if; else - -- We have an ending $ sign + -- We have an ending $ or % sign - Append ('$'); + Append (P); end if; else @@ -322,27 +353,41 @@ package body GNAT.Directory_Operations is --------- procedure Var (K : in out Positive) is + P : constant Character := Path (K); + T : Character; E : Positive; begin - if Path (K) = '{' then + K := K + 1; + + if P = '%' or else Path (K) = '{' then - -- Look for closing } (curly bracket). + -- Set terminator character + + if P = '%' then + T := '%'; + else + T := '}'; + K := K + 1; + end if; + + -- Look for terminator character, k point to the first character + -- for the variable name. E := K; loop E := E + 1; - exit when Path (E) = '}' or else E = Path'Last; + exit when Path (E) = T or else E = Path'Last; end loop; - if Path (E) = '}' then + if Path (E) = T then -- OK found, translate with environment value declare Env : OS_Lib.String_Access := - OS_Lib.Getenv (Path (K + 1 .. E - 1)); + OS_Lib.Getenv (Path (K .. E - 1)); begin Append (Env.all); @@ -350,10 +395,15 @@ package body GNAT.Directory_Operations is end; else - -- No closing curly bracket, not a variable after all or a + -- No terminator character, not a variable after all or a -- syntax error, ignore it, insert string as-is. - Append ('$'); + Append (P); -- Add prefix character + + if T = '}' then -- If we were looking for curly bracket + Append ('{'); -- terminator, add the curly bracket + end if; + Append (Path (K .. E)); end if; @@ -466,13 +516,23 @@ package body GNAT.Directory_Operations is Style : Path_Style := System_Default) return String is - N_Path : String := Path; - K : Positive := N_Path'First; - Prev_Dirsep : Boolean := False; + N_Path : String := Path; + K : Positive := N_Path'First; + Prev_Dirsep : Boolean := False; begin - for J in Path'Range loop + if Dir_Separator = '\' + and then Path'Length > 1 + and then Path (K .. K + 1) = "\\" + then + if Style = UNIX then + N_Path (K .. K + 1) := "//"; + end if; + K := K + 2; + end if; + + for J in K .. Path'Last loop if Strings.Maps.Is_In (Path (J), Dir_Seps) then if not Prev_Dirsep then case Style is @@ -548,7 +608,7 @@ package body GNAT.Directory_Operations is -------------- procedure Make_Dir (Dir_Name : Dir_Name_Str) is - C_Dir_Name : String := Dir_Name & ASCII.NUL; + C_Dir_Name : constant String := Dir_Name & ASCII.NUL; function mkdir (Dir_Name : String) return Integer; pragma Import (C, mkdir, "__gnat_mkdir"); @@ -567,7 +627,7 @@ package body GNAT.Directory_Operations is (Dir : out Dir_Type; Dir_Name : Dir_Name_Str) is - C_File_Name : String := Dir_Name & ASCII.NUL; + C_File_Name : constant String := Dir_Name & ASCII.NUL; function opendir (File_Name : String) @@ -596,8 +656,9 @@ package body GNAT.Directory_Operations is Filename_Addr : Address; Filename_Len : Integer; - Buffer : array (0 .. 1024) of Character; - -- 1024 is the value of FILENAME_MAX in stdio.h + Buffer : array (0 .. Filename_Max + 12) of Character; + -- 12 is the size of the dirent structure (see dirent.h), without the + -- field for the filename. function readdir_gnat (Directory : System.Address; @@ -638,7 +699,8 @@ package body GNAT.Directory_Operations is (Source => Address, Target => Path_String_Access); - Path_Access : Path_String_Access := Address_To_Access (Filename_Addr); + Path_Access : constant Path_String_Access := + Address_To_Access (Filename_Addr); begin for J in Str'First .. Last loop @@ -665,14 +727,60 @@ package body GNAT.Directory_Operations is -- Remove_Dir -- ---------------- - procedure Remove_Dir (Dir_Name : Dir_Name_Str) is - C_Dir_Name : String := Dir_Name & ASCII.NUL; + procedure Remove_Dir + (Dir_Name : Dir_Name_Str; + Recursive : Boolean := False) + is + C_Dir_Name : constant String := Dir_Name & ASCII.NUL; + Current_Dir : constant Dir_Name_Str := Get_Current_Dir; + Last : Integer; + Str : String (1 .. Filename_Max); + Success : Boolean; + Working_Dir : Dir_Type; procedure rmdir (Dir_Name : String); pragma Import (C, rmdir, "rmdir"); begin - rmdir (C_Dir_Name); + -- Remove the directory only if it is empty + + if not Recursive then + rmdir (C_Dir_Name); + + if GNAT.OS_Lib.Is_Directory (Dir_Name) then + raise Directory_Error; + end if; + + -- Remove directory and all files and directories that it may contain + + else + Change_Dir (Dir_Name); + Open (Working_Dir, "."); + + loop + Read (Working_Dir, Str, Last); + exit when Last = 0; + + if GNAT.OS_Lib.Is_Directory (Str (1 .. Last)) then + if Str (1 .. Last) /= "." and then Str (1 .. Last) /= ".." then + Remove_Dir (Str (1 .. Last), True); + Remove_Dir (Str (1 .. Last)); + end if; + + else + GNAT.OS_Lib.Delete_File (Str (1 .. Last), Success); + + if not Success then + Change_Dir (Current_Dir); + raise Directory_Error; + end if; + end if; + end loop; + + Change_Dir (Current_Dir); + Close (Working_Dir); + Remove_Dir (Dir_Name); + end if; end Remove_Dir; end GNAT.Directory_Operations; |