paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-31 17:12:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

rtl/amiga: do not UnLock the initial lock returned by CurrentDir in legacy MatchFirst

Browse Source
This commit is contained in:
Karoly Balogh 2021-12-27 12:00:32 +01:00
parent 27e9377a3a
commit 08f3a3c8ef
1 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
rtl/amiga/m68k/legacydos.inc
View File

@ -238,6 +238,7 @@ var
Path,FileN: AnsiString; Path,FileN: AnsiString;
LastSeparatorPos: Integer; LastSeparatorPos: Integer;
i: Integer; i: Integer;
newLock: boolean;
DirLock: BPTR; DirLock: BPTR;
ib: TFileInfoBlock; ib: TFileInfoBlock;
Res: LongInt; Res: LongInt;
@ -272,12 +273,16 @@ begin
// if no path is given use the current working dir, or try to lock the dir // if no path is given use the current working dir, or try to lock the dir
if Path = '' then if Path = '' then
begin begin
newLock := False;
DirLock := CurrentDir(0); DirLock := CurrentDir(0);
if DirLock <> 0 then if DirLock <> 0 then
CurrentDir(DirLock); UnLock(CurrentDir(DirLock));
end end
else else
begin
newLock := True;
DirLock := Lock(PChar(Path), ACCESS_READ); DirLock := Lock(PChar(Path), ACCESS_READ);
end;
// //
// no dirlock found -> dir not found // no dirlock found -> dir not found
if DirLock = 0 then if DirLock = 0 then
@ -289,6 +294,8 @@ begin
if Examine(DirLock, @ib) = 0 then if Examine(DirLock, @ib) = 0 then
begin begin
MatchFirst := -1; MatchFirst := -1;
if newLock then
UnLock(DirLock);
Exit; Exit;
end; end;
// we search here directly what we need to find // we search here directly what we need to find
@ -334,6 +341,7 @@ begin
// most importantly set the return code // most importantly set the return code
MatchFirst := 0; MatchFirst := 0;
end; end;
if newLock then
Unlock(DirLock); Unlock(DirLock);
end; end;