mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 02:07:53 +02:00
pas2js: descend pascal class from jsfunction
git-svn-id: trunk@45700 -
This commit is contained in:
Mattias Gaertner
parent
225b06e84a
commit
8d2e9b2f75
@ -28034,7 +28034,7 @@ var
|
||||
begin
|
||||
Result:=false;
|
||||
if aClass=nil then exit;
|
||||
while (aClass<>nil) and aClass.IsExternal do
|
||||
while aClass<>nil do
|
||||
begin
|
||||
if aClass.ExternalName=ExtName then exit(true);
|
||||
AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
|
||||
|
||||
@ -2990,7 +2990,7 @@ begin
|
||||
if not aClass.IsExternal then exit;
|
||||
if aClass.Parent is TPasMembersType then
|
||||
exit; // nested class
|
||||
if not IsExternalClass_Name(aClass,Data^.JSName) then exit;
|
||||
if aClass.ExternalName<>Data^.JSName then exit;
|
||||
Data^.Found:=aClass;
|
||||
Data^.ElScope:=ElScope;
|
||||
Data^.StartScope:=StartScope;
|
||||
@ -4333,12 +4333,12 @@ begin
|
||||
okClass:
|
||||
begin
|
||||
if (ClassScope.NewInstanceFunction=nil)
|
||||
and (Proc.ClassType=TPasClassFunction)
|
||||
and (ClassScope.AncestorScope<>nil)
|
||||
and (TPasClassType(ClassScope.AncestorScope.Element).IsExternal)
|
||||
and (Proc.ClassType=TPasClassFunction)
|
||||
and (Proc.Visibility in [visProtected,visPublic,visPublished])
|
||||
and (TPasClassFunction(Proc).FuncType.ResultEl.ResultType=AClassOrRec)
|
||||
and (Proc.Modifiers*[pmOverride,pmExternal]=[])
|
||||
and (Proc.Modifiers-[pmVirtual,pmAssembler]=[])
|
||||
and (Proc.ProcType.Modifiers*[ptmOfObject]=[ptmOfObject]) then
|
||||
begin
|
||||
// The first non private class function in a Pascal class descending
|
||||
@ -14374,7 +14374,7 @@ var
|
||||
AncestorPath, OwnerName, DestructorName, FnName, IntfKind: String;
|
||||
C: TClass;
|
||||
AssignSt: TJSSimpleAssignStatement;
|
||||
NeedInitFunction, HasConstructor: Boolean;
|
||||
NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt: Boolean;
|
||||
Proc: TPasProcedure;
|
||||
aResolver: TPas2JSResolver;
|
||||
begin
|
||||
@ -14419,11 +14419,17 @@ begin
|
||||
Call:=CreateCallExpression(El);
|
||||
try
|
||||
AncestorIsExternal:=(Ancestor is TPasClassType) and TPasClassType(Ancestor).IsExternal;
|
||||
IsJSFunction:=aResolver.IsExternalClass_Name(El,'Function');
|
||||
|
||||
NeedClassExt:=AncestorIsExternal or IsJSFunction;
|
||||
if NeedClassExt and (El.ObjKind<>okClass) then
|
||||
RaiseNotSupported(El,AContext,20200627083750);
|
||||
|
||||
if El.ObjKind=okInterface then
|
||||
FnName:=GetBIName(pbifnIntfCreate)
|
||||
else if El.ObjKind in okAllHelpers then
|
||||
FnName:=GetBIName(pbifnCreateHelper)
|
||||
else if AncestorIsExternal then
|
||||
else if NeedClassExt then
|
||||
FnName:=GetBIName(pbifnCreateClassExt)
|
||||
else
|
||||
FnName:=GetBIName(pbifnCreateClass);
|
||||
@ -14462,7 +14468,7 @@ begin
|
||||
AncestorPath:=CreateReferencePath(Ancestor,AContext,rpkPathAndName);
|
||||
Call.AddArg(CreatePrimitiveDotExpr(AncestorPath,El));
|
||||
|
||||
if AncestorIsExternal and (El.ObjKind=okClass) then
|
||||
if NeedClassExt then
|
||||
begin
|
||||
// add the name of the NewInstance function
|
||||
if Scope.NewInstanceFunction<>nil then
|
||||
|
||||
@ -609,6 +609,7 @@ type
|
||||
Procedure TestExternalClass_NewInstance_NonVirtualFail;
|
||||
Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail;
|
||||
Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail;
|
||||
Procedure TestExternalClass_JSFunctionPasDescendant;
|
||||
Procedure TestExternalClass_PascalProperty;
|
||||
Procedure TestExternalClass_TypeCastToRootClass;
|
||||
Procedure TestExternalClass_TypeCastToJSObject;
|
||||
@ -17481,6 +17482,77 @@ begin
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_JSFunctionPasDescendant;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch externalclass}',
|
||||
'type',
|
||||
' TJSFunction = class external name ''Function''',
|
||||
' end;',
|
||||
' TExtA = class external name ''ExtA''(TJSFunction)',
|
||||
' end;',
|
||||
' TBird = class (TExtA)',
|
||||
' public',
|
||||
' Size: word;',
|
||||
' class var Legs: word;',
|
||||
' constructor Create(a: word);',
|
||||
' end;',
|
||||
' TEagle = class (TBird)',
|
||||
' public',
|
||||
' constructor Create(b: word); reintroduce;',
|
||||
' end;',
|
||||
'constructor TBird.Create(a: word);',
|
||||
'begin',
|
||||
'end;',
|
||||
'constructor TEagle.Create(b: word);',
|
||||
'begin',
|
||||
' inherited Create(b);',
|
||||
'end;',
|
||||
'var',
|
||||
' Bird: TBird;',
|
||||
' Eagle: TEagle;',
|
||||
'begin',
|
||||
' Bird:=TBird.Create(3);',
|
||||
' Eagle:=TEagle.Create(4);',
|
||||
' Bird.Size:=Bird.Size+5;',
|
||||
' Bird.Legs:=Bird.Legs+6;',
|
||||
' Eagle.Size:=Eagle.Size+5;',
|
||||
' Eagle.Legs:=Eagle.Legs+6;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_JSFunctionPasDescendant',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClassExt($mod, "TBird", ExtA, "", function () {',
|
||||
' this.Legs = 0;',
|
||||
' this.$init = function () {',
|
||||
' this.Size = 0;',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.Create = function (a) {',
|
||||
' return this;',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClassExt($mod, "TEagle", $mod.TBird, "", function () {',
|
||||
' this.Create$1 = function (b) {',
|
||||
' $mod.TBird.Create.call(this, b);',
|
||||
' return this;',
|
||||
' };',
|
||||
'});',
|
||||
'this.Bird = null;',
|
||||
'this.Eagle = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.Bird = $mod.TBird.$create("Create", [3]);',
|
||||
'$mod.Eagle = $mod.TEagle.$create("Create$1", [4]);',
|
||||
'$mod.Bird.Size = $mod.Bird.Size + 5;',
|
||||
'$mod.TBird.Legs = $mod.Bird.Legs + 6;',
|
||||
'$mod.Eagle.Size = $mod.Eagle.Size + 5;',
|
||||
'$mod.TBird.Legs = $mod.Eagle.Legs + 6;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_PascalProperty;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
38
utils/pas2js/dist/rtl.js
vendored
38
utils/pas2js/dist/rtl.js
vendored
@ -347,34 +347,41 @@ var rtl = {
|
||||
// Create a class using an external ancestor.
|
||||
// If newinstancefnname is given, use that function to create the new object.
|
||||
// If exist call BeforeDestruction and AfterConstruction.
|
||||
var c = Object.create(ancestor);
|
||||
var isFunc = rtl.isFunction(ancestor);
|
||||
var c = null;
|
||||
if (isFunc){
|
||||
// create pascal class descendent from JS function
|
||||
c = Object.create(ancestor.prototype);
|
||||
} else if (ancestor.$func){
|
||||
// create pascal class descendent from a pascal class descendent of a JS function
|
||||
isFunc = true;
|
||||
c = Object.create(ancestor);
|
||||
c.$ancestor = ancestor;
|
||||
} else {
|
||||
c = Object.create(ancestor);
|
||||
}
|
||||
c.$create = function(fn,args){
|
||||
if (args == undefined) args = [];
|
||||
var o = null;
|
||||
if (newinstancefnname.length>0){
|
||||
o = this[newinstancefnname](fn,args);
|
||||
if (!o.$class){
|
||||
o.$class = this;
|
||||
o.$classname = this.$classname;
|
||||
o.$name = this.$name;
|
||||
o.$fullname = this.$fullname;
|
||||
o.$ancestor = this.$ancestor;
|
||||
}
|
||||
} else if(isFunc) {
|
||||
o = new c.$func(args);
|
||||
} else {
|
||||
o = Object.create(this);
|
||||
o = Object.create(c);
|
||||
}
|
||||
if (this.$init) this.$init.call(o);
|
||||
if (o.$init) o.$init();
|
||||
try{
|
||||
if (typeof(fn)==="string"){
|
||||
this[fn].apply(o,args);
|
||||
} else {
|
||||
fn.apply(o,args);
|
||||
};
|
||||
if (this.AfterConstruction) this.call.AfterConstruction(o);
|
||||
if (o.AfterConstruction) o.AfterConstruction();
|
||||
} catch($e){
|
||||
// do not call BeforeDestruction
|
||||
if (this.Destroy) this.Destroy.call(o);
|
||||
if (this.$final) this.$final.call(o);
|
||||
if (o.Destroy) o.Destroy();
|
||||
if (o.$final) o.$final();
|
||||
throw $e;
|
||||
}
|
||||
return o;
|
||||
@ -385,6 +392,11 @@ var rtl = {
|
||||
if (this.$final) this.$final();
|
||||
};
|
||||
rtl.initClass(c,parent,name,initfn);
|
||||
if (isFunc){
|
||||
function f(){}
|
||||
f.prototype = c;
|
||||
c.$func = f;
|
||||
}
|
||||
},
|
||||
|
||||
createHelper: function(parent,name,ancestor,initfn){
|
||||
|
||||
Loading…
Reference in New Issue
Block a user