DWScript:发布更新到当前开发版本

时间:2013-05-27 13:29:10

标签: dwscript

本周末,我从DWScript SVN更新了我的代码库。我使用预览2.7,现在我使用的是最新的主干版本。

我重新编译了我的应用程序,现在不再触发OnAfterInitUnitTable。实际上根本没有调用TdwsUnit.InitUnitTable。 BTW:TDWSunit是在运行时通过代码创建的,然后使用ExposeRTTI公开两个类。需要公开每个类的一个实例。

现在是什么 - 触发OnAfterInitUnitTable的先决条件?

任何帮助表示感谢。

编辑:要重现的示例代码:

program ExposeTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    SysUtils, Classes, TypInfo,
    dwsRTTIExposer, dwsExprs, dwsComp;

type
    TScriptApplication = class(TPersistent)

    end;

    TTestClass = class(TThread)
    private
        FScript                  : IdwsProgram;
        FDelphiWebScript         : TDelphiWebScript;
        FUnit                    : TdwsUnit;
        FScriptApplication       : TScriptApplication;
        FSuccess                 : Boolean;
        procedure ExposeInstancesAfterInitTable(Sender: TObject);
    public
        constructor Create;
        destructor Destroy; override;
        procedure Execute; override;
    end;

var
    Test : TTestClass;


{ TTestClass }

constructor TTestClass.Create;
begin
    inherited Create(TRUE);
    FScriptApplication              := TScriptApplication.Create;
    FDelphiWebScript                := TDelphiWebScript.Create(nil);
    FUnit                           := TdwsUnit.Create(nil);
    FUnit.UnitName                  := 'Test';
    FUnit.Script                    := FDelphiWebScript;
    FUnit.ExposeRTTI(TypeInfo(TScriptApplication), [eoNoFreeOnCleanup]);
    FUnit.OnAfterInitUnitTable      := ExposeInstancesAfterInitTable;
end;

destructor TTestClass.Destroy;
begin
    FreeAndNil(FScriptApplication);
    FreeAndNil(FUnit);
    FreeAndNil(FDelphiWebScript);
    inherited;
end;

procedure TTestClass.Execute;
begin
    WriteLn('Test 1');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('Unit Test; var I: Integer; I := 0;');
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test 2');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('var I: Integer; I := 0;');
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test Done');
end;

procedure TTestClass.ExposeInstancesAfterInitTable(Sender: TObject);
begin
    FUnit.ExposeInstanceToUnit('Application', 'TScriptApplication', FScriptApplication);
    WriteLn('OnAfterInitUnitTable called');
    FSuccess     := TRUE;
end;

begin
    Test := TTestClass.Create;
    Test.Start;
    Sleep(1000);
    WriteLn('Hit enter to quit');
    ReadLn;
    Test.Free;
end.

EDIt2:其他版本使用Eric Grange在下面的答案1中提出的建议来显示新问题;

program ExposeTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    SysUtils, Classes, TypInfo,
    dwsRTTIExposer, dwsFunctions, dwsExprs, dwsComp;

type
    TScriptApplication = class(TPersistent)
    published
        procedure Demo;
    end;

    TTestClass = class(TThread)
    private
        FScript                  : IdwsProgram;
        FDelphiWebScript         : TDelphiWebScript;
        FUnit                    : TdwsUnit;
        FScriptApplication       : TScriptApplication;
        FSuccess                 : Boolean;
        procedure ExposeInstancesAfterInitTable(Sender: TObject);
        function NeedUnitHandler(const UnitName   : UnicodeString;
                                 var   UnitSource : UnicodeString): IdwsUnit;
    public
        constructor Create;
        destructor Destroy; override;
        procedure Execute; override;
    end;

var
    Test : TTestClass;


{ TTestClass }

constructor TTestClass.Create;
begin
    inherited Create(TRUE);
    FScriptApplication              := TScriptApplication.Create;
    FDelphiWebScript                := TDelphiWebScript.Create(nil);
    FDelphiWebScript.OnNeedUnit     := NeedUnitHandler;
    FUnit                           := TdwsUnit.Create(nil);
    FUnit.UnitName                  := 'Test';
    FUnit.Script                    := FDelphiWebScript;
    FUnit.ExposeRTTI(TypeInfo(TScriptApplication), [eoNoFreeOnCleanup]);
    FUnit.OnAfterInitUnitTable      := ExposeInstancesAfterInitTable;
end;

destructor TTestClass.Destroy;
begin
    FreeAndNil(FScriptApplication);
    FreeAndNil(FUnit);
    FreeAndNil(FDelphiWebScript);
    inherited;
end;

procedure TTestClass.Execute;
begin
    WriteLn('Test 1');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('Unit Test; var I: Integer; I := 0;');
    WriteLn(FScript.Msgs.AsInfo);
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test 2');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('uses Other;');
    WriteLn(FScript.Msgs.AsInfo);
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test Done');
end;

procedure TTestClass.ExposeInstancesAfterInitTable(Sender: TObject);
begin
    FUnit.ExposeInstanceToUnit('Application', 'TScriptApplication', FScriptApplication);
    WriteLn('OnAfterInitUnitTable called');
    FSuccess     := TRUE;
end;

function TTestClass.NeedUnitHandler(
    const UnitName   : UnicodeString;
    var   UnitSource : UnicodeString): IdwsUnit;
begin
    Result := nil;
    if SameText(UnitName, 'Other') then
    UnitSource := 'unit Other;' + #13#10 +
                  'procedure Func;' + #13#10 +
                  'begin' + #13#10 +
                  '  Application.Demo;' + #13#10 +
                  'end;' + #13#10
    else
        UnitSource := '';
end;

{ TScriptApplication }

procedure TScriptApplication.Demo;
begin

end;

begin
    Test := TTestClass.Create;
    Test.Start;
    Sleep(1000);
    WriteLn('Hit enter to quit');
    ReadLn;
    Test.Free;
end.

1 个答案:

答案 0 :(得分:0)

当遇到“单元”作为主程序时,编译器当前假设它只是用于IDE目的的编译,即。检查语法错误,构建符号映射,提供建议等,结果程序未完全初始化。

因此,如果你想编译单元并制作一个可执行程序,你可以拥有一个主程序,它就像是:

uses Test;

这将编译一个由您的单元组成的程序,可以为其创建执行,并且可以通过exec.Info调用函数,可以实例化类等等。

Edit2:对于第二个测试用例,如果“使用Test”,它就可以工作被添加。为了与Delphi完全交叉编译,您还需要接口/实现部分(仅在定位脚本时,它们不是必需的)

unit Other;

interface

uses Test;

procedure Func;

implementation

procedure Func;
begin
  Application.Demo;
end;

如果使用$ RTTI指令为方法生成RTTI,至少使用

{$RTTI EXPLICIT METHODS([vcPublished])}
TScriptApplication = class(TPersistent)
published
    procedure Demo;
end;

否则您会收到有关“未找到”演示的错误。