paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 10:40:13 +02: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

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

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