kenjreno
2a1f111565
Verbatim port of Fastway-Server's TFWScheduler from fw_scheduler.pas
per feedback_copy_dont_reinterpret.md. Library named fpc-cron;
class TCron. Adjustments limited to:
- Type renames per family convention.
- uses clause: drop fw_consts/fw_log/fw_config/fw_database/
fw_plugin_*/dbapi_*; add log.types (fpc-log) + db.dialect/
schema/pool (fpc-db v0.3.0) + cron.types + cron.events.
fpc-cron does NOT depend on fpc-events.
- TDBPool injected on Create where canonical used global DB.
- Logging through optional log.types.TLogProc callback (the
canonical ecosystem-wide logger shape used by every other
fpc-* library). Category='cron'.
- Events: typed observer callbacks (cron.events) instead of
canonical's EventBus.Fire calls. OnTaskStart /
OnTaskComplete / OnTaskRegistered / OnPluginOrphaned /
OnThreadStart / OnThreadStop are assignable properties on
TCron. Same per-library typed-callback pattern as
fpc-binkp's bp.events and fpc-comet's cm.events.
- System-task dispatch: consumer-registered via
RegisterSystemTask (no Fastway-specific log_cleanup / etc.
baked in). Dispatcher shape preserved.
- DoWalCheckpointTruncate lifted out (Fastway-specific).
- No global Scheduler singleton.
- ParseCronField / MatchesCron promoted to class function for
test access; bodies byte-verbatim from canonical (verified
by normalised diff).
Schema: system_scheduler + scheduler_log table names + columns
preserved verbatim from canonical fw_schema.pas, so an existing
Fastway database is reusable as-is.
Behaviours preserved verbatim: cron grammar (5-field, *, */N,
a,b,c, a-b, a-b/N, literal), UTC math via LocalTimeToUniversal,
schedule-miss-on-long-task semantics, TThread + PRTLEvent +
1-second wake loop, suspended-Create + .Start, SyncPluginTasks
orphan cleanup, MatchesCron's DecodeDateFully call (cosmetic but
present in canonical), MatchesCron's pre-try-finally TBits
allocation (known leak inherited verbatim and documented).
Docs: README + docs/API.md + docs/architecture.md +
docs/DEVELOPER_GUIDE.md. fpc.cfg for multi-target builds.
Tests: 73 assertions across 23 scenarios (37 pure-cron + 36
SQLite-backed end-to-end) pass on x86_64-linux. Pre-tag -vh
audit on src/ reports zero hints/warnings on cron.* units.
339 lines
8.2 KiB
ObjectPascal
339 lines
8.2 KiB
ObjectPascal
{ test_cron -- pure cron parser tests, no DB, no thread.
|
|
|
|
Exercises TCron.ParseCronField + MatchesCron via the class
|
|
function path, verifying the canonical 5-field cron grammar:
|
|
*, */N, a,b,c, a-b, single literal, ranges, out-of-range. }
|
|
|
|
program test_cron;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
uses
|
|
{$IFDEF UNIX}cthreads,{$ENDIF}
|
|
Classes, SysUtils, DateUtils,
|
|
cron.version, cron.runner;
|
|
|
|
var
|
|
Total, Passed, Failed: Integer;
|
|
|
|
procedure Check(const Name: string; OK: Boolean);
|
|
begin
|
|
Inc(Total);
|
|
if OK then
|
|
begin
|
|
Inc(Passed);
|
|
Writeln(' [PASS] ', Name);
|
|
end
|
|
else
|
|
begin
|
|
Inc(Failed);
|
|
Writeln(' [FAIL] ', Name);
|
|
end;
|
|
end;
|
|
|
|
function BitsCount(B: TBits): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to B.Size - 1 do
|
|
if B.Bits[I] then Inc(Result);
|
|
end;
|
|
|
|
function BitsSet(B: TBits; const AValues: array of Integer): Boolean;
|
|
var
|
|
V, I: Integer;
|
|
Expected: Boolean;
|
|
begin
|
|
Result := True;
|
|
for I := 0 to B.Size - 1 do
|
|
begin
|
|
Expected := False;
|
|
for V := Low(AValues) to High(AValues) do
|
|
if AValues[V] = I then
|
|
begin
|
|
Expected := True;
|
|
Break;
|
|
end;
|
|
if B.Bits[I] <> Expected then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TestParseStar;
|
|
var
|
|
B: TBits;
|
|
begin
|
|
Writeln('-- ParseCronField: *');
|
|
B := TCron.ParseCronField('*', 0, 59);
|
|
try
|
|
Check('* covers all 60 minute slots', BitsCount(B) = 60);
|
|
Check('* sets bit 0', B.Bits[0]);
|
|
Check('* sets bit 59', B.Bits[59]);
|
|
Check('* allocates exactly AMax+1 capacity', B.Size = 60);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TestParseStep;
|
|
var
|
|
B: TBits;
|
|
begin
|
|
Writeln('-- ParseCronField: */N');
|
|
B := TCron.ParseCronField('*/15', 0, 59);
|
|
try
|
|
Check('*/15 sets exactly 4 bits (0,15,30,45)', BitsCount(B) = 4);
|
|
Check('*/15 bit pattern correct',
|
|
BitsSet(B, [0, 15, 30, 45]));
|
|
finally
|
|
B.Free;
|
|
end;
|
|
|
|
B := TCron.ParseCronField('*/10', 0, 59);
|
|
try
|
|
Check('*/10 sets 6 bits (0,10,20,30,40,50)', BitsCount(B) = 6);
|
|
Check('*/10 bit pattern correct',
|
|
BitsSet(B, [0, 10, 20, 30, 40, 50]));
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TestParseList;
|
|
var
|
|
B: TBits;
|
|
begin
|
|
Writeln('-- ParseCronField: a,b,c');
|
|
B := TCron.ParseCronField('1,3,5,7', 0, 23);
|
|
try
|
|
Check('1,3,5,7 sets exactly 4 bits',
|
|
BitsCount(B) = 4);
|
|
Check('1,3,5,7 bit pattern correct',
|
|
BitsSet(B, [1, 3, 5, 7]));
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TestParseRange;
|
|
var
|
|
B: TBits;
|
|
begin
|
|
Writeln('-- ParseCronField: a-b');
|
|
B := TCron.ParseCronField('9-17', 0, 23);
|
|
try
|
|
Check('9-17 sets 9 bits',
|
|
BitsCount(B) = 9);
|
|
Check('9-17 bit pattern correct',
|
|
BitsSet(B, [9, 10, 11, 12, 13, 14, 15, 16, 17]));
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TestParseRangeStep;
|
|
var
|
|
B: TBits;
|
|
begin
|
|
Writeln('-- ParseCronField: a-b/N');
|
|
B := TCron.ParseCronField('0-59/15', 0, 59);
|
|
try
|
|
Check('0-59/15 sets 4 bits',
|
|
BitsCount(B) = 4);
|
|
Check('0-59/15 bit pattern correct',
|
|
BitsSet(B, [0, 15, 30, 45]));
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TestParseSingle;
|
|
var
|
|
B: TBits;
|
|
begin
|
|
Writeln('-- ParseCronField: single literal');
|
|
B := TCron.ParseCronField('3', 0, 23);
|
|
try
|
|
Check('"3" sets exactly bit 3',
|
|
(BitsCount(B) = 1) and B.Bits[3]);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TestParseOutOfRange;
|
|
var
|
|
B: TBits;
|
|
begin
|
|
Writeln('-- ParseCronField: out of range silently dropped');
|
|
B := TCron.ParseCronField('99', 0, 59);
|
|
try
|
|
Check('"99" leaves all bits unset',
|
|
BitsCount(B) = 0);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TestMatchesEveryMinute;
|
|
var
|
|
T: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: every minute');
|
|
T := EncodeDate(2026, 5, 5) + EncodeTime(13, 27, 0, 0);
|
|
Check('* * * * * matches any minute',
|
|
TCron.MatchesCron('* * * * *', T));
|
|
end;
|
|
|
|
procedure TestMatchesTopOfHour;
|
|
var
|
|
T1, T2: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: top of hour');
|
|
T1 := EncodeDate(2026, 5, 5) + EncodeTime(13, 0, 0, 0);
|
|
T2 := EncodeDate(2026, 5, 5) + EncodeTime(13, 1, 0, 0);
|
|
Check('0 * * * * matches top-of-hour',
|
|
TCron.MatchesCron('0 * * * *', T1));
|
|
Check('0 * * * * does not match :01',
|
|
not TCron.MatchesCron('0 * * * *', T2));
|
|
end;
|
|
|
|
procedure TestMatchesDaily3am;
|
|
var
|
|
T1, T2: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: daily 3am');
|
|
T1 := EncodeDate(2026, 5, 5) + EncodeTime(3, 0, 0, 0);
|
|
T2 := EncodeDate(2026, 5, 5) + EncodeTime(3, 1, 0, 0);
|
|
Check('0 3 * * * matches 03:00',
|
|
TCron.MatchesCron('0 3 * * *', T1));
|
|
Check('0 3 * * * does not match 03:01',
|
|
not TCron.MatchesCron('0 3 * * *', T2));
|
|
end;
|
|
|
|
procedure TestMatchesHourly30;
|
|
var
|
|
T1, T2: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: hourly :30');
|
|
T1 := EncodeDate(2026, 5, 5) + EncodeTime(7, 30, 0, 0);
|
|
T2 := EncodeDate(2026, 5, 5) + EncodeTime(7, 29, 0, 0);
|
|
Check('30 * * * * matches :30',
|
|
TCron.MatchesCron('30 * * * *', T1));
|
|
Check('30 * * * * does not match :29',
|
|
not TCron.MatchesCron('30 * * * *', T2));
|
|
end;
|
|
|
|
procedure TestMatchesWeekday95;
|
|
var
|
|
Wed14, Sat14: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: weekday 9-17 hours');
|
|
{ 2026-05-06 is a Wednesday; 2026-05-09 is a Saturday. }
|
|
Wed14 := EncodeDate(2026, 5, 6) + EncodeTime(14, 0, 0, 0);
|
|
Sat14 := EncodeDate(2026, 5, 9) + EncodeTime(14, 0, 0, 0);
|
|
Check('0 9-17 * * 1-5 matches Wed 14:00',
|
|
TCron.MatchesCron('0 9-17 * * 1-5', Wed14));
|
|
Check('0 9-17 * * 1-5 does not match Sat 14:00',
|
|
not TCron.MatchesCron('0 9-17 * * 1-5', Sat14));
|
|
end;
|
|
|
|
procedure TestMatchesEvery15;
|
|
var
|
|
T0, T7, T15, T30: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: every 15 minutes');
|
|
T0 := EncodeDate(2026, 5, 5) + EncodeTime(0, 0, 0, 0);
|
|
T7 := EncodeDate(2026, 5, 5) + EncodeTime(0, 7, 0, 0);
|
|
T15 := EncodeDate(2026, 5, 5) + EncodeTime(0, 15, 0, 0);
|
|
T30 := EncodeDate(2026, 5, 5) + EncodeTime(0, 30, 0, 0);
|
|
Check('*/15 * * * * matches :00',
|
|
TCron.MatchesCron('*/15 * * * *', T0));
|
|
Check('*/15 * * * * matches :15',
|
|
TCron.MatchesCron('*/15 * * * *', T15));
|
|
Check('*/15 * * * * matches :30',
|
|
TCron.MatchesCron('*/15 * * * *', T30));
|
|
Check('*/15 * * * * does not match :07',
|
|
not TCron.MatchesCron('*/15 * * * *', T7));
|
|
end;
|
|
|
|
procedure TestMatchesJan1Midnight;
|
|
var
|
|
T1, T2, T3: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: 0 0 1 1 * (Jan 1 midnight only)');
|
|
T1 := EncodeDate(2026, 1, 1) + EncodeTime(0, 0, 0, 0);
|
|
T2 := EncodeDate(2026, 1, 1) + EncodeTime(0, 1, 0, 0);
|
|
T3 := EncodeDate(2026, 1, 2) + EncodeTime(0, 0, 0, 0);
|
|
Check('0 0 1 1 * matches Jan 1 00:00',
|
|
TCron.MatchesCron('0 0 1 1 *', T1));
|
|
Check('0 0 1 1 * does not match Jan 1 00:01',
|
|
not TCron.MatchesCron('0 0 1 1 *', T2));
|
|
Check('0 0 1 1 * does not match Jan 2 00:00',
|
|
not TCron.MatchesCron('0 0 1 1 *', T3));
|
|
end;
|
|
|
|
procedure TestMatchesSundaysMidnight;
|
|
var
|
|
Sun, Mon: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: 0 0 * * 0 (Sundays at midnight)');
|
|
{ 2026-05-10 is a Sunday; 2026-05-11 is a Monday. }
|
|
Sun := EncodeDate(2026, 5, 10) + EncodeTime(0, 0, 0, 0);
|
|
Mon := EncodeDate(2026, 5, 11) + EncodeTime(0, 0, 0, 0);
|
|
Check('0 0 * * 0 matches Sun 00:00',
|
|
TCron.MatchesCron('0 0 * * 0', Sun));
|
|
Check('0 0 * * 0 does not match Mon 00:00',
|
|
not TCron.MatchesCron('0 0 * * 0', Mon));
|
|
end;
|
|
|
|
procedure TestMatchesShortExpr;
|
|
var
|
|
T: TDateTime;
|
|
begin
|
|
Writeln('-- MatchesCron: malformed expressions');
|
|
T := EncodeDate(2026, 5, 5) + EncodeTime(13, 27, 0, 0);
|
|
Check('truncated "* * *" never matches',
|
|
not TCron.MatchesCron('* * *', T));
|
|
Check('empty expression never matches',
|
|
not TCron.MatchesCron('', T));
|
|
end;
|
|
|
|
procedure TestVersionConst;
|
|
begin
|
|
Writeln('-- version constant');
|
|
Check('CRON_VERSION_STRING = 0.1.0',
|
|
CRON_VERSION_STRING = '0.1.0');
|
|
end;
|
|
|
|
begin
|
|
Total := 0; Passed := 0; Failed := 0;
|
|
|
|
TestVersionConst;
|
|
TestParseStar;
|
|
TestParseStep;
|
|
TestParseList;
|
|
TestParseRange;
|
|
TestParseRangeStep;
|
|
TestParseSingle;
|
|
TestParseOutOfRange;
|
|
TestMatchesEveryMinute;
|
|
TestMatchesTopOfHour;
|
|
TestMatchesDaily3am;
|
|
TestMatchesHourly30;
|
|
TestMatchesWeekday95;
|
|
TestMatchesEvery15;
|
|
TestMatchesJan1Midnight;
|
|
TestMatchesSundaysMidnight;
|
|
TestMatchesShortExpr;
|
|
|
|
Writeln;
|
|
Writeln(Format('Total: %d Passed: %d Failed: %d',
|
|
[Total, Passed, Failed]));
|
|
if Failed > 0 then Halt(1);
|
|
end.
|