Ken Johnson
a541085a4b
Ask 1 from fpc-binkp consumer thread: non-storage libraries
(fpc-ftn-transport, fpc-binkp, future fpc-comet-proto / fpc-emsi,
SQL-backed messaging like Fastway) only need TFTNAddress, not the
full 1041-line mb.types. Extract to src/mb.address.pas (~90 lines,
only SysUtils) so they can cp a single file into their project.
mb.types continues to uses mb.address so existing callers see the
type transitively -- BUT FPC does not propagate record-field access
through re-export, so consumers that touch TFTNAddress.Zone/Net/
Node/Point directly must add mb.address to their own uses clause.
All 7 in-tree .uni adapters, 2 examples, 5 test harnesses updated.
No behavioural change. Full suite passes, multi-target build
green (x86_64-linux, i386-{linux,freebsd,win32,os2,go32v2}).
306 lines
8.8 KiB
ObjectPascal
306 lines
8.8 KiB
ObjectPascal
{
|
|
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.
|