unit test_HCRes;

{ Tests for uCICHCLzh and uCICHCResContainer.

  The LZH vectors in vectors/lzh (NN.lzh -> NN.bin, raw streams with no size
  prefix; the size is the .bin's length) are synthetic, generated by the
  Stratsims HC Platform Editor's reference encoder, and cover: empty, one
  byte, every byte value, a repetitive text, a distance-1 run, near-random
  data, and a stream long enough to force the adaptive tree to rebuild. }

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, testregistry, uCICHCLzh, uCICHCResContainer;

type
  TTestHCRes = class(TTestCase)
  private
    function VectorPath(const AName: String): String;
    function ReadBytes(const APath: String): RawByteString;
    function Bytes(const S: String): RawByteString;
  published
    /// <summary>Every vector decodes to its .bin byte for byte.</summary>
    procedure TestLzhVectors;
    /// <summary>A stream cut short raises ECICLzhError rather than looping or reading past the end.</summary>
    procedure TestLzhTruncatedRaises;
    /// <summary>A negative size is refused; size 0 is ''.</summary>
    procedure TestLzhSizes;
    /// <summary>New (7) vs old (5) header by file name.</summary>
    procedure TestHeaderSizeForName;
    /// <summary>Write then read back, BBFT prefix and 7-byte headers: plain, empty and LZH slots.</summary>
    procedure TestContainerRoundTripNew;
    /// <summary>Write then read back without a prefix and with 5-byte headers.</summary>
    procedure TestContainerRoundTripOld;
    /// <summary>A malformed offset table raises ECICResError.</summary>
    procedure TestContainerMalformed;
    /// <summary>FromFile picks the header size from the file name.</summary>
    procedure TestContainerFromFile;
  end;

implementation

function TTestHCRes.VectorPath(const AName: String): String;
begin
  Result := ExtractFilePath(ParamStr(0)) + 'vectors' + PathDelim + 'lzh' + PathDelim + AName;
end;

function TTestHCRes.ReadBytes(const APath: String): RawByteString;
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(APath, fmOpenRead or fmShareDenyWrite);
  try
    SetLength(Result, FS.Size);
    if FS.Size > 0 then
      FS.ReadBuffer(Result[1], FS.Size);
  finally
    FS.Free;
  end;
  SetCodePage(Result, CP_NONE, False);
end;

function TTestHCRes.Bytes(const S: String): RawByteString;
begin
  SetLength(Result, Length(S));
  if S <> '' then
    Move(S[1], Result[1], Length(S));
  SetCodePage(Result, CP_NONE, False);
end;

procedure TTestHCRes.TestLzhVectors;
var
  I: Integer;
  Name: String;
  Expected, Got: RawByteString;
begin
  for I := 0 to 6 do
  begin
    Name := Format('%.2d', [I]);
    AssertTrue('vector ' + Name + ' present', FileExists(VectorPath(Name + '.lzh')));
    Expected := ReadBytes(VectorPath(Name + '.bin'));
    Got := CICLzhDecode(ReadBytes(VectorPath(Name + '.lzh')), Length(Expected));
    AssertEquals('vector ' + Name + ' length', Length(Expected), Length(Got));
    AssertTrue('vector ' + Name + ' bytes', CompareByte(Expected[1], Got[1], Length(Expected)) = 0);
  end;
end;

procedure TTestHCRes.TestLzhTruncatedRaises;
var
  Stream: RawByteString;
  Size: Integer;
  Raised: Boolean;
begin
  Stream := ReadBytes(VectorPath('06.lzh'));
  Size := Length(ReadBytes(VectorPath('06.bin')));
  Stream := Copy(Stream, 1, Length(Stream) div 2);
  Raised := False;
  try
    CICLzhDecode(Stream, Size);
  except
    on E: ECICLzhError do
      Raised := True;
  end;
  AssertTrue('half a stream raises ECICLzhError', Raised);
end;

procedure TTestHCRes.TestLzhSizes;
var
  Raised: Boolean;
begin
  AssertEquals('size 0', '', CICLzhDecode(Bytes('anything'), 0));
  Raised := False;
  try
    CICLzhDecode(Bytes('x'), -1);
  except
    on E: ECICLzhError do
      Raised := True;
  end;
  AssertTrue('negative size raises', Raised);
end;

procedure TTestHCRes.TestHeaderSizeForName;
begin
  AssertEquals('commondb', HCRES_NEW_HEADER_SIZE, CICResHeaderSizeForName('C:\HC\commondb.res'));
  AssertEquals('GIUKUSNI', HCRES_NEW_HEADER_SIZE, CICResHeaderSizeForName('GIUKUSNI.RES'));
  AssertEquals('hdsl', HCRES_NEW_HEADER_SIZE, CICResHeaderSizeForName('hdsl.res'));
  AssertEquals('HDSU upper case', HCRES_NEW_HEADER_SIZE, CICResHeaderSizeForName('HDSU.RES'));
  AssertEquals('GIUK', HCRES_OLD_HEADER_SIZE, CICResHeaderSizeForName('GIUK.RES'));
  AssertEquals('HDS1', HCRES_OLD_HEADER_SIZE, CICResHeaderSizeForName('HDS1.RES'));
  AssertEquals('HDSK is old', HCRES_OLD_HEADER_SIZE, CICResHeaderSizeForName('hdsk.res'));
end;

procedure TTestHCRes.TestContainerRoundTripNew;
var
  C, R: TCICResContainer;
  Lzh, Plain: RawByteString;
  Res: TCICResResource;
begin
  Lzh := ReadBytes(VectorPath('03.lzh'));
  Plain := ReadBytes(VectorPath('03.bin'));
  C := TCICResContainer.Create;
  try
    C.Resources.Add(TCICResResource.CreateOf(Bytes('hello'), HCRES_TYPE_STD_DATA, 0, HCRES_COMPRESS_NONE_RANDOM));
    C.Resources.Add(TCICResResource.CreateEmpty);
    Res := TCICResResource.CreateOf(Lzh, HCRES_TYPE_STD_DATA, 0, HCRES_COMPRESS_LZH_RANDOM);
    Res.DataSize := Length(Plain);
    C.Resources.Add(Res);
    R := TCICResContainer.FromBytes(C.ToBytes, HCRES_NEW_HEADER_SIZE);
  finally
    C.Free;
  end;
  try
    AssertEquals('structure version', HCRES_STRUCTURE_VERSION, R.StructureVersion);
    AssertEquals('three slots', 3, R.SlotCount);
    AssertEquals('plain slot', 'hello', R.Resources[0].Data);
    AssertTrue('empty slot', R.Resources[1].IsEmpty);
    AssertEquals('empty data', '', R.Resources[1].Data);
    AssertEquals('LZH datasize kept', Length(Plain), R.Resources[2].DataSize);
    AssertTrue('LZH slot decoded', R.Resources[2].Data = Plain);
  finally
    R.Free;
  end;
end;

procedure TTestHCRes.TestContainerRoundTripOld;
var
  C, R: TCICResContainer;
begin
  C := TCICResContainer.Create;
  try
    C.StructureVersion := 0; // no BBFT prefix
    C.HeaderSize := HCRES_OLD_HEADER_SIZE;
    C.Resources.Add(TCICResResource.CreateEmpty);
    C.Resources.Add(TCICResResource.CreateOf(Bytes('GIUK -- Greenland'), HCRES_TYPE_STD_DATA, 0, HCRES_COMPRESS_NONE));
    AssertFalse('no prefix written', Copy(C.ToBytes, 1, 4) = 'BBFT');
    R := TCICResContainer.FromBytes(C.ToBytes, HCRES_OLD_HEADER_SIZE);
  finally
    C.Free;
  end;
  try
    AssertEquals('no prefix read', 0, R.StructureVersion);
    AssertEquals('text', 'GIUK -- Greenland', R.Resources[1].Data);
  finally
    R.Free;
  end;
end;

procedure TTestHCRes.TestContainerMalformed;
var
  Raised: Boolean;
begin
  Raised := False;
  try
    TCICResContainer.FromBytes(Bytes(#6#0#0#0'xx'), HCRES_OLD_HEADER_SIZE).Free;
  except
    on E: ECICResError do
      Raised := True;
  end;
  AssertTrue('offset[0] not a multiple of 4', Raised);

  Raised := False;
  try
    TCICResContainer.FromBytes(Bytes(#40#0#0#0), HCRES_OLD_HEADER_SIZE).Free;
  except
    on E: ECICResError do
      Raised := True;
  end;
  AssertTrue('table runs past EOF', Raised);

  Raised := False;
  try
    TCICResContainer.FromBytes(Bytes(#1#0), HCRES_OLD_HEADER_SIZE).Free;
  except
    on E: ECICResError do
      Raised := True;
  end;
  AssertTrue('truncated file', Raised);
end;

procedure TTestHCRes.TestContainerFromFile;
var
  C, R: TCICResContainer;
  Path: String;
  FS: TFileStream;
  Data: RawByteString;
begin
  C := TCICResContainer.Create;
  try
    C.HeaderSize := HCRES_NEW_HEADER_SIZE;
    C.Resources.Add(TCICResResource.CreateOf(Bytes('WestPac'), HCRES_TYPE_STD_DATA, 0, HCRES_COMPRESS_NONE));
    Data := C.ToBytes;
  finally
    C.Free;
  end;
  Path := GetTempDir + 'hdsl_' + IntToStr(GetTickCount64) + '.res';
  FS := TFileStream.Create(Path, fmCreate);
  try
    FS.WriteBuffer(Data[1], Length(Data));
  finally
    FS.Free;
  end;
  try
    R := TCICResContainer.FromFile(Path);
    try
      AssertEquals('7-byte headers for an hdsl file', HCRES_NEW_HEADER_SIZE, R.HeaderSize);
      AssertEquals('content', 'WestPac', R.Resources[0].Data);
    finally
      R.Free;
    end;
  finally
    DeleteFile(Path);
  end;
end;

initialization
  RegisterTest(TTestHCRes);

end.