TestShaper.pas

unit TestShaper;

interface

uses
  System.SysUtils,
  System.IOUtils,
  System.StrUtils,
  System.Generics.Collections,
  IniFiles,
  TestFramework,
  PascalType.Types,
  PascalType.Unicode,
  PascalType.Classes,
  PascalType.GlyphString,
  PascalType.FontFace.SFNT,
  PascalType.Shaper,
  PascalType.Shaper.Plan,
  PascalType.Shaper.Script.Default;

(*

This unit test uses the data from the Harfbuzz shaper unit test suite.
The suite is found here: https://github.com/harfbuzz/harfbuzz/tree/main/test/shape

The unit test assumes that a copy of the Harfbuzz unit test data files
from test/shape/data is located locally in the relative path "..\Data".

The test file parser supports both the format of the Adobe AOTS test files and
the format of the Harfbuzz in-house test files.

The Harfbuff "render" unit tests are ignored.
The Harfbuff "macos" unit tests rely on Apple system fonts and are ignored.

*)

type
  TRegressionTestSuite = class(TTestSuite)
  private
    FExecuted: boolean;
    FLastPassed: boolean;
    FRegression: string;
  protected
    procedure RunTest(testResult: TTestResult); override;
  public
    procedure LoadConfiguration(const iniFile :TCustomIniFile; const section :string); override;
    procedure SaveConfiguration(const iniFile :TCustomIniFile; const section :string); override;

    property LastPassed: boolean read FLastPassed write FLastPassed;
  end;

type
  TRegressionTestCase = class(TTestCase)
  private
    FExecuted: boolean;
    FLastPassed: boolean;
    FRegression: string;
  protected
    procedure RunTest(testResult: TTestResult); override;
  public
    procedure LoadConfiguration(const iniFile :TCustomIniFile; const section :string); override;
    procedure SaveConfiguration(const iniFile :TCustomIniFile; const section :string); override;

    property LastPassed: boolean read FLastPassed write FLastPassed;
  end;

type
  TTestCaseHarfbuzzShaper = class(TRegressionTestCase)
  private type
    TTestOptions = set of (
      toClusters,
      toGlyphNames,
      toPositions,
      toAdvances,
      toSinglePar
    );
  private
    FLine: string;
    FTestID: string;
    FFontFile: string;
    FOptions: string;
    FInput: string;
    FExpected: string;
    FFontFace: TPascalTypeFontFace;
  private
    procedure ParseCodepoints(const Input: string; var CodePoints: TPascalTypeCodePoints);
    procedure ParseOptions(var Options: TTestOptions; var Features: TArray<string>; var Script: TTableType; var Language: TTableType; var Direction: TPascalTypeDirection; var ShaperOptions: TShaperOptions; var ClusterLevel: TClusterLevel);
    procedure ApplyFeatures(const AParams: TArray<string>; var AFeatures: TPascalTypeFeatures; AGlyphs: TPascalTypeGlyphString);
    function BuildResult(ShapedText: TPascalTypeGlyphString; Options: TTestOptions): string;
    procedure ProcessLine(ActualGlyphs: TPascalTypeGlyphString; Options: TTestOptions);

  public
    constructor Create(const ALine, ATestID, AName, AFontFile, AOptions, AInput, AExpected: string); reintroduce;
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure Test;
  end;

implementation

uses
  System.Math,
  System.Types,
  System.RegularExpressions;

function ParseHex(const S: string): TPascalTypeCodePoint;
begin
  var Temp := S;
  if StartsStr('U+', Temp) then
    Delete(Temp, 1, 2);
  Result := TPascalTypeCodePoint(StrToInt('$' + Temp));
end;

function Unescape(const S: string): string;
begin
  Result := S;
  Result := ReplaceStr(Result, '\n', #10);
  Result := ReplaceStr(Result, '\r', #13);
  Result := ReplaceStr(Result, '\t', #9);
end;

function SplitOptions(const S: string): TArray<string>;
begin
  var List := TList<string>.Create;
  try
    var Current := '';
    var InQuote := False;

    for var c in S do
    begin

      if (c = '"') then
        InQuote := not InQuote
      else
      if (c = ' ') and (not InQuote) then
      begin
        if (Current <> '') then
        begin
          List.Add(Current);
          Current := '';
          continue;
        end;
      end else
        Current := Current + c;
    end;

    if (Current <> '') then
      List.Add(Current);

    Result := List.ToArray;
  finally
    List.Free;
  end;
end;

{ TRegressionTestSuite }

procedure TRegressionTestSuite.LoadConfiguration(const iniFile: TCustomIniFile; const section: string);
begin
  inherited;

  FLastPassed := iniFile.ReadBool(section, GetName+'.passed', True);
  FRegression := iniFile.ReadString(section, GetName+'.regression', '');
end;

procedure TRegressionTestSuite.RunTest(testResult: TTestResult);
begin
  try

    FExecuted := True;
    FRegression := '';

    inherited;

    if (not FLastPassed) then
      FRegression := 'FIXED';

    FLastPassed := True;

  except

    if (FLastPassed) then
      FRegression := 'BROKEN';

    FLastPassed := False;

    raise;
  end;
end;

procedure TRegressionTestSuite.SaveConfiguration(const iniFile: TCustomIniFile; const section: string);
begin
  inherited;

  if (FExecuted) then
  begin
    iniFile.WriteBool(section, GetName+'.passed', FLastPassed);
    if (FRegression <> '') then
      iniFile.WriteString(section, GetName+'.regression', FRegression)
    else
      iniFile.DeleteKey(section, GetName+'.regression');
  end;
  iniFile.WriteBool(section, GetName+'.executed', FExecuted);
end;

{ TRegressionTestCase }

procedure TRegressionTestCase.LoadConfiguration(const iniFile: TCustomIniFile; const section: string);
begin
  inherited;

  FLastPassed := iniFile.ReadBool(section, GetName+'.passed', True);
  FRegression := iniFile.ReadString(section, GetName+'.regression', '');
end;

procedure TRegressionTestCase.RunTest(testResult: TTestResult);
begin
  try

    FExecuted := True;
    FRegression := '';

    inherited;

    if (not FLastPassed) then
      FRegression := 'FIXED';

    FLastPassed := True;

  except

    if (FLastPassed) then
      FRegression := 'BROKEN';

    FLastPassed := False;

    raise;
  end;
end;

procedure TRegressionTestCase.SaveConfiguration(const iniFile: TCustomIniFile; const section: string);
begin
  inherited;

  if (FExecuted) then
  begin
    iniFile.WriteBool(section, GetName+'.passed', FLastPassed);
    if (FRegression <> '') then
      iniFile.WriteString(section, GetName+'.regression', FRegression)
    else
      iniFile.DeleteKey(section, GetName+'.regression');
  end;
  iniFile.WriteBool(section, GetName+'.executed', FExecuted);
end;

{ TTestCaseHarfbuzzShaper }

constructor TTestCaseHarfbuzzShaper.Create(const ALine, ATestID, AName, AFontFile, AOptions, AInput, AExpected: string);
begin
  inherited Create('Test');

  FTestName := AName;

  FLine := ALine;
  FTestID := ATestID;
  FFontFile := AFontFile;
  FOptions := AOptions;
  FInput := AInput;
  FExpected := AExpected;
end;

procedure TTestCaseHarfbuzzShaper.SetUp;
begin
  inherited;
  FFontFace := TPascalTypeFontFace.Create;
end;

procedure TTestCaseHarfbuzzShaper.TearDown;
begin
  FFontFace.Free;
  inherited;
end;

procedure TTestCaseHarfbuzzShaper.ApplyFeatures(const AParams: TArray<string>; var AFeatures: TPascalTypeFeatures; AGlyphs: TPascalTypeGlyphString);
begin
  for var Feature in AParams do
  begin
    if (Feature = '') then
      continue;

    var FeatureName := Feature;
    var FeatureValue := True;

    //
    // From aots\tests\gsub3_1_lookupflag.tests:
    //
    //   ../fonts/gsub3_1_lookupflag_f1.otf;--features="-test[4],test[5],test[6]=2,-test[7]" --single-par --no-clusters --no-glyph-names --no-positions;U+0011,U+0012,U+0012,U+0012,U+0013,U+0013,U+0013,U+0013,U+0011;[17|18|18|18|19|22|23|19|17]
    //
    // the part:
    //
    //   --features="-test[4],test[5],test[6]=2,-test[7]"
    //
    // The "[n]" likely means "enable/disable the feature on glyph n"
    // The "=2" appears to be the "Alternate Index", 1-based.
    //
    // Looking at the expected output, it seems as glyph 5 and 6 (zero index) has been replaced.
    //

    if (CharInSet(FeatureName[1], ['+', '-'])) then
    begin
      FeatureValue := (FeatureName[1] = '+');
      Delete(FeatureName, 1, 1);
    end;

    var StartIndex := Pos('[', FeatureName);

    if (StartIndex > 0) then
    begin
      var EndIndex := Pos(']', FeatureName, StartIndex+1);
      if (EndIndex > 0) then
      begin
        var Index: integer;
        if (not TryStrToInt(Copy(FeatureName, StartIndex+1, EndIndex-StartIndex-1), Index)) then
          Fail('Unit test parser: Invalid index in glyph feature: '+Feature);

        var Tag := Copy(FeatureName, 1, StartIndex-1);
        var TableType: TTableType := Tag;
        AGlyphs[Index].UserFeatures.Enabled[TableType.AsAnsiChar] := FeatureValue;

        var AlternateIndex: integer := 1;
        StartIndex := Pos('=', FeatureName, EndIndex);
        if (StartIndex > 0) then
        begin
          if (not TryStrToInt(Copy(FeatureName, StartIndex+1, MaxInt), AlternateIndex)) or (AlternateIndex < 1) then
            Fail('Unit test parser: Invalid alternate index in glyph feature: '+Feature);
        end;
        AGlyphs[Index].AlternateIndex := AlternateIndex - 1;
      end else
        Fail('Unit test parser: Missing "]" in glyph feature: '+Feature);

      // Fall through to enable the feature globally on the shaper
      FeatureValue := True;
    end else
    if ContainsStr(FeatureName, '=') then
    begin
      var FeatureParts := FeatureName.Split(['=']);
      FeatureName := FeatureParts[0];
      FeatureValue := (FeatureParts[1] <> '0');
    end;

    AFeatures[TTableType(FeatureName).AsAnsiChar] := FeatureValue;
  end;
end;

procedure TTestCaseHarfbuzzShaper.ParseCodepoints(const Input: string; var CodePoints: TPascalTypeCodePoints);
begin
  var Parts := Input.Split([',']);

  if (ContainsStr(Input, 'U+')) or (Length(Parts) > 1) then
  begin
    SetLength(CodePoints, Length(Parts));

    for var i := 0 to High(Parts) do
      CodePoints[i] := ParseHex(Trim(Parts[i]));
  end else
    CodePoints := PascalTypeUnicode.UTF16ToUTF32(Unescape(Input));
end;

procedure TTestCaseHarfbuzzShaper.ParseOptions(var Options: TTestOptions; var Features: TArray<string>; var Script: TTableType;
  var Language: TTableType; var Direction: TPascalTypeDirection; var ShaperOptions: TShaperOptions; var ClusterLevel: TClusterLevel);
begin
  var Params := SplitOptions(FOptions);

  var j := 0;

  while j < Length(Params) do
  begin
    var Option := Params[j];

    if (Option = '--cluster-level') and (j < High(Params)) then
    begin
      Inc(j);
      var Level := StrToIntDef(Params[j], -1);
      case Level of
        0: ClusterLevel := clLevel0;
        1: ClusterLevel := clLevel1;
        2: ClusterLevel := clLevel2;
        3: ClusterLevel := clLevel3;
      end;
    end else
    if StartsStr('--cluster-level=', Option) then
    begin
      var Level := StrToIntDef(Copy(Option, 17, MaxInt), -1);
      case Level of
        0: ClusterLevel := clLevel0;
        1: ClusterLevel := clLevel1;
        2: ClusterLevel := clLevel2;
        3: ClusterLevel := clLevel3;
      end;
    end else
    if (Option = '--features') and (j < High(Params)) then
    begin
      Inc(j);
      Features := Params[j].Split([',']);
    end else
    if StartsStr('--features=', Option) then
    begin
      Features := Copy(Option, 12, MaxInt).Split([',']);
    end else
    if (Option = '--script') and (j < High(Params)) then
    begin
      Inc(j);
      Script := Params[j];
    end else
    if StartsStr('--script=', Option) then
    begin
      Script := Copy(Option, 10, MaxInt);
    end else
    if (Option = '--language') and (j < High(Params)) then
    begin
      Inc(j);
      Language := Params[j];
    end else
    if StartsStr('--language=', Option) then
    begin
      Language := Copy(Option, 12, MaxInt);
    end else
    if StartsStr('--variations=', Option) then
    begin
      var Variations := Copy(Option, 14, MaxInt).Split([',']);
      for var V in Variations do
      begin
        var KV := V.Split(['=', ':']);
        if Length(KV) = 2 then
        begin
          var Value := StrToFloat(KV[1], TFormatSettings.Invariant);

          // If ID is a tag we must set value by tag in order to support HOI
          if (FFontFace.FindAxisByTag(KV[0]) <> -1) then
            FFontFace.AxisValue[KV[0]] := Value
          else
          begin
            // Look for name
            var Index := FFontFace.FindAxisByName(KV[0]);

            // Try index if name wasn't found
            if (Index = -1) then
              Index := StrToIntDef(KV[0], -1);

            if (Index <> -1) then
              FFontFace.AxisValueByIndex[Index] := Value;
          end;
        end;
      end;
    end else
    if (Option = '--direction') and (j < High(Params)) then
    begin
      Inc(j);
      var Dir := Params[j];
      if Dir = 'ltr' then
        Direction := dirLeftToRight
      else
      if Dir = 'rtl' then
        Direction := dirRightToLeft
      else
      if Dir = 'ttb' then
        Direction := dirTopDown;
    end else
    if StartsStr('--direction=', Option) then
    begin
      var Dir := Copy(Option, 13, MaxInt);
      if (Dir = 'ltr') or (Dir = 'l') then
        Direction := dirLeftToRight
      else
      if (Dir = 'rtl') or (Dir = 'r') then
        Direction := dirRightToLeft
      else
      if (Dir = 'ttb') or (Dir = 't') then
        Direction := dirTopDown;
    end else
    if Option = '--no-clusters' then
      Exclude(Options, toClusters)
    else
    if Option = '--no-glyph-names' then
      Exclude(Options, toGlyphNames)
    else
    if Option = '--no-positions' then
    begin
      Exclude(Options, toPositions);
      Exclude(Options, toAdvances);
    end else
    if Option = '--no-advances' then
      Exclude(Options, toAdvances)
    else
    if Option = '--ned' then
    begin
      Exclude(Options, toClusters);
      Exclude(Options, toAdvances);
    end else
    if Option = '--single-par' then
      Include(Options, toSinglePar)
    else
    if Option = '--remove-default-ignorables' then
      ShaperOptions := ShaperOptions + [sfRemoveDefaultIgnorables] - [sfHideDefaultIgnorables]
    else
    if Option = '--preserve-default-ignorables' then
      ShaperOptions := ShaperOptions - [sfRemoveDefaultIgnorables, sfHideDefaultIgnorables];

    Inc(j);
  end;
end;

function TTestCaseHarfbuzzShaper.BuildResult(ShapedText: TPascalTypeGlyphString; Options: TTestOptions): string;
begin
  Result := '[';
  var Cursor := TPoint.Create(0, 0);

  for var i := 0 to ShapedText.Count - 1 do
  begin
    if (i > 0) then
      Result := Result + '|';

    var Glyph := ShapedText[i];

    // DONE : Harfbuzz uses a different system than AOTS; There are no options.
    // Instead the expected string specifies what we should compare.

    if (toGlyphNames in Options) then
      Result := Result + FFontFace.GetGlyphName(Glyph.GlyphID)
    else
      Result := Result + IntToStr(Glyph.GlyphID);

    if (toClusters in Options) then
      Result := Result + '=' + IntToStr(Glyph.Cluster);

    // Position relative to cursor
    var Position := Cursor;

    Inc(Position.X, Glyph.XOffset);
    Inc(Position.Y, Glyph.YOffset);

    // Advance cursor
    Inc(Cursor.X, Glyph.XAdvance);
    Inc(Cursor.Y, Glyph.YAdvance);

    if (toPositions in Options) then
    begin
      if (toAdvances in Options) then
      begin
        if (Glyph.XOffset <> 0) or (Glyph.YOffset <> 0) then
          Result := Result + '@' + IntToStr(Glyph.XOffset) + ',' + IntToStr(Glyph.YOffset);

        Result := Result + '+' + IntToStr(Glyph.XAdvance);

        if (Glyph.YAdvance <> 0) then
          Result := Result + ',' + IntToStr(Glyph.YAdvance);
      end else
      if (Position.X <> 0) or (Position.Y <> 0) then
      begin
        Result := Result + '@' + IntToStr(Position.X) + ',' + IntToStr(Position.Y);
      end;

    end;
  end;
  Result := Result + ']';
end;

procedure TTestCaseHarfbuzzShaper.ProcessLine(ActualGlyphs: TPascalTypeGlyphString; Options: TTestOptions);

  procedure CheckGlyph(Expected, Actual: integer; const ValueName: string; Index: integer); overload;
  begin
    if (Expected = Actual) then
    begin
      Check(True);
      exit;
    end;

    // Build actual output string
    var ActualStr := BuildResult(ActualGlyphs, Options);

    var Msg := Format('Shaping mismatch in %s, %s, index: %d [%s]'#13'Test case: %s'#13'Expected: %s'#13'Actual: %s'#13, [FTestID, Name, Index, ValueName, FLine, FExpected, ActualStr]);
    CheckEquals(Expected, Actual, Msg);
  end;

  procedure CheckGlyph(const Expected: string; Actual: integer; const ValueName: string; Index: integer); overload;
  begin
    if (Expected = '') then
      exit;

    var ExpectedValue: integer;

    if (not TryStrToInt(Expected, ExpectedValue)) then
      Fail(Format('Failed to parse "%s" as %s'#13'%s', [Expected, ValueName, FExpected]));

    CheckGlyph(ExpectedValue, Actual, ValueName, Index);
  end;

  procedure CheckGlyph(const Expected, Actual: string; const ValueName: string; Index: integer); overload;
  begin
    if (Expected = '') then
      exit;

    if (Expected = Actual) then
    begin
      Check(True);
      exit;
    end;

    // Build actual output string
    var ActualStr := BuildResult(ActualGlyphs, Options);

    var Msg := Format('Shaping mismatch in %s, %s, index: %d [%s]'#13'Test case: %s'#13'Expected: %s'#13'Actual: %s'#13, [FTestID, Name, Index, ValueName, FLine, FExpected, ActualStr]);
    CheckEquals(Expected, Actual, Msg);
  end;

(*

  HarfBuzz text Serialization Rules

  The serialization logic for glyphs in "text" format (used in HarfBuzz
  in-house tests) follows these rules:

  - Buffer Delimiters: The entire sequence is enclosed in square brackets [].
    Individual glyph entries are separated by a pipe |.

  - Glyph Identity: Each entry starts with the glyph name. If glyph names are
    unavailable or suppressed, the decimal glyph index is used.

  - Cluster: If cluster information is enabled, it follows the glyph name/index,
    preceded by an equals sign (e.g., =0).

  - Positioning and Mode (Relative vs. Absolute):
    HarfBuzz operates in two modes depending on whether Advances are being
    displayed.

    - Relative Mode (Advances Shown):

      - Triggered when the --no-advances flag is not set.
      - Output includes a + sign followed by the advances (e.g., +0,-1000).
      - The @x,y coordinates represent the individual glyph offsets (x_offset,
        y_offset) relative to the current pen position.
      - Crucially: The pen position (accumulated advances) is not added to
        these coordinates.

    - Absolute Mode (Advances Hidden):

      - Triggered when the --no-advances flag (or --no-positions) is set.
      - Output does not contain the + sign or advance values.
      - The @x,y coordinates represent the absolute position from the start of
        the buffer.
      - Crucially: The coordinates are calculated as (Sum of all previous
        advances) + current glyph offset.

  - Coordinate Formatting:

    - The @x,y block is only included if at least one of the coordinates
      (calculated based on the mode) is non-zero.

    - Values are formatted as decimal integers. Negative values include a minus
      sign. Positive values do not include a plus sign.

  - Advance Formatting:

    - When shown, the horizontal advance is always preceded by a + (e.g., +0).

    - The vertical advance is only included if it is non-zero, preceded by a
      comma (e.g., +0,-1000).

  See: hb-buffer-serialize.cc

*)
const
  Pattern =
    // <glyph name or id>=<cluster id>
    // Relative mode: <X offset>,<Y offset>+<X advance>,<Y advance>
    // Absolute mode: <abs X pos>,<abs Y pos>
    '''
    (?'GlyphID'[^=@+|]+)(?:=(?'Cluster'\d+))?

    (?:

      (?:@(?'XOffset'-?\d+),(?'YOffset'-?\d+))?
      \+(?'XAdvance'-?\d+)(?:,(?'YAdvance'-?\d+))?

      |

      @(?'XPos'-?\d+),(?'YPos'-?\d+)

    )?
    ''';
begin
  var Expected := Copy(FExpected, 2, Length(FExpected)-2);
  var GlyphSequence := Expected.Split(['|']);

  var ExpectedGlyps := FExpected.Split(['|']);

  if (Length(GlyphSequence) <> ActualGlyphs.Count) then
  begin
    CheckEquals(Length(GlyphSequence), ActualGlyphs.Count,
      Format('Incorrect number of glyphs in result'#13'Test case: %s'#13'Expected: %s'#13'Actual: %s'#13, [FLine, FExpected, BuildResult(ActualGlyphs, Options)]));
  end;

  var sPattern := Pattern.Replace(' ', '').Replace(#13, '').Replace(#10, '');
  var RegEx := TRegEx.Create(sPattern, [roCompiled]);

  var GlyphIndex := 0;
  var Cursor := TPoint.Create(0, 0);

  for var GlyphInfo in GlyphSequence do
  begin
    var Match := RegEx.Match(GlyphInfo);
    if (not Match.Success) then
      Check(False, Format('Failed to parse test case: %s'#13'%s'#13, [GlyphInfo, BuildResult(ActualGlyphs, Options)]));

    var Glyph := ActualGlyphs[GlyphIndex];

    // Position relative to cursor
    var Position := Cursor;

    Inc(Position.X, Glyph.XOffset);
    Inc(Position.Y, Glyph.YOffset);

    // Advance cursor
    Inc(Cursor.X, Glyph.XAdvance);
    Inc(Cursor.Y, Glyph.YAdvance);

    // Yes, this makes no sense - but it's hardcoded in the HarfBuzz unit test runner
//    if (Glyph.IsMark) then
//      Dec(CursorX, 1500);

    var Group: TGroup;

    if (Match.Groups.TryGetNamedGroup('GlyphID', Group)) and (Group.Value <> '') then
    begin
      var GlyphID: integer;
      if (TryStrToInt(Group.Value, GlyphID)) then
        CheckGlyph(GlyphID, Glyph.GlyphID, 'Glyph ID', GlyphIndex)
      else
        CheckGlyph(Group.Value, FFontFace.GetGlyphName(Glyph.GlyphID), 'Glyph name', GlyphIndex)
    end else
      Fail(Format('Failed to parse GlyphID: %s', [GlyphInfo]));

    if (Match.Groups.TryGetNamedGroup('Cluster', Group)) then
      CheckGlyph(Group.Value, Glyph.Cluster, 'Cluster', GlyphIndex);

    if (Match.Groups.TryGetNamedGroup('XPos', Group)) then
    begin
      Include(Options, toPositions);
      Exclude(Options, toAdvances);

      CheckGlyph(Group.Value, Position.X, 'XPos', GlyphIndex);

      if (Match.Groups.TryGetNamedGroup('YPos', Group)) then
        CheckGlyph(Group.Value, Position.Y, 'YPos', GlyphIndex);
    end;

    if (Match.Groups.TryGetNamedGroup('XOffset', Group)) then
    begin
      Include(Options, toPositions);
      Include(Options, toAdvances);

      CheckGlyph(Group.Value, Glyph.XOffset, 'XOffset', GlyphIndex);

      if (Match.Groups.TryGetNamedGroup('YOffset', Group)) then
        CheckGlyph(Group.Value, Glyph.YOffset, 'YOffset', GlyphIndex);
    end;

    if (Match.Groups.TryGetNamedGroup('XAdvance', Group)) then
    begin
      Include(Options, toPositions);
      Include(Options, toAdvances);

      CheckGlyph(Group.Value, Glyph.XAdvance, 'XAdvance', GlyphIndex);

      if (Match.Groups.TryGetNamedGroup('YAdvance', Group)) then
        CheckGlyph(Group.Value, Glyph.YAdvance, 'YAdvance', GlyphIndex);
    end;

    Inc(GlyphIndex);

  end;
end;

procedure TTestCaseHarfbuzzShaper.Test;
begin
  if not TFile.Exists(FFontFile) then
    Check(False, Format('Font file not found: %s', [FFontFile]));

  FFontFace.LoadFromFile(FFontFile);

  var Script: TTableType := 0;
  var Language: TTableType := 0;
  var Direction: TPascalTypeDirection := dirDefault;
  var Features: TArray<string> := [];
  var Options: TTestOptions := [toClusters, toGlyphNames, toPositions, toAdvances];
  var ShaperOptions: TShaperOptions := PascalTypeDefaultOptions;
  var ClusterLevel: TClusterLevel := clLevel0; // HarfBuzz default is Level 0

  // Parse Options
  ParseOptions(Options, Features, Script, Language, Direction, ShaperOptions, ClusterLevel);

  var CodePoints: TPascalTypeCodePoints;
  ParseCodepoints(FInput, CodePoints);

  if (Script.AsCardinal = 0) then
    Script := TPascalTypeShaper.DetectScript(CodePoints);

  var Shaper := TPascalTypeShaper.CreateShaper(FFontFace, Script);
  try
    if (Direction = dirDefault) then
      Direction := TPascalTypeShaper.DetectDirection(CodePoints);

    Shaper.Direction := Direction;
    Shaper.Script := Script;
    Shaper.Language := Language;
    Shaper.ClusterLevel := ClusterLevel;
    Shaper.Options := ShaperOptions;

    var Glyphs := Shaper.TextToGlyphs(CodePoints);
    try
      ApplyFeatures(Features, Shaper.UserFeatures^, Glyphs);

      Shaper.Shape(Glyphs);

      ProcessLine(Glyphs, Options);

    finally
      Glyphs.Free;
    end;
  finally
    Shaper.Free;
  end;
end;

procedure RegisterHarfbuzzTests(const TestSuite: ITestSuite);

  procedure ProcessTestCases(const RootSuite: ITestSuite; const TestCases: TArray<string>);
  begin
    for var FileName in TestCases do
    begin
      var SuiteName := TPath.GetFileNameWithoutExtension(FileName);

      var Lines: TArray<string>;
      try
        Lines := TFile.ReadAllLines(FileName);
      except
        continue;
      end;

      if (Length(Lines) = 0) then
        exit;

      var IsOpenType := True;
      var Suite: ITestSuite := nil;

      var LineNo := 0;
      for var Line in Lines do
      begin
        Inc(LineNo);

        var TrimmedLine := Trim(Line);
        if (TrimmedLine = '') or (TrimmedLine.StartsWith('#')) then
          continue;

        // OS font; Likely macOS
        if (TrimmedLine.StartsWith('/')) then
          continue;

        if (TrimmedLine.StartsWith('@shapers=')) then
        begin

          // Only the "ot" shaper tests are applicable for us
          IsOpenType := TrimmedLine.Contains('ot');

          continue;
        end;

        if (not IsOpenType) then
          continue;

        var Parts := TrimmedLine.Split([';']);
        if Length(Parts) < 4 then
          continue;

        // Font collections; Not yet supported
        if (Parts[1].Contains('--face-index')) then
          continue;

        // AAT; Not yet supported
        if (Parts[1].Contains('--font-ptem')) then
          continue;


        // Engine level font scaling; Not yet supported
        if (Parts[1].Contains('--font-size')) then
          continue;

        // --show-extents; Not yet supported by unit test
        if (Parts[1].Contains('--show-extents')) then
          continue;

        if (Suite = nil) then
        begin
          Suite := TTestSuite.Create(SuiteName);
          RootSuite.AddTest(Suite);
        end;

        // Font file is relative to the directory of the .tests file
        var FontFile := TPath.Combine(TPath.GetDirectoryName(FileName), Parts[0]);
        FontFile := TPath.GetFullPath(FontFile);

        var TestID := RootSuite.Name + '\' + SuiteName;

        Parts[0] := TPath.GetFileName(Parts[0]);
        TrimmedLine := string.Join(';', Parts);

        var Test: ITest := TTestCaseHarfbuzzShaper.Create(TrimmedLine, TestID, Format('Line %d', [LineNo]), FontFile, Parts[1], Parts[2], Parts[3]);

        Suite.AddTest(Test);
      end;
    end;
  end;

  procedure ProcessFolder(const RootSuite: ITestSuite; const Folder: string);
  begin
    var TestDir := TPath.GetFullPath(TPath.Combine(Folder, 'tests'));
    if not TDirectory.Exists(TestDir) then
      exit;

    if ContainsText(TestDir, 'render') then
      exit;

    var Files := TDirectory.GetFiles(TestDir, '*.tests');
    if (Length(Files) = 0) then
      exit;

    var SuiteName := TPath.GetFileName(Folder);

    var Suite: ITestSuite := TRegressionTestSuite.Create(SuiteName);
    RootSuite.AddTest(Suite);

    ProcessTestCases(Suite, Files);
  end;

begin
  var DataDir := TPath.GetFullPath(TPath.Combine(ExtractFilePath(ParamStr(0)), '..\Data'));
  if not TDirectory.Exists(DataDir) then
    exit;

  var RootSuite: ITestSuite := TRegressionTestSuite.Create('Harfbuzz Shaper Tests');
  TestSuite.AddSuite(RootSuite);

  var Folders := TDirectory.GetDirectories(DataDir);

  for var Folder in Folders do
    ProcessFolder(RootSuite, Folder);
end;

var
  TestSuiteShaper: ITestSuite;

initialization
  TestSuiteShaper := TRegressionTestSuite.Create('Shaper');
  RegisterTest(TestSuiteShaper);

  RegisterHarfbuzzTests(TestSuiteShaper);
end.