From 47c1423ff233cdf2c7f0a793a51671c1a6800806 Mon Sep 17 00:00:00 2001 From: martin Date: Fri, 2 Aug 2013 08:01:20 +0000 Subject: [PATCH] MacroScript: start selftests git-svn-id: trunk@42256 - --- components/macroscript/editormacroscript.lpk | 8 +- components/macroscript/editormacroscript.pas | 2 +- components/macroscript/emscriptclasses.pas | 213 ++++++++---------- components/macroscript/emscriptmacro.pas | 50 ++-- .../macroscript/test/testscriptprocs.pas | 19 +- 5 files changed, 137 insertions(+), 155 deletions(-) diff --git a/components/macroscript/editormacroscript.lpk b/components/macroscript/editormacroscript.lpk index 523dac29b8..115067a932 100644 --- a/components/macroscript/editormacroscript.lpk +++ b/components/macroscript/editormacroscript.lpk @@ -1,4 +1,4 @@ - + @@ -23,7 +23,7 @@ This package requires: PascalScript from REM Objects (http://www.remobjects.com/ Extends the Editors macro recorder and player. Macros can be written in pascal script. They also have access to additional properties and methods."/> - + @@ -37,6 +37,10 @@ Extends the Editors macro recorder and player. Macros can be written in pascal s + + + + diff --git a/components/macroscript/editormacroscript.pas b/components/macroscript/editormacroscript.pas index 5fc5bc795f..ccfa07d35d 100644 --- a/components/macroscript/editormacroscript.pas +++ b/components/macroscript/editormacroscript.pas @@ -7,7 +7,7 @@ unit EditorMacroScript; interface uses - RegisterEMS, EMScriptMacro, EMScriptClasses, LazarusPackageIntf; + RegisterEMS, EMScriptMacro, EMScriptClasses, EMSSelfTest, LazarusPackageIntf; implementation diff --git a/components/macroscript/emscriptclasses.pas b/components/macroscript/emscriptclasses.pas index 12b722baad..15dc53d2e0 100644 --- a/components/macroscript/emscriptclasses.pas +++ b/components/macroscript/emscriptclasses.pas @@ -22,17 +22,15 @@ type { TEMSTPSExec } TEMSTPSExec = class(TPSDebugExec) - private + protected FCLassImp: TPSRuntimeClassImporter; FSynEdit: TCustomSynEdit; - procedure AddFuncToExec; + procedure AddFuncToExec; virtual; procedure AddECFuncToExecEnum(const s: String); // ec... commands public constructor Create; destructor Destroy; override; - - procedure AddSelfTests; property SynEdit: TCustomSynEdit read FSynEdit write FSynEdit; end; @@ -40,30 +38,32 @@ type TEMSPSPascalCompiler = class(TPSPascalCompiler) private - FSelfTests: Boolean; procedure AddECFuncToCompEnum(const s: String); public constructor Create; - - procedure AddSelfTests; end; +{$IFDEF PasMacroNoNativeCalls} + PPoint = ^TPoint; +function GetSetFromStack(Stack: TPSStack; Idx: Integer): Cardinal; +function GetEnumFromStack(Stack: TPSStack; Idx: Integer): Cardinal; +function GetVarPointFromStack(Stack: TPSStack; Idx: Integer): PPoint; +function GetPointFromStack(Stack: TPSStack; Idx: Integer): TPoint; +{$ENDIF} -procedure CompRegisterBasics(AComp: TPSPascalCompiler); -procedure ExecRegisterBasics(AExec: TEMSTPSExec); - -procedure CompRegisterTSynEdit(AComp: TPSPascalCompiler); -procedure ExecRegisterTSynEdit(AExec: TEMSTPSExec); - -procedure CompRegisterTClipboard(AComp: TPSPascalCompiler); -procedure ExecRegisterTClipboard(AExec: TEMSTPSExec); - -procedure CompRegisterSelfTests(AComp: TPSPascalCompiler); -procedure ExecRegisterSelfTests(AExec: TEMSTPSExec); implementation +procedure CompRegisterBasics(AComp: TPSPascalCompiler); forward; +procedure ExecRegisterBasics(AExec: TEMSTPSExec); forward; + +procedure CompRegisterTSynEdit(AComp: TPSPascalCompiler); forward; +procedure ExecRegisterTSynEdit(AExec: TEMSTPSExec); forward; + +procedure CompRegisterTClipboard(AComp: TPSPascalCompiler); forward; +procedure ExecRegisterTClipboard(AExec: TEMSTPSExec); forward; + {$IFDEF NeedTPointFix} type TPoint2 = record x,y,a,b,c: Longint; end; {$ENDIF} @@ -89,9 +89,6 @@ begin CompRegisterTSynEdit(S); S.AddFunction('function Caller: TSynEdit;'); CompRegisterTClipboard(S); - - if S.FSelfTests then - CompRegisterSelfTests(S); end; Result := True; @@ -118,12 +115,6 @@ begin inherited Create; OnUses := @CompilerOnUses; BooleanShortCircuit := True; - FSelfTests := False; -end; - -procedure TEMSPSPascalCompiler.AddSelfTests; -begin - FSelfTests := True; end; { TEMSTPSExec } @@ -195,12 +186,6 @@ begin ExecRegisterTClipboard(Self); end; -procedure TEMSTPSExec.AddSelfTests; -begin - ExecRegisterSelfTests(Self); -end; - - {%region RegisterBasics} Function EMS_MessageDlg(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint): Integer; @@ -238,16 +223,6 @@ begin Result.Y := AY; end; -function test_ord_mt(AType: TMsgDlgType): Integer; -begin - Result := ord(AType); -end; - -function test_ord_mb(ABtn: TMsgDlgBtn): Integer; -begin - Result := ord(ABtn); -end; - const DeclMessageDlg = 'Function MessageDlg(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint): Integer'; DeclMessageDlgPos = 'Function MessageDlgPos(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer'; @@ -268,11 +243,6 @@ const DeclPoint = 'function Point(AX, AY: Integer): TPoint;'; FuncPoint: function(AX, AY: Integer): {$IFDEF NeedTPointFix}TPoint2{$ELSE}TPoint{$ENDIF} = @EMS_Point; // @Classes.Point; - Decltest_ord_mt = 'function test_ord_mt(AType: TMsgDlgType): Integer;'; - Decltest_ord_mb = 'function test_ord_mb(ABtn: TMsgDlgBtn): Integer;'; - Functest_ord_mt: function(AType: TMsgDlgType): Integer = @test_ord_mt; - Functest_ord_mb: function(ABtn: TMsgDlgBtn): Integer = @test_ord_mb; - procedure CompRegisterBasics(AComp: TPSPascalCompiler); procedure AddConst(const Name, FType: TbtString; I: Integer); begin @@ -305,35 +275,77 @@ begin AComp.AddDelphiFunction(DeclShowMessagePos); AComp.AddDelphiFunction(DeclInputBox); AComp.AddDelphiFunction(DeclInputQuery); - - // for tests - AComp.AddDelphiFunction(Decltest_ord_mb); - AComp.AddDelphiFunction(Decltest_ord_mt); end; -function ExecBasicHandler({%H-}Caller: TPSExec; p: TPSExternalProcRec; {%H-}Global, Stack: TPSStack): Boolean; - function GetSetFromStack(Idx: Integer): Cardinal; - var - val: PPSVariant; - dat: Pointer; - begin - if Idx < 0 then Idx := Idx + Stack.Count; - val := Stack[Idx]; - if val^.FType.BaseType <> btSet then raise TEMScriptBadParamException.Create('Invalid set'); - dat := @PPSVariantData(val)^.Data; - Result := tbtu32(dat^); - end; - function GetEnumFromStack(Idx: Integer): Cardinal; - var - val: PPSVariant; - dat: Pointer; - begin - if Idx < 0 then Idx := Idx + Stack.Count; - val := Stack[Idx]; - if val^.FType.BaseType <> btEnum then raise TEMScriptBadParamException.Create('Invalid set'); - dat := @PPSVariantData(val)^.Data; - Result := tbtu32(dat^); - end; +{$IFDEF PasMacroNoNativeCalls} +function GetSetFromStack(Stack: TPSStack; Idx: Integer): Cardinal; +var + val: PPSVariant; + dat: Pointer; +begin + if Idx < 0 then Idx := Idx + Stack.Count; + val := Stack[Idx]; + if val^.FType.BaseType <> btSet then raise TEMScriptBadParamException.Create('Invalid set'); + dat := @PPSVariantData(val)^.Data; + Result := tbtu32(dat^); +end; + +function GetEnumFromStack(Stack: TPSStack; Idx: Integer): Cardinal; +var + val: PPSVariant; + dat: Pointer; +begin + if Idx < 0 then Idx := Idx + Stack.Count; + val := Stack[Idx]; + if val^.FType.BaseType <> btEnum then raise TEMScriptBadParamException.Create('Invalid set'); + dat := @PPSVariantData(val)^.Data; + Result := tbtu32(dat^); +end; + +function GetVarPointFromStack(Stack: TPSStack; Idx: Integer): PPoint; +var + res: PPSVariant; + data: Pointer; + typerec: TPSTypeRec; +begin + if Idx < 0 then Idx := Idx + Stack.Count; + res := Stack[Idx]; + typerec := res^.FType; + + if typerec.BaseType = btPointer then begin + typerec := PPSVariantPointer(res)^.DestType; + Result := PPSVariantPointer(res)^.DataDest; + end + else + Result := @(PPSVariantRecord(res)^.data); + + if typerec.BaseType <> btRecord then raise TEMScriptBadParamException.Create('Invalid result type for "point(x,y)"'); + if typerec.RealSize <> SizeOf({$IFDEF NeedTPointFix}TPoint2{$ELSE}TPoint{$ENDIF}) then raise TEMScriptBadParamException.Create('Invalid result size for "point(x,y)"'); + if Result = nil then raise TEMScriptBadParamException.Create('Invalid result data for "point(x,y)"'); +end; + +function GetPointFromStack(Stack: TPSStack; Idx: Integer): TPoint; +var + res: PPSVariant; + data: Pointer; + typerec: TPSTypeRec; +begin + if Idx < 0 then Idx := Idx + Stack.Count; + res := Stack[Idx]; + typerec := res^.FType; + + if typerec.BaseType <> btRecord then raise TEMScriptBadParamException.Create('Invalid result type for "point(x,y)"'); + if typerec.RealSize <> SizeOf({$IFDEF NeedTPointFix}TPoint2{$ELSE}TPoint{$ENDIF}) then raise TEMScriptBadParamException.Create('Invalid result size for "point(x,y)"'); + + data := @(PPSVariantRecord(res)^.data); + if data = nil then raise TEMScriptBadParamException.Create('Invalid result data for "point(x,y)"'); + + Result := PPoint(data)^; + +end; + +function ExecBasicHandler({%H-}Caller: TPSExec; p: TPSExternalProcRec; + {%H-}Global, Stack: TPSStack): Boolean; var res: PPSVariant; data: Pointer; @@ -345,33 +357,21 @@ begin case Longint(p.Ext1) of 0: begin // POINT() if Stack.Count < 3 then raise TEMScriptBadParamException.Create('Invalid param count for "Point"');; - res := Stack[Stack.Count-1]; - typerec := res^.FType; - - if typerec.BaseType = btPointer then begin - typerec := PPSVariantPointer(res)^.DestType; - data := PPSVariantPointer(res)^.DataDest; - end - else - data := @(PPSVariantRecord(res)^.data); - - if typerec.BaseType <> btRecord then raise TEMScriptBadParamException.Create('Invalid result type for "point(x,y)"'); - if typerec.RealSize <> SizeOf(TPoint) then raise TEMScriptBadParamException.Create('Invalid result size for "point(x,y)"'); - if data = nil then raise TEMScriptBadParamException.Create('Invalid result data for "point(x,y)"'); + data := GetVarPointFromStack(Stack, -1); TPoint(data^) := Point(Stack.GetInt(-2), Stack.GetInt(-3)); end; 50: begin // MessageDlg(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint): Integer'; if Stack.Count < 5 then raise TEMScriptBadParamException.Create('Invalid param count for "MessageDlg"');; Stack.SetInt(-1, MessageDlg(Stack.GetAnsiString(-2), TMsgDlgType(Stack.GetUInt(-3)), - TMsgDlgButtons(GetSetFromStack(-4)), Stack.GetInt(-5)) + TMsgDlgButtons(GetSetFromStack(Stack, -4)), Stack.GetInt(-5)) ); end; 51: begin // MessageDlgPos(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer if Stack.Count < 7 then raise TEMScriptBadParamException.Create('Invalid param count for "MessageDlgPos"');; Stack.SetInt(-1, MessageDlgPos(Stack.GetAnsiString(-2), TMsgDlgType(Stack.GetUInt(-3)), - TMsgDlgButtons(GetSetFromStack(-4)), Stack.GetInt(-5), + TMsgDlgButtons(GetSetFromStack(Stack, -4)), Stack.GetInt(-5), Stack.GetInt(-6), Stack.GetInt(-7) ) ); end; @@ -379,7 +379,7 @@ begin if Stack.Count < 8 then raise TEMScriptBadParamException.Create('Invalid param count for "MessageDlgPosHelp"');; Stack.SetInt(-1, MessageDlgPosHelp(Stack.GetAnsiString(-2), TMsgDlgType(Stack.GetUInt(-3)), - TMsgDlgButtons(GetSetFromStack(-4)), Stack.GetInt(-5), + TMsgDlgButtons(GetSetFromStack(Stack, -4)), Stack.GetInt(-5), Stack.GetInt(-6), Stack.GetInt(-7), Stack.GetAnsiString(-8)) ); end; @@ -408,19 +408,11 @@ begin ); tbtstring(temp.Dta^) := s; end; - 900: begin // test_ord_mb(ABtn: TMsgDlgBtn): Integer; - if Stack.Count < 2 then raise TEMScriptBadParamException.Create('Invalid param count for "test_ord_mb"'); - Stack.SetInt(-1, test_ord_mb(TMsgDlgBtn(Stack.GetUInt(-2))) ); - end; - 901: begin // test_ord_mt(AType: TMsgDlgType): Integer; - if Stack.Count < 2 then raise TEMScriptBadParamException.Create('Invalid param count for "test_ord_mt"'); - // Stack[Stack.Count-2]^.FType.ExportName = 'TMSGDLGTYPE' - Stack.SetInt(-1, test_ord_mt(TMsgDlgType(Stack.GetUInt(-2))) ); - end; else Result := False; end; end; +{$ENDIF} procedure ExecRegisterBasics(AExec: TEMSTPSExec); begin @@ -791,25 +783,4 @@ end; {%endregion RegisterTClipboard} -{%region RegisterSelfTests} - -procedure CompRegisterSelfTests(AComp: TPSPascalCompiler); -begin - -end; - -procedure ExecRegisterSelfTests(AExec: TEMSTPSExec); -begin - // for tests - {$IFnDEF PasMacroNoNativeCalls} - AExec.RegisterDelphiFunction(Functest_ord_mb, 'test_ord_mb', cdRegister); - AExec.RegisterDelphiFunction(Functest_ord_mt, 'test_ord_mt', cdRegister); - {$ELSE} - AExec.RegisterFunctionName('test_ord_mb', @ExecBasicHandler, Pointer(900), nil); - AExec.RegisterFunctionName('test_ord_mt', @ExecBasicHandler, Pointer(901), nil); - {$ENDIF} -end; - -{%endregion RegisterSelfTests} - end. diff --git a/components/macroscript/emscriptmacro.pas b/components/macroscript/emscriptmacro.pas index 3ec43a0ebc..cd31e6934c 100644 --- a/components/macroscript/emscriptmacro.pas +++ b/components/macroscript/emscriptmacro.pas @@ -5,8 +5,9 @@ unit EMScriptMacro; interface uses - Classes, SysUtils, SrcEditorIntf, IDEMsgIntf, Controls, SynEdit, EMScriptClasses, Laz2_XMLCfg, uPSRuntime, - uPSUtils, LazLoggerBase; + Classes, SysUtils, SrcEditorIntf, IDEMsgIntf, Controls, SynEdit, + EMScriptClasses, Laz2_XMLCfg, uPSRuntime, uPSUtils, + LazLoggerBase; type @@ -24,6 +25,8 @@ type FPrivateExec: TEMSTPSExec; function GetCompiler: TEMSPSPascalCompiler; function GetExec: TEMSTPSExec; + procedure SetCompiler(AValue: TEMSPSPascalCompiler); + procedure SetExec(AValue: TEMSTPSExec); protected function GetMacroName: String; override; procedure SetMacroName(AValue: string); override; @@ -39,8 +42,8 @@ type procedure Compile; procedure FixBeginEnd; - property Compiler: TEMSPSPascalCompiler read GetCompiler; - property Exec: TEMSTPSExec read GetExec; + property Compiler: TEMSPSPascalCompiler read GetCompiler write SetCompiler; + property Exec: TEMSTPSExec read GetExec write SetExec; public constructor Create({%H-}aOwner: TComponent); override; destructor Destroy; override; @@ -57,7 +60,6 @@ type function IsInvalid: Boolean; override; function IsRecording({%H-}AnEditor: TWinControl): Boolean; override; - procedure MakeTestable; property PrivateCompiler: TEMSPSPascalCompiler read FPrivateCompiler write FPrivateCompiler; property PrivateExec: TEMSTPSExec read FPrivateExec write FPrivateExec; end; @@ -66,19 +68,19 @@ type implementation var - TheCompiler: TEMSPSPascalCompiler; - TheExec: TEMSTPSExec; + GlobalCompiler: TEMSPSPascalCompiler; + GlobalExec: TEMSTPSExec; { Create global objects } procedure CreateCompiler; begin - TheCompiler := TEMSPSPascalCompiler.Create; + GlobalCompiler := TEMSPSPascalCompiler.Create; end; procedure CreateExec; begin - TheExec := TEMSTPSExec.Create; + GlobalExec := TEMSTPSExec.Create; end; { TEMSEditorMacro } @@ -87,14 +89,26 @@ function TEMSEditorMacro.GetCompiler: TEMSPSPascalCompiler; begin Result := FPrivateCompiler; if Result = nil then - Result := TheCompiler; + Result := GlobalCompiler; end; function TEMSEditorMacro.GetExec: TEMSTPSExec; begin Result := FPrivateExec; if Result = nil then - Result := TheExec; + Result := GlobalExec; +end; + +procedure TEMSEditorMacro.SetCompiler(AValue: TEMSPSPascalCompiler); +begin + FreeAndNil(FPrivateCompiler); + FPrivateCompiler := AValue; +end; + +procedure TEMSEditorMacro.SetExec(AValue: TEMSTPSExec); +begin + FreeAndNil(FPrivateExec); + FPrivateExec := AValue; end; function TEMSEditorMacro.GetMacroName: String; @@ -314,23 +328,13 @@ begin Result := False; end; -procedure TEMSEditorMacro.MakeTestable; -begin - FreeAndNil(FPrivateExec); - FreeAndNil(FPrivateCompiler); - TheCompiler := TEMSPSPascalCompiler.Create; - TheCompiler.AddSelfTests; - TheExec := TEMSTPSExec.Create; - TheExec.AddSelfTests; -end; - initialization CreateCompiler; CreateExec; finalization - FreeAndNil(TheExec); - FreeAndNil(TheCompiler); + FreeAndNil(GlobalExec); + FreeAndNil(GlobalCompiler); end. diff --git a/components/macroscript/test/testscriptprocs.pas b/components/macroscript/test/testscriptprocs.pas index 12cadf2e7a..99688f80c3 100644 --- a/components/macroscript/test/testscriptprocs.pas +++ b/components/macroscript/test/testscriptprocs.pas @@ -5,8 +5,8 @@ unit TestScriptProcs; interface uses - Classes, SysUtils, SynEdit, EMScriptMacro, Controls, Dialogs, Clipbrd, fpcunit, testutils, - testregistry; + Classes, SysUtils, SynEdit, EMScriptMacro, EMSSelfTest, Controls, Dialogs, + Clipbrd, fpcunit, testutils, testregistry; type @@ -23,6 +23,7 @@ type published procedure TestBasics; procedure TestSynProcs; + procedure TestSelfTest; procedure TestInteractiv; end; @@ -63,8 +64,7 @@ end; procedure TTestCase1.TestBasics; begin FTestSyn := TSynEdit.Create(nil); - FTestMacro := TEMSEditorMacro.Create(nil); - FTestMacro.MakeTestable; + FTestMacro := TEMSelfTestEditorMacro.Create(nil); try DoTestSimple('SizeOf(TPoint)', '', 'var p: TPoint; begin if SizeOf(p) = ' +IntToStr(SizeOf(TPoint)) + ' then Caller.InsertTextAtCaret(''Y'', scamEnd); end.', @@ -159,8 +159,7 @@ end; procedure TTestCase1.TestSynProcs; begin FTestSyn := TSynEdit.Create(nil); - FTestMacro := TEMSEditorMacro.Create(nil); - FTestMacro.MakeTestable; + FTestMacro := TEMSelfTestEditorMacro.Create(nil); try {%region Text / point / ecXXX *} @@ -581,11 +580,15 @@ begin end; end; +procedure TTestCase1.TestSelfTest; +begin + AssertTrue(DoSelfTest); +end; + procedure TTestCase1.TestInteractiv; begin FTestSyn := TSynEdit.Create(nil); - FTestMacro := TEMSEditorMacro.Create(nil); - FTestMacro.MakeTestable; + FTestMacro := TEMSelfTestEditorMacro.Create(nil); try DoTestSimple('ShowMessage', 'Y',