mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:09:31 +02:00
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
parent
277d98431c
commit
02c72dd5c4
@ -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;
|
||||
|
||||
@ -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();',
|
||||
|
||||
@ -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,41 +2029,36 @@ 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;
|
||||
end;
|
||||
|
||||
//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);
|
||||
|
||||
CheckDiff(Msg,ExpectedSrc,ActualSrc);
|
||||
end;
|
||||
|
||||
procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string);
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
19
utils/pas2js/dist/rtl.js
vendored
19
utils/pas2js/dist/rtl.js
vendored
@ -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,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user