pastojs: check name of external class constructor

git-svn-id: trunk@40882 -

packages/pastojs/src/fppas2js.pp

@@ -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;
 

packages/pastojs/tests/tcmodules.pas

@@ -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;