From 734a30e8575b51afb9f5a0c6412820213a358710 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 16 Aug 1998 09:12:11 +0000 Subject: [PATCH] Corrected fexpand behaviour. --- rtl/dos/dos.pp | 42 ++++++++++++++++++++++++++++--- rtl/linux/linux.pp | 18 +++++++++++--- rtl/win32/dos.pp | 61 ++++++++++++++++++++++++++++++++++++---------- 3 files changed, 101 insertions(+), 20 deletions(-) diff --git a/rtl/dos/dos.pp b/rtl/dos/dos.pp index 43131b9238..01796e58ea 100644 --- a/rtl/dos/dos.pp +++ b/rtl/dos/dos.pp @@ -799,6 +799,7 @@ end; for i:=1 to length(pa) do if pa[i]='/' then pa[i]:='\'; + if (length(pa)>1) and (pa[1] in ['A'..'Z']) and (pa[2]=':') then begin { we must get the right directory } @@ -816,6 +817,14 @@ end; pa:=s+pa else pa:=s+'\'+pa; + + { Turbo Pascal gives current dir on drive if only drive given as parameter! } + if length(pa) = 2 then + begin + getdir(byte(pa[1])-64,s); + pa := s; + end; + {First remove all references to '\.\'} while pos ('\.\',pa)<>0 do delete (pa,pos('\.\',pa),2); @@ -827,18 +836,40 @@ end; j:=i-1; while (j>1) and (pa[j]<>'\') do dec (j); + if pa[j+1] = ':' then j := 3; delete (pa,j,i-j+3); end; until i=0; - {Remove End . and \} + + { Turbo Pascal gets rid of a \.. at the end of the path } + { Now remove also any reference to '\..' at end of line + + of course previous dir.. } + i:=pos('\..',pa); + if i<>0 then + begin + if i = length(pa) - 2 then + begin + j:=i-1; + while (j>1) and (pa[j]<>'\') do + dec (j); + delete (pa,j,i-j+3); + end; + pa := pa + '\'; + end; + { Remove End . and \} if (length(pa)>0) and (pa[length(pa)]='.') then dec(byte(pa[0])); - if (length(pa)>0) and (pa[length(pa)]='\') then + { if only the drive + a '\' is left then the '\' should be left to prevtn the program + accessing the current directory on the drive rather than the root!} + { if the last char of path = '\' then leave it in as this is what TP does! } + if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then dec(byte(pa[0])); + { if only a drive is given in path then there should be a '\' at the + end of the string given back } + if length(path) = 2 then pa := pa + '\'; fexpand:=pa; end; - Function FSearch(path: pathstr; dirlist: string): pathstr; var i,p1 : longint; @@ -1011,7 +1042,10 @@ End; end. { $Log$ - Revision 1.6 1998-08-05 21:01:50 michael + Revision 1.7 1998-08-16 09:12:13 michael + Corrected fexpand behaviour. + + Revision 1.6 1998/08/05 21:01:50 michael applied bugfix from maillist to fsearch Revision 1.5 1998/05/31 14:18:13 peter diff --git a/rtl/linux/linux.pp b/rtl/linux/linux.pp index 4301cf1a58..5f00fc12af 100644 --- a/rtl/linux/linux.pp +++ b/rtl/linux/linux.pp @@ -2864,9 +2864,18 @@ Begin else if i=1 then {i=1, so we have temp='/../something', just delete '/../'} delete(temp,1,3); - until i=0; -{Remove ending . and / which may exist} + { Remove ending /.. } + i:=pos('/..',pa); + if i<>0 and (i =length(pa)-2) then + begin + j:=i-1; + while (j>1) and (pa[j]<>'/') do + dec (j); + delete (pa,j,i-j+3); + end; + end; + { if last character is / then remove it - dir is also a file :-) } if (length(temp)>0) and (temp[length(temp)]='/') then dec(byte(temp[0])); fexpand:=temp; @@ -3521,7 +3530,10 @@ End. { $Log$ - Revision 1.14 1998-08-14 12:01:04 carl + Revision 1.15 1998-08-16 09:12:14 michael + Corrected fexpand behaviour. + + Revision 1.14 1998/08/14 12:01:04 carl * ifdef i386 for ports access Revision 1.13 1998/08/12 11:10:25 michael diff --git a/rtl/win32/dos.pp b/rtl/win32/dos.pp index d8ecbeac82..95599f46df 100644 --- a/rtl/win32/dos.pp +++ b/rtl/win32/dos.pp @@ -610,9 +610,10 @@ end; function fexpand(const path : pathstr) : pathstr; + var - s,pa : string[79]; - i,j : longint; + s,pa : string[79]; + i,j : longint; begin getdir(0,s); pa:=upcase(path); @@ -620,15 +621,16 @@ begin for i:=1 to length(pa) do if pa[i]='/' then pa[i]:='\'; + if (length(pa)>1) and (pa[1] in ['A'..'Z']) and (pa[2]=':') then begin - { we must get the right directory } - getdir(ord(pa[1])-ord('A')+1,s); - if (ord(pa[0])>2) and (pa[3]<>'\') then - if pa[1]=s[1] then - pa:=s+'\'+copy (pa,3,length(pa)) - else - pa:=pa[1]+':\'+copy (pa,3,length(pa)) + { we must get the right directory } + getdir(ord(pa[1])-ord('A')+1,s); + if (ord(pa[0])>2) and (pa[3]<>'\') then + if pa[1]=s[1] then + pa:=s+'\'+copy (pa,3,length(pa)) + else + pa:=pa[1]+':\'+copy (pa,3,length(pa)) end else if pa[1]='\' then @@ -637,6 +639,14 @@ begin pa:=s+pa else pa:=s+'\'+pa; + + { Turbo Pascal gives current dir on drive if only drive given as parameter! } + if length(pa) = 2 then + begin + getdir(byte(pa[1])-64,s); + pa := s; + end; + {First remove all references to '\.\'} while pos ('\.\',pa)<>0 do delete (pa,pos('\.\',pa),2); @@ -648,18 +658,40 @@ begin j:=i-1; while (j>1) and (pa[j]<>'\') do dec (j); + if pa[j+1] = ':' then j := 3; delete (pa,j,i-j+3); end; until i=0; - {Remove End . and \} + + { Turbo Pascal gets rid of a \.. at the end of the path } + { Now remove also any reference to '\..' at end of line + + of course previous dir.. } + i:=pos('\..',pa); + if i<>0 then + begin + if i = length(pa) - 2 then + begin + j:=i-1; + while (j>1) and (pa[j]<>'\') do + dec (j); + delete (pa,j,i-j+3); + end; + pa := pa + '\'; + end; + { Remove End . and \} if (length(pa)>0) and (pa[length(pa)]='.') then dec(byte(pa[0])); - if (length(pa)>0) and (pa[length(pa)]='\') then + { if only the drive + a '\' is left then the '\' should be left to prevtn the program + accessing the current directory on the drive rather than the root!} + { if the last char of path = '\' then leave it in as this is what TP does! } + if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then dec(byte(pa[0])); + { if only a drive is given in path then there should be a '\' at the + end of the string given back } + if length(path) = 2 then pa := pa + '\'; fexpand:=pa; end; - Function FSearch(path: pathstr; dirlist: string): pathstr; var i,p1 : longint; @@ -843,7 +875,10 @@ End; end. { $Log$ - Revision 1.7 1998-06-10 10:39:13 peter + Revision 1.8 1998-08-16 09:12:11 michael + Corrected fexpand behaviour. + + Revision 1.7 1998/06/10 10:39:13 peter * working w32 rtl Revision 1.6 1998/06/08 23:07:45 peter