From a820a0f393cd8d33fff2b197d863b039a5ff0cda Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Sat, 7 Apr 2001 19:37:27 +0000 Subject: [PATCH] * fix for absolute paths on platforms without drives (*nix), support for long volume names added --- rtl/inc/fexpand.inc | 199 +++++++++++++++++++++++++++++--------------- 1 file changed, 133 insertions(+), 66 deletions(-) diff --git a/rtl/inc/fexpand.inc b/rtl/inc/fexpand.inc index b64409bc3a..8db5f4cee5 100644 --- a/rtl/inc/fexpand.inc +++ b/rtl/inc/fexpand.inc @@ -17,7 +17,7 @@ ****************************************************************************} -function GetDirIO (DriveNr: byte; var Dir: OpenString): word; +procedure GetDirIO (DriveNr: byte; var Dir: OpenString); (* GetDirIO is supposed to return the root of the given drive *) (* in case of an error for compatibility of FExpand with TP/BP. *) @@ -28,19 +28,32 @@ begin OldInOutRes := InOutRes; InOutRes := 0; GetDir (DriveNr, Dir); - GetDirIO := InOutRes; InOutRes := OldInOutRes; end; +{$IFDEF FPC_FEXPAND_VOLUMES} +procedure GetDirIO (const VolumeName: OpenString; var Dir: OpenString); + +var + OldInOutRes: word; +begin + OldInOutRes := InOutRes; + InOutRes := 0; + GetDir (VolumeName, Dir); + InOutRes := OldInOutRes; +end; +{$ENDIF FPC_FEXPAND_VOLUMES} + + function FExpand (const Path: PathStr): PathStr; (* LFNSupport boolean constant, variable or function must be declared for all the platforms, at least locally in the Dos unit implementation part. - In addition, FPC_FEXPAND_UNC, FPC_FEXPAND_DRIVES, FPC_FEXPAND_GETENV_PCHAR - and FPC_FEXPAND_TILDE conditionals might be defined to specify FExpand - behaviour. Only forward slashes are supported if UNIX conditional - is defined, both forward and backslashes otherwise. + In addition, FPC_FEXPAND_UNC, FPC_FEXPAND_DRIVES, FPC_FEXPAND_GETENV_PCHAR, + FPC_FEXPAND_TILDE and FPC_FEXPAND_VOLUMES conditionals might be defined to + specify FExpand behaviour. Only forward slashes are supported if UNIX + conditional is defined, both forward and backslashes otherwise. *) const @@ -49,13 +62,14 @@ const {$ELSE UNIX} DirSep = '\'; {$ENDIF UNIX} + DriveSep = ':'; {$IFDEF FPC_FEXPAND_DRIVES} - PathStart = 3; + PathStart: longint = 3; {$ELSE FPC_FEXPAND_DRIVES} PathStart = 1; {$ENDIF FPC_FEXPAND_DRIVES} -var S, Pa: PathStr; +var S, Pa, Dirs: PathStr; I, J: longint; begin @@ -68,10 +82,13 @@ begin for I := 1 to Length (Pa) do if Pa [I] = '/' then Pa [I] := DirSep; -{$ENDIF} +{$ENDIF UNIX} +{$IFDEF FPC_FEXPAND_VOLUMES} + PathStart := Succ (Pos (DriveSep, Pa)); +{$ENDIF FPC_FEXPAND_VOLUMES} {$IFDEF FPC_FEXPAND_TILDE} - {Replace ~/ with $HOME} - if (Length (Pa) >= 1) and (Pa [1] ='~') and + {Replace ~/ with $HOME/} + if (Length (Pa) >= 1) and (Pa [1] = '~') and ((Pa [2] = DirSep) or (Length (Pa) = 1)) then begin {$IFDEF FPC_FEXPAND_GETENV_PCHAR} @@ -88,45 +105,85 @@ begin Pa := S + Copy (Pa, 2, Pred (Length (Pa))); end; {$ENDIF FPC_FEXPAND_TILDE} +{$IFDEF FPC_FEXPAND_VOLUMES} + if PathStart > 1 then +{$ELSE FPC_FEXPAND_VOLUMES} if (Length (Pa) > 1) and (Pa [1] in ['A'..'Z', 'a'..'z']) and - (Pa [2] = ':') then + (Pa [2] = DriveSep) then +{$ENDIF FPC_FEXPAND_VOLUMES} begin {$IFDEF FPC_FEXPAND_DRIVES} + {$IFDEF FPC_FEXPAND_VOLUMES} + GetDirIO (Copy (Pa, 1, PathStart - 2), S); + {$ELSE FPC_FEXPAND_VOLUMES} { Always uppercase driveletter } if (Pa [1] in ['a'..'z']) then Pa [1] := Chr (Ord (Pa [1]) and not ($20)); - if GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S) = 0 then ; - case Length (Pa) of - 2: Pa := S; + GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S); + {$ENDIF FPC_FEXPAND_VOLUMES} + if Length (Pa) = Pred (PathStart) then + Pa := S else - if Pa [3] <> DirSep then + if Pa [PathStart] <> DirSep then + {$IFDEF FPC_FEXPAND_VOLUMES} + if Copy (Pa, 1, PathStart - 2) = Copy (S, 1, PathStart - 2) + then + {$ELSE FPC_FEXPAND_VOLUMES} if Pa [1] = S [1] then + {$ENDIF FPC_FEXPAND_VOLUMES} begin { remove ending slash if it already exists } if S [Length (S)] = DirSep then Dec (S [0]); - Pa := S + DirSep + Copy (Pa, 3, Length (Pa)) + Pa := S + DirSep + + Copy (Pa, PathStart, Length (Pa) - PathStart + 1) end else - Pa := Pa [1] + ':' + DirSep + Copy (Pa, 3, Length (Pa)) - end; + {$IFDEF FPC_FEXPAND_VOLUMES} + Pa := Copy (Pa, 1, PathStart - 2) + DriveSep + DirSep + + Copy (Pa, PathStart, Length (Pa) - PathStart + 1) + {$ELSE FPC_FEXPAND_VOLUMES} + Pa := Pa [1] + DriveSep + DirSep + + Copy (Pa, PathStart, Length (Pa) - PathStart + 1) + {$ENDIF FPC_FEXPAND_VOLUMES} end else {$ELSE FPC_FEXPAND_DRIVES} Delete (Pa, 1, 2); end; + {Check whether we don't have an absolute path already} + if (Length (Pa) >= PathStart) and (Pa [PathStart] <> DirSep) then {$ENDIF FPC_FEXPAND_DRIVES} begin - if GetDirIO (0, S) = 0 then ; + GetDirIO (0, S); {$IFDEF FPC_FEXPAND_DRIVES} if (Length (Pa) > 0) and (Pa [1] = DirSep) then begin {$IFDEF FPC_FEXPAND_UNC} - { Do not touch Network drive names } - if not ((Length (Pa) > 1) and (Pa [2] = Pa [1]) - and LFNSupport) then + {Do not touch network drive names} + if (Length (Pa) > 1) and (Pa [2] = DirSep) + and LFNSupport then + begin + if Length (Pa) = 2 then + Pa := DirSep + DirSep + '.' + DirSep; + PathStart := 3; + {Find the start of the string of directories} + while (Pa [PathStart] <> DirSep) and + (PathStart <= Length (Pa)) do + Inc (PathStart); + if PathStart > Length (Pa) then Pa := Pa + DirSep; + end + else {$ENDIF FPC_FEXPAND_UNC} - Pa := S [1] + ':' + Pa + {$IFDEF FPC_FEXPAND_VOLUMES} + begin + I := Pos (DriveSep, S); + Pa := Copy (S, 1, Pred (I)) + DriveSep + Pa; + PathStart := Succ (I); + end; + {$ELSE FPC_FEXPAND_VOLUMES} + Pa := S [1] + DriveSep + Pa; + {$ENDIF FPC_FEXPAND_VOLUMES} end else {$ENDIF FPC_FEXPAND_DRIVES} @@ -141,62 +198,69 @@ begin else Pa := S + DirSep + Pa; end; + {Get string of directories to only process relative references on this one} + Dirs := Copy (Pa, Succ (PathStart), Length (Pa) - PathStart); {First remove all references to '\.\'} - I := Pos (DirSep + '.' + DirSep, Pa); + I := Pos (DirSep + '.' + DirSep, Dirs); while I <> 0 do begin - Delete (Pa, I, 2); - I := Pos (DirSep + '.' + DirSep, Pa); + Delete (Dirs, I, 2); + I := Pos (DirSep + '.' + DirSep, Dirs); end; {Now remove also all references to '\..\' + of course previous dirs..} - I := Pos (DirSep + '..' + DirSep, Pa); + I := Pos (DirSep + '..' + DirSep, Dirs); while I <> 0 do begin J := Pred (I); - while (J > 0) and (Pa [J] <> DirSep) do + while (J > 0) and (Dirs [J] <> DirSep) do Dec (J); - if (J = 0) -{$IFDEF FPC_FEXPAND_UNC} - or (J = 1) and (I = 2) -{$ENDIF FPC_FEXPAND_UNC} - then - Delete (Pa, Succ (I), 3) - else - Delete (Pa, Succ (J), I - J + 3); - I := Pos (DirSep + '..' + DirSep, Pa); + Delete (Dirs, Succ (J), I - J + 3); + I := Pos (DirSep + '..' + DirSep, Dirs); end; - {Now remove also any reference to '\..' at the end of line - + of course previous dir..} - I := Pos (DirSep + '..', Pa); - if (I <> 0) and (I = Length (Pa) - 2) then + {Then remove also a reference to '\..' at the end of line + + the previous directory, of course,...} + I := Pos (DirSep + '..', Dirs); + if (I <> 0) and (I = Length (Dirs) - 2) then begin J := Pred (I); - while (J >= 1) and (Pa [J] <> DirSep) do + while (J >= 0) and (Dirs [J] <> DirSep) do Dec (J); - if (J = 0) -{$IFDEF FPC_FEXPAND_UNC} - or (J = 1) and (I = 2) -{$ENDIF FPC_FEXPAND_UNC} - then - Delete (Pa, Succ (I), 2) + if (J = 0) then + Dirs := '' else - Delete (Pa, Succ (J), I - J + 2); + Delete (Dirs, Succ (J), I - J + 2); end; - {Now remove also any reference to '\.' at the end of line} - I := Pos (DirSep + '.', Pa); - if (I <> 0) and (I = Pred (Length (Pa))) then -{$IFDEF FPC_FEXPAND_DRIVES} - if (I = 3) and (Pa [2] = ':') -{$ELSE FPC_FEXPAND_DRIVES} - if (I = 1) -{$ENDIF FPC_FEXPAND_DRIVES} -{$IFDEF FPC_FEXPAND_UNC} - or (I = 2) and (Pa [1] = '\') -{$ENDIF FPC_FEXPAND_UNC} - then - Dec (Pa [0]) - else - Delete (Pa, I, 2); + {...and also a possible reference to '\.'} + if (Length (Dirs) = 1) then + begin + if (Dirs [1] = '.') then + {A special case} + Dirs := '' + end + else + if (Length (Dirs) <> 0) and (Dirs [Length (Dirs)] = '.') and + (Dirs [Pred (Length (Dirs))] = DirSep) then + Dec (Dirs [0], 2); + {Finally remove '.\' at the beginning of the string of directories...} + while (Length (Dirs) >= 2) and (Dirs [1] = '.') and (Dirs [2] = DirSep) do + Delete (Dirs, 1, 2); + {...and possible (invalid) references to '..\' as well} + while (Length (Dirs) >= 3) and (Dirs [1] = '.') and (Dirs [2] = '.') and + (Dirs [3] = DirSep) do + Delete (Dirs, 1, 3); + {Two special cases - '.' and '..' alone} + if (Length (Dirs) = 1) and (Dirs [1] = '.') or + (Length (Dirs) = 2) and (Dirs [1] = '.') and (Dirs [2] = '.') then + Dirs := ''; + {Join the parts back to create the complete path} + if Length (Dirs) = 0 then + begin + Pa := Copy (Pa, 1, PathStart); + if Pa [PathStart] <> DirSep then + Pa := Pa + DirSep; + end + else + Pa := Copy (Pa, 1, PathStart) + Dirs; {Remove ending \ if not supplied originally, the original string wasn't empty (to stay compatible) and if not really needed} if (Length (Pa) > PathStart) and (Pa [Length (Pa)] = DirSep) @@ -207,7 +271,10 @@ end; { $Log$ - Revision 1.5 2001-03-21 21:08:20 hajny + Revision 1.6 2001-04-07 19:37:27 hajny + * fix for absolute paths on platforms without drives (*nix), support for long volume names added + + Revision 1.5 2001/03/21 21:08:20 hajny * GetDir fixed Revision 1.4 2001/03/19 21:09:30 hajny