ShaderFile/tests/uShaderFileTestCase.pas

unit uShaderFileTestCase;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, testregistry,
  uengShaderFile, uengShaderGenerator, uengShaderFileTypes;

type
  TShaderFileTestCase = class(TTestCase)
  protected
    procedure DoTest(const aCode, aClass, aResult: String; const aArgs: array of const);
    procedure DoTest(const aCode, aClass, aResult: String);
    procedure DoTest(const aCode, aResult: String; const aArgs: array of const);
    procedure DoTest(const aCode, aResult: String);
  end;

  TTestCase_IfElifElseEnd = class(TShaderFileTestCase)
  published
    procedure Simple_0;
    procedure Simple_1;
    procedure Simple_2;

    procedure Inline_0;
    procedure Inline_1;
  end;

  TTestCase_FuncProcMain = class(TShaderFileTestCase)
  published
    procedure Main_Simple;

    procedure Func_Simple_0;
    procedure Func_Simple_1;

    procedure Proc_Inline;

    procedure Func_InlineSingleReturn;
    procedure Func_InlineMultiReturn;
  end;

  TTestCase_Include = class(TShaderFileTestCase)
  published
    procedure Include_Simple;
  end;

  TTestCase_Class = class(TShaderFileTestCase)
  published
    procedure Simple;
    procedure InheritedFunc;
    procedure InheritedMain;
  end;

  TTestCase_General = class(TShaderFileTestCase)
  published
    procedure OrderOfMainProcClassContent;
  end;

implementation

uses
  Forms, variants;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TShaderFileTestCase///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TShaderFileTestCase.DoTest(const aCode, aClass, aResult: String; const aArgs: array of const);
var
  shdr: TengShaderFile;
  gen: TengShaderGenerator;
  code: TengShaderCode;
  sl: TStringList;
  i: Integer;
  s: String;
begin
  shdr := TengShaderFile.Create;
  code := TengShaderCode.Create;
  sl   := TStringList.Create;
  try
    shdr.LoadFromFile(ExpandFileName('testfiles\' + aCode));
    gen := shdr.Generator[aClass];
    for i := 0 to High(aArgs) do begin
      case aArgs[i].VType of
        vtAnsiString:     s := AnsiString(aArgs[i].VAnsiString);
        vtString:         s := String(aArgs[i].VString);
        vtWideString:     s := string(WideString(aArgs[i].VWideString));
        vtUnicodeString:  s := string(UnicodeString(aArgs[i].VUnicodeString));

        vtInteger:        gen.PropertyByName[s] := aArgs[i].VInteger;
        vtBoolean:        gen.PropertyByName[s] := aArgs[i].VBoolean;
        vtExtended:       gen.PropertyByName[s] := aArgs[i].VExtended^;
        vtCurrency:       gen.PropertyByName[s] := aArgs[i].VCurrency^;
        vtVariant:        gen.PropertyByName[s] := aArgs[i].VVariant^;
        vtInt64:          gen.PropertyByName[s] := aArgs[i].VInt64^;
        vtQWord:          gen.PropertyByName[s] := aArgs[i].VQWord^;
      else
        raise Exception.Create('invalid variadic type');
      end;
    end;
    gen.GenerateCode(code);
    sl.LoadFromFile(ExpandFileName('testfiles\' + aResult));
    AssertEquals(sl.Text, code.Text);
  finally
    FreeAndNil(sl);
    FreeAndNil(code);
    FreeAndNil(shdr);
  end;
end;

procedure TShaderFileTestCase.DoTest(const aCode, aClass, aResult: String);
begin
  DoTest(aCode, aClass, aResult, []);
end;

procedure TShaderFileTestCase.DoTest(const aCode, aResult: String; const aArgs: array of const);
begin
  DoTest(aCode, '', aResult, aArgs);
end;

procedure TShaderFileTestCase.DoTest(const aCode, aResult: String);
begin
  DoTest(aCode, '', aResult, []);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TTestCase_IfElifElseEnd///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TTestCase_IfElifElseEnd.Simple_0;
begin
  DoTest('code_IfElifElseEnd_Simple.shdr', 'result_IfElifElseEnd_Simple_0.shdr', ['TestProp', 0]);
end;

procedure TTestCase_IfElifElseEnd.Simple_1;
begin
  DoTest('code_IfElifElseEnd_Simple.shdr', 'result_IfElifElseEnd_Simple_1.shdr', ['TestProp', 1]);
end;

procedure TTestCase_IfElifElseEnd.Simple_2;
begin
  DoTest('code_IfElifElseEnd_Simple.shdr', 'result_IfElifElseEnd_Simple_2.shdr', ['TestProp', 2]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TTestCase_IfElifElseEnd.Inline_0;
begin
  DoTest('code_IfElifElseEnd_Inline.shdr', 'result_IfElifElseEnd_Inline_0.shdr', ['TestProp', 0]);
end;

procedure TTestCase_IfElifElseEnd.Inline_1;
begin
  DoTest('code_IfElifElseEnd_Inline.shdr', 'result_IfElifElseEnd_Inline_1.shdr', ['TestProp', 1]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TTestCase_MainSimple//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TTestCase_FuncProcMain.Main_Simple;
begin
  DoTest('code_Main_Simple.shdr', 'result_Main_Simple.shdr');
end;

procedure TTestCase_FuncProcMain.Func_Simple_0;
begin
  DoTest('code_Func_Simple.shdr', 'result_Func_Simple_0.shdr', ['TestProperty', 0]);
end;

procedure TTestCase_FuncProcMain.Func_Simple_1;
begin
  DoTest('code_Func_Simple.shdr', 'result_Func_Simple_1.shdr', ['TestProperty', 1]);
end;

procedure TTestCase_FuncProcMain.Proc_Inline;
begin
  DoTest('code_Proc_Inline.shdr', 'result_Proc_Inline.shdr');
end;

procedure TTestCase_FuncProcMain.Func_InlineSingleReturn;
begin
  DoTest('code_Func_InlineSingleReturn.shdr', 'result_Func_InlineSingleReturn.shdr');
end;

procedure TTestCase_FuncProcMain.Func_InlineMultiReturn;
begin
  DoTest('code_Func_InlineMultiReturn.shdr', 'result_Func_InlineMultiReturn.shdr');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TTestCase_Include/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TTestCase_Include.Include_Simple;
begin
  DoTest('code_Include_Simple.shdr', 'result_Include_Simple.shdr');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TTestCase_Class///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TTestCase_Class.Simple;
begin
  DoTest('code_Class_Simple.shdr', 'SimpleClass', 'result_Class_Simple.shdr');
end;

procedure TTestCase_Class.InheritedFunc;
begin
  DoTest('code_Class_InheritedFunc.shdr', 'SimpleClass', 'result_Class_InheritedFunc.shdr');
end;

procedure TTestCase_Class.InheritedMain;
begin
  DoTest('code_Class_InheritedMain.shdr', 'SimpleClass', 'result_Class_InheritedMain.shdr');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TTestCase_General/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TTestCase_General.OrderOfMainProcClassContent;
begin
  DoTest('code_General_OrderOfMainProcClassContent.shdr', 'TestClass', 'result_General_OrderOfMainProcClassContent.shdr');
end;

initialization
  RegisterTest(TTestCase_IfElifElseEnd);
  RegisterTest(TTestCase_FuncProcMain);
  RegisterTest(TTestCase_Include);
  RegisterTest(TTestCase_Class);
  RegisterTest(TTestCase_General);

end.