fpc-msgbase/tests/test_read.pas

{
  test_read.pas - read-only smoke tests against the real BBS
  sample bases at /home/ken/fidonet/msg/.  Validates that our
  unified API returns the same counts and first/last records
  that Allfix's native tools would produce.

  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,
  ma.types, ma.events, ma.api,
  ma.fmt.hudson,   ma.fmt.hudson.uni,
  ma.fmt.jam,      ma.fmt.jam.uni,
  ma.fmt.squish,   ma.fmt.squish.uni,
  ma.fmt.msg,      ma.fmt.msg.uni,
  ma.fmt.pkt,      ma.fmt.pkt.uni,
  ma.fmt.pcboard,  ma.fmt.pcboard.uni,
  ma.fmt.ezycom,   ma.fmt.ezycom.uni,
  ma.fmt.goldbase, ma.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.WhoFrom);
    AssertEquals('Msg[0].WhoTo',   'Chad Lynch',   msg.WhoTo);
    AssertEquals('Msg[0].Subject', 'Test',         msg.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.MsgNum);
    AssertTrue('Msg[0].WhoFrom not empty', Length(msg.WhoFrom) > 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('message_api: read tests');
  WriteLn;
  TestJam;
  TestMsg;
  TestHudson;
  TestAutoDetect;
  Halt(TestsSummary);
end.