unit test_DatabaseMatch;

{$mode objfpc}{$H+}

/// <summary>
/// FPCUnit tests for uHCLDatabaseMatch: database names reduced to family and
/// build date, candidates from catalog files, the exact-or-nearest-newer
/// choice, and finding an installed database by identity.
/// </summary>

interface

uses
  Classes, SysUtils, fpcunit, testregistry, uHCLCatalog, uHCLDatabaseMatch;

type
  TTestDatabaseMatch = class(TTestCase)
  private
    FDir: String;
    function DBFile(const AID, ALabel, AFileName: String): THCLCatalogFile;
    procedure AddVersion(var AFile: THCLCatalogFile; const ALabel, AFileName: String);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    /// <summary>Real catalog names reduce to family and date.</summary>
    procedure TestParse;
    /// <summary>Names without a clean six-digit date or a family are refused.</summary>
    procedure TestParseRefusals;
    /// <summary>Current and earlier versions become candidates; links and fileless entries do not.</summary>
    procedure TestCandidates;
    /// <summary>The build itself when the catalog has it.</summary>
    procedure TestChooseExact;
    /// <summary>Otherwise the nearest newer build of the same family, never another family.</summary>
    procedure TestChooseNearestNewer;
    /// <summary>Nothing on or after the build: no choice.</summary>
    procedure TestChooseNone;
    /// <summary>An installed database is found by identity whatever its folder is called.</summary>
    procedure TestFindInstalled;
  end;

implementation

procedure TTestDatabaseMatch.SetUp;
begin
  FDir := IncludeTrailingPathDelimiter(GetTempDir) + 'HCLDBMatch_' + IntToStr(GetTickCount64);
  ForceDirectories(FDir);
end;

procedure TTestDatabaseMatch.TearDown;

  procedure Wipe(const ADir: String);
  var
    SR: TSearchRec;
  begin
    if FindFirst(ADir + PathDelim + '*', faAnyFile, SR) = 0 then
    try
      repeat
        if (SR.Name = '.') or (SR.Name = '..') then
          Continue;
        if (SR.Attr and faDirectory) <> 0 then
          Wipe(ADir + PathDelim + SR.Name)
        else
          DeleteFile(ADir + PathDelim + SR.Name);
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
    RemoveDir(ADir);
  end;

begin
  Wipe(FDir);
end;

function TTestDatabaseMatch.DBFile(const AID, ALabel, AFileName: String): THCLCatalogFile;
begin
  Result := Default(THCLCatalogFile);
  Result.ID := AID;
  Result.Title := ALabel;
  Result.ArtifactType := 'PlatformDB';
  Result.VersionLabel := ALabel;
  Result.FileName := AFileName;
  Result.DownloadUrl := 'https://invalid.example/' + AID;
end;

procedure TTestDatabaseMatch.AddVersion(var AFile: THCLCatalogFile; const ALabel, AFileName: String);
begin
  SetLength(AFile.Versions, Length(AFile.Versions) + 1);
  AFile.Versions[High(AFile.Versions)].VersionLabel := ALabel;
  AFile.Versions[High(AFile.Versions)].FileName := AFileName;
  AFile.Versions[High(AFile.Versions)].DownloadUrl := 'https://invalid.example/v';
end;

procedure TTestDatabaseMatch.TestParse;
var
  Id: THCLDBId;
begin
  AssertTrue(HCLParseDBId('HCDB-060103', Id));
  AssertEquals('family', 'HCDB', Id.Family);
  AssertEquals('date', 20060103, Id.Date);

  AssertTrue(HCLParseDBId('HCDB2-170909', Id));
  AssertEquals('HCDB2 is its own family', 'HCDB2', Id.Family);
  AssertEquals('2017', 20170909, Id.Date);

  AssertTrue(HCLParseDBId('HCDB_070414_2006.13b3', Id));
  AssertEquals('underscores', 'HCDB', Id.Family);
  AssertEquals('first six-digit run', 20070414, Id.Date);

  AssertTrue(HCLParseDBId('HCDB070524_HC2003.15', Id));
  AssertEquals('no separator', 'HCDB', Id.Family);
  AssertEquals('date', 20070524, Id.Date);

  AssertTrue(HCLParseDBId('HC_80to95_DB_110101', Id));
  AssertEquals('timeline family', 'HC80TO95DB', Id.Family);

  AssertTrue(HCLParseDBId('HCDB-250724 (1980-2015 era)', Id));
  AssertEquals('a folder name with a note', 20250724, Id.Date);

  AssertTrue(HCLParseDBId('hcdb 150928', Id));
  AssertEquals('lower case, space', 'HCDB', Id.Family);

  AssertTrue(HCLParseDBId('HC_WW2_DB_050316', Id));
  AssertEquals('1990s cut-off not hit', 20050316, Id.Date);
  AssertTrue(HCLParseDBId('HCWW-991231', Id));
  AssertEquals('50-99 is 19xx', 19991231, Id.Date);

  HCLParseDBId('HCDB-060103', Id);
  AssertEquals('text', 'HCDB 2006-01-03', HCLDBIdText(Id));
end;

procedure TTestDatabaseMatch.TestParseRefusals;
var
  Id: THCLDBId;
begin
  AssertFalse('no date', HCLParseDBId('HCDB', Id));
  AssertFalse('seven digits', HCLParseDBId('HC_EURO_DB_0802122', Id));
  AssertFalse('eight digits', HCLParseDBId('HC_Euro_DB_08062007', Id));
  AssertFalse('no family', HCLParseDBId('060103', Id));
  AssertFalse('family must start with a letter', HCLParseDBId('2-060103', Id));
  AssertFalse('not a date', HCLParseDBId('HCDB-061303', Id));
  AssertFalse('empty', HCLParseDBId('', Id));
end;

procedure TTestDatabaseMatch.TestCandidates;
var
  Files: THCLCatalogFileArray;
  C: THCLDBCandidateArray;
  Link: THCLCatalogFile;
begin
  SetLength(Files, 3);
  Files[0] := DBFile('h:235', 'HCDB-250724', 'HCDB-250724.zip');
  AddVersion(Files[0], 'HCDB-150928', 'HCDB-150928.zip');
  AddVersion(Files[0], 'mystery', 'HCDB-140909.zip');  // label says nothing: the file name does
  AddVersion(Files[0], 'notes', 'readme.zip');         // neither: skipped
  Link := DBFile('h:9', 'HCDB-990101', 'x.zip');
  Link.ExternalLink := True;
  Files[1] := Link;
  Files[2] := DBFile('h:10', 'HCDB-120101', '');       // no file
  C := HCLDBCandidates(Files);
  AssertEquals('current plus two recognisable versions', 3, Length(C));
  AssertEquals('current first', 'HCDB-250724', C[0].Name);
  AssertFalse('current is current', C[0].CatalogFile.IsPreviousVersion);
  AssertEquals('earlier version', 'HCDB-150928', C[1].Name);
  AssertTrue('selected as an earlier version', C[1].CatalogFile.IsPreviousVersion);
  AssertEquals('by file name', 'HCDB-140909', C[2].Name);
  AssertEquals('its file', 'HCDB-140909.zip', C[2].CatalogFile.FileName);
end;

procedure TTestDatabaseMatch.TestChooseExact;
var
  Files: THCLCatalogFileArray;
  Need: THCLDBId;
  Got: THCLDBCandidate;
  Exact: Boolean;
begin
  SetLength(Files, 2);
  Files[0] := DBFile('h:235', 'HCDB-250724', 'HCDB-250724.zip');
  AddVersion(Files[0], 'HCDB-150928', 'HCDB-150928.zip');
  Files[1] := DBFile('h:500', 'HCDB-150928', 'HCDB-150928.zip');  // the same build, current elsewhere
  HCLParseDBId('HCDB-150928', Need);
  AssertTrue(HCLChooseDatabase(Need, HCLDBCandidates(Files), Got, Exact));
  AssertTrue('exact', Exact);
  AssertEquals('the build', 20150928, Got.Id.Date);
  AssertFalse('a current version beats an earlier one of the same build', Got.CatalogFile.IsPreviousVersion);
  AssertEquals('from that entry', 'h:500', Got.CatalogFile.ID);
end;

procedure TTestDatabaseMatch.TestChooseNearestNewer;
var
  Files: THCLCatalogFileArray;
  Need: THCLDBId;
  Got: THCLDBCandidate;
  Exact: Boolean;
begin
  SetLength(Files, 4);
  Files[0] := DBFile('h:235', 'HCDB-250724', 'HCDB-250724.zip');
  AddVersion(Files[0], 'HCDB-130818', 'HCDB-130818.zip');
  Files[1] := DBFile('h:214', 'HCDB-070414 compatible with 2003.16b3', 'HCDB_070414_2006.13b3.zip');
  Files[2] := DBFile('h:226', 'HCDB-070524 compatible with 2003.15', 'HCDB070524_HC2003.15.zip');
  Files[3] := DBFile('h:934', 'HCDB2-061201', 'HCDB2-061201.zip');   // another family, closer in date
  HCLParseDBId('HCDB-060103', Need);  // Pinger Charlie
  AssertTrue(HCLChooseDatabase(Need, HCLDBCandidates(Files), Got, Exact));
  AssertFalse('not exact', Exact);
  AssertEquals('the nearest newer HCDB, not HCDB2', 'h:214', Got.CatalogFile.ID);
  AssertEquals('2007-04-14', 20070414, Got.Id.Date);
end;

procedure TTestDatabaseMatch.TestChooseNone;
var
  Files: THCLCatalogFileArray;
  Need: THCLDBId;
  Got: THCLDBCandidate;
  Exact: Boolean;
begin
  SetLength(Files, 1);
  Files[0] := DBFile('h:1', 'HCDB-070414', 'HCDB-070414.zip');
  HCLParseDBId('HCDB-250801', Need);
  AssertFalse('only older builds', HCLChooseDatabase(Need, HCLDBCandidates(Files), Got, Exact));
  HCLParseDBId('HCWW-101110', Need);
  AssertFalse('no such family', HCLChooseDatabase(Need, HCLDBCandidates(Files), Got, Exact));
  AssertFalse('no requirement', HCLChooseDatabase(Default(THCLDBId), HCLDBCandidates(Files), Got, Exact));
end;

procedure TTestDatabaseMatch.TestFindInstalled;
var
  Need: THCLDBId;
  FS: TFileStream;
begin
  ForceDirectories(FDir + PathDelim + 'HCDB-070414 compatible with 2003.16b3');
  FS := TFileStream.Create(FDir + PathDelim + 'HCDB-070414 compatible with 2003.16b3' + PathDelim + 'commondb.res', fmCreate);
  FS.Free;
  ForceDirectories(FDir + PathDelim + 'HCDB-060103');  // empty: not installed
  ForceDirectories(FDir + PathDelim + 'cache');

  HCLParseDBId('HCDB_070414', Need);
  AssertEquals('found by identity', 'HCDB-070414 compatible with 2003.16b3', HCLFindInstalledDatabase(FDir, Need));
  HCLParseDBId('HCDB-060103', Need);
  AssertEquals('a folder without commondb.res does not count', '', HCLFindInstalledDatabase(FDir, Need));
  AssertEquals('missing directory', '', HCLFindInstalledDatabase(FDir + PathDelim + 'nope', Need));
end;

initialization
  RegisterTest(TTestDatabaseMatch);

end.