paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 19:49:12 +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

16
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,14 +169,15 @@ 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 }
@ -194,7 +195,7 @@ begin
dirlist:='';
end;
if (newdir<>'') and
not (newdir[length(newdir)] in AllowDirectorySeparators+AllowDriveSeparators) then
not (newdir[length(newdir)] in AllowDirectorySeparators+DriveSeparator) then
newdir:=newdir+DirectorySeparator;
if CheckFile (NewDir + Path + #0) then
NewDir := NewDir + Path
@ -204,7 +205,6 @@ begin
FSearch := NewDir;
end;
end;
end;
procedure GetFTime (var F; var Time: longint); assembler;

20
rtl/go32v2/dos.pp
View File

@ -983,10 +983,16 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
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
@ -995,11 +1001,6 @@ begin
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
@ -1014,18 +1015,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
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;
findclose(s);
end;
{ change to short filename if successful DOS call PM }

16
rtl/msdos/dos.pp
View File

@ -765,10 +765,16 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
p1 : integer;
p1 : longint;
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
@ -777,11 +783,6 @@ begin
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
@ -803,11 +804,10 @@ begin
newdir:=newdir+path
else
newdir:='';
findclose(s);
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
findclose(s);
end;
{ change to short filename if successful DOS call PM }

25
rtl/netware/dos.pp
View File

@ -352,24 +352,24 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
s : searchrec;
newdir : pathstr;
begin
write ('FSearch ("',path,'","',dirlist,'"');
{ 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,s);
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
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
@ -384,18 +384,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
newdir:=newdir+'/';
findfirst(newdir+path,anyfile,s);
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;
findclose(s);
end;
{******************************************************************************

24
rtl/netwlibc/dos.pp
View File

@ -454,23 +454,24 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
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,s);
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
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
@ -485,18 +486,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
newdir:=newdir+'/';
findfirst(newdir+path,anyfile,s);
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;
findclose(s);
end;
{******************************************************************************

22
rtl/os2/dos.pas
View File

@ -106,12 +106,18 @@ 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
{ 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
@ -120,11 +126,6 @@ begin
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
@ -139,18 +140,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
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;
findclose(s);
end;
procedure getftime(var f;var time:longint);

24
rtl/watcom/dos.pp
View File

@ -631,23 +631,24 @@ end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
p1 : longint;
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,s);
findfirst(path,anyfile and not(directory),s);
if doserror=0 then
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
@ -662,18 +663,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile,s);
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;
findclose(s);
end;
{ change to short filename if successful DOS call PM }

18
rtl/win/dos.pp
View File

@ -554,6 +554,12 @@ 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
@ -562,11 +568,6 @@ begin
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
@ -581,18 +582,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
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;
findclose(s);
end;
procedure getftime(var f;var time : longint);

20
rtl/win16/dos.pp
View File

@ -800,10 +800,16 @@ end;}
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
p1 : integer;
p1 : longint;
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
@ -812,11 +818,6 @@ begin
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
@ -831,18 +832,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
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;
findclose(s);
end;
{ change to short filename if successful DOS call PM }

18
rtl/wince/dos.pp
View File

@ -410,6 +410,12 @@ 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
@ -418,11 +424,6 @@ begin
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
@ -437,18 +438,17 @@ begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
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;
findclose(s);
end;
{ </immobilizer> }