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

rtl/amiga: added minimalistic #?.<ext> and *.<ext> pattern matching to legacy MatchFirst

Browse Source
This commit is contained in:
Karoly Balogh 2021-12-27 15:13:37 +01:00
parent 50572fda8c
commit cbc8aa63c8
1 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -230,11 +230,31 @@ end;
{ helper function used by MatchFirst, all input is expected to be lowercase }
function NameMatchesPattern(pattern: AnsiString; filename: AnsiString): boolean;
var
ofs: longint;
begin
NameMatchesPattern:=(pattern = '*') or (pattern = '#?') or (pattern = filename);
if not NameMatchesPattern then
begin
// TODO: pattern detection
{ handle the simple case of #?.<ext> and *.<ext>, which is one of the most often used }
ofs:=Pos('#?',pattern);
if (ofs = 1) then
begin
Delete(pattern,1,length('#?'));
ofs:=Pos(pattern,filename);
NameMatchesPattern:=(ofs > 0) and ((ofs - 1) = length(filename) - length(pattern));
if NameMatchesPattern then
exit;
end;
ofs:=Pos('*',pattern);
if (ofs = 1) then
begin
Delete(pattern,1,length('*'));
ofs:=Pos(pattern,filename);
NameMatchesPattern:=(ofs > 0) and ((ofs - 1) = length(filename) - length(pattern));
if NameMatchesPattern then
exit;
end;
end;
end;