This weekend, I updated my code base from DWScript SVN. I used Preview 2.7 and now I'm using up-to-date trunk version.

I recompile my application and now the OnAfterInitUnitTable is no more triggered. Actually TdwsUnit.InitUnitTable is not called at all. BTW: TDWSunit is created at runtime by code and then two classes are exposed using ExposeRTTI. In need to expose one instance of each class.

What are - now - the prerequisites to have OnAfterInitUnitTable triggered?

Any help appreciated.

EDIT: Sample code to reproduce:

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: Other version to show the new issue using suggestion by Eric Grange in answer 1 below;

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.
有帮助吗?

解决方案

When encountering a "unit" as main program, the compiler currently assumes it's just a compilation for IDE purposes, ie. to check for syntax errors, build a symbol map, provide suggestions, etc. and the resulting program isn't fully initialized as a consequence.

So if you want to compile the unit and make an executable program, you can have a main program that'll just be something like:

uses Test;

This will compile a program comprised of your unit, for which executions can be created and where functions can be called though exec.Info, classes can be instantiated, etc.

Edit2: For the second test case, it works if "uses Test;" is added. For full cross-compilability with Delphi, you'll also need interface/implementation sections (when targeting script only, they are not necessary)

unit Other;

interface

uses Test;

procedure Func;

implementation

procedure Func;
begin
  Application.Demo;
end;

and if RTTI is generated for the methods with the $RTTI directive, at least with

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

otherwise you get an error about "Demo" not being found.

许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top