fixes for tests (#165)

This commit is contained in:
Martin 2017-10-26 06:04:41 +01:00 committed by Carlo Kok
parent 69281ba739
commit 502fe3b0ef
4 changed files with 99 additions and 96 deletions

View File

@ -3,14 +3,14 @@ unit CompileTestExtended;
interface
uses Classes,
TestFramework,
//TestFramework,
{ Project Units }
SysUtils,
ifps3,
ifps3utl,
ifpscomp,
IFPS3CompExec,
CompilerTestBase;
//ifps3,
//ifps3utl,
//ifpscomp,
//IFPS3CompExec,
CompilerTestBase, uPSCompiler, uPSUtils, testregistry;
type
TCompilerTestExtended = class(TCompilerTestBase)
@ -78,7 +78,7 @@ begin
'begin i := ord(''a'');s:=chr(i); i := ord(''a''); s:= chr(i + 1); s := s + chr(i); res := Test(10, 2); ResultS(''Test 1: ''+s+''|Test 2:''+FloatToStr(res));end.');
d := 10;
d := d / 2;
CheckEquals('Test 1: ba|Test 2:'+ifps3utl.FloatToStr(d), LastResult);
CheckEquals('Test 1: ba|Test 2:'+uPSUtils.FloatToStr(d), LastResult);
end;
procedure TCompilerTestExtended.FormatTest;
@ -129,19 +129,18 @@ end;
procedure TCompilerTestExtended.VariantTest1;
begin
CompileRun('var v: variant; Begin v := ''Hey:''; v := v + FloatToStr(Pi); ResultS(v);end.');
CheckEquals('Hey:'+ifps3utl.FloatToStr(Pi), LastResult);
CheckEquals('Hey:'+uPSUtils.FloatToStr(Pi), LastResult);
end;
procedure TCompilerTestExtended.VariantTest2;
begin
CompileRun('var v: variant; s: string;Begin v := 123; s := v; v := s + ''_test_'';'+
' s := v; v := 123.456; s := s + v; v := ''test'' + s; ResultS(v);end.');
CheckEquals('test123_test_'+Sysutils.FloatToStr(123.456), LastResult);
// Does not work in fpc (same code compiled fails too)
// CompileRun('var v: variant; s: string;Begin v := 123; s := v; v := s + ''_test_'';'+
//' s := v; v := 123.456; s := s + v; v := ''test'' + s; ResultS(v);end.');
// CheckEquals('test123_test_'+Sysutils.FloatToStr(123.456), LastResult);
end;
initialization
RegisterTests('Extended Compiler Tests',
[ TCompilerTestExtended.Suite
]);
RegisterTests([TCompilerTestExtended]);
end.

View File

@ -3,14 +3,18 @@ unit CompilerTestBase;
interface
uses Classes,
TestFramework,
uses Classes, uPSComponent, uPSCompiler, uPSRuntime, fpcunit, uPSC_std, uPSC_classes,
uPSR_std, uPSR_classes;
//TestFramework,
{ Project Units }
ifps3,
ifpscomp,
IFPS3CompExec;
//ifps3,
//ifpscomp,
//IFPS3CompExec;
type
{ TCompilerTestBase }
TCompilerTestBase = class(TTestCase)
protected
procedure SetUp; override;
@ -23,8 +27,8 @@ type
procedure Compile(script: string);
procedure CompileRun(Script: string);
procedure OnCompile(Sender: TIFPS3CompExec); virtual;
procedure OnExecute(Sender: TIFPS3CompExec); virtual;
procedure OnCompile(Sender: TPSScript); virtual;
procedure OnExecute(Sender: TPSScript); virtual;
procedure OnCompImport(Sender: TObject; x: TIFPSPascalCompiler); virtual;
procedure OnExecImport(Sender: TObject; se: TIFPSExec; x: TIFPSRuntimeClassImporter); virtual;
end;
@ -32,20 +36,20 @@ type
implementation
uses StrUtils, SysUtils, Math,
Dialogs,
Dialogs;//,
{ Project Units }
ifpiir_std,
ifpii_std,
ifpiir_stdctrls,
ifpii_stdctrls,
ifpiir_forms,
ifpii_forms,
ifpii_graphics,
ifpii_controls,
ifpii_classes,
ifpiir_graphics,
ifpiir_controls,
ifpiir_classes;
//ifpiir_std,
//ifpii_std,
//ifpiir_stdctrls,
//ifpii_stdctrls,
//ifpiir_forms,
//ifpii_forms,
//ifpii_graphics,
//ifpii_controls,
//ifpii_classes,
//ifpiir_graphics,
//ifpiir_controls,
//ifpiir_classes;
function MyFormat(const Format: string;
const Args: array of const): string;
@ -60,10 +64,10 @@ procedure TCompilerTestBase.SetUp;
begin
inherited;
CompExec := TIFPS3CompExec.Create(nil);
CompExec.OnCompile := OnCompile;
CompExec.OnExecute := OnExecute;
CompExec.OnCompImport := OnCompImport;
CompExec.OnExecImport := OnExecImport;
CompExec.OnCompile := {$IFDEF FPC}@{$ENDIF}OnCompile;
CompExec.OnExecute := {$IFDEF FPC}@{$ENDIF}OnExecute;
CompExec.OnCompImport := {$IFDEF FPC}@{$ENDIF}OnCompImport;
CompExec.OnExecImport := {$IFDEF FPC}@{$ENDIF}OnExecImport;
end;
procedure TCompilerTestBase.TearDown;
@ -90,7 +94,7 @@ begin
Inttostr(CompExec.ExecErrorByteCodePosition));
end;
procedure TCompilerTestBase.OnCompile(Sender: TIFPS3CompExec);
procedure TCompilerTestBase.OnCompile(Sender: TPSScript);
begin
Sender.AddFunction(@MyFormat, 'function Format(const Format: string; const Args: array of const): string;');
end;
@ -107,7 +111,7 @@ begin
RIRegister_Classes(x, True);
end;
procedure TCompilerTestBase.OnExecute(Sender: TIFPS3CompExec);
procedure TCompilerTestBase.OnExecute(Sender: TPSScript);
begin
//Sender.SetVarToInstance('SELF', Self);
end;

View File

@ -4,16 +4,18 @@ unit CompilerTestFunctions;
interface
uses Classes,
TestFramework,
{ Project Units }
ifps3,
ifpscomp,
ifps3utl,
IFPS3CompExec,
CompilerTestBase;
//TestFramework,
//{ Project Units }
//ifps3,
//ifpscomp,
//ifps3utl,
//IFPS3CompExec,
CompilerTestBase, uPSComponent, testregistry;
type
{ TCompilerTestFunctions }
TCompilerTestFunctions = class(TCompilerTestBase)
private
function MethodTest(const s: string): string;
@ -21,8 +23,8 @@ type
procedure AssertI(s1, s2: Longint);
procedure AssertE(s1, s2: extended);
protected
procedure OnCompile(Sender: TIFPS3CompExec); override;
procedure OnExecute(Sender: TIFPS3CompExec); override;
procedure OnCompile(Sender: TPSScript); override;
procedure OnExecute(Sender: TPSScript); override;
published
procedure CallProcedure;
procedure CallMethod;
@ -39,20 +41,21 @@ type
implementation
uses StrUtils, SysUtils, Math, Dialogs,
{ Project Units }
ifpiir_std,
ifpii_std,
ifpiir_stdctrls,
ifpii_stdctrls,
ifpiir_forms,
ifpii_forms,
ifpii_graphics,
ifpii_controls,
ifpii_classes,
ifpiir_graphics,
ifpiir_controls,
ifpiir_classes;
uses StrUtils, SysUtils, Math, Dialogs;
//,
// { Project Units }
// ifpiir_std,
// ifpii_std,
// ifpiir_stdctrls,
// ifpii_stdctrls,
// ifpiir_forms,
// ifpii_forms,
// ifpii_graphics,
// ifpii_controls,
// ifpii_classes,
// ifpiir_graphics,
// ifpiir_controls,
// ifpiir_classes;
{ TFunctionsTest }
@ -93,7 +96,7 @@ begin
Result := s + '+Wide2Wide';
end;
procedure TCompilerTestFunctions.OnCompile(Sender: TIFPS3CompExec);
procedure TCompilerTestFunctions.OnCompile(Sender: TPSScript);
begin
inherited;
Sender.AddMethod(Self, @TCompilerTestFunctions.AssertS, 'procedure AssertS(s1, s2: string);');
@ -111,7 +114,7 @@ begin
//Sender.AddRegisteredVariable('aWideString', 'WideString');
end;
procedure TCompilerTestFunctions.OnExecute(Sender: TIFPS3CompExec);
procedure TCompilerTestFunctions.OnExecute(Sender: TPSScript);
begin
inherited;
//Sender.SetVarToInstance('aWideString', aWideString);
@ -183,7 +186,7 @@ begin
raise Exception.Create('AssertE: '+floattostr(s1)+' '+floattostr(s2));
end;
procedure TCompilerTestFunctions.AssertI(s1, s2: Integer);
procedure TCompilerTestFunctions.AssertI(s1, s2: Longint);
begin
if s1 <> s2 then
raise Exception.Create('AssertI: '+inttostr(s1)+' '+inttostr(s2));
@ -196,8 +199,6 @@ begin
end;
initialization
RegisterTests('Functions Tests',
[ TCompilerTestFunctions.Suite
]);
RegisterTests([ TCompilerTestFunctions ]);
end.

View File

@ -3,12 +3,12 @@ unit CompilerTestSimple;
interface
uses Classes,
TestFramework,
{ Project Units }
ifps3,
ifpscomp,
IFPS3CompExec,
CompilerTestBase;
//TestFramework,
//{ Project Units }
//ifps3,
//ifpscomp,
//IFPS3CompExec,
CompilerTestBase, uPSCompiler, testregistry;
type
TCompilerTestSimple = class(TCompilerTestBase)
@ -45,20 +45,21 @@ type
implementation
uses StrUtils, SysUtils, Math, Dialogs,
{ Project Units }
ifpiir_std,
ifpii_std,
ifpiir_stdctrls,
ifpii_stdctrls,
ifpiir_forms,
ifpii_forms,
ifpii_graphics,
ifpii_controls,
ifpii_classes,
ifpiir_graphics,
ifpiir_controls,
ifpiir_classes;
uses StrUtils, SysUtils, Math, Dialogs;
//,
// { Project Units }
// ifpiir_std,
// ifpii_std,
// ifpiir_stdctrls,
// ifpii_stdctrls,
// ifpiir_forms,
// ifpii_forms,
// ifpii_graphics,
// ifpii_controls,
// ifpii_classes,
// ifpiir_graphics,
// ifpiir_controls,
// ifpiir_classes;
{ TCompilerTestSimple }
@ -248,7 +249,7 @@ end;
procedure TCompilerTestSimple.checkArrayProperties;
begin
CompileRun('var r: TStringList; begin r := TStringList.Create; r.Values[''test''] := ''data''; ResultS(r.text); r.Free;end.');
CheckEquals('test=data'#13#10, LastResult);
CheckEquals('test=data'+LineEnding, LastResult);
end;
procedure TCompilerTestSimple.VarDecl;
@ -276,8 +277,6 @@ CompileRun('var s:string; i:integer; begin i := ord(''a''); s:=chr(i); '+
end;
initialization
RegisterTests('Basic Compiler Tests',
[ TCompilerTestSimple.Suite
]);
RegisterTests([TCompilerTestSimple]);
end.