pas2js: Pascal descendent from JS function: inherited calls ancestor function

git-svn-id: trunk@45708 -

packages/fcl-json/src/fpjson.pp

@@ -1048,7 +1048,7 @@ begin
     TJSONData.DoError(SErrNoParserHandler)
   else
     begin
-    Setlength(S,JSON.Size);
+    Setlength(S{%H-},JSON.Size);
     if Length(S)>0 then
       JSON.ReadBuffer(S[1],Length(S));
     end;

packages/fcl-passrc/src/pasresolver.pp

@@ -15919,7 +15919,7 @@ begin
 
   IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
   try
-    SetLength(InferenceTypes,TemplTypes.Count);
+    SetLength(InferenceTypes{%H-},TemplTypes.Count);
     for i:=0 to TemplTypes.Count-1 do
       InferenceTypes[i]:=Default(TInferredType);
 
@@ -28223,7 +28223,7 @@ begin
       ['type with '+IntToStr(Params.Count)+' generic template(s)',
        GenericEl.Name+GetGenericParamCommas(GenericTemplateList.Count)],El);
 
-  SetLength(ParamsResolved,Params.Count);
+  SetLength(ParamsResolved{%H-},Params.Count);
   IsSelf:=true;
   for i:=0 to Params.Count-1 do
     begin

packages/pastojs/src/fppas2js.pp

@@ -563,6 +563,7 @@ type
     pbifnBitwiseNativeIntXor,
     pbifnCheckMethodCall,
     pbifnCheckVersion,
+    pbifnClassAncestorFunc,
     pbifnClassInstanceFree,
     pbifnClassInstanceNew,
     pbifnCreateClass,
@@ -742,6 +743,7 @@ const
     'xor', // pbifnBitwiseNativeIntXor,
     'checkMethodCall', // pbifnCheckMethodCall
     'checkVersion', // pbifnCheckVersion
+    '$func', // pbifnClassAncestorFunc
     '$destroy', // pbifnClassInstanceFree
     '$create', // pbifnClassInstanceNew
     'createClass', // pbifnCreateClass   rtl.createClass
@@ -9691,36 +9693,48 @@ function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr;
       DoError(20170418204325,nNestedInheritedNeedsParameters,sNestedInheritedNeedsParameters,
         [],El);
 
-    if (AncestorProc.Parent is TPasClassType)
-        and TPasClassType(AncestorProc.Parent).IsExternal then
-      begin
-      // ancestor is in an external class
-      // They could be overriden, without a Pascal declaration
-      // -> use the direct ancestor class of the current proc
-      aClass:=SelfContext.ThisPas as TPasClassType;
-      if aClass.CustomData=nil then
-        RaiseInconsistency(20170323111252,aClass);
-      ClassScope:=TPasClassScope(aClass.CustomData);
-      AncestorScope:=ClassScope.AncestorScope;
-      if AncestorScope=nil then
-        RaiseInconsistency(20170323111306,aClass);
-      AncestorClass:=AncestorScope.Element as TPasClassType;
-      FunName:=CreateReferencePath(AncestorClass,AContext,rpkPathAndName,true)
-        +'.'+TransformVariableName(AncestorProc,AContext);
-      end
-    else
-      FunName:=CreateReferencePath(AncestorProc,AContext,rpkPathAndName,true);
-    if AncestorProc.ProcType.Args.Count=0 then
-      Apply:=false;
-    if Apply and (SelfContext=AContext) then
-      // create "ancestor.funcname.apply(this,arguments)"
-      FunName:=FunName+'.apply'
-    else
-      // create "ancestor.funcname.call(this,param1,param2,...)"
-      FunName:=FunName+'.call';
     Call:=nil;
     try
       Call:=CreateCallExpression(ParentEl);
+      if (AncestorProc.Parent is TPasClassType)
+          and TPasClassType(AncestorProc.Parent).IsExternal then
+        begin
+        // ancestor is in an external class
+        // They could be overriden, without a Pascal declaration
+        // -> use the direct ancestor class of the current proc
+        aClass:=SelfContext.ThisPas as TPasClassType;
+        if aClass.CustomData=nil then
+          RaiseInconsistency(20170323111252,aClass);
+        ClassScope:=TPasClassScope(aClass.CustomData);
+        AncestorScope:=ClassScope.AncestorScope;
+        if AncestorScope=nil then
+          RaiseInconsistency(20170323111306,aClass);
+        AncestorClass:=AncestorScope.Element as TPasClassType;
+        if (AncestorProc.ClassType=TPasConstructor) and SameText(AncestorProc.Name,'new')
+            and AContext.Resolver.IsExternalClass_Name(TPasClassType(AncestorProc.Parent),'Function') then
+          begin
+          // calling ancestor new constructor
+          // this.$func(param1,param2,...)
+          FunName:='this.'+GetBIName(pbifnClassAncestorFunc);
+          Call.Expr:=CreatePrimitiveDotExpr(FunName,ParentEl);
+          CreateProcedureCall(Call,ParamsExpr,AncestorProc.ProcType,AContext);
+          Result:=Call;
+          exit;
+          end
+        else
+          FunName:=CreateReferencePath(AncestorClass,AContext,rpkPathAndName,true)
+            +'.'+TransformVariableName(AncestorProc,AContext);
+        end
+      else
+        FunName:=CreateReferencePath(AncestorProc,AContext,rpkPathAndName,true);
+      if AncestorProc.ProcType.Args.Count=0 then
+        Apply:=false;
+      if Apply and (SelfContext=AContext) then
+        // create "ancestor.funcname.apply(this,arguments)"
+        FunName:=FunName+'.apply'
+      else
+        // create "ancestor.funcname.call(this,param1,param2,...)"
+        FunName:=FunName+'.call';
       Call.Expr:=CreatePrimitiveDotExpr(FunName,ParentEl);
       Call.AddArg(CreatePrimitiveDotExpr(SelfName,ParentEl));
       if Apply then

packages/pastojs/tests/tcmodules.pas

@@ -17491,6 +17491,7 @@ begin
   '  TJSFunction = class external name ''Function''',
   '  end;',
   '  TExtA = class external name ''ExtA''(TJSFunction)',
+  '    constructor New(w: word);',
   '  end;',
   '  TBird = class (TExtA)',
   '  public',
@@ -17504,6 +17505,8 @@ begin
   '  end;',
   'constructor TBird.Create(a: word);',
   'begin',
+  '  inherited;',  // silently ignored
+  '  inherited New(a);', // this.$func(a)
   'end;',
   'constructor TEagle.Create(b: word);',
   'begin',
@@ -17531,6 +17534,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function (a) {',
+    '    this.$func(a);',
     '    return this;',
     '  };',
     '});',