paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: constructor of external class: funcname and {}

Browse Source 
git-svn-id: trunk@43166 -
This commit is contained in:
Mattias Gaertner 2019-10-11 10:25:24 +00:00
parent 1bed61195e
commit 8d60f4542c
3 changed files with 187 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
packages/pastojs/src/fppas2js.pp
View File

@ -228,6 +228,8 @@ Works:
- destructor forbidden
- constructor must not be virtual
- constructor 'new' -> new extclass(params)
- constructor Name -> new extclass.name(params)
- constructor Name external name '{}' -> {}
- identifiers are renamed to avoid clashes with external names
- call inherited
- Pascal descendant can override newinstance
@ -508,7 +510,7 @@ const
nVirtualMethodNameMustMatchExternal = 4013;
nPublishedNameMustMatchExternal = 4014;
nInvalidVariableModifier = 4015;
nExternalObjectConstructorMustBeNamedNew = 4016;
// was nExternalObjectConstructorMustBeNamedNew = 4016;
nNewInstanceFunctionMustBeVirtual = 4017;
nNewInstanceFunctionMustHaveTwoParameters = 4018;
nNewInstanceFunctionMustNotHaveOverloadAtX = 4019;
@ -540,7 +542,7 @@ resourcestring
sVirtualMethodNameMustMatchExternal = 'Virtual method name must match external';
sInvalidVariableModifier = 'Invalid variable modifier "%s"';
sPublishedNameMustMatchExternal = 'Published name must match external';
sExternalObjectConstructorMustBeNamedNew = 'external object constructor must be named "new"';
// was sExternalObjectConstructorMustBeNamedNew = 'external object constructor must be named "new"';
sNewInstanceFunctionMustBeVirtual = 'NewInstance function must be virtual';
sNewInstanceFunctionMustHaveTwoParameters = 'NewInstance function must have two parameters';
sNewInstanceFunctionMustNotHaveOverloadAtX = 'NewInstance function must not have overload at %s';
@ -4073,16 +4075,13 @@ begin
// constructor of external class can't be overriden -> forbid virtual
RaiseMsg(20170323100447,nInvalidXModifierY,sInvalidXModifierY,
[Proc.ElementTypeName,'virtual,external'],Proc);
ExtName:=ComputeConstString(Proc.LibrarySymbolName,true,true);
if CompareText(Proc.Name,'new')=0 then
begin
ExtName:=ComputeConstString(Proc.LibrarySymbolName,true,true);
if ExtName<>Proc.Name then
RaiseMsg(20170323083511,nVirtualMethodNameMustMatchExternal,
sVirtualMethodNameMustMatchExternal,[],Proc.LibrarySymbolName);
end
else
RaiseMsg(20190116211019,nExternalObjectConstructorMustBeNamedNew,
sExternalObjectConstructorMustBeNamedNew,[],El);
end;
end
else
RaiseMsg(20170322163210,nPasElementNotSupported,sPasElementNotSupported,
@ -10371,68 +10370,83 @@ var
OldAccess: TCtxAccess;
ExtNameEl: TJSElement;
WithData: TPas2JSWithExprScope;
PosEl: TPasElement;
aResolver: TPas2JSResolver;
begin
Result:=nil;
aResolver:=AContext.Resolver;
NewExpr:=nil;
ExtNameEl:=nil;
try
Proc:=Ref.Declaration as TPasConstructor;
ExtNameEl:=nil;
if Left<>nil then
begin
if AContext.Resolver<>nil then
begin
AContext.Resolver.ComputeElement(Left,LeftResolved,[]);
if LeftResolved.BaseType=btModule then
begin
// e.g. Unit.TExtA
// ExtName is global -> omit unit
Left:=nil;
end
else ;
end;
if Left<>nil then
begin
// convert left side
OldAccess:=AContext.Access;
AContext.Access:=caRead;
ExtNameEl:=ConvertExpression(Left,AContext);
AContext.Access:=OldAccess;
end;
end;
if ExtNameEl=nil then
begin
if Ref.WithExprScope<>nil then
begin
// using local WITH var
WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
ExtName:=WithData.WithVarName;
if ExtName='' then
RaiseNotSupported(ParamsExpr,AContext,20190209092049);
end
else
// use external class name
ExtName:=(Proc.Parent as TPasClassType).ExternalName;
if ExtName='' then
DoError(20180511163944,nJSNewNotSupported,sJSNewNotSupported,[],ParamsExpr);
ExtNameEl:=CreatePrimitiveDotExpr(ExtName,Ref.Element);
end;
PosEl:=Ref.Element;
if CompareText(Proc.Name,'new')=0 then
begin
// create "new ExtName(params)"
NewExpr:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,Ref.Element));
NewExpr.MExpr:=ExtNameEl;
NewExpr.Args:=TJSArguments(CreateElement(TJSArguments,Ref.Element));
ExtNameEl:=nil;
if ParamsExpr<>nil then
CreateProcedureCallArgs(NewExpr.Args.Elements,ParamsExpr,Proc.ProcType,AContext);
Result:=NewExpr;
NewExpr:=nil;
if Left<>nil then
begin
if aResolver<>nil then
begin
aResolver.ComputeElement(Left,LeftResolved,[]);
if LeftResolved.BaseType=btModule then
begin
// e.g. Unit.TExtA
// ExtName is global -> omit unit
Left:=nil;
end
else ;
end;
if Left<>nil then
begin
// convert left side
OldAccess:=AContext.Access;
AContext.Access:=caRead;
ExtNameEl:=ConvertExpression(Left,AContext);
AContext.Access:=OldAccess;
end;
end;
if ExtNameEl=nil then
begin
if Ref.WithExprScope<>nil then
begin
// using local WITH var
WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
ExtName:=WithData.WithVarName;
if ExtName='' then
RaiseNotSupported(ParamsExpr,AContext,20190209092049);
end
else
// use external class name
ExtName:=(Proc.Parent as TPasClassType).ExternalName;
if ExtName='' then
DoError(20180511163944,nJSNewNotSupported,sJSNewNotSupported,[],ParamsExpr);
ExtNameEl:=CreatePrimitiveDotExpr(ExtName,PosEl);
end;
end
else
RaiseNotSupported(Ref.Element,AContext,20190116210204);
begin
// external constructor ProcName
ExtName:='';
if aResolver<>nil then
ExtName:=aResolver.ComputeConstString(Proc.LibrarySymbolName,true,true);
if ExtName='{}' then
begin
// external constructor {} -> "{}"
Result:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,PosEl));
exit;
end;
// external constructor ProcName -> "new ExtA.ProcName()"
ExtNameEl:=CreateReferencePathExpr(Proc,AContext,true);
end;
NewExpr:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,PosEl));
NewExpr.MExpr:=ExtNameEl;
ExtNameEl:=nil;
NewExpr.Args:=TJSArguments(CreateElement(TJSArguments,PosEl));
if ParamsExpr<>nil then
CreateProcedureCallArgs(NewExpr.Args.Elements,ParamsExpr,Proc.ProcType,AContext);
Result:=NewExpr;
NewExpr:=nil;
finally
ExtNameEl.Free;
NewExpr.Free;

129
packages/pastojs/tests/tcmodules.pas
View File

@ -588,6 +588,8 @@ type
Procedure TestExternalClass_FuncClassOf_New;
Procedure TestExternalClass_New_PasClassFail;
Procedure TestExternalClass_New_PasClassBracketsFail;
Procedure TestExternalClass_Constructor;
Procedure TestExternalClass_ConstructorBrackets;
Procedure TestExternalClass_LocalConstSameName;
Procedure TestExternalClass_ReintroduceOverload;
Procedure TestExternalClass_Inherited;
@ -16369,27 +16371,29 @@ end;
procedure TTestModule.TestExternalClass_New;
begin
StartProgram(false);
Add('{$modeswitch externalclass}');
Add('type');
Add(' TExtA = class external name ''ExtA''');
Add(' constructor New;');
Add(' constructor New(i: longint; j: longint = 2);');
Add(' end;');
Add('var');
Add(' A: texta;');
Add('begin');
Add(' a:=texta.new;');
Add(' a:=texta(texta.new);');
Add(' a:=texta.new();');
Add(' a:=texta.new(1);');
Add(' with texta do begin');
Add(' a:=new;');
Add(' a:=new();');
Add(' a:=new(2);');
Add(' end;');
Add(' a:=test1.texta.new;');
Add(' a:=test1.texta.new();');
Add(' a:=test1.texta.new(3);');
Add([
'{$modeswitch externalclass}',
'type',
' TExtA = class external name ''ExtA''',
' constructor New;',
' constructor New(i: longint; j: longint = 2);',
' end;',
'var',
' A: texta;',
'begin',
' a:=texta.new;',
' a:=texta(texta.new);',
' a:=texta.new();',
' a:=texta.new(1);',
' with texta do begin',
' a:=new;',
' a:=new();',
' a:=new(2);',
' end;',
' a:=test1.texta.new;',
' a:=test1.texta.new();',
' a:=test1.texta.new(3);',
'']);
ConvertProgram;
CheckSource('TestExternalClass_New',
LinesToStr([ // statements
@ -16532,6 +16536,89 @@ begin
ConvertProgram;
end;
procedure TTestModule.TestExternalClass_Constructor;
begin
StartProgram(false);
Add([
'{$modeswitch externalclass}',
'type',
' TExtA = class external name ''ExtA''',
' constructor Create;',
' constructor Create(i: longint; j: longint = 2);',
' end;',
'var',
' A: texta;',
'begin',
' a:=texta.create;',
' a:=texta(texta.create);',
' a:=texta.create();',
' a:=texta.create(1);',
' with texta do begin',
' a:=create;',
' a:=create();',
' a:=create(2);',
' end;',
' a:=test1.texta.create;',
' a:=test1.texta.create();',
' a:=test1.texta.create(3);',
'']);
ConvertProgram;
CheckSource('TestExternalClass_Constructor',
LinesToStr([ // statements
'this.A = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.A = new ExtA.Create();',
'$mod.A = new ExtA.Create();',
'$mod.A = new ExtA.Create();',
'$mod.A = new ExtA.Create(1,2);',
'$mod.A = new ExtA.Create();',
'$mod.A = new ExtA.Create();',
'$mod.A = new ExtA.Create(2,2);',
'$mod.A = new ExtA.Create();',
'$mod.A = new ExtA.Create();',
'$mod.A = new ExtA.Create(3,2);',
'']));
end;
procedure TTestModule.TestExternalClass_ConstructorBrackets;
begin
StartProgram(false);
Add([
'{$modeswitch externalclass}',
'type',
' TExtA = class external name ''ExtA''',
' constructor Create; external name ''{}'';',
' end;',
'var',
' A: texta;',
'begin',
' a:=texta.create;',
' a:=texta(texta.create);',
' a:=texta.create();',
' with texta do begin',
' a:=create;',
' a:=create();',
' end;',
' a:=test1.texta.create;',
' a:=test1.texta.create();',
'']);
ConvertProgram;
CheckSource('TestExternalClass_ConstructorBrackets',
LinesToStr([ // statements
'this.A = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.A = {};',
'$mod.A = {};',
'$mod.A = {};',
'$mod.A = {};',
'$mod.A = {};',
'$mod.A = {};',
'$mod.A = {};',
'']));
end;
procedure TTestModule.TestExternalClass_LocalConstSameName;
begin
StartProgram(false);

10
utils/pas2js/docs/translation.html
View File

@ -2691,10 +2691,14 @@ function(){
An external class is not a TObject and has none of its methods.<br>
All members are external. If you omit the <i>external</i> modifier the
external name is the member name. Keep in mind that JS is case sensitive.<br>
Destructors are not allowed.<br>
Constructors are only allowed with the name <i>New</i> and a call
translates to <i>new ExtClass(params)</i>.
Properties work the same as with Pascal classes, i.e. are replaced by Getter/Setter.<br>
Destructors are not allowed.<br>
Constructors are supported in three ways:
<ul>
<li>With name <i>New</i> it is translated to <i>new ExtClass(params)</i>.</li>
<li>With external name <i>'{}'</i> it is translated to <i>{}</i>.</li>
<li>Otherwise it is translated to <i>new ExtClass.FuncName(params)</i>.</li>
</ul>
<table class="sample">
<tbody>