paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 09:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

Corrected fexpand behaviour.

Browse Source
This commit is contained in:
michael 1998-08-16 09:12:11 +00:00
parent 1737d27ff1
commit 734a30e857
3 changed files with 101 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
rtl/dos/dos.pp
View File

@ -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

18
rtl/linux/linux.pp
View File

@ -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

61
rtl/win32/dos.pp
View File

@ -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