paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 23:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: check name of external class constructor

Browse Source 
git-svn-id: trunk@40882 -
This commit is contained in:
Mattias Gaertner 2019-01-16 21:31:43 +00:00
parent ccdc0ce767
commit 73ebd10999
2 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -487,7 +487,7 @@ const
nVirtualMethodNameMustMatchExternal = 4013;
nPublishedNameMustMatchExternal = 4014;
nInvalidVariableModifier = 4015;
nNoArgumentsAllowedForExternalObjectConstructor = 4016;
nExternalObjectConstructorMustBeNamedNew = 4016;
nNewInstanceFunctionMustBeVirtual = 4017;
nNewInstanceFunctionMustHaveTwoParameters = 4018;
nNewInstanceFunctionMustNotHaveOverloadAtX = 4019;
@ -515,7 +515,7 @@ resourcestring
sVirtualMethodNameMustMatchExternal = 'Virtual method name must match external';
sInvalidVariableModifier = 'Invalid variable modifier "%s"';
sPublishedNameMustMatchExternal = 'Published name must match external';
sNoArgumentsAllowedForExternalObjectConstructor = 'no arguments allowed for external object constructor';
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';
@ -3728,12 +3728,9 @@ begin
RaiseMsg(20170323083511,nVirtualMethodNameMustMatchExternal,
sVirtualMethodNameMustMatchExternal,[],Proc.LibrarySymbolName);
end
else if El.Args.Count>0 then
RaiseMsg(20170322164357,nNoArgumentsAllowedForExternalObjectConstructor,
sNoArgumentsAllowedForExternalObjectConstructor,[],TPasArgument(El.Args[0]));
if pmVirtual in Proc.Modifiers then
RaiseMsg(20170322183141,nInvalidXModifierY,sInvalidXModifierY,
[Proc.ElementTypeName,'virtual'],Proc.ProcType);
else
RaiseMsg(20190116211019,nExternalObjectConstructorMustBeNamedNew,
sExternalObjectConstructorMustBeNamedNew,[],El);
end
else
RaiseMsg(20170322163210,nPasElementNotSupported,sPasElementNotSupported,
@ -9259,7 +9256,6 @@ var
Proc: TPasConstructor;
ExtName: String;
NewExpr: TJSNewMemberExpression;
Call: TJSCallExpression;
LeftResolved: TPasResolverResult;
OldAccess: TCtxAccess;
ExtNameEl: TJSElement;
@ -9267,7 +9263,6 @@ var
begin
Result:=nil;
NewExpr:=nil;
Call:=nil;
ExtNameEl:=nil;
try
Proc:=Ref.Declaration as TPasConstructor;
@ -9313,7 +9308,7 @@ begin
if CompareText(Proc.Name,'new')=0 then
begin
// create 'new ExtName(params)'
// create "new ExtName(params)"
NewExpr:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,Ref.Element));
NewExpr.MExpr:=ExtNameEl;
NewExpr.Args:=TJSArguments(CreateElement(TJSArguments,Ref.Element));
@ -9324,11 +9319,10 @@ begin
NewExpr:=nil;
end
else
RaiseInconsistency(20170323083214,Proc);
RaiseNotSupported(Ref.Element,AContext,20190116210204);
finally
ExtNameEl.Free;
NewExpr.Free;
Call.Free;
end;
end;

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

@ -15012,6 +15012,7 @@ begin
Add('type');
Add(' TExtAClass = class of TExtA;');
Add(' TExtA = class external name ''ExtA''');
Add(' C: TExtAClass;');
Add(' constructor New;');
Add(' end;');
Add('var');
@ -15026,6 +15027,7 @@ begin
Add(' end;');
Add(' a:=test1.c.new;');
Add(' a:=test1.c.new();');
Add(' a:=A.c.new();');
ConvertProgram;
CheckSource('TestExternalClass_ClassOf_New',
LinesToStr([ // statements
@ -15040,6 +15042,7 @@ begin
'$mod.A = new $with1();',
'$mod.A = new $mod.C();',
'$mod.A = new $mod.C();',
'$mod.A = new $mod.A.C();',
'']));
end;
@ -15698,6 +15701,8 @@ begin
' v:=GetItems(14);',
' setitems(15,16);',
' end;',
' v:=test1.arr.items[17];',
' test1.arr.items[18]:=v;',
'']);
ConvertProgram;
CheckSource('TestExternalClass_BracketAccessor',
@ -15741,6 +15746,8 @@ begin
'var $with2 = $mod.Arr;',
'$mod.v = $with2[14];',
'$with2[15] = 16;',
'$mod.v = $mod.Arr[17];',
'$mod.Arr[18] = $mod.v;',
'']));
end;