فهرست منبع

pastojs: moved unit implementation js function into unit interface to share local vars

git-svn-id: trunk@46816 -
Mattias Gaertner 4 سال پیش
والد
کامیت
02c72dd5c4

+ 51 - 65
packages/pastojs/src/fppas2js.pp

@@ -668,6 +668,7 @@ type
     pbivnIntfKind,
     pbivnIntfMaps,
     pbivnImplementation,
+    pbivnImplCode,
     pbivnMessageInt,
     pbivnMessageStr,
     pbivnLocalModuleRef,
@@ -849,10 +850,11 @@ const
     '$kind', // pbivnIntfKind
     '$intfmaps', // pbivnIntfMaps
     '$impl', // pbivnImplementation
+    '$implcode', // pbivnImplCode
     '$msgint', // pbivnMessageInt
     '$msgstr', // pbivnMessageStr
-    '$lmr', // pbivnLocalModuleRef
-    '$ltr', // pbivnLocalTypeRef
+    '$lm', // pbivnLocalModuleRef
+    '$lt', // pbivnLocalTypeRef
     '$l', // pbivnLoop
     '$end', // pbivnLoopEnd
     '$in', // pbivnLoopIn
@@ -7600,28 +7602,40 @@ Program:
  rtl.module('program',
     [<uses1>,<uses2>, ...],
     function(){
+      var $mod = this;
       <programsection>
       this.$main=function(){
         <initialization>
         };
     });
 
-Unit:
+Unit without implementation:
  rtl.module('<unitname>',
     [<interface uses1>,<uses2>, ...],
     function(){
-      var $impl = {};
+      var $mod = this;
       this.$impl = $impl;
       <interface>
       this.$init=function(){
         <initialization>
         };
+    });
+
+Unit with implementation:
+ rtl.module('<unitname>',
+    [<interface uses1>,<uses2>, ...],
+    function(){
+      var $mod = this;
+      var $impl = $mod.$impl;
+      <interface>
+      $impl.$code=function(){
+        };
+      this.$init=function(){
+        <initialization>
+        };
     },
     [<implementation uses1>,<uses2>, ...],
-    function(){
-      var $impl = this.$impl;
-      <implementation>
-    });
+    );
 *)
 Var
   OuterSrc , Src: TJSSourceElements;
@@ -7633,9 +7647,9 @@ Var
   IntfContext: TSectionContext;
   ImplVarSt: TJSVariableStatement;
   HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean;
-  UsesClause: TPasUsesClause;
   Prg: TPasProgram;
   Lib: TPasLibrary;
+  AssignSt: TJSSimpleAssignStatement;
 begin
   Result:=Nil;
   OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
@@ -7683,8 +7697,6 @@ begin
       end;
 
     ImplVarSt:=nil;
-    HasImplUsesClause:=false;
-
     IntfContext:=TSectionContext.Create(El,Src,AContext);
     try
       // add "var $mod = this;"
@@ -7725,18 +7737,28 @@ begin
           end;
         if Assigned(El.InterfaceSection) then
           AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext));
-        CreateInitSection(El,Src,IntfContext);
 
-        // add optional implementation uses list: [<implementation uses1>,<uses2>, ...]
-        if Assigned(El.ImplementationSection) then
+        ImplFunc:=CreateImplementationSection(El,IntfContext);
+        if ImplFunc=nil then
           begin
-          UsesClause:=El.ImplementationSection.UsesClause;
-          if length(UsesClause)>0 then
-            begin
-            ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
-            HasImplUsesClause:=true;
-            end;
+          // remove unneeded $impl from interface
+          RemoveFromSourceElements(Src,ImplVarSt);
+          HasImplUsesClause:=length(El.ImplementationSection.UsesClause)>0;
+          end
+        else
+          begin
+          // add $mod.$implcode = ImplFunc;
+          AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+          AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
+          AssignSt.Expr:=ImplFunc;
+          AddToSourceElements(Src,AssignSt);
+          HasImplUsesClause:=true;
           end;
+        if HasImplUsesClause then
+          // add implementation uses list: [<implementation uses1>,<uses2>, ...]
+          ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
+
+        CreateInitSection(El,Src,IntfContext);
 
         end;
     finally
@@ -7746,19 +7768,6 @@ begin
     // add implementation function
     if ImplVarSt<>nil then
       begin
-      ImplFunc:=CreateImplementationSection(El,AContext);
-      if ImplFunc=nil then
-        begin
-        // remove unneeded $impl from interface
-        RemoveFromSourceElements(Src,ImplVarSt);
-        end
-      else
-        begin
-        // add param
-        if not HasImplUsesClause then
-          ArgArray.AddElement(CreateElement(TJSArrayLiteral,El));
-        ArgArray.AddElement(ImplFunc);
-        end;
       end;
     ok:=true;
   finally
@@ -16731,43 +16740,23 @@ var
   Src: TJSSourceElements;
   ImplContext: TSectionContext;
   ImplDecl: TJSElement;
-  ImplVarSt: TJSVariableStatement;
   FunDecl: TJSFunctionDeclarationStatement;
-  ModVarName, ImplVarName: String;
 begin
   Result:=nil;
   // create function(){}
-  FunDecl:=CreateFunctionSt(El,true,true);
+  FunDecl:=CreateFunctionSt(El.ImplementationSection,true,true);
   Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
 
   // create section context (a function)
-  ImplContext:=TSectionContext.Create(El,Src,AContext);
+  ImplContext:=TSectionContext.Create(El.ImplementationSection,Src,AContext);
   try
-    if coUseStrict in Options then
-      AddToSourceElements(Src,CreateLiteralString(El,'use strict'));
-
-    // add "var $mod = this;"
-    ImplContext.ThisPas:=El;
-    ModVarName:=GetBIName(pbivnModule);
-    AddToSourceElements(Src,CreateVarStatement(ModVarName,
-      CreatePrimitiveDotExpr('this',El),El));
-    ImplContext.AddLocalVar(ModVarName,El,false);
-
-    // add var $impl = $mod.$impl
-    ImplVarName:=GetBIName(pbivnImplementation);
-    ImplVarSt:=CreateVarStatement(ImplVarName,
-      CreateMemberExpression([ModVarName,ImplVarName]),El.ImplementationSection);
-    AddToSourceElements(Src,ImplVarSt);
-    ImplContext.AddLocalVar(ImplVarName,El.ImplementationSection,false);
-
+    // ToDo: ImplContext.ThisPas:=El;
     // create implementation declarations
     ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
     if ImplDecl<>nil then
       RaiseInconsistency(20170910175032,El); // elements should have been added directly
-    if Src.Statements[Src.Statements.Count-1].Node=ImplVarSt then
+    if Src.Statements.Count=0 then
       exit; // no implementation
-    // add impl declarations
-    AddToSourceElements(Src,ImplDecl);
     Result:=FunDecl;
   finally
     ImplContext.Free;
@@ -23956,9 +23945,9 @@ var
 begin
   aType:=AContext.Resolver.ResolveAliasType(El);
   Result:=AContext.GetLocalName(aType,true);
-  AliasGlobals:=coAliasGlobals in Options;
   if Result<>'' then
     exit; // already exists
+  AliasGlobals:=coAliasGlobals in Options;
 
   Parent:=El.Parent;
   Result:=AContext.GetLocalName(Parent,AliasGlobals);
@@ -25484,7 +25473,7 @@ begin
     else
       Result:=GetBIName(pbivnModules)+'.'+Result;
 
-    if (coAliasGlobals in Options) and (Result<>'this') then
+    if coAliasGlobals in Options then
       Result:=CreateGlobalAlias(El,Result,AContext);
     end;
 end;
@@ -25752,11 +25741,8 @@ begin
     begin
     // El is from another unit
     SectionContext:=TSectionContext(AContext.GetContextOfType(TSectionContext));
-    if SectionContext.PasElement is TInterfaceSection then
-      begin
-      // check if from impl uses clause
-
-      end;
+    if SectionContext.Parent is TSectionContext then
+      SectionContext:=TSectionContext(SectionContext.Parent);
 
     FuncContext:=AContext.GetFunctionContext;
     if El is TPasModule then
@@ -25770,7 +25756,7 @@ begin
     // insert var $lmr = JSPath;
     Expr:=CreatePrimitiveDotExpr(JSPath,El);
     V:=CreateVarStatement(Result,Expr,El);
-    AddHeaderStatement(V,El,AContext);
+    AddHeaderStatement(V,El,SectionContext);
     // ToDo: check if from impl uses section and separate "var $lmr = null;" and "$lmr = JSPath";
     end;
 end;

+ 86 - 92
packages/pastojs/tests/tcgenerics.pas

@@ -256,24 +256,23 @@ begin
     '    return this;',
     '    };',
     '  }, true);',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '    });',
+    '    $impl.f = $mod.TAnt$G1.$new();',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.f.x.b = $impl.f.x.b + 10;',
     '  };',
-    '}, [], function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '  });',
-    '  $impl.f = $mod.TAnt$G1.$new();',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Record_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.TAnt$G1.$initSpec();',
@@ -1151,24 +1150,23 @@ begin
     '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
     '    };',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '    });',
+    '    $impl.f = null;',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.f.x.b = $impl.f.x.b + 10;',
     '  };',
-    '}, [], function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '  });',
-    '  $impl.f = null;',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.TAnt$G1.$initSpec();',
@@ -1363,26 +1361,25 @@ begin
     '  $mod.$rtti.$ExtClass("TAnt<UnitA.TBird>", {',
     '    jsclass: "SET"',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '      var $r = $mod.$rtti.$Record("TBird", {});',
+    '      $r.addField("b", rtl.word);',
+    '    });',
+    '    $impl.f = null;',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.f.x.b = $impl.f.x.b + 10;',
     '  };',
-    '}, [], function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '    var $r = $mod.$rtti.$Record("TBird", {});',
-    '    $r.addField("b", rtl.word);',
-    '  });',
-    '  $impl.f = null;',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     //'pas.UnitA.TAnt$G1.$initSpec();',
@@ -1560,15 +1557,14 @@ begin
     '      $impl.DoIt();',
     '    };',
     '  });',
-    '}, [], function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  $impl.DoIt = function () {',
-    '    var b = null;',
-    '    b = $mod.TBird$G2.$create("Create");',
-    '    b.Fly();',
+    '  $mod.$implcode = function () {',
+    '    $impl.DoIt = function () {',
+    '      var b = null;',
+    '      b = $mod.TBird$G2.$create("Create");',
+    '      b.Fly();',
+    '    };',
     '  };',
-    '});',
+    '}, []);',
     '']));
 end;
 
@@ -2082,28 +2078,27 @@ begin
     '  $mod.$rtti.$StaticArray("TStatic<UnitA.TBird>", {',
     '    dims: [2]',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '      var $r = $mod.$rtti.$Record("TBird", {});',
+    '      $r.addField("b", rtl.word);',
+    '    });',
+    '    $impl.d = [];',
+    '    $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.d[0].b = $impl.s[0].b;',
     '    $impl.s = $mod.TStatic$G1$clone($impl.s);',
     '  };',
-    '}, [], function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '    var $r = $mod.$rtti.$Record("TBird", {});',
-    '    $r.addField("b", rtl.word);',
-    '  });',
-    '  $impl.d = [];',
-    '  $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
@@ -2205,29 +2200,28 @@ begin
     '      this.procsig = rtl.newTIProcSig([["a", $mod.$rtti["TBird"], 2]], $mod.$rtti["TBird"]);',
     '    }',
     '  });',
+    '  $mod.$implcode = function () {',
+    '    rtl.recNewT($impl, "TBird", function () {',
+    '      this.b = 0;',
+    '      this.$eq = function (b) {',
+    '        return this.b === b.b;',
+    '      };',
+    '      this.$assign = function (s) {',
+    '        this.b = s.b;',
+    '        return this;',
+    '      };',
+    '      var $r = $mod.$rtti.$Record("TBird", {});',
+    '      $r.addField("b", rtl.word);',
+    '    });',
+    '    $impl.f = null;',
+    '    $impl.b = $impl.TBird.$new();',
+    '    $impl.p = null;',
+    '  };',
     '  $mod.$init = function () {',
     '    $impl.b.$assign($impl.f($impl.b));',
     '    $impl.p = $mod.$rtti["TAnt<UnitA.TBird>"];',
     '  };',
-    '}, [], function () {',
-    '  var $mod = this;',
-    '  var $impl = $mod.$impl;',
-    '  rtl.recNewT($impl, "TBird", function () {',
-    '    this.b = 0;',
-    '    this.$eq = function (b) {',
-    '      return this.b === b.b;',
-    '    };',
-    '    this.$assign = function (s) {',
-    '      this.b = s.b;',
-    '      return this;',
-    '    };',
-    '    var $r = $mod.$rtti.$Record("TBird", {});',
-    '    $r.addField("b", rtl.word);',
-    '  });',
-    '  $impl.f = null;',
-    '  $impl.b = $impl.TBird.$new();',
-    '  $impl.p = null;',
-    '});']));
+    '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
     'pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();',

+ 20 - 33
packages/pastojs/tests/tcmodules.pas

@@ -112,7 +112,6 @@ type
     FFilename: string;
     FFileResolver: TStreamResolver;
     FHub: TPas2JSResolverHub;
-    FJSImplementationSrc: TJSSourceElements;
     FJSImplementationUses: TJSArrayLiteral;
     FJSInitBody: TJSFunctionBody;
     FJSImplentationUses: TJSArrayLiteral;
@@ -211,7 +210,6 @@ type
     property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
     property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
     property JSInitBody: TJSFunctionBody read FJSInitBody;
-    property JSImplementationSrc: TJSSourceElements read FJSImplementationSrc;
     property ExpectedErrorClass: ExceptClass read FExpectedErrorClass write FExpectedErrorClass;
     property ExpectedErrorMsg: string read FExpectedErrorMsg write FExpectedErrorMsg;
     property ExpectedErrorNumber: integer read FExpectedErrorNumber write FExpectedErrorNumber;
@@ -1978,12 +1976,6 @@ begin
     exit;
   Arg:=JSModuleCallArgs.Elements.Elements[3];
   CheckUsesList('implementation',Arg,FJSImplentationUses);
-
-  // optional: implementation function()
-  if JSModuleCallArgs.Elements.Count<5 then
-    exit;
-  Arg:=JSModuleCallArgs.Elements.Elements[4];
-  CheckFunctionParam('module impl-function',Arg,FJSImplementationSrc);
 end;
 
 procedure TCustomTestModule.ConvertProgram;
@@ -2037,40 +2029,35 @@ var
   ActualSrc, ExpectedSrc, InitName: String;
 begin
   ActualSrc:=JSToStr(JSModuleSrc);
-  ExpectedSrc:=
-    'var $mod = this;'+LineEnding
-   +Statements;
   if coUseStrict in Converter.Options then
-    ExpectedSrc:='"use strict";'+LineEnding+ExpectedSrc;
-  if Module is TPasProgram then
-    InitName:='$main'
+    ExpectedSrc:='"use strict";'+LineEnding
   else
-    InitName:='$init';
+    ExpectedSrc:='';
+  ExpectedSrc:=ExpectedSrc+'var $mod = this;'+LineEnding;
+  ExpectedSrc:=ExpectedSrc+Statements;
+
+  // unit implementation
+  if (Trim(ImplStatements)<>'') then
+    ExpectedSrc:=ExpectedSrc+LineEnding
+      +'$mod.$implcode = function () {'+LineEnding
+      +ImplStatements
+      +'};'+LineEnding;
+
+  // program main or unit initialization
   if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
+    begin
+    if Module is TPasProgram then
+      InitName:='$main'
+    else
+      InitName:='$init';
     ExpectedSrc:=ExpectedSrc+LineEnding
       +'$mod.'+InitName+' = function () {'+LineEnding
       +InitStatements
       +'};'+LineEnding;
-  //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
-  //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
-  CheckDiff(Msg,ExpectedSrc,ActualSrc);
-
-  if (JSImplementationSrc<>nil) then
-    begin
-    ActualSrc:=JSToStr(JSImplementationSrc);
-    ExpectedSrc:=
-      'var $mod = this;'+LineEnding
-     +'var $impl = $mod.$impl;'+LineEnding
-     +ImplStatements;
-    end
-  else
-    begin
-    ActualSrc:='';
-    ExpectedSrc:=ImplStatements;
     end;
-  //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
-  //writeln('TCustomTestModule.CheckSource Expected: ',ExpectedSrc);
 
+  //writeln('TCustomTestModule.CheckSource ExpectedIntf="',ExpectedSrc,'"');
+  //writeln('TTestModule.CheckSource InitStatements="',Trim(InitStatements),'"');
   CheckDiff(Msg,ExpectedSrc,ActualSrc);
 end;
 

+ 67 - 66
packages/pastojs/tests/tcoptimizations.pas

@@ -58,7 +58,7 @@ type
   published
     // unit optimization: jsaliasglobals
     procedure TestOptAliasGlobals_Program;
-    procedure TestOptAliasGlobals_Unit; // ToDo
+    procedure TestOptAliasGlobals_Unit_FromIntfImpl_ToIntfImpl;
     // ToDo: external var, const, class
     // ToDo: RTTI
     // ToDo: typeinfo(var), typeinfo(type)
@@ -251,42 +251,39 @@ begin
   ConvertProgram;
   CheckSource('TestOptAliasGlobals_Program',
     LinesToStr([
-    'var $lmr = pas.UnitA;',
-    'var $ltr = $lmr.TBird;',
-    'var $ltr1 = $lmr.TRec;',
-    'rtl.createClass($mod, "TEagle", $ltr, function () {',
+    'var $lm = pas.UnitA;',
+    'var $lt = $lm.TBird;',
+    'var $lt1 = $lm.TRec;',
+    'rtl.createClass($mod, "TEagle", $lt, function () {',
     '  this.Run = function (w) {',
     '    var Result = 0;',
     '    return Result;',
     '  };',
     '});',
     'this.e = null;',
-    'this.r = $ltr1.$new();',
+    'this.r = $lt1.$new();',
     'this.c = {};',
     '']),
     LinesToStr([
     '$mod.e = $mod.TEagle.$create("Create");',
-    '$lmr.b = $ltr.$create("Create");',
-    '$ltr.c = $mod.e.c + 1;',
-    '$mod.r.x = $ltr.c;',
-    '$mod.r.x = $lmr.b.c;',
+    '$lm.b = $lt.$create("Create");',
+    '$lt.c = $mod.e.c + 1;',
+    '$mod.r.x = $lt.c;',
+    '$mod.r.x = $lm.b.c;',
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(4);',
-    '$mod.c = rtl.refSet($lmr.cRedBlue);',
+    '$mod.c = rtl.refSet($lm.cRedBlue);',
     '']));
 end;
 
-procedure TTestOptimizations.TestOptAliasGlobals_Unit;
+procedure TTestOptimizations.TestOptAliasGlobals_Unit_FromIntfImpl_ToIntfImpl;
 begin
   AddModuleWithIntfImplSrc('UnitA.pas',
   LinesToStr([
     'type',
     '  TBird = class',
-    '  public',
-    '    class var Span: word;',
-    '    class procedure Fly(w: word); virtual; abstract;',
-    '    class procedure Swim; static;',
+    '  public Speed: word;',
     '  end;',
     '  TRecA = record',
     '    x: word;',
@@ -294,24 +291,21 @@ begin
     'var Bird: TBird;',
     '']),
   LinesToStr([
-    'class procedure TBird.Swim; begin end;',
     '']));
   AddModuleWithIntfImplSrc('UnitB.pas',
   LinesToStr([
     'type',
     '  TAnt = class',
-    '  public',
-    '    class var Legs: word;',
-    '    class procedure Run(w: word); virtual; abstract;',
-    '    class procedure Walk; static;',
+    '  public Size: word;',
     '  end;',
     '  TRecB = record',
     '    y: word;',
     '  end;',
+    '  TBear = class',
+    '  end;',
     'var Ant: TAnt;',
     '']),
   LinesToStr([
-    'class procedure TAnt.Walk; begin end;',
     '']));
   StartUnit(true,[supTObject]);
   Add([
@@ -319,76 +313,83 @@ begin
   'interface',
   'uses unita;',
   'type',
-  '  TEagle = class(TBird)',
-  '    class var EagleRec: TRecA;',
-  '    class procedure Fly(w: word = 5); override;',
+  '  TEagle = class(TBird)', // intf-JS to intf-uses
+  '    procedure Fly;',
   '  end;',
   'implementation',
   'uses unitb;',
   'type',
-  '  TRedAnt = class(TAnt)',
-  '    class var RedAntRecA: TRecA;',
-  '    class var RedAntRecB: TRecB;',
-  '    class procedure Run(w: word = 6); override;',
+  '  TRedAnt = class(TAnt)', // impl-JS to impl-uses
+  '    procedure Run;',
   '  end;',
-  'class procedure TEagle.Fly(w: word);',
+  'procedure TEagle.Fly;',
   'begin',
+  '  TRedAnt.Create;', // intf-JS to impl-JS
+  '  TAnt.Create;', // intf-JS to impl-uses
+  '  TBird.Create;', // intf-JS to intf-uses
+  '  TEagle.Create;', // intf-JS to intf-JS
   'end;',
-  'class procedure TRedAnt.Run(w: word);',
+  'procedure TRedAnt.Run;',
   'begin',
+  '  TRedAnt.Create;', // impl-JS to impl-JS
+  '  TAnt.Create;', // impl-JS to impl-uses
+  '  TBird.Create;', // impl-JS to intf-uses
+  '  TEagle.Create;', // impl-JS to intf-JS
+  '  TBear.Create', // only in impl-JS to impl-uses
   'end;',
   'var',
-  '  Eagle: TEagle;',
   '  RedAnt: TRedAnt;',
+  '  Ant: TAnt;',
+  '  Bird: TBird;',
+  '  Eagle: TEagle;',
   'initialization',
-  '  Eagle:=TEagle.Create;',
-  '  RedAnt:=TRedAnt.Create;',
-  '  Bird:=TBird.Create;',
-  '  Ant:=TAnt.Create;',
-  '  TRedAnt.RedAntRecA.x:=TRedAnt.RedAntRecB.y;',
-  '  Ant.Walk;',
-  '  RedAnt.Walk;',
-  '  RedAnt.Run(17);',
+  '  RedAnt:=TRedAnt.Create;', // init to impl-JS
+  '  Ant:=TAnt.Create;', // init to impl-uses
+  '  Bird:=TBird.Create;', // init to intf-uses
+  '  Eagle:=TEagle.Create;', // init to intf-JS
+  '  Eagle.Fly;',
+  '  RedAnt.Run;',
   '']);
   ConvertUnit;
-  CheckSource('TestOptAliasGlobals_Unit',
+  CheckSource('TestOptAliasGlobals_Unit_FromIntfImpl_ToIntfImpl',
     LinesToStr([
     'var $impl = $mod.$impl;',
-    'var $lmr = pas.UnitA;',
-    'var $ltr = $lmr.TBird;',
-    'var $ltr1 = $lmr.TRecA;',
-    'var $lmr1 = pas.UnitB;',
-    'var $ltr2 = $lmr1.TAnt;',
-    'rtl.createClass($mod, "TEagle", $ltr, function () {',
-    '  this.EagleRec = $ltr1.$new();',
-    '  this.Fly = function (w) {',
+    'var $lm = pas.UnitA;',
+    'var $lt = $lm.TBird;',
+    'var $lm1 = pas.UnitB;',
+    'var $lt1 = $lm1.TAnt;',
+    'var $lt2 = $lm1.TBear;',
+    'rtl.createClass($mod, "TEagle", $lt, function () {',
+    '  this.Fly = function () {',
+    '    $impl.TRedAnt.$create("Create");',
+    '    $lt1.$create("Create");',
+    '    $lt.$create("Create");',
+    '    $mod.TEagle.$create("Create");',
     '  };',
     '});',
     '']),
     LinesToStr([
-    '$impl.Eagle = $mod.TEagle.$create("Create");',
     '$impl.RedAnt = $impl.TRedAnt.$create("Create");',
-    '$lmr.Bird = $ltr.$create("Create");',
-    '$lmr1.Ant = $ltr2.$create("Create");',
-    '$impl.TRedAnt.RedAntRecA.x = $impl.TRedAnt.RedAntRecB.y;',
-    '$lmr1.Ant.Walk();',
-    '$impl.RedAnt.Walk();',
-    '$impl.RedAnt.$class.Run(17);',
+    '$impl.Ant = $lt1.$create("Create");',
+    '$impl.Bird = $lt.$create("Create");',
+    '$impl.Eagle = $mod.TEagle.$create("Create");',
+    '$impl.Eagle.Fly();',
+    '$impl.RedAnt.Run();',
     '']),
     LinesToStr([
-    'var $lmr = pas.UnitB;',
-    'var $ltr = $lmr.TAnt;',
-    'var $lmr1 = pas.UnitA;',
-    'var $ltr1 = $lmr1.TRecA;',
-    'var $ltr2 = $lmr.TRecB;',
-    'rtl.createClass($impl, "TRedAnt", $ltr, function () {',
-    '  this.RedAntRecA = $ltr1.$new();',
-    '  this.RedAntRecB = $ltr2.$new();',
-    '  this.Run = function (w) {',
+    'rtl.createClass($impl, "TRedAnt", $lt1, function () {',
+    '  this.Run = function () {',
+    '    $impl.TRedAnt.$create("Create");',
+    '    $lt1.$create("Create");',
+    '    $lt.$create("Create");',
+    '    $mod.TEagle.$create("Create");',
+    '    $lt2.$create("Create");',
     '  };',
     '});',
-    '$impl.Eagle = null;',
     '$impl.RedAnt = null;',
+    '$impl.Ant = null;',
+    '$impl.Bird = null;',
+    '$impl.Eagle = null;',
     '']));
 end;
 

+ 9 - 10
utils/pas2js/dist/rtl.js

@@ -98,32 +98,31 @@ var rtl = {
   m_initializing: 4, // running initialization
   m_initialized: 5,
 
-  module: function(module_name, intfuseslist, intfcode, impluseslist, implcode){
-    if (rtl.debug_load_units) rtl.debug('rtl.module name="'+module_name+'" intfuses='+intfuseslist+' impluses='+impluseslist+' hasimplcode='+rtl.isFunction(implcode));
+  module: function(module_name, intfuseslist, intfcode, impluseslist){
+    if (rtl.debug_load_units) rtl.debug('rtl.module name="'+module_name+'" intfuses='+intfuseslist+' impluses='+impluseslist);
     if (!rtl.hasString(module_name)) rtl.error('invalid module name "'+module_name+'"');
     if (!rtl.isArray(intfuseslist)) rtl.error('invalid interface useslist of "'+module_name+'"');
     if (!rtl.isFunction(intfcode)) rtl.error('invalid interface code of "'+module_name+'"');
     if (!(impluseslist==undefined) && !rtl.isArray(impluseslist)) rtl.error('invalid implementation useslist of "'+module_name+'"');
-    if (!(implcode==undefined) && !rtl.isFunction(implcode)) rtl.error('invalid implementation code of "'+module_name+'"');
 
     if (pas[module_name])
       rtl.error('module "'+module_name+'" is already registered');
 
+    var r = Object.create(rtl.tSectionRTTI);
     var module = pas[module_name] = {
       $name: module_name,
       $intfuseslist: intfuseslist,
       $impluseslist: impluseslist,
       $state: rtl.m_loading,
       $intfcode: intfcode,
-      $implcode: implcode,
-      $impl: null,
-      $rtti: Object.create(rtl.tSectionRTTI)
+      $implcode: null,
+      $impl: impluseslist?{
+          $module: module,
+          $rtti: r
+        }:null,
+      $rtti: r
     };
     module.$rtti.$module = module;
-    if (implcode) module.$impl = {
-      $module: module,
-      $rtti: module.$rtti
-    };
   },
 
   exitcode: 0,