{ test_write_existing.pas - write into copies of real populated bases and verify integrity. Never touches the source trees: ~/fidonet/msg/jam/10thamd.* (291 messages on disk) ~/fidonet/msg/netmail/ (27 numbered *.msg files) Both are copied into /tmp scratch dirs first. Tests append messages, reopen, verify counts and that pre-existing messages are still readable. } program test_write_existing; {$mode objfpc}{$H+} uses SysUtils, testutil, mb.address, mb.types, mb.events, mb.api, mb.fmt.jam, mb.fmt.jam.uni, mb.fmt.msg, mb.fmt.msg.uni, mb.fmt.hudson, mb.fmt.hudson.uni; const JAM_SRC = '/home/ken/fidonet/msg/jam/10thamd'; JAM_SCRATCH = '/tmp/ma_write_jam'; MSG_SRC = '/home/ken/fidonet/msg/netmail'; MSG_SCRATCH = '/tmp/ma_write_msg'; HUDSON_SCRATCH = '/tmp/ma_write_hudson'; HUDSON_SEED_N = 50; { seed from JAM source } function RunShell(const Cmd: string): integer; begin Result := ExecuteProcess('/bin/sh', ['-c', Cmd]); end; function MakeMsg(N: longint): TUniMessage; begin Result.Attributes.Clear; Result.Attributes.SetValue('from', 'WriteTester' + IntToStr(N)); Result.Attributes.SetValue('to', 'Receiver' + IntToStr(N)); Result.Attributes.SetValue('subject', 'written #' + IntToStr(N)); Result.Attributes.SetDate('date.written', EncodeDate(2026, 4, 15) + EncodeTime(10, N mod 60, 0, 0)); Result.Attributes.SetBool('attr.local', true); Result.Attributes.SetBool('attr.echo', true); Result.Attributes.SetAddr('addr.orig', MakeFTNAddress(1, 100, 200, 0)); Result.Attributes.SetAddr('addr.dest', MakeFTNAddress(1, 100, 300, 0)); Result.Attributes.SetValue('area', 'TEST'); Result.Body := 'Appended message body ' + IntToStr(N) + #13; end; procedure TestJamAppend; const APPEND_COUNT = 10; var base: TMessageBase; msg: TUniMessage; i, preCount: longint; begin TestBegin(SysUtils.Format( 'JAM: append %d messages to real 291-msg base', [APPEND_COUNT])); if not FileExists(JAM_SRC + '.jhr') then begin WriteLn('SKIP (source missing)'); exit; end; { Fresh scratch copy. } if DirectoryExists(ExtractFilePath(JAM_SCRATCH + '.')) then RunShell(SysUtils.Format('rm -f %s/10thamd.*', [ExtractFilePath(JAM_SCRATCH + '.')])); ForceDirectories(ExtractFilePath(JAM_SCRATCH + '.')); RunShell(SysUtils.Format('cp %s.jhr %s.jhr', [JAM_SRC, JAM_SCRATCH])); RunShell(SysUtils.Format('cp %s.jdt %s.jdt', [JAM_SRC, JAM_SCRATCH])); RunShell(SysUtils.Format('cp %s.jdx %s.jdx', [JAM_SRC, JAM_SCRATCH])); RunShell(SysUtils.Format('cp %s.jlr %s.jlr', [JAM_SRC, JAM_SCRATCH])); RunShell(SysUtils.Format('chmod u+w %s.*', [JAM_SCRATCH])); { Record pre-count. } base := MessageBaseOpen(mbfJam, JAM_SCRATCH, momReadOnly); try AssertTrue('Pre-open RO', base.Open); preCount := base.MessageCount; AssertEquals('Pre-count', 291, preCount); finally base.Close; base.Free; end; { Append phase. } base := MessageBaseOpen(mbfJam, JAM_SCRATCH, momReadWrite); try AssertTrue('Open RW', base.Open); for i := 1 to APPEND_COUNT do begin msg := MakeMsg(i); AssertTrue('WriteMessage ' + IntToStr(i), base.WriteMessage(msg)); end; AssertEquals('Count after append', preCount + APPEND_COUNT, base.MessageCount); finally base.Close; base.Free; end; { Reopen + verify. } base := MessageBaseOpen(mbfJam, JAM_SCRATCH, momReadOnly); try AssertTrue('Reopen RO', base.Open); AssertEquals('Count after reopen', preCount + APPEND_COUNT, base.MessageCount); { First original message should still be Robert Wolfe. } AssertTrue('Read original msg 0', base.ReadMessage(0, msg)); AssertEquals('Msg[0].WhoFrom', 'Robert Wolfe', msg.Attributes.Get('from')); { Appended messages should be at indexes preCount..preCount+9. } for i := 1 to APPEND_COUNT do begin AssertTrue('Read appended ' + IntToStr(i), base.ReadMessage(preCount + i - 1, msg)); AssertEquals('Appended WhoFrom', 'WriteTester' + IntToStr(i), msg.Attributes.Get('from')); AssertEquals('Appended Subject', 'written #' + IntToStr(i), msg.Attributes.Get('subject')); AssertTrue('Appended body contains marker', Pos('Appended message body ' + IntToStr(i), msg.Body) > 0); end; finally base.Close; base.Free; end; TestOK; end; procedure TestMsgAppend; const APPEND_COUNT = 5; var base: TMessageBase; msg: TUniMessage; i, preCount: longint; begin TestBegin(SysUtils.Format( '*.MSG: append %d messages to 27-msg netmail dir', [APPEND_COUNT])); if not DirectoryExists(MSG_SRC) then begin WriteLn('SKIP (source missing)'); exit; end; { Fresh scratch copy. } if DirectoryExists(MSG_SCRATCH) then RunShell(SysUtils.Format('rm -rf %s', [MSG_SCRATCH])); ForceDirectories(MSG_SCRATCH); RunShell(SysUtils.Format('cp -r %s/. %s/', [MSG_SRC, MSG_SCRATCH])); RunShell(SysUtils.Format('chmod -R u+w %s', [MSG_SCRATCH])); base := MessageBaseOpen(mbfMsg, MSG_SCRATCH, momReadOnly); try AssertTrue('Pre-open RO', base.Open); preCount := base.MessageCount; AssertEquals('Pre-count', 27, preCount); finally base.Close; base.Free; end; base := MessageBaseOpen(mbfMsg, MSG_SCRATCH, momReadWrite); try AssertTrue('Open RW', base.Open); for i := 1 to APPEND_COUNT do begin msg := MakeMsg(100 + i); AssertTrue('WriteMessage ' + IntToStr(i), base.WriteMessage(msg)); AssertTrue('New MsgNum > 0', msg.Attributes.GetInt('msg.num') > 0); end; AssertEquals('Count after append', preCount + APPEND_COUNT, base.MessageCount); finally base.Close; base.Free; end; base := MessageBaseOpen(mbfMsg, MSG_SCRATCH, momReadOnly); try AssertTrue('Reopen RO', base.Open); AssertEquals('Count after reopen', preCount + APPEND_COUNT, base.MessageCount); finally base.Close; base.Free; end; TestOK; end; { SeedHudsonFromJam - create a populated Hudson base by copying the first N messages from the real JAM sample. Lets Hudson tests run against realistic data without committing binary samples to the repo. } procedure SeedHudsonFromJam(const AHudsonPath: string; N: longint); var src, dst: TMessageBase; msg: TUniMessage; i, copied: longint; begin if DirectoryExists(AHudsonPath) then RunShell(SysUtils.Format('rm -rf %s', [AHudsonPath])); ForceDirectories(AHudsonPath); dst := MessageBaseOpen(mbfHudson, AHudsonPath, 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 TestHudsonAppend; const APPEND_COUNT = 10; var base: TMessageBase; msg: TUniMessage; i, preCount: longint; begin TestBegin(SysUtils.Format( 'Hudson: seed %d msgs from JAM, append %d, verify', [HUDSON_SEED_N, APPEND_COUNT])); if not FileExists(JAM_SRC + '.jhr') then begin WriteLn('SKIP (JAM source missing)'); exit; end; SeedHudsonFromJam(HUDSON_SCRATCH, HUDSON_SEED_N); base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadOnly); try AssertTrue('Pre-open RO', base.Open); preCount := base.MessageCount; AssertEquals('Pre-count', HUDSON_SEED_N, preCount); finally base.Close; base.Free; end; base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadWrite); try AssertTrue('Open RW', base.Open); for i := 1 to APPEND_COUNT do begin msg := MakeMsg(200 + i); AssertTrue('WriteMessage ' + IntToStr(i), base.WriteMessage(msg)); end; AssertEquals('Count after append', preCount + APPEND_COUNT, base.MessageCount); finally base.Close; base.Free; end; base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadOnly); try AssertTrue('Reopen RO', base.Open); AssertEquals('Count after reopen', preCount + APPEND_COUNT, base.MessageCount); for i := 1 to APPEND_COUNT do begin AssertTrue('Read appended ' + IntToStr(i), base.ReadMessage(preCount + i - 1, msg)); AssertEquals('Appended WhoFrom', 'WriteTester' + IntToStr(200 + i), msg.Attributes.Get('from')); end; finally base.Close; base.Free; end; TestOK; end; begin WriteLn('fpc-msgbase: write-to-existing-base tests'); WriteLn; TestJamAppend; TestMsgAppend; TestHudsonAppend; Halt(TestsSummary); end.