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

* fix for bug #24504 (extended version of patch by Bart Broersma)

Browse Source 
git-svn-id: trunk@34849 -
This commit is contained in:
Tomas Hajny 2016-11-08 22:16:49 +00:00
parent 78abcbd4ca
commit b7de70422f
10 changed files with 327 additions and 328 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
rtl/emx/dos.pas
View File

@ -145,7 +145,7 @@ procedure syscall;external name '___SYSCALL';
function fsearch(path:pathstr;dirlist:string):pathstr;
var i,p1:longint;
var p1:longint;
newdir:pathstr;
{$ASMMODE INTEL}
@ -169,40 +169,40 @@ end ['eax', 'ecx', 'edx'];
{$ASMMODE ATT}
begin
{ No wildcards allowed in these things }
if (Pos ('?', Path) <> 0) or (Pos ('*', Path) <> 0) then
begin
FSearch := '';
Exit;
end;
{ check if the file specified exists }
if CheckFile (Path + #0) then
FSearch := Path
else
begin
{No wildcards allowed in these things:}
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and
not (newdir[length(newdir)] in AllowDirectorySeparators+AllowDriveSeparators) then
newdir:=newdir+DirectorySeparator;
if CheckFile (NewDir + Path + #0) then
NewDir := NewDir + Path
else
NewDir := '';
until (DirList = '') or (NewDir <> '');
FSearch := NewDir;
end;
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and
not (newdir[length(newdir)] in AllowDirectorySeparators+DriveSeparator) then
newdir:=newdir+DirectorySeparator;
if CheckFile (NewDir + Path + #0) then
NewDir := NewDir + Path
else
NewDir := '';
until (DirList = '') or (NewDir <> '');
FSearch := NewDir;
end;
end;

66
rtl/go32v2/dos.pp
View File

@ -983,48 +983,48 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
{ check if the file specified exists }
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

66
rtl/msdos/dos.pp
View File

@ -765,48 +765,48 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
p1 : integer;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
{ check if the file specified exists }
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

69
rtl/netware/dos.pp
View File

@ -352,49 +352,48 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
write ('FSearch ("',path,'","',dirlist,'"');
{ check if the file specified exists }
findfirst(path,anyfile,s);
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow backslash as slash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
newdir:=newdir+'/';
findfirst(newdir+path,anyfile,s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow backslash as slash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

68
rtl/netwlibc/dos.pp
View File

@ -454,48 +454,48 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
{ check if the file specified exists }
findfirst(path,anyfile,s);
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow backslash as slash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
newdir:=newdir+'/';
findfirst(newdir+path,anyfile,s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow backslash as slash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

68
rtl/os2/dos.pas
View File

@ -106,50 +106,50 @@ begin
end;
function FSearch (Path: PathStr; DirList: string): PathStr;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
{ check if the file specified exists }
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

68
rtl/watcom/dos.pp
View File

@ -631,48 +631,48 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
{ check if the file specified exists }
findfirst(path,anyfile,s);
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile,s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

62
rtl/win/dos.pp
View File

@ -554,44 +554,44 @@ var
s : searchrec;
newdir : pathstr;
begin
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

66
rtl/win16/dos.pp
View File

@ -800,48 +800,48 @@ end;}
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
p1 : integer;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
{ check if the file specified exists }
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;

62
rtl/wince/dos.pp
View File

@ -410,44 +410,44 @@ var
s : searchrec;
newdir : pathstr;
begin
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
begin
fsearch:='';
exit;
end;
{ check if the file specified exists }
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
begin
begin
findclose(s);
fsearch:=path;
exit;
end;
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
{ allow slash as backslash }
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
newdir:=newdir+DirectorySeparator;
findfirst(newdir+path,anyfile and not(directory),s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
{ </immobilizer> }