TpaxScripter Demo. Full Test.


unit fulltest1;   

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, PaxScripter, PaxPascal {$IFDEF VER150} ,variants,varutils, {$ENDIF};

type

{$M+} tnewobj=class private fname:string; published property name:string read fname write fname; end; {$M-}

TForm1 = class(TForm) Button1: TButton; Memo2: TMemo; cbShowOk: TCheckBox; cbAuto: TCheckBox; PaxScripter1: TPaxScripter; PaxPascal1: TPaxPascal; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private fvar,v,r: Variant; failcount:integer; Fobj1:tnewobj; procedure doOnPrint(Sender: TPaxScripter; const S: String); procedure doOnError(Sender: TPaxScripter); procedure say(a: variant); procedure testglobals; procedure simpleparam; procedure check(cond: boolean; msg: String); procedure arrayParam; procedure hostAccess; function myfunc(a:string):string; function myfunc2(a:variant):variant; function myfunc3(a:variant):variant; procedure myException; function _test(script: string; const params: array of const): variant; function test(script:string; const params:array of const):variant; procedure exceptions; public procedure automation; published property var1: variant read fvar write fvar; property obj1:TnewObj read Fobj1; end;

var Form1: TForm1;

implementation

uses ComObj, ActiveX, IMP_ActiveX, imp_pascal;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject); begin registerclasstype(tnewobj,-1); registerclassType(tform1,-1); registerMethod(tform1,'function myfunc(a:string):string;',@tform1.myfunc); registerMethod(tform1,'function myfunc2(a: variant): variant;',@tform1.myfunc2); registerMethod(tform1,'function myfunc3(a: variant): variant;',@tform1.myfunc3); registerMethod(tform1,'procedure MyException;',@tform1.myException); fobj1:=tnewobj.create; end;

procedure TForm1.doOnPrint(Sender: TPaxScripter; const S: String); begin memo2.lines.Add(S); end;

procedure tform1.say(a:variant); begin memo2.lines.add(string(a)); end;

procedure tform1.check(cond:boolean; msg:String); begin if cond then if cbshowok.checked then say(msg+' ok') else else begin say(msg+' failed'); inc(failCount) end; end;

function TForm1._test(script: string; const params: array of const): variant; begin PaxScripter1.ResetScripter; PaxScripter1.AddModule('1', 'paxPascal'); PaxScripter1.AddCode('1',script); PaxScripter1.Run; result := PaxScripter1.CallFunction('f',params); end;

function TForm1.test(script: string; const params: array of const): variant; begin try result:=_test(script,params); except say(exception(exceptObject).Message); result:=unassigned; end; end;

procedure tform1.testglobals; begin test('var a; function f; begin a:="global"; end;',[]); v := PaxScripter1.Values['a']; check(v='global','read global'); PaxScripter1.Values['a']:='global changed'; check(PaxScripter1.Values['a']='global changed','write global'); end;

procedure tform1.simpleparam;

procedure test1(msg:string; v1:variant); begin r:=test('function f(a); begin print(a); result:=a; end;', [v1]); check(r=v1,msg); end;

function getParam(fname:string; index:integer):variant; var subid,paramid:integer; begin SubID := PaxScripter1.GetMemberID(fname); if SubID = 0 then raise Exception.Create('Function not found'); ParamID := PaxScripter1.GetParamID(SubID, index); result := PaxScripter1.GetValueByID(ParamID); end;

begin test1('integer',1000); test1('string','mike'); test1('Date',now()); test1('byte',1); test1('boolean',true); test1('double',1.23); v:=100; r:=test('function f(var a); begin a:=a+10; end;',[v]); check(getParam('f',1)=110,'param by ref');

r:=test('function f(a); begin result:=a.caption; end;',[self]); check(r=caption,'Delphi Object parameter');

end;

procedure tform1.arrayParam; begin v:=varArrayof([1,2,3]); r:=test('function f(a); begin result:=a; end;', [v]); check(r[1]=2,'array invariance'); r:=test('function f(a); begin result:=a[1]; end;', [v]); check(r=2,'array access');

v:=vararrayof([VarArrayof([1,2,3]),4,5]); r:=test('function f(a); var a1; begin a1:=a[0]; result:=a1[1]; end;', [v]); check(r=2,'nested array access'); r:=test('function f(a); begin result:=a[0][1]; end;', [v]); check(r=2,'nested array access2');

r:=test('function f(a); begin result:=toInteger(a[0])+toInteger(a[1]); end;', [varArrayOf(['1','2'])]); check(r=3,'conversion of string parameters');

end;

procedure tform1.hostAccess; begin fvar := VarArrayOf([1, 2, 3]); r:=test('function f; begin print(form1.var1); result:=form1.var1; end;', []); check(r[1]=2,'host access 1'); r:=test('function f; begin print(form1.var1[1]); result:=form1.var1[1]; end;', []); check(r=2,'host access 2');

fobj1.name:='mike'; r:=test('function f; begin result:=form1.obj1.name; end;',[]); check(r='mike','class property');

r:=test('function f; begin result:=form1.myfunc("pa"); end;',[]); check(r='papa','host function call');

r:=test('function f; begin result:=form1.myfunc2(10); end;',[]); check(r=20,'host function call2');

r:=test('function f(a); begin result:=form1.myfunc2(a[1]); end;', [vararrayof([1000,2000])]); check(r=2010,'host function call3');

r:=test( 'function f; var a = VarArrayCreate([0,1], varVariant); begin a[0]:=1; a[1]:=2;'#13#10+ 'result:=form1.myfunc3(a); end;',[]); check(r=3,'array parameter to host');

end;

procedure tform1.automation; var fword:olevariant; begin fword:=createoleobject('word.application'); r:=test('function f(a); begin result:=a.path; end;', [fword]); fword.quit; check(pos('\',r)>0,'automation parameter'); end;

procedure tform1.exceptions; var ok:boolean; begin r:=test( ' function f;'#13#10+ ' begin'#13#10+ ' try'#13#10+ ' raise 100;'#13#10+ ' result:=1;'#13#10+ ' except'#13#10+ ' result:=2;'#13#10+ ' end;'#13#10+ ' end;',[]); check(r=2,'simple exception handling');

try r:=_test( ' function f; begin raise 100; end;',[]); if PaxScripter1.IsError then raise Exception.Create(PaxScripter1.ErrorDescription); ok:=false; except ok:=true; end; check(ok,'exception in script propagates to host');

r:=test( ' function f;'#13#10+ ' begin'#13#10+ ' try'#13#10+ ' form1.myException;'#13#10+ ' result:=1;'#13#10+ ' except'#13#10+ ' result:=2;'#13#10+ ' end;'#13#10+ ' end;',[]); check(r=2, 'Exception from host is caught');

try r:=_test( ' function f; begin form1.myException; end;',[]); if PaxScripter1.IsError then raise Exception.Create(PaxScripter1.ErrorDescription); ok:=false; except ok:=true; end; check(ok,'exception from host callback propagates to host');

try r:=_test( ' function f; begin form1.noSuchVariable; end;',[]); if PaxScripter1.IsError then raise Exception.Create(PaxScripter1.ErrorDescription); ok:=false; except ok:=true; end; check(ok,'undefined identifier raises exception');

end;

procedure TForm1.Button1Click(Sender: TObject); begin try failcount:=0; PaxScripter1.OnPrint:=DoOnPrint; PaxScripter1.OnShowError:=doOnError; PaxScripter1.RegisterObject('Form1', self); memo2.clear; testglobals; simpleparam; ArrayParam; hostAccess; if cbauto.checked then automation; exceptions; finally if failcount>0 then say(format('%d failures!',[failcount])) else say('congatulations'); end; end;

function TForm1.myfunc(a: string): string; begin result:=a+a; end;

function TForm1.myfunc2(a: variant): variant; begin result:=integer(a)+10; end;

procedure TForm1.myException; begin raise exception.create('exception from host'); end;

procedure TForm1.doOnError(Sender: TPaxScripter); begin say('error from script'); end;

function TForm1.myfunc3(a: variant): variant; begin result:=a[0]+a[1]; end;

end.


Copyright © 1999-2006 VIRT Laboratory. All rights reserved.