# revisions: 45709,45714,45715,45716,45742,45830,45861,45862,45863,45962,45963,45964,45965,45966,46272,46273,46287,

git-svn-id: branches/fixes_3_2@46826 -

.gitattributes

@@ -3520,6 +3520,7 @@ packages/fcl-js/examples/fpjsmin.pp svneol=native#text/plain
 packages/fcl-js/examples/srcmapdump.lpi svneol=native#text/plain
 packages/fcl-js/examples/srcmapdump.lpr svneol=native#text/plain
 packages/fcl-js/fpmake.pp svneol=native#text/plain
+packages/fcl-js/src/fcl-js.inc svneol=native#text/plain
 packages/fcl-js/src/jsbase.pp svneol=native#text/plain
 packages/fcl-js/src/jsminifier.pp svneol=native#text/plain
 packages/fcl-js/src/jsparser.pp svneol=native#text/plain
@@ -3623,6 +3624,7 @@ packages/fcl-passrc/examples/pasrewrite.pp svneol=native#text/plain
 packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain
+packages/fcl-passrc/src/fcl-passrc.inc svneol=native#text/plain
 packages/fcl-passrc/src/pasresolveeval.pas svneol=native#text/plain
 packages/fcl-passrc/src/pasresolver.pp svneol=native#text/plain
 packages/fcl-passrc/src/passrcutil.pp svneol=native#text/plain
@@ -8111,6 +8113,7 @@ packages/pastojs/src/pas2jsresources.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsresstrfile.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
+packages/pastojs/src/pastojs.inc svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain
 packages/pastojs/tests/tcgenerics.pas svneol=native#text/plain

packages/fcl-js/src/fcl-js.inc

@@ -0,0 +1,9 @@
+{$mode objfpc}{$H+}
+{$if defined(fpc) or defined(NodeJS)}
+  {$define HasFileWriter}
+{$endif}
+
+{$IF FPC_FULLVERSION>30100}
+  {$warn 6058 off} // cannot inline
+{$ENDIF}
+

packages/fcl-js/src/jswriter.pp

@@ -14,13 +14,9 @@
   **********************************************************************}
 unit jswriter;
 
-{$mode objfpc}{$H+}
-{ $DEFINE DEBUGJSWRITER}
-{AllowWriteln}
+{$i fcl-js.inc}
 
-{$if defined(fpc) or defined(NodeJS)}
-  {$define HasFileWriter}
-{$endif}
+{ $DEFINE DEBUGJSWRITER}
 
 interface
 

packages/fcl-passrc/src/fcl-passrc.inc

@@ -0,0 +1,23 @@
+{$mode objfpc}{$H+}
+{$inline on}
+
+{$ifdef fpc}
+  {$define UsePChar}
+  {$define HasInt64}
+  {$define UsePChar}
+  {$define UseAnsiStrings}
+  {$define HasStreams}
+  {$IF FPC_FULLVERSION<30101}
+    {$define EmulateArrayInsert}
+  {$endif}
+  {$define HasFS}
+{$endif}
+
+{$IFDEF NODEJS}
+  {$define HasFS}
+{$ENDIF}
+
+{$IF FPC_FULLVERSION>30100}
+  {$warn 6058 off} // cannot inline
+{$ENDIF}
+

packages/fcl-passrc/src/pasresolver.pp

@@ -306,13 +306,7 @@ Notes:
 }
 unit PasResolver;
 
-{$mode objfpc}{$H+}
-{$inline on}
-
-{$ifdef fpc}
-  {$define UsePChar}
-  {$define HasInt64}
-{$endif}
+{$i fcl-passrc.inc}
 
 {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
 {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
@@ -1280,6 +1274,7 @@ type
   TPRResolveVarAccesses = set of TResolvedRefAccess;
 
 const
+  rraAllRead = [rraRead,rraReadAndAssign,rraVarParam];
   rraAllWrite = [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam];
 
   ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (
@@ -11030,14 +11025,15 @@ begin
       ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
       if not (Value.CustomData is TResolvedReference) then
         RaiseNotYetImplemented(20190115144534,Params);
-      // already resolved
+      // already resolved via ResolveNameExpr, which calls ResolveArrayParamsExprName
       exit;
       end
     else
       begin
-      // ToDo: (a+b)[]
-      //ResolveBinaryExpr(TBinaryExpr(Params.Value),rraRead);
-      RaiseNotYetImplemented(20190115144539,Params);
+      // For example (a+b)[]  or (a as b)[]
+      Value:=Params.Value;
+      ResolveBinaryExpr(TBinaryExpr(Value),rraRead);
+      ComputeElement(Value,ResolvedEl,[rcSetReferenceFlags]);
       end;
     end
   else
@@ -16397,8 +16393,19 @@ var
   procedure InsertBehind(List: TFPList);
   var
     Last: TPasElement;
-    i: Integer;
+    i, LastIndex: Integer;
+    GenScope: TPasGenericScope;
+    ProcScope: TPasProcedureScope;
   begin
+    // insert in front of currently parsed elements
+    // beware: specializing an element can create other specialized elements
+    // add behind last specialized element of this GenericEl
+    // for example: A = class(B<C<D>>)
+    // =>
+    //  D
+    //  C<D>
+    //  B<C<D>>
+    //  A
     Last:=GenericEl;
     if SpecializedItems<>nil then
       begin
@@ -16406,15 +16413,46 @@ var
       if i>=0 then
         Last:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
       end;
-    i:=List.IndexOf(Last);
-    if i<0 then
+    LastIndex:=List.IndexOf(Last);
+    if (LastIndex<0) then
+      if GenericEl is TPasProcedure then
+      else
+        RaiseNotYetImplemented(20200725093218,El);
+    i:=List.Count-1;
+    while i>LastIndex do
       begin
-      {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)}
-      writeln('InsertBehind Generic=',GetObjName(GenericEl),' Last=',GetObjName(Last));
-      //for i:=0 to List.Count-1 do writeln('  ',GetObjName(TObject(List[i])));
-      {$ENDIF}
-      i:=List.Count-1;
+      Last:=TPasElement(List[i]);
+      if Last is TPasGenericType then
+        begin
+        if (Last.CustomData<>nil) then
+          begin
+          GenScope:=Last.CustomData as TPasGenericScope;
+          if GenScope.GenericStep>=psgsInterfaceParsed then
+            break; // finished generic type
+          end;
+        // type is still parsed => insert in front
+        dec(i);
+        end
+      else if Last is TPasProcedure then
+        begin
+        ProcScope:=Last.CustomData as TPasProcedureScope;
+        if ProcScope.GenericStep>=psgsInterfaceParsed then
+          break; // finished generic proc
+        // proc is still parsed => insert in front
+        dec(i);
+        end
+      else
+        break;
       end;
+
+    //if i<0 then
+    //  begin
+    //  {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)}
+    //  writeln('InsertBehind Generic=',GetObjName(GenericEl),' Last=',GetObjName(Last));
+    //  //for i:=0 to List.Count-1 do writeln('  ',GetObjName(TObject(List[i])));
+    //  {$ENDIF}
+    //  i:=List.Count-1;
+    //  end;
     List.Insert(i+1,NewEl);
   end;
 

packages/fcl-passrc/src/pastree.pp

@@ -14,15 +14,13 @@
 
  **********************************************************************}
 
-{$mode objfpc}
-{$h+}
-
 unit PasTree;
 
+{$i fcl-passrc.inc}
+
 {$if defined(debugrefcount) or defined(VerbosePasTreeMem) or defined(VerbosePasResolver)}
   {$define EnablePasTreeGlobalRefCount}
 {$endif}
-{$inline on}
 
 interface
 
@@ -1187,6 +1185,7 @@ type
   { TPasClassOperator }
 
   TPasClassOperator = class(TPasOperator)
+  public
     function TypeName: string; override;
     function GetProcTypeEnum: TProcType; override;
   end;
@@ -1637,7 +1636,7 @@ type
   TPasImplTryExceptElse = class(TPasImplTryHandler)
   end;
 
-  { TPasImplExceptOn }
+  { TPasImplExceptOn - Parent is TPasImplTryExcept }
 
   TPasImplExceptOn = class(TPasImplStatement)
   public

packages/fcl-passrc/src/pscanner.pp

@@ -16,22 +16,7 @@
 
 unit PScanner;
 
-{$mode objfpc}
-{$h+}
-
-{$ifdef fpc}
-  {$define UsePChar}
-  {$define UseAnsiStrings}
-  {$define HasStreams}
-  {$IF FPC_FULLVERSION<30101}
-    {$define EmulateArrayInsert}
-  {$endif}
-  {$define HasFS}
-{$endif}
-
-{$IFDEF NODEJS}
-  {$define HasFS}
-{$ENDIF}
+{$i fcl-passrc.inc}
 
 interface
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -13146,23 +13146,29 @@ begin
   Add([
   'type',
   '  TObject = class',
+  '  end;',
+  '  TBird = class',
   '    function GetB(Index: longint): longint;',
   '    procedure SetB(Index: longint; Value: longint);',
   '    property B[Index: longint]: longint read GetB write SetB; default;',
   '  end;',
-  'function TObject.GetB(Index: longint): longint;',
+  'function TBird.GetB(Index: longint): longint;',
   'begin',
   'end;',
-  'procedure TObject.SetB(Index: longint; Value: longint);',
+  'procedure TBird.SetB(Index: longint; Value: longint);',
   'begin',
   '  if Value=Self[Index] then ;',
   '  Self[Index]:=Value;',
   'end;',
-  'var o: TObject;',
+  'var',
+  '  b: TBird;',
+  '  o: TObject;',
   'begin',
-  '  o[3]:=4;',
-  '  if o[5]=6 then;',
-  '  if 7=o[8] then;']);
+  '  b[3]:=4;',
+  '  if b[5]=6 then;',
+  '  if 7=b[8] then;',
+  '  (o as TBird)[9]:=10;',
+  '']);
   ParseProgram;
 end;
 

packages/pastojs/src/fppas2js.pp

@@ -616,6 +616,7 @@ type
     pbifnRecordAssign,
     pbifnRecordClone,
     pbifnRecordCreateType,
+    pbifnRecordCreateSpecializeType,
     pbifnRecordEqual,
     pbifnRecordNew,
     pbifnRTTIAddField, // typeinfos of tkclass and tkrecord have addField
@@ -743,7 +744,7 @@ const
     'xor', // pbifnBitwiseNativeIntXor,
     'checkMethodCall', // pbifnCheckMethodCall
     'checkVersion', // pbifnCheckVersion
-    '$func', // pbifnClassAncestorFunc
+    '$ancestorfunc', // pbifnClassAncestorFunc
     '$destroy', // pbifnClassInstanceFree
     '$create', // pbifnClassInstanceNew
     'createClass', // pbifnCreateClass   rtl.createClass
@@ -795,7 +796,8 @@ const
     'rcSetCharAt',  // pbifnRangeCheckSetCharAt  rtl.rcSetCharAt
     '$assign', // pbifnRecordAssign
     '$clone', // pbifnRecordClone
-    'recNewT', // pbifnRecordNew
+    'recNewT', // pbifnRecordCreateType
+    'recNewS', // pbifnRecordCreateSpecializeType
     '$eq', // pbifnRecordEqual
     '$new', // pbifnRecordNew
     'addField', // pbifnRTTIAddField
@@ -1384,6 +1386,14 @@ type
       end;
       PHasAnoFuncData = ^THasAnoFuncData;
     procedure OnHasAnonymousEl(El: TPasElement; arg: pointer);
+  protected
+    type
+      THasElReadingDeclData = record
+        Decl: TPasElement;
+        El: TPasElement;
+      end;
+      PHasElReadingDeclData = ^THasElReadingDeclData;
+    procedure OnHasElReadingDecl(El: TPasElement; arg: pointer);
   protected
     type
       TPRFindExtSystemClass = record
@@ -1563,7 +1573,8 @@ type
       InResolved: TPasResolverResult; out ArgResolved, LengthResolved,
       PropResultResolved: TPasResolverResult): boolean;
     function IsHelperMethod(El: TPasElement): boolean; override;
-    function IsHelperForMember(El: TPasElement): boolean;
+    function IsHelperForMember(El: TPasElement): boolean; virtual;
+    function ImplBlockReadsDecl(Block: TPasImplBlock; Decl: TPasElement): boolean; virtual;
   end;
 
 //------------------------------------------------------------------------------
@@ -2980,6 +2991,22 @@ begin
   Data^.Expr:=TProcedureExpr(El);
 end;
 
+procedure TPas2JSResolver.OnHasElReadingDecl(El: TPasElement; arg: pointer);
+var
+  Data: PHasElReadingDeclData absolute arg;
+  Ref: TResolvedReference;
+begin
+  if Data^.El<>nil then exit;
+  if El.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(El.CustomData);
+    if (Ref.Declaration=Data^.Decl) and (Ref.Access in rraAllRead) then
+      begin
+      Data^.El:=El;
+      end;
+    end;
+end;
+
 procedure TPas2JSResolver.OnFindExtSystemClass(El: TPasElement; ElScope,
   StartScope: TPasScope; FindExtSystemClassData: Pointer; var Abort: boolean);
 var
@@ -3249,6 +3276,7 @@ begin
     exit(false); // there is no overload
 
   if (El.ClassType=TPasClassFunction)
+      and (El.Parent.ClassType=TPasClassType)
       and (TPas2JSClassScope(TPasClassType(El.Parent).CustomData).NewInstanceFunction=El) then
     begin
     Duplicate:=GetDuplicate;
@@ -3517,6 +3545,8 @@ var
   Scope: TPasIdentifierScope;
 begin
   i:=FOverloadScopes.Count-1;
+  if i<0 then
+    RaiseInternalError(20200723125456);
   Scope:=TPasIdentifierScope(FOverloadScopes[i]);
   if Scope.ClassType=TPas2JSOverloadChgThisScope then
     Scope.Free;
@@ -6789,6 +6819,17 @@ begin
     Result:=true;
 end;
 
+function TPas2JSResolver.ImplBlockReadsDecl(Block: TPasImplBlock;
+  Decl: TPasElement): boolean;
+var
+  Data: THasElReadingDeclData;
+begin
+  Data.Decl:=Decl;
+  Data.El:=nil;
+  Block.ForEachCall(@OnHasElReadingDecl,@Data);
+  Result:=Data.El<>nil;
+end;
+
 { TParamContext }
 
 constructor TParamContext.Create(PasEl: TPasElement; JSEl: TJSElement;
@@ -11988,39 +12029,91 @@ function TPasToJSConverter.ConvertBuiltIn_Exit(El: TPasExpr;
 // convert "exit;" -> in a function: "return result;"  in a procedure: "return;"
 // convert "exit(param);" -> "return param;"
 var
-  ProcEl: TPasElement;
-  Scope: TPas2JSProcedureScope;
-  VarName: String;
+  ParentEl: TPasElement;
+  ImplProcScope: TPas2JSProcedureScope;
+  ResultVarName: String;
   FuncContext: TFunctionContext;
   AssignSt: TJSSimpleAssignStatement;
   St: TJSStatementList;
-  Proc: TPasProcedure;
+  ImplProc, DeclProc: TPasProcedure;
+  ImplTry: TPasImplTry;
+  ResultIsRead: Boolean;
+  ResultEl: TPasResultElement;
 begin
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertBuiltIn_Exit ',GetObjName(El));
   {$ENDIF}
-  ProcEl:=El.Parent;
-  while (ProcEl<>nil) and not (ProcEl is TPasProcedure) do
-    ProcEl:=ProcEl.Parent;
-  // ProcEl can be nil, when exit is in program begin block
-  Proc:=TPasProcedure(ProcEl);
+  ParentEl:=El.Parent;
+  while (ParentEl<>nil) and not (ParentEl is TPasProcedure) do
+    ParentEl:=ParentEl.Parent;
+  // ParentEl can be nil, when exit is in program begin block
+  ImplProc:=TPasProcedure(ParentEl);
+  ResultVarName:='';
+  if ImplProc<>nil then
+    begin
+    ImplProcScope:=ImplProc.CustomData as TPas2JSProcedureScope;
+    if ImplProc.ProcType is TPasFunctionType then
+      begin
+      ResultVarName:=ImplProcScope.ResultVarName; // ResultVarName needs ImplProc
+      if ResultVarName='' then
+        ResultVarName:=ResolverResultVar;
+      end;
+    end;
   Result:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
   if (El is TParamsExpr) and (length(TParamsExpr(El).Params)>0) then
     begin
-    // with parameter. convert "exit(param);" -> "return param;"
-    TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
+    // with parameter, e.g. "exit(param);"
+    ResultIsRead:=false;
+    if (ResultVarName<>'') then
+      begin
+      DeclProc:=ImplProcScope.DeclarationProc;
+      if DeclProc=nil then
+        DeclProc:=ImplProc; // Note: references refer to ResultEl of DeclProc
+      ResultEl:=TPasFunctionType(DeclProc.ProcType).ResultEl;
+      ParentEl:=El.Parent;
+      while (ParentEl<>ImplProc) do
+        begin
+        if ParentEl is TPasImplTry then
+          begin
+          ImplTry:=TPasImplTry(ParentEl);
+          if ImplTry.FinallyExcept is TPasImplTryFinally then
+            begin
+            if AContext.Resolver.ImplBlockReadsDecl(ImplTry.FinallyExcept,ResultEl) then
+              begin
+              ResultIsRead:=true;
+              break;
+              end;
+            end;
+          end;
+        ParentEl:=ParentEl.Parent;
+        end;
+      end;
+
+    if ResultIsRead then
+      begin
+      // create "Result = param; return Result;"
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=CreatePrimitiveDotExpr(ResultVarName,El);
+      AssignSt.Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
+      TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(ResultVarName,El);
+      St:=TJSStatementList(CreateElement(TJSStatementList,El));
+      St.A:=AssignSt;
+      St.B:=Result;
+      Result:=St;
+      end
+    else
+      begin
+      // create "return param;"
+      TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
+      end;
     end
   else
     begin
     // without parameter
-    if (Proc<>nil) and (Proc.ProcType is TPasFunctionType) then
-      begin
-      // in a function, "return result;"
-      Scope:=Proc.CustomData as TPas2JSProcedureScope;
-      VarName:=Scope.ResultVarName;
-      if VarName='' then
-        VarName:=ResolverResultVar;
-      TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(VarName,El);
+    if (ResultVarName<>'') then
+      begin
+      // in a function, "return Result;"
+      TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(ResultVarName,El);
       end
     else
       ; // in a procedure, "return;" which means "return undefined;"
@@ -16758,7 +16851,10 @@ begin
           // clone sub static array
           VarAssignSt.Expr:=CreateCloneStaticArray(PasVar,TPasArrayType(PasVarType),
                                               SrcExpr,aContext);
-          end;
+          end
+        else
+          // reference dynamic array
+          VarAssignSt.Expr:=CreateArrayRef(PasVar,SrcExpr);
         end
       else if PasVarClass=TPasSetType then
         begin
@@ -24475,6 +24571,7 @@ var
   NewFields, Vars, Methods: TFPList;
   ok, IsFull: Boolean;
   VarSt: TJSVariableStatement;
+  bifn: TPas2JSBuiltInName;
 begin
   Result:=nil;
   if El.Name='' then
@@ -24492,7 +24589,17 @@ begin
   try
     // rtl.recNewT()
     Call:=CreateCallExpression(El);
-    Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnRecordCreateType)]);
+    bifn:=pbifnRecordCreateType;
+    {$IFDEF EnableDelaySpecialize}
+    RecScope:=TPas2JSRecordScope(El.CustomData);
+    if RecScope.SpecializedFromItem<>nil then
+      begin
+      if RecScope.SpecializedFromItem.FirstSpecialize.GetModule<>EL.GetModule then
+        bifn:=pbifnRecordCreateSpecializeType;
+      end;
+    {$ENDIF}
+
+    Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(bifn)]);
 
     // types are stored in interface/implementation
     if El.Parent is TProcedureBody then
@@ -24561,12 +24668,9 @@ begin
           PasVarType:=aResolver.ResolveAliasType(PasVar.VarType);
           if PasVarType.ClassType=TPasArrayType then
             begin
-            if length(TPasArrayType(PasVarType).Ranges)>0 then
-              begin
-              // sub static array
-              NewFields.Add(PasVar);
-              continue;
-              end;
+            // sub array
+            NewFields.Add(PasVar);
+            continue;
             end
           else if PasVarType.ClassType=TPasRecordType then
             begin

packages/pastojs/src/pas2jsjsresources.pp

@@ -83,7 +83,7 @@ begin
   aName:=Options.Values['name'];
   if aName='' then
     aName:=ChangeFileExt(ExtractFileName(aFileName),'');
-  Result:=Format(SAddResource,[aName,LowerCase(CurrentUnitName),aFormat,aData]);
+  Result:=Format(SAddResource,[LowerCase(aName),LowerCase(CurrentUnitName),aFormat,aData]);
 end;
 
 procedure TJSResourceHandler.HandleResource(aFileName: string; Options: TStrings);

packages/pastojs/src/pastojs.inc

@@ -0,0 +1,12 @@
+{$mode objfpc}{$H+}
+{$inline on}
+
+{$ifdef fpc}
+  {$define UsePChar}
+  {$define HasInt64}
+{$endif}
+
+{$IF FPC_FULLVERSION>30100}
+  {$warn 6058 off} // cannot inline
+{$ENDIF}
+

packages/pastojs/tests/tcfiler.pas

@@ -18,7 +18,7 @@
 }
 unit TCFiler;
 
-{$mode objfpc}{$H+}
+{$i ../src/pastojs.inc}
 
 interface
 
@@ -3077,6 +3077,8 @@ end;
 
 procedure TTestPrecompile.TestPC_SpecializeClassSameUnit;
 begin
+  exit;
+
   StartUnit(false);
   Add([
   '{$mode delphi}',

packages/pastojs/tests/tcgenerics.pas

@@ -17,7 +17,9 @@ type
     // generic record
     Procedure TestGen_RecordEmpty;
     Procedure TestGen_Record_ClassProc;
-    Procedure TestGen_Record_DelayProgram; // ToDo
+    Procedure TestGen_Record_AsClassVar_Program;
+    Procedure TestGen_Record_AsClassVar_UnitImpl; // ToDo
+    // ToDo: delay using recNewS
 
     // generic class
     Procedure TestGen_ClassEmpty;
@@ -41,7 +43,7 @@ type
     procedure TestGen_ExtClass_Array;
     procedure TestGen_ExtClass_GenJSValueAssign;
     procedure TestGen_ExtClass_AliasMemberType;
-    Procedure TestGen_ExtClass_RTTI; // ToDo: use "TGJSSET<JSValue>"
+    Procedure TestGen_ExtClass_RTTI;
 
     // class interfaces
     procedure TestGen_ClassInterface_Corba;
@@ -154,10 +156,8 @@ begin
     '']));
 end;
 
-procedure TTestGenerics.TestGen_Record_DelayProgram;
+procedure TTestGenerics.TestGen_Record_AsClassVar_Program;
 begin
-  exit;
-
   StartProgram(false);
   Add([
   '{$modeswitch AdvancedRecords}',
@@ -173,9 +173,19 @@ begin
   '  f.x.b:=f.x.b+10;',
   '']);
   ConvertProgram;
-  CheckSource('TestGen_Record_DelayProgram',
+  CheckSource('TestGen_Record_AsClassVar_Program',
     LinesToStr([ // statements
-    'rtl.recNewS($mod, "TAnt$G1", function () {',
+    'rtl.recNewT($mod, "TBird", function () {',
+    '  this.b = 0;',
+    '  this.$eq = function (b) {',
+    '    return this.b === b.b;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    this.b = s.b;',
+    '    return this;',
+    '  };',
+    '});',
+    'rtl.recNewT($mod, "TAnt$G1", function () {',
     '  this.x = $mod.TBird.$new();',
     '  this.$eq = function (b) {',
     '    return true;',
@@ -184,7 +194,51 @@ begin
     '    return this;',
     '  };',
     '}, true);',
-    'rtl.recNewT($mod, "TBird", function () {',
+    'this.f = $mod.TAnt$G1.$new();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.f.x.b = $mod.f.x.b + 10;',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_Record_AsClassVar_UnitImpl;
+begin
+  StartUnit(true);
+  Add([
+  'interface',
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  generic TAnt<T> = record',
+  '    class var x: T;',
+  '  end;',
+  'implementation',
+  'type',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var f: specialize TAnt<TBird>;',
+  'begin',
+  '  f.x.b:=f.x.b+10;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestGen_Record_AsClassVar_UnitImpl',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    'rtl.recNewT($mod, "TAnt$G1", function () {',
+    '  this.x = $impl.TBird.$new();',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '}, true);',
+    '']),
+    LinesToStr([ // $mod.$init
+    '  $impl.f.x.b = $impl.f.x.b + 10;',
+    '']),
+    LinesToStr([ // statements
+    'rtl.recNewT($impl, "TBird", function () {',
     '  this.b = 0;',
     '  this.$eq = function (b) {',
     '    return this.b === b.b;',
@@ -194,11 +248,8 @@ begin
     '    return this;',
     '  };',
     '});',
-    '$mod.TAnt$G1();',
-    'this.f = $mod.TAnt$G1.$new();',
-    '']),
-    LinesToStr([ // $mod.$main
-    '$mod.f.x.b = $mod.f.x.b + 10;',
+    //'$mod.TAnt$G1();',
+    '$impl.f = $mod.TAnt$G1.$new();',
     '']));
 end;
 
@@ -653,18 +704,18 @@ begin
     '  this.$final = function () {',
     '  };',
     '});',
+    'this.count = 0;',
     'rtl.createClass($mod, "TPoint$G1", $mod.TObject, function () {',
     '  this.x = 0;',
     '  this.Fly = function () {',
     '  };',
     '});',
+    'this.r = null;',
     'rtl.createClass($mod, "TPoint$G2", $mod.TObject, function () {',
     '  this.x = 0;',
     '  this.Fly = function () {',
     '  };',
     '});',
-    'this.count = 0;',
-    'this.r = null;',
     'this.s = null;',
     '']),
     LinesToStr([ // $mod.$main
@@ -1158,13 +1209,13 @@ begin
   CheckSource('TestGen_ClassInterface_Corba',
     LinesToStr([ // statements
     'rtl.createInterface($mod, "IUnknown", "{00000000-0000-0000-C000-000000000046}", [], null);',
-    'rtl.createInterface($mod, "IBird$G2", "{7D9907A1-5178-37B5-9D32-7BC020005905}", ["GetSize", "SetSize", "DoIt"], $mod.IUnknown);',
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  };',
     '  this.$final = function () {',
     '  };',
     '});',
+    'rtl.createInterface($mod, "IBird$G2", "{7D9907A1-5178-37B5-9D32-7BC020005905}", ["GetSize", "SetSize", "DoIt"], $mod.IUnknown);',
     'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
     '  rtl.addIntf(this, $mod.IBird$G2);',
     '});',
@@ -1197,6 +1248,7 @@ begin
   CheckSource('TestGen_ClassInterface_InterfacedObject',
     LinesToStr([ // statements
     'rtl.createInterface($mod, "IComparer$G2", "{505778ED-F783-4456-9691-32F419CC5E18}", ["Compare"], pas.system.IUnknown);',
+    'this.aComparer = null;',
     'rtl.createClass($mod, "TComparer$G1", pas.system.TInterfacedObject, function () {',
     '  this.Compare = function (Left, Right) {',
     '    var Result = 0;',
@@ -1205,7 +1257,6 @@ begin
     '  rtl.addIntf(this, $mod.IComparer$G2);',
     '  rtl.addIntf(this, pas.system.IUnknown);',
     '});',
-    'this.aComparer = null;',
     '']),
     LinesToStr([ // $mod.$main
     'rtl.setIntfP($mod, "aComparer", rtl.queryIntfT($mod.TComparer$G1.$create("Create"), $mod.IComparer$G2), true);',
@@ -1286,12 +1337,12 @@ begin
     '      $impl.DoIt();',
     '    };',
     '  });',
+    '  this.b = null;',
     '  rtl.createClass($mod, "TBird$G2", pas.system.TObject, function () {',
     '    this.Fly = function () {',
     '      $impl.DoIt();',
     '    };',
     '  });',
-    '  this.b = null;',
     '}, null, function () {',
     '  var $mod = this;',
     '  var $impl = $mod.$impl;',
@@ -1378,6 +1429,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '});',
+    'this.o = null;',
     'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
     '  this.$init = function () {',
     '    $mod.TObject.$init.call(this);',
@@ -1388,7 +1440,6 @@ begin
     '    if (4 === $mod.o.Field) ;',
     '  };',
     '});',
-    'this.o = null;',
     'this.b = null;',
     '']),
     LinesToStr([ // $mod.$main
@@ -1454,6 +1505,7 @@ begin
   ConvertProgram;
   CheckSource('TestGenProc_Function_ObjFPC',
     LinesToStr([ // statements
+    'this.w = 0;',
     'this.Run$s0 = function (a) {',
     '  var Result = 0;',
     '  var i = 0;',
@@ -1461,7 +1513,6 @@ begin
     '  Result = a;',
     '  return Result;',
     '};',
-    'this.w = 0;',
     '']),
     LinesToStr([ // $mod.$main
     '$mod.w = $mod.Run$s0(3);',
@@ -1486,6 +1537,7 @@ begin
   ConvertProgram;
   CheckSource('TestGenProc_Function_Delphi',
     LinesToStr([ // statements
+    'this.w = 0;',
     'this.Run$s0 = function (a) {',
     '  var Result = 0;',
     '  var i = 0;',
@@ -1493,7 +1545,6 @@ begin
     '  Result = a;',
     '  return Result;',
     '};',
-    'this.w = 0;',
     '']),
     LinesToStr([ // $mod.$main
     '$mod.w = $mod.Run$s0(3);',

packages/pastojs/tests/tcmodules.pas

@@ -319,6 +319,7 @@ type
     Procedure TestFunctionResultInForLoop;
     Procedure TestFunctionResultInTypeCast;
     Procedure TestExit;
+    Procedure TestExit_ResultInFinally;
     Procedure TestBreak;
     Procedure TestBreakAsVar;
     Procedure TestContinue;
@@ -512,7 +513,8 @@ type
     Procedure TestClass_Property_IndexSpec;
     Procedure TestClass_PropertyOfTypeArray;
     Procedure TestClass_PropertyDefault;
-    Procedure TestClass_PropertyDefault2;
+    Procedure TestClass_PropertyDefault_TypecastToOtherDefault;
+    //Procedure TestClass_PropertyDefault;
     Procedure TestClass_PropertyOverride;
     Procedure TestClass_PropertyIncVisibility;
     Procedure TestClass_Assigned;
@@ -3731,6 +3733,77 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExit_ResultInFinally;
+begin
+  StartProgram(false);
+  Add([
+  'function Run: word;',
+  'begin',
+  '  try',
+  '    exit(3);', // no Result in finally -> use return 3
+  '  finally',
+  '  end;',
+  'end;',
+  'function Fly: word;',
+  'begin',
+  '  try',
+  '    exit(3);',
+  '  finally',
+  '    if Result>0 then ;',
+  '  end;',
+  'end;',
+  'function Jump: word;',
+  'begin',
+  '  try',
+  '    try',
+  '      exit(4);',
+  '    finally',
+  '    end;',
+  '  finally',
+  '    if Result>0 then ;',
+  '  end;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExit_ResultInFinally',
+    LinesToStr([ // statements
+    'this.Run = function () {',
+    '  var Result = 0;',
+    '  try {',
+    '    return 3;',
+    '  } finally {',
+    '  };',
+    '  return Result;',
+    '};',
+    'this.Fly = function () {',
+    '  var Result = 0;',
+    '  try {',
+    '    Result = 3;',
+    '    return Result;',
+    '  } finally {',
+    '    if (Result > 0) ;',
+    '  };',
+    '  return Result;',
+    '};',
+    'this.Jump = function () {',
+    '  var Result = 0;',
+    '  try {',
+    '    try {',
+    '      Result = 4;',
+    '      return Result;',
+    '    } finally {',
+    '    };',
+    '  } finally {',
+    '    if (Result > 0) ;',
+    '  };',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestBreak;
 begin
   StartProgram(false);
@@ -10640,9 +10713,9 @@ begin
     'rtl.recNewT($mod, "TBigRec", function () {',
     '  this.Int = 0;',
     '  this.D = 0.0;',
-    '  this.Arr = [];',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
+    '    r.Arr = [];',
     '    r.Arr2 = rtl.arraySetLength(null, 0, 2);',
     '    r.Small = $mod.TSmallRec.$new();',
     '    r.Enums = {};',
@@ -10654,7 +10727,7 @@ begin
     '  this.$assign = function (s) {',
     '    this.Int = s.Int;',
     '    this.D = s.D;',
-    '    this.Arr = s.Arr;',
+    '    this.Arr = rtl.arrayRef(s.Arr);',
     '    this.Arr2 = s.Arr2.slice(0);',
     '    this.Small.$assign(s.Small);',
     '    this.Enums = rtl.refSet(s.Enums);',
@@ -11110,9 +11183,9 @@ begin
   CheckSource('TestRecord_FieldArray',
     LinesToStr([ // statements
     'rtl.recNewT($mod, "TRec", function () {',
-    '  this.a = [];',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
+    '    r.a = [];',
     '    r.s = rtl.arraySetLength(null, 0, 2);',
     '    r.m = rtl.arraySetLength(null, 0, 2, 2);',
     '    r.o = rtl.arraySetLength(null, 0, 2);',
@@ -11122,7 +11195,7 @@ begin
     '    return (this.a === b.a) && rtl.arrayEq(this.s, b.s) && rtl.arrayEq(this.m, b.m) && rtl.arrayEq(this.o, b.o);',
     '  };',
     '  this.$assign = function (s) {',
-    '    this.a = s.a;',
+    '    this.a = rtl.arrayRef(s.a);',
     '    this.s = s.s.slice(0);',
     '    this.m = s.m.slice(0);',
     '    this.o = s.o.slice(0);',
@@ -11176,9 +11249,9 @@ begin
     '});',
     'rtl.recNewT($mod, "TRec", function () {',
     '  this.i = 0;',
-    '  this.a = [];',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
+    '    r.a = [];',
     '    r.s = rtl.arraySetLength(null, 0, 2);',
     '    r.m = rtl.arraySetLength(null, 0, 2, 2);',
     '    r.p = $mod.TPoint.$new();',
@@ -11189,7 +11262,7 @@ begin
     '  };',
     '  this.$assign = function (s) {',
     '    this.i = s.i;',
-    '    this.a = s.a;',
+    '    this.a = rtl.arrayRef(s.a);',
     '    this.s = s.s.slice(0);',
     '    this.m = s.m.slice(0);',
     '    this.p.$assign(s.p);',
@@ -11585,9 +11658,9 @@ begin
     '}, true);',
     'rtl.recNewT($mod, "TRec", function () {',
     '  this.i = 0;',
-    '  this.a = [];',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
+    '    r.a = [];',
     '    r.s = rtl.arraySetLength(null, 0, 2);',
     '    r.m = rtl.arraySetLength(null, 0, 2, 2);',
     '    r.p = $mod.TPoint.$new();',
@@ -11598,7 +11671,7 @@ begin
     '  };',
     '  this.$assign = function (s) {',
     '    this.i = s.i;',
-    '    this.a = s.a;',
+    '    this.a = rtl.arrayRef(s.a);',
     '    this.s = s.s.slice(0);',
     '    this.m = s.m.slice(0);',
     '    this.p.$assign(s.p);',
@@ -13086,32 +13159,34 @@ end;
 procedure TTestModule.TestClass_Property_Indexed;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('    FItems: array of longint;');
-  Add('    function GetItems(Index: longint): longint;');
-  Add('    procedure SetItems(Index: longint; Value: longint);');
-  Add('    procedure DoIt;');
-  Add('    property Items[Index: longint]: longint read getitems write setitems;');
-  Add('  end;');
-  Add('function tobject.getitems(index: longint): longint;');
-  Add('begin');
-  Add('  Result:=fitems[index];');
-  Add('end;');
-  Add('procedure tobject.setitems(index: longint; value: longint);');
-  Add('begin');
-  Add('  fitems[index]:=value;');
-  Add('end;');
-  Add('procedure tobject.doit;');
-  Add('begin');
-  Add('  items[1]:=2;');
-  Add('  items[3]:=items[4];');
-  Add('  self.items[5]:=self.items[6];');
-  Add('  items[items[7]]:=items[items[8]];');
-  Add('end;');
-  Add('var Obj: tobject;');
-  Add('begin');
-  Add('  obj.Items[11]:=obj.Items[12];');
+  Add([
+  'type',
+  '  TObject = class',
+  '    FItems: array of longint;',
+  '    function GetItems(Index: longint): longint;',
+  '    procedure SetItems(Index: longint; Value: longint);',
+  '    procedure DoIt;',
+  '    property Items[Index: longint]: longint read getitems write setitems;',
+  '  end;',
+  'function tobject.getitems(index: longint): longint;',
+  'begin',
+  '  Result:=fitems[index];',
+  'end;',
+  'procedure tobject.setitems(index: longint; value: longint);',
+  'begin',
+  '  fitems[index]:=value;',
+  'end;',
+  'procedure tobject.doit;',
+  'begin',
+  '  items[1]:=2;',
+  '  items[3]:=items[4];',
+  '  self.items[5]:=self.items[6];',
+  '  items[items[7]]:=items[items[8]];',
+  'end;',
+  'var Obj: tobject;',
+  'begin',
+  '  obj.Items[11]:=obj.Items[12];',
+  '']);
   ConvertProgram;
   CheckSource('TestClass_Property_Indexed',
     LinesToStr([ // statements
@@ -13294,36 +13369,50 @@ begin
   'type',
   '  TArray = array of longint;',
   '  TObject = class',
+  '  end;',
+  '  TBird = class',
   '    FItems: TArray;',
   '    function GetItems(Index: longint): longint;',
   '    procedure SetItems(Index, Value: longint);',
   '    property Items[Index: longint]: longint read getitems write setitems; default;',
   '  end;',
-  'function tobject.getitems(index: longint): longint;',
+  'function TBird.getitems(index: longint): longint;',
   'begin',
   'end;',
-  'procedure tobject.setitems(index, value: longint);',
+  'procedure TBird.setitems(index, value: longint);',
   'begin',
   '  Self[1]:=2;',
   '  Self[3]:=Self[index];',
   '  Self[index]:=Self[Self[value]];',
   '  Self[Self[4]]:=value;',
   'end;',
-  'var Obj: tobject;',
+  'var',
+  '  Bird: TBird;',
+  '  Obj: TObject;',
   'begin',
-  '  obj[11]:=12;',
-  '  obj[13]:=obj[14];',
-  '  obj[obj[15]]:=obj[obj[15]];',
-  '  TObject(obj)[16]:=TObject(obj)[17];']);
+  '  bird[11]:=12;',
+  '  bird[13]:=bird[14];',
+  '  bird[Bird[15]]:=bird[Bird[15]];',
+  '  TBird(obj)[16]:=TBird(obj)[17];',
+  '  (obj as tbird)[18]:=19;',
+  '']);
   ConvertProgram;
   CheckSource('TestClass_PropertyDefault',
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
     '    this.FItems = [];',
     '  };',
     '  this.$final = function () {',
     '    this.FItems = undefined;',
+    '    $mod.TObject.$final.call(this);',
     '  };',
     '  this.GetItems = function (Index) {',
     '    var Result = 0;',
@@ -13336,17 +13425,19 @@ begin
     '    this.SetItems(this.GetItems(4), Value);',
     '  };',
     '});',
-    'this.Obj = null;'
-    ]),
+    'this.Bird = null;',
+    'this.Obj = null;',
+    '']),
     LinesToStr([ // $mod.$main
-    '$mod.Obj.SetItems(11, 12);',
-    '$mod.Obj.SetItems(13, $mod.Obj.GetItems(14));',
-    '$mod.Obj.SetItems($mod.Obj.GetItems(15), $mod.Obj.GetItems($mod.Obj.GetItems(15)));',
+    '$mod.Bird.SetItems(11, 12);',
+    '$mod.Bird.SetItems(13, $mod.Bird.GetItems(14));',
+    '$mod.Bird.SetItems($mod.Bird.GetItems(15), $mod.Bird.GetItems($mod.Bird.GetItems(15)));',
     '$mod.Obj.SetItems(16, $mod.Obj.GetItems(17));',
+    'rtl.as($mod.Obj, $mod.TBird).SetItems(18, 19);',
     '']));
 end;
 
-procedure TTestModule.TestClass_PropertyDefault2;
+procedure TTestModule.TestClass_PropertyDefault_TypecastToOtherDefault;
 begin
   StartProgram(false);
   Add([
@@ -13379,7 +13470,7 @@ begin
   '  TBetaList(List[false])[5]:=nil;',
   '']);
   ConvertProgram;
-  CheckSource('TestClass_PropertyDefault2',
+  CheckSource('TestClass_PropertyDefault_TypecastToOtherDefault',
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
@@ -17534,7 +17625,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  this.Create = function (a) {',
-    '    this.$func(a);',
+    '    this.$ancestorfunc(a);',
     '    return this;',
     '  };',
     '});',
@@ -29879,14 +29970,18 @@ begin
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
     'rtl.recNewT($mod, "TFloatRec", function () {',
-    '  this.c = [];',
-    '  this.d = [];',
+    '  this.$new = function () {',
+    '    var r = Object.create(this);',
+    '    r.c = [];',
+    '    r.d = [];',
+    '    return r;',
+    '  };',
     '  this.$eq = function (b) {',
     '    return (this.c === b.c) && (this.d === b.d);',
     '  };',
     '  this.$assign = function (s) {',
-    '    this.c = s.c;',
-    '    this.d = s.d;',
+    '    this.c = rtl.arrayRef(s.c);',
+    '    this.d = rtl.arrayRef(s.d);',
     '    return this;',
     '  };',
     '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',

utils/pas2js/dist/rtl.js

@@ -396,6 +396,7 @@ var rtl = {
       function f(){}
       f.prototype = c;
       c.$func = f;
+      c.$ancestorfunc = ancestor;
     }
   },
 
@@ -892,7 +893,7 @@ var rtl = {
     }
     var dimmax = stack.length-1;
     var depth = 0;
-    var lastlen = stack[dimmax].dim;
+    var lastlen = 0;
     var item = null;
     var a = null;
     var src = arr;
@@ -915,44 +916,51 @@ var rtl = {
         srclen = 0;
         oldlen = a.length;
       }
-      a.length = stack[depth].dim;
+      lastlen = stack[depth].dim;
+      a.length = lastlen;
       if (depth>0){
         item.a[item.i]=a;
         item.i++;
+        if ((lastlen===0) && (item.i<item.a.length)) continue;
       }
-      if (depth<dimmax){
-        item = stack[depth];
-        item.a = a;
-        item.i = 0;
-        item.src = src;
-        depth++;
-      } else {
-        if (rtl.isArray(defaultvalue)){
-          // array of dyn array
-          for (var i=0; i<srclen; i++) a[i]=src[i];
-          for (var i=oldlen; i<lastlen; i++) a[i]=[];
-        } else if (rtl.isObject(defaultvalue)) {
-          if (rtl.isTRecord(defaultvalue)){
-            // array of record
-            for (var i=0; i<srclen; i++) a[i]=defaultvalue.$clone(src[i]);
-            for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue.$new();
+      if (lastlen>0){
+        if (depth<dimmax){
+          item = stack[depth];
+          item.a = a;
+          item.i = 0;
+          item.src = src;
+          depth++;
+          continue;
+        } else {
+          if (srclen>lastlen) srclen=lastlen;
+          if (rtl.isArray(defaultvalue)){
+            // array of dyn array
+            for (var i=0; i<srclen; i++) a[i]=src[i];
+            for (var i=oldlen; i<lastlen; i++) a[i]=[];
+          } else if (rtl.isObject(defaultvalue)) {
+            if (rtl.isTRecord(defaultvalue)){
+              // array of record
+              for (var i=0; i<srclen; i++) a[i]=defaultvalue.$clone(src[i]);
+              for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue.$new();
+            } else {
+              // array of set
+              for (var i=0; i<srclen; i++) a[i]=rtl.refSet(src[i]);
+              for (var i=oldlen; i<lastlen; i++) a[i]={};
+            }
           } else {
-            // array of set
-            for (var i=0; i<srclen; i++) a[i]=rtl.refSet(src[i]);
-            for (var i=oldlen; i<lastlen; i++) a[i]={};
+            for (var i=0; i<srclen; i++) a[i]=src[i];
+            for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue;
           }
-        } else {
-          for (var i=0; i<srclen; i++) a[i]=src[i];
-          for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue;
-        }
-        while ((depth>0) && (stack[depth-1].i>=stack[depth-1].dim)){
-          depth--;
-        };
-        if (depth===0){
-          if (dimmax===0) return a;
-          return stack[0].a;
         }
       }
+      // backtrack
+      while ((depth>0) && (stack[depth-1].i>=stack[depth-1].dim)){
+        depth--;
+      };
+      if (depth===0){
+        if (dimmax===0) return a;
+        return stack[0].a;
+      }
     }while (true);
   },
 

utils/pas2js/docs/translation.html

@@ -2300,7 +2300,7 @@ End.
 
     <div class="section">
     <h2 id="dispatch">Dispatch messages</h2>
-    The procedure modifier <b>message</b> and the <b>Dispatch</b> works
+    The procedure modifier <b>message</b> and the <b>Dispatch</b> method works
     similar to FPC/Delphi, as it expects a record of a specific format and
     <b><i>TObject.Dispatch</i></b> calls the corresponding method with that
     message number or string.<br>
@@ -2799,10 +2799,11 @@ End.
 
     <div class="section">
     <h2 id="externalclassancestor">External class as ancestor</h2>
-    A Pascal class can descend from an external class.<br>
+    A Pascal class can descend from an external class - a JS object or function.<br>
     The methods <i>AfterConstruction</i> and <i>BeforeDestruction</i>
     are called if they exist.<br>
-    New instances are created by default with <i>Object.create(ancestorclass)</i>.<br>
+    New instances of a JS Object descendant are created by default with <i>Object.create(ancestorclass)</i>.<br>
+    New instances of a JS Function descendant are created by default with <i>new DescendantFunc()</i>.<br>
     You can override this, by providing a<br>
     <b>class function NewInstance(fnname: string; const paramsarray): TPasClass; virtual;</b>.
     This method is called to create a new instance and before calling the constructor.
@@ -2817,19 +2818,22 @@ End.
         </tr>
         <tr>
           <td>
-<pre>Program MyModule;
+<pre>
+// Example for descending a Pascal class from a JS Object
+Program MyModule;
 {$modeswitch externalclass}
 type
   TExtA = class external name 'ExtA'
   end;
   TMyB = class(TExtA)
   protected
+    // optional: override default allocation
     class function NewInstance(fnname: string; const paramarray): TMyB; virtual;
   end;
 class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;
 Begin
   asm
-  Result = Object.create(ExtA);
+  Result = Object.create(ExtA); // that is what the rtl does
   end;
 End;
 
@@ -2854,6 +2858,62 @@ End.
   $mod.$main = function () {
   };
 });
+</pre>
+          </td>
+        </tr>
+      </tbody>
+    </table>
+    <table class="sample">
+      <tbody>
+        <tr>
+          <th>Pascal</th>
+          <th>JavaScript</th>
+        </tr>
+        <tr>
+          <td>
+<pre>
+// Example for descending a Pascal class from a JS Function
+Program MyModule;
+{$modeswitch externalclass}
+uses JS;
+type
+  TExternalFunc = class external name 'ExternalFunc'(TJSFunction)
+    constructor New(a: word);
+  end;
+  TMyFunc = class(TExternalFunc)
+    constructor Create(b: word);
+  end;
+constructor TMyFunc.Create(b: word);
+Begin
+  inherited New(b+1); // optional: call inherited constructor function
+End;
+
+var
+  f: TMyFunc;
+Begin
+  f:=TMyFunc.Create(3);
+  writeln(jsInstanceOf(f,TExternalFunc)); // writes true, instanceof operator works as expected
+End.
+</pre>
+          </td>
+          <td>
+<pre>rtl.module("program",["System","js"],function () {
+  var $mod = this;
+  rtl.createClassExt($mod, "TMyFunc", ExternalFunc, "", function () {
+    this.$init = function () {
+    };
+    this.$final = function () {
+    };
+    this.Create$2 = function (b) {
+      this.$ancestorfunc(b+1);
+    };
+  });
+  this.f = null;
+  $mod.$main = function () {
+    f = $mod.TMyFunc.$create("Create$2",[3]);
+    pas.System.Writeln(pas.JS.jsInstanceOf(f,ExternalFunc));
+  };
+});
 </pre>
           </td>
         </tr>