fpc-msgbase/tests/test_pack.pas

{
  test_pack.pas - Pack semantics against real base copies.

  Two JAM tests:

    1. No-op pack: copy the real 291-message 10thamd to scratch,
       call Pack with no age/count purge, verify count and field
       integrity survive.

    2. Purge-deleted pack: copy again, mark 5 messages deleted via
       the native class, Pack, verify count dropped by exactly 5
       and that a known-live message still reads correctly.
}

program test_pack;

{$mode objfpc}{$H+}

uses
  SysUtils,
  testutil,
  ma.types, ma.events, ma.api,
  ma.fmt.jam,    ma.fmt.jam.uni,
  ma.fmt.hudson, ma.fmt.hudson.uni;

const
  JAM_SRC        = '/home/ken/fidonet/msg/jam/10thamd';
  SCRATCH_A      = '/tmp/ma_pack_noop';
  SCRATCH_B      = '/tmp/ma_pack_purge';
  HUDSON_SCRATCH = '/tmp/ma_pack_hudson';
  HUDSON_SEED    = 50;

function RunShell(const Cmd: string): integer;
begin
  Result := ExecuteProcess('/bin/sh', ['-c', Cmd]);
end;

procedure CopyJamBase(const Dest: string);
var
  dir: string;
begin
  dir := ExtractFilePath(Dest + '.');
  ForceDirectories(dir);
  RunShell(SysUtils.Format('rm -f %s.*', [Dest]));
  RunShell(SysUtils.Format('cp %s.jhr %s.jhr', [JAM_SRC, Dest]));
  RunShell(SysUtils.Format('cp %s.jdt %s.jdt', [JAM_SRC, Dest]));
  RunShell(SysUtils.Format('cp %s.jdx %s.jdx', [JAM_SRC, Dest]));
  RunShell(SysUtils.Format('cp %s.jlr %s.jlr', [JAM_SRC, Dest]));
  RunShell(SysUtils.Format('chmod u+w %s.*', [Dest]));
end;

procedure TestNoOpPack;
var
  base: TMessageBase;
  msg:  TUniMessage;
  preCount, postCount: longint;
begin
  TestBegin('JAM: no-op Pack on 291-msg base preserves every message');
  if not FileExists(JAM_SRC + '.jhr') then begin
    WriteLn('SKIP'); exit;
  end;
  CopyJamBase(SCRATCH_A);

  base := MessageBaseOpen(mbfJam, SCRATCH_A, momReadWrite);
  try
    AssertTrue('Open RW', base.Open);
    preCount := base.MessageCount;
    AssertEquals('Pre-count', 291, preCount);
    AssertTrue('Pack(0,0)', base.Pack(0, 0, False));
    postCount := base.MessageCount;
    AssertEquals('Post-count unchanged', preCount, postCount);

    { Spot-check first + last message fields survived. }
    AssertTrue('Read first', base.ReadMessage(0, msg));
    AssertEquals('Msg[0].WhoFrom', 'Robert Wolfe', msg.Attributes.Get('from'));
    AssertTrue('Read last',
               base.ReadMessage(base.MessageCount - 1, msg));
  finally
    base.Close;
    base.Free;
  end;
  TestOK;
end;

procedure TestPurgePack;
const
  KILL = 5;
var
  base:    TMessageBase;
  adapter: TJamMessageBase;
  nat:     TJamMessage;
  hdr:     JamHdr;
  msg:     TUniMessage;
  preCount, postCount, i: longint;
begin
  TestBegin(SysUtils.Format(
    'JAM: Pack removes %d deleted messages', [KILL]));
  if not FileExists(JAM_SRC + '.jhr') then begin
    WriteLn('SKIP'); exit;
  end;
  CopyJamBase(SCRATCH_B);

  { Phase 1: mark KILL messages deleted via the native class. }
  base := MessageBaseOpen(mbfJam, SCRATCH_B, momReadWrite);
  adapter := base as TJamMessageBase;
  try
    AssertTrue('Open RW', base.Open);
    preCount := base.MessageCount;

    for i := 0 to KILL - 1 do begin
      AssertTrue('Native.ReadMessage ' + IntToStr(i),
                 adapter.Native.ReadMessage(i, nat));
      AssertTrue('ReadHeader',
                 adapter.Native.ReadHeader(nat.HdrOffset, hdr));
      hdr.Attribute := hdr.Attribute or longint($80000000);
      adapter.Native.UpdateHeader(nat.HdrOffset, hdr);
    end;
    adapter.Native.IncModCounter;
    adapter.Native.UpdateHdrInfo;

    { Phase 2: Pack via unified API. }
    AssertTrue('Pack(0,0)', base.Pack(0, 0, False));

    postCount := base.MessageCount;
    AssertEquals('Count after purge', preCount - KILL, postCount);

    { The first surviving message is what was at index KILL pre-pack. }
    AssertTrue('Read survivor[0]', base.ReadMessage(0, msg));
    AssertFalse('Survivor is not deleted',
                msg.Attributes.GetBool('attr.deleted', false));
  finally
    base.Close;
    base.Free;
  end;

  { Reopen fresh and confirm the on-disk count sticks. }
  base := MessageBaseOpen(mbfJam, SCRATCH_B, momReadOnly);
  try
    AssertTrue('Reopen RO', base.Open);
    AssertEquals('Post-pack count after reopen',
                 preCount - KILL, base.MessageCount);
  finally
    base.Close;
    base.Free;
  end;

  TestOK;
end;

procedure SeedHudson(const APath: string; N: longint);
var
  src, dst: TMessageBase;
  msg: TUniMessage;
  i, copied: longint;
begin
  if DirectoryExists(APath) then
    RunShell(SysUtils.Format('rm -rf %s', [APath]));
  ForceDirectories(APath);
  dst := MessageBaseOpen(mbfHudson, APath, momCreate);
  try
    if not dst.Open then exit;
    src := MessageBaseOpen(mbfJam, JAM_SRC, momReadOnly);
    try
      if not src.Open then exit;
      copied := 0;
      i := 0;
      while (copied < N) and (i < src.MessageCount) do begin
        if src.ReadMessage(i, msg) then begin
          dst.WriteMessage(msg);
          Inc(copied);
        end;
        Inc(i);
      end;
    finally
      src.Close;
      src.Free;
    end;
  finally
    dst.Close;
    dst.Free;
  end;
end;

procedure TestHudsonPurgePack;
const
  KILL = 7;
var
  base:    TMessageBase;
  adapter: THudsonMessageBase;
  hdr:     HudsonHdrRec;
  i, preCount, postCount: longint;
  msg: TUniMessage;
begin
  TestBegin(SysUtils.Format(
    'Hudson: seed %d + mark %d deleted + Pack',
    [HUDSON_SEED, KILL]));
  if not FileExists(JAM_SRC + '.jhr') then begin
    WriteLn('SKIP'); exit;
  end;

  SeedHudson(HUDSON_SCRATCH, HUDSON_SEED);

  base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadWrite);
  adapter := base as THudsonMessageBase;
  try
    AssertTrue('Open RW', base.Open);
    preCount := base.MessageCount;
    AssertEquals('Pre-count', HUDSON_SEED, preCount);

    for i := 0 to KILL - 1 do begin
      AssertTrue('Native.ReadHeader ' + IntToStr(i),
                 adapter.Native.ReadHeader(i, hdr));
      hdr.MsgAttr := hdr.MsgAttr or $01;   { HUDSON_DELETED }
      adapter.Native.UpdateHeader(i, hdr);
    end;

    AssertTrue('Pack(0,0)', base.Pack(0, 0, False));

    postCount := base.MessageCount;
    AssertEquals('Count after Pack', preCount - KILL, postCount);

    AssertTrue('Read survivor[0]', base.ReadMessage(0, msg));
    AssertFalse('Survivor not deleted',
                msg.Attributes.GetBool('attr.deleted', false));
  finally
    base.Close;
    base.Free;
  end;

  { Reopen and confirm. }
  base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadOnly);
  try
    AssertTrue('Reopen RO', base.Open);
    AssertEquals('Post-pack count after reopen',
                 HUDSON_SEED - KILL, base.MessageCount);
  finally
    base.Close;
    base.Free;
  end;

  TestOK;
end;

begin
  WriteLn('fpc-msgbase: Pack tests against real base data');
  WriteLn;
  TestNoOpPack;
  TestPurgePack;
  TestHudsonPurgePack;
  Halt(TestsSummary);
end.