fixes for tests (#165)
This commit is contained in:
Martin
Carlo Kok
parent
69281ba739
commit
502fe3b0ef
@ -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.
|
||||
|
||||
@ -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;
|
||||
@ -134,4 +138,4 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
end.
|
||||
|
||||
@ -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.
|
||||
end.
|
||||
|
||||
@ -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.
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user