afe3fdfd77
git-svn-id: http://code.remobjects.com/svn/pascalscript@1 5c9d2617-0215-0410-a2ee-e80e04d1c6d8
137 lines
3.3 KiB
ObjectPascal
137 lines
3.3 KiB
ObjectPascal
|
|
unit CompilerTestBase;
|
|
|
|
interface
|
|
|
|
uses Classes,
|
|
TestFramework,
|
|
{ Project Units }
|
|
ifps3,
|
|
ifpscomp,
|
|
IFPS3CompExec;
|
|
|
|
type
|
|
TCompilerTestBase = class(TTestCase)
|
|
protected
|
|
procedure SetUp; override;
|
|
procedure TearDown; override;
|
|
protected
|
|
last_script : string;
|
|
CompExec: TIFPS3CompExec;
|
|
//Compiler: TIFPSPascalCompiler;
|
|
//Exec: TIFPSExec;
|
|
procedure Compile(script: string);
|
|
procedure CompileRun(Script: string);
|
|
|
|
procedure OnCompile(Sender: TIFPS3CompExec); virtual;
|
|
procedure OnExecute(Sender: TIFPS3CompExec); virtual;
|
|
procedure OnCompImport(Sender: TObject; x: TIFPSPascalCompiler); virtual;
|
|
procedure OnExecImport(Sender: TObject; se: TIFPSExec; x: TIFPSRuntimeClassImporter); virtual;
|
|
end;
|
|
|
|
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;
|
|
|
|
function MyFormat(const Format: string;
|
|
const Args: array of const): string;
|
|
begin
|
|
Result := SysUtils.Format(Format, Args);
|
|
end;
|
|
|
|
|
|
{ TCompilerTestBase }
|
|
|
|
procedure TCompilerTestBase.SetUp;
|
|
begin
|
|
inherited;
|
|
CompExec := TIFPS3CompExec.Create(nil);
|
|
CompExec.OnCompile := OnCompile;
|
|
CompExec.OnExecute := OnExecute;
|
|
CompExec.OnCompImport := OnCompImport;
|
|
CompExec.OnExecImport := OnExecImport;
|
|
end;
|
|
|
|
procedure TCompilerTestBase.TearDown;
|
|
begin
|
|
CompExec.Free;
|
|
//Compiler.Free;
|
|
//Exec.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCompilerTestBase.CompileRun(Script: string);
|
|
var
|
|
ok: boolean;
|
|
begin
|
|
last_script := Script;
|
|
|
|
Compile(script);
|
|
|
|
ok := CompExec.Execute;
|
|
|
|
Check(ok, 'Exec Error:' + Script + #13#10 +
|
|
CompExec.ExecErrorToString + ' at ' +
|
|
Inttostr(CompExec.ExecErrorProcNo) + '.' +
|
|
Inttostr(CompExec.ExecErrorByteCodePosition));
|
|
end;
|
|
|
|
procedure TCompilerTestBase.OnCompile(Sender: TIFPS3CompExec);
|
|
begin
|
|
Sender.AddFunction(@MyFormat, 'function Format(const Format: string; const Args: array of const): string;');
|
|
end;
|
|
|
|
procedure TCompilerTestBase.OnCompImport(Sender: TObject; x: TIFPSPascalCompiler);
|
|
begin
|
|
SIRegister_Std(x);
|
|
SIRegister_Classes(x, true);
|
|
end;
|
|
|
|
procedure TCompilerTestBase.OnExecImport(Sender: TObject; se: TIFPSExec; x: TIFPSRuntimeClassImporter);
|
|
begin
|
|
RIRegister_Std(x);
|
|
RIRegister_Classes(x, True);
|
|
end;
|
|
|
|
procedure TCompilerTestBase.OnExecute(Sender: TIFPS3CompExec);
|
|
begin
|
|
//Sender.SetVarToInstance('SELF', Self);
|
|
end;
|
|
|
|
procedure TCompilerTestBase.Compile(script: string);
|
|
var
|
|
OutputMessages: string;
|
|
ok: Boolean;
|
|
i: Longint;
|
|
begin
|
|
|
|
CompExec.Script.Clear;
|
|
CompExec.Script.Add(Script);
|
|
|
|
OutputMessages := '';
|
|
ok := CompExec.Compile;
|
|
if (NOT ok) then
|
|
begin
|
|
//Get Compiler Messages now.
|
|
for i := 0 to CompExec.CompilerMessageCount - 1 do
|
|
OutputMessages := OutputMessages + CompExec.CompilerErrorToStr(i);
|
|
end;
|
|
Check(ok, 'Compiling failed:' + Script + #13#10 + OutputMessages);
|
|
|
|
end;
|
|
|
|
end. |