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

git-svn-id: trunk@46816 -
This commit is contained in:
Mattias Gaertner 2020-09-09 19:56:43 +00:00
parent 277d98431c
commit 02c72dd5c4
5 changed files with 233 additions and 266 deletions

View File

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

View File

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

View File

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

View File

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

View File

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