|
|
|
@@ -11,61 +11,86 @@ uses |
|
|
|
type |
|
|
|
TShaderFileTestCase = class(TTestCase) |
|
|
|
protected |
|
|
|
procedure DoTest(const aCode: String; const aValue: Integer; const aResult: String); |
|
|
|
procedure DoTest(const aCode: String; const aResult: String); |
|
|
|
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_IfElseElifEnd = class(TShaderFileTestCase) |
|
|
|
TTestCase_IfElifElseEnd = class(TShaderFileTestCase) |
|
|
|
published |
|
|
|
procedure IfElifElseEnd0; |
|
|
|
procedure IfElifElseEnd1; |
|
|
|
procedure IfElifElseEnd2; |
|
|
|
procedure Simple_0; |
|
|
|
procedure Simple_1; |
|
|
|
procedure Simple_2; |
|
|
|
|
|
|
|
procedure InlineIf0; |
|
|
|
procedure InlineIf1; |
|
|
|
procedure Inline_0; |
|
|
|
procedure Inline_1; |
|
|
|
end; |
|
|
|
|
|
|
|
TTestCase_FuncProcMain = class(TShaderFileTestCase) |
|
|
|
published |
|
|
|
procedure SimpleMain; |
|
|
|
procedure Main_Simple; |
|
|
|
|
|
|
|
procedure SimpleFunc0; |
|
|
|
procedure SimpleFunc1; |
|
|
|
procedure Func_Simple_0; |
|
|
|
procedure Func_Simple_1; |
|
|
|
|
|
|
|
procedure InlineProc; |
|
|
|
procedure Proc_Inline; |
|
|
|
|
|
|
|
procedure InlineFuncSingleReturn; |
|
|
|
procedure InlineFuncMultiReturn; |
|
|
|
procedure Func_InlineSingleReturn; |
|
|
|
procedure Func_InlineMultiReturn; |
|
|
|
end; |
|
|
|
|
|
|
|
TTestCase_Include = class(TShaderFileTestCase) |
|
|
|
published |
|
|
|
procedure SimpleInclude; |
|
|
|
procedure Include_Simple; |
|
|
|
end; |
|
|
|
|
|
|
|
TTestCase_Class = class(TShaderFileTestCase) |
|
|
|
published |
|
|
|
procedure Simple; |
|
|
|
end; |
|
|
|
|
|
|
|
implementation |
|
|
|
|
|
|
|
uses |
|
|
|
Forms; |
|
|
|
Forms, variants; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TShaderFileTestCase/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TShaderFileTestCase.DoTest(const aCode: String; const aValue: Integer; const aResult: String); |
|
|
|
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['']; |
|
|
|
if (gen.PropertyCount > 0) then |
|
|
|
gen.PropertyByIndex[0] := aValue; |
|
|
|
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); |
|
|
|
@@ -76,85 +101,104 @@ begin |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TShaderFileTestCase.DoTest(const aCode: String; const aResult: String); |
|
|
|
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, 0, aResult); |
|
|
|
DoTest(aCode, '', aResult, []); |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TTestCase_IfElseElifEnd/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TTestCase_IfElifElseEnd/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TTestCase_IfElseElifEnd.IfElifElseEnd0; |
|
|
|
procedure TTestCase_IfElifElseEnd.Simple_0; |
|
|
|
begin |
|
|
|
DoTest('code_IfElseElifEnd.shdr', 0, 'result_IfElseElifEnd_0.shdr'); |
|
|
|
DoTest('code_IfElifElseEnd_Simple.shdr', 'result_IfElifElseEnd_Simple_0.shdr', ['TestProp', 0]); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_IfElseElifEnd.IfElifElseEnd1; |
|
|
|
procedure TTestCase_IfElifElseEnd.Simple_1; |
|
|
|
begin |
|
|
|
DoTest('code_IfElseElifEnd.shdr', 1, 'result_IfElseElifEnd_1.shdr'); |
|
|
|
DoTest('code_IfElifElseEnd_Simple.shdr', 'result_IfElifElseEnd_Simple_1.shdr', ['TestProp', 1]); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_IfElseElifEnd.IfElifElseEnd2; |
|
|
|
procedure TTestCase_IfElifElseEnd.Simple_2; |
|
|
|
begin |
|
|
|
DoTest('code_IfElseElifEnd.shdr', 2, 'result_IfElseElifEnd_2.shdr'); |
|
|
|
DoTest('code_IfElifElseEnd_Simple.shdr', 'result_IfElifElseEnd_Simple_2.shdr', ['TestProp', 2]); |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TTestCase_IfElseElifEnd.InlineIf0; |
|
|
|
procedure TTestCase_IfElifElseEnd.Inline_0; |
|
|
|
begin |
|
|
|
DoTest('code_InlineIf.shdr', 0, 'result_InlineIf_0.shdr'); |
|
|
|
DoTest('code_IfElifElseEnd_Inline.shdr', 'result_IfElifElseEnd_Inline_0.shdr', ['TestProp', 0]); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_IfElseElifEnd.InlineIf1; |
|
|
|
procedure TTestCase_IfElifElseEnd.Inline_1; |
|
|
|
begin |
|
|
|
DoTest('code_InlineIf.shdr', 1, 'result_InlineIf_1.shdr'); |
|
|
|
DoTest('code_IfElifElseEnd_Inline.shdr', 'result_IfElifElseEnd_Inline_1.shdr', ['TestProp', 1]); |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TTestCase_MainSimple////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TTestCase_FuncProcMain.SimpleMain; |
|
|
|
procedure TTestCase_FuncProcMain.Main_Simple; |
|
|
|
begin |
|
|
|
DoTest('code_SimpleMain.shdr', 'result_SimpleMain.shdr'); |
|
|
|
DoTest('code_Main_Simple.shdr', 'result_Main_Simple.shdr'); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_FuncProcMain.SimpleFunc0; |
|
|
|
procedure TTestCase_FuncProcMain.Func_Simple_0; |
|
|
|
begin |
|
|
|
DoTest('code_SimpleFunc.shdr', 0, 'result_SimpleFunc_0.shdr'); |
|
|
|
DoTest('code_Func_Simple.shdr', 'result_Func_Simple_0.shdr', ['TestProperty', 0]); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_FuncProcMain.SimpleFunc1; |
|
|
|
procedure TTestCase_FuncProcMain.Func_Simple_1; |
|
|
|
begin |
|
|
|
DoTest('code_SimpleFunc.shdr', 1, 'result_SimpleFunc_1.shdr'); |
|
|
|
DoTest('code_Func_Simple.shdr', 'result_Func_Simple_1.shdr', ['TestProperty', 1]); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_FuncProcMain.InlineProc; |
|
|
|
procedure TTestCase_FuncProcMain.Proc_Inline; |
|
|
|
begin |
|
|
|
DoTest('code_InlineProc.shdr', 'result_InlineProc.shdr'); |
|
|
|
DoTest('code_Proc_Inline.shdr', 'result_Proc_Inline.shdr'); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_FuncProcMain.InlineFuncSingleReturn; |
|
|
|
procedure TTestCase_FuncProcMain.Func_InlineSingleReturn; |
|
|
|
begin |
|
|
|
DoTest('code_InlineFuncSingleReturn.shdr', 'result_InlineFuncSingleReturn.shdr'); |
|
|
|
DoTest('code_Func_InlineSingleReturn.shdr', 'result_Func_InlineSingleReturn.shdr'); |
|
|
|
end; |
|
|
|
|
|
|
|
procedure TTestCase_FuncProcMain.InlineFuncMultiReturn; |
|
|
|
procedure TTestCase_FuncProcMain.Func_InlineMultiReturn; |
|
|
|
begin |
|
|
|
DoTest('code_InlineFuncMultiReturn.shdr', 'result_InlineFuncMultiReturn.shdr'); |
|
|
|
DoTest('code_Func_InlineMultiReturn.shdr', 'result_Func_InlineMultiReturn.shdr'); |
|
|
|
end; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TTestCase_Include///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TTestCase_Include.SimpleInclude; |
|
|
|
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_SimpleInclude.shdr', 0, 'result_SimpleInclude.shdr'); |
|
|
|
DoTest('code_Class_Simple.shdr', 'SimpleClass', 'result_Class_Simple.shdr'); |
|
|
|
end; |
|
|
|
|
|
|
|
initialization |
|
|
|
RegisterTest(TTestCase_IfElseElifEnd); |
|
|
|
RegisterTest(TTestCase_IfElifElseEnd); |
|
|
|
RegisterTest(TTestCase_FuncProcMain); |
|
|
|
RegisterTest(TTestCase_Include); |
|
|
|
RegisterTest(TTestCase_Class); |
|
|
|
|
|
|
|
end. |
|
|
|
|