{ test_read.pas - read-only smoke tests against real BBS sample bases at /home/ken/fidonet/msg/. Validates that our unified API returns the expected counts and first/last records for each format. If the sample directory isn't present the tests are skipped (returns 0 so CI still passes on fresh checkouts). } program test_read; {$mode objfpc}{$H+} uses SysUtils, testutil, mb.types, mb.events, mb.api, mb.fmt.hudson, mb.fmt.hudson.uni, mb.fmt.jam, mb.fmt.jam.uni, mb.fmt.squish, mb.fmt.squish.uni, mb.fmt.msg, mb.fmt.msg.uni, mb.fmt.pcboard, mb.fmt.pcboard.uni, mb.fmt.ezycom, mb.fmt.ezycom.uni, mb.fmt.goldbase, mb.fmt.goldbase.uni; const SAMPLES_ROOT = '/home/ken/fidonet/msg'; { Walk every message in the base and return a count of successful reads. Used to verify the adapter can iterate without crashing. } function WalkAll(base: TMessageBase): longint; var i, n, ok: longint; msg: TUniMessage; begin ok := 0; n := base.MessageCount; for i := 0 to n - 1 do if base.ReadMessage(i, msg) then Inc(ok); Result := ok; end; procedure TestJam; var base: TMessageBase; msg: TUniMessage; walked: longint; begin TestBegin('JAM/10thamd (212KB .JHR, 246KB .JDT)'); if not FileExists(SAMPLES_ROOT + '/jam/10thamd.jhr') then begin WriteLn('SKIP (sample missing)'); exit; end; base := MessageBaseOpen(mbfJam, SAMPLES_ROOT + '/jam/10thamd', momReadOnly); try AssertTrue('Open', base.Open); AssertEquals('MessageCount', 291, base.MessageCount); AssertTrue('Read first', base.ReadMessage(0, msg)); AssertEquals('Msg[0].WhoFrom', 'Robert Wolfe', msg.Attributes.Get('from')); AssertEquals('Msg[0].WhoTo', 'Chad Lynch', msg.Attributes.Get('to')); AssertEquals('Msg[0].Subject', 'Test', msg.Attributes.Get('subject')); AssertTrue('Read last', base.ReadMessage(base.MessageCount - 1, msg)); walked := WalkAll(base); AssertEquals('WalkAll count', base.MessageCount, walked); finally base.Close; base.Free; end; TestOK; end; procedure TestMsg; var base: TMessageBase; msg: TUniMessage; walked: longint; begin TestBegin('FTS-1 MSG/netmail (27 numbered files)'); if not DirectoryExists(SAMPLES_ROOT + '/netmail') then begin WriteLn('SKIP (sample missing)'); exit; end; base := MessageBaseOpen(mbfMsg, SAMPLES_ROOT + '/netmail', momReadOnly); try AssertTrue('Open', base.Open); AssertEquals('MessageCount', 27, base.MessageCount); AssertTrue('Read first', base.ReadMessage(0, msg)); AssertEquals('Msg[0].MsgNum', 1, msg.Attributes.GetInt('msg.num')); AssertTrue('Msg[0].WhoFrom not empty', Length(msg.Attributes.Get('from')) > 0); walked := WalkAll(base); AssertEquals('WalkAll count', 27, walked); finally base.Close; base.Free; end; TestOK; end; procedure TestHudson; var base: TMessageBase; begin TestBegin('Hudson (empty sample base)'); if not FileExists(SAMPLES_ROOT + '/hudson/msginfo.bbs') then begin WriteLn('SKIP (sample missing)'); exit; end; base := MessageBaseOpen(mbfHudson, SAMPLES_ROOT + '/hudson', momReadOnly); try AssertTrue('Open', base.Open); AssertEquals('MessageCount', 0, base.MessageCount); finally base.Close; base.Free; end; TestOK; end; procedure TestAutoDetect; var fmt: TMsgBaseFormat; begin TestBegin('Autodetect hudson sample'); if not DirectoryExists(SAMPLES_ROOT + '/hudson') then begin WriteLn('SKIP (sample missing)'); exit; end; AssertTrue('DetectFormat', DetectFormat(SAMPLES_ROOT + '/hudson', fmt)); AssertEquals('detected', ord(mbfHudson), ord(fmt)); TestOK; end; begin WriteLn('fpc-msgbase: read tests'); WriteLn; TestJam; TestMsg; TestHudson; TestAutoDetect; Halt(TestsSummary); end.