pastojs: delay RTTI init of record/class/proctype specializations

git-svn-id: trunk@46748 -
(cherry picked from commit 4db51d69e40a294ea88629acad5e18c0b83fea27)

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -49,12 +49,12 @@ type
     procedure TestGen_RecordLocalNameDuplicateFail;
     procedure TestGen_Record;
     procedure TestGen_RecordDelphi;
-    procedure TestGen_RecordNestedSpecialized;
+    procedure TestGen_RecordNestedSpecialize_ClassRecord;
+    procedure TestGen_RecordNestedSpecialize_Self;
     procedure TestGen_Record_SpecializeSelfInsideFail;
     procedure TestGen_Record_ReferGenericSelfFail;
     procedure TestGen_RecordAnoArray;
     // ToDo: unitname.specialize TBird<word>.specialize TAnt<word>
-    procedure TestGen_RecordNestedSpecialize;
 
     // generic class
     procedure TestGen_Class;
@@ -78,6 +78,7 @@ type
     procedure TestGen_Class_MethodImplConstraintFail;
     procedure TestGen_Class_MethodImplTypeParamNameMismatch;
     procedure TestGen_Class_SpecializeSelfInside;
+    procedure TestGen_Class_AncestorTFail;
     procedure TestGen_Class_GenAncestor;
     procedure TestGen_Class_AncestorSelfFail;
     procedure TestGen_ClassOfSpecializeFail;
@@ -729,7 +730,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_RecordNestedSpecialized;
+procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize_ClassRecord;
 begin
   StartProgram(false);
   Add([
@@ -744,6 +745,21 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize_Self;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T> = record v: T; end;',
+  'var',
+  '  a: specialize TBird<specialize TBird<word>>;',
+  'begin',
+  '  a.v.v:=3;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_Record_SpecializeSelfInsideFail;
 begin
   StartProgram(false);
@@ -790,21 +806,6 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize;
-begin
-  StartProgram(false);
-  Add([
-  '{$mode objfpc}',
-  'type',
-  '  generic TBird<T> = record v: T; end;',
-  'var',
-  '  a: specialize TBird<specialize TBird<word>>;',
-  'begin',
-  '  a.v.v:=3;',
-  '']);
-  ParseProgram;
-end;
-
 procedure TTestResolveGenerics.TestGen_Class;
 begin
   StartProgram(false);
@@ -1261,6 +1262,22 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_AncestorTFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = class end;',
+  '  generic TFish<T: TBird> = class(T)',
+  '    v: T;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('class type expected, but T found',nXExpectedButYFound);
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_GenAncestor;
 begin
   StartProgram(false);

packages/pastojs/src/fppas2js.pp

@@ -571,6 +571,7 @@ type
     pbifnClassAncestorFunc,
     pbifnClassInstanceFree,
     pbifnClassInstanceNew,
+    pbifnClassInitSpecialize,
     pbifnCreateClass,
     pbifnCreateClassExt,
     pbifnCreateHelper,
@@ -695,6 +696,7 @@ type
     pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
     pbivnRTTIPointer_RefType, // reftype
     pbivnRTTIProcFlags, // flags
+    pbivnRTTIProc_InitSpec, // init
     pbivnRTTIProcVar_ProcSig, // procsig
     pbivnRTTIPropDefault, // Default
     pbivnRTTIPropIndex, // index
@@ -751,6 +753,7 @@ const
     '$ancestorfunc', // pbifnClassAncestorFunc
     '$destroy', // pbifnClassInstanceFree
     '$create', // pbifnClassInstanceNew
+    '$initSpec', // pbifnClassInitSpecialize
     'createClass', // pbifnCreateClass   rtl.createClass
     'createClassExt', // pbifnCreateClassExt  rtl.createClassExt
     'createHelper', // pbifnCreateHelper  rtl.createHelper
@@ -874,6 +877,7 @@ const
     'methodkind', // pbivnRTTIMethodKind
     'reftype', // pbivnRTTIPointer_RefType
     'flags', // pbivnRTTIProcFlags
+    'init', // pbivnRTTIProc_InitSpec
     'procsig', // pbivnRTTIProcVar_ProcSig
     'Default', // pbivnRTTIPropDefault
     'index', // pbivnRTTIPropIndex
@@ -1493,7 +1497,7 @@ type
     // generic/specialize
     procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem);
       override;
-    function SpecializeNeedsDelay(SpecializedItem: TPRSpecializedItem): TPasElement;
+    function SpecializeNeedsDelay(SpecializedItem: TPRSpecializedItem): TPasElement; virtual;
   protected
     const
       cJSValueConversion = 2*cTypeConversion;
@@ -1960,6 +1964,8 @@ type
     Function CreateImplementationSection(El: TPasModule; AContext: TConvertContext): TJSFunctionDeclarationStatement; virtual;
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
+    Procedure AddDelayedInits(El: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual;
+    Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     // set
     Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
     // record
@@ -1977,6 +1983,8 @@ type
       Fields: TFPList): TJSElement; virtual;
     Procedure CreateRecordRTTI(El: TPasRecordType; Src: TJSSourceElements;
       FuncContext: TFunctionContext); virtual;
+    Function CreateDelayedInitFunction(PosEl: TPasElement; Src: TJSSourceElements;
+      FuncContext: TFunctionContext; out DelaySrc: TJSSourceElements): TFunctionContext; virtual;
     // array
     Function CreateArrayConcat(ElTypeResolved: TPasResolverResult; PosEl: TPasElement;
       AContext: TConvertContext): TJSCallExpression; overload; virtual;
@@ -4949,15 +4957,23 @@ end;
 
 procedure TPas2JSResolver.SpecializeGenericImpl(
   SpecializedItem: TPRSpecializedItem);
+var
+  El: TPasElement;
 begin
   inherited SpecializeGenericImpl(SpecializedItem);
-  if SpecializedItem.SpecializedEl is TPasMembersType then
+
+  El:=SpecializedItem.SpecializedEl;
+  if (El is TPasGenericType)
+      and (SpecializeNeedsDelay(SpecializedItem)<>nil) then
+    TPas2JSResolverHub(Hub).AddJSDelaySpecialize(TPasGenericType(El));
+
+  if El is TPasMembersType then
     begin
     if FOverloadScopes=nil then
       begin
       FOverloadScopes:=TFPList.Create;
       try
-        RenameMembers(TPasMembersType(SpecializedItem.SpecializedEl));
+        RenameMembers(TPasMembersType(El));
       finally
         ClearOverloadScopes;
       end;
@@ -4980,9 +4996,7 @@ var
   ParamResolver, GenResolver: TPasResolver;
 begin
   Result:=nil;
-  {$IFNDEF EnableDelaySpecialize}
-  exit;
-  {$ENDIF}
+  if SpecializedItem=nil then exit;
   Gen:=SpecializedItem.GenericEl;
   GenSection:=GetParentSection(Gen);
   if not (GenSection is TInterfaceSection) then
@@ -4998,6 +5012,9 @@ begin
     Param:=ResolveAliasType(Params[i],false);
     if Param.ClassType=TPasUnresolvedSymbolRef then
       continue; // built-in type -> no delay needed
+    if (Param.CustomData is TPasGenericScope)
+        and (TPasGenericScope(Param.CustomData).GenericStep<psgsInterfaceParsed) then
+      exit(Param); // specialization is within param itself -> needs delay
     ParamSection:=GetParentSection(Param);
     if ParamSection=GenSection then
       continue; // same section -> no delay needed
@@ -7531,6 +7548,8 @@ Var
   ImplVarSt: TJSVariableStatement;
   HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean;
   UsesClause: TPasUsesClause;
+  Prg: TPasProgram;
+  Lib: TPasLibrary;
 begin
   Result:=Nil;
   OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
@@ -7594,15 +7613,18 @@ begin
 
       if (El is TPasProgram) then
         begin // program
-        if Assigned(TPasProgram(El).ProgramSection) then
-          AddToSourceElements(Src,ConvertDeclarations(TPasProgram(El).ProgramSection,IntfContext));
-        CreateInitSection(El,Src,IntfContext);
+        Prg:=TPasProgram(El);
+        if Assigned(Prg.ProgramSection) then
+          AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
+        AddDelayedInits(Prg,Src,IntfContext);
+        CreateInitSection(Prg,Src,IntfContext);
         end
       else if El is TPasLibrary then
         begin // library
-        if Assigned(TPasLibrary(El).LibrarySection) then
-          AddToSourceElements(Src,ConvertDeclarations(TPasLibrary(El).LibrarySection,IntfContext));
-        CreateInitSection(El,Src,IntfContext);
+        Lib:=TPasLibrary(El);
+        if Assigned(Lib.LibrarySection) then
+          AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
+        CreateInitSection(Lib,Src,IntfContext);
         end
       else
         begin // unit
@@ -14607,6 +14629,9 @@ var
   end;
 
 var
+  aResolver: TPas2JSResolver;
+  DelaySrc: TJSSourceElements;
+  DelayFuncContext: TFunctionContext;
   Call: TJSCallExpression;
   FunDecl: TJSFunctionDeclarationStatement;
   Src: TJSSourceElements;
@@ -14620,9 +14645,9 @@ var
   AncestorPath, OwnerName, DestructorName, FnName, IntfKind: String;
   C: TClass;
   AssignSt: TJSSimpleAssignStatement;
-  NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt: Boolean;
+  NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt,
+    SpecializeNeedsDelay: Boolean;
   Proc: TPasProcedure;
-  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
   aResolver:=AContext.Resolver;
@@ -14652,16 +14677,20 @@ begin
       end;
     FreeAndNil(Scope.MsgIntToProc);
     FreeAndNil(Scope.MsgStrToProc);
+    SpecializeNeedsDelay:=aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil;
     end
   else
     begin
     Scope:=nil;
     IsTObject:=(El.AncestorType=nil) and (El.ObjKind=okClass) and SameText(El.Name,'TObject');
     Ancestor:=El.AncestorType;
+    SpecializeNeedsDelay:=false;
     end;
 
   // create call 'rtl.createClass(' or 'rtl.createInterface('
   FuncContext:=nil;
+  DelaySrc:=nil;
+  DelayFuncContext:=nil;
   Call:=CreateCallExpression(El);
   try
     AncestorIsExternal:=(Ancestor is TPasClassType) and TPasClassType(Ancestor).IsExternal;
@@ -14797,7 +14826,16 @@ begin
           else
             RaiseNotSupported(P,FuncContext,20161221233338);
           if NewEl<>nil then
-            AddToSourceElements(Src,NewEl);
+            begin
+            if SpecializeNeedsDelay and not (P is TPasProcedure) then
+              begin
+              if DelayFuncContext=nil then
+                DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
+              AddToSourceElements(DelaySrc,NewEl);
+              end
+            else
+              AddToSourceElements(Src,NewEl);
+            end;
           end;
         end;
 
@@ -14861,7 +14899,14 @@ begin
         AddClassMessageIds(El,Src,FuncContext,pbivnMessageInt);
         AddClassMessageIds(El,Src,FuncContext,pbivnMessageStr);
         // add RTTI init function
-        AddClassRTTI(El,Src,FuncContext);
+        if SpecializeNeedsDelay then
+          begin
+          if DelayFuncContext=nil then
+            DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
+          AddClassRTTI(El,DelaySrc,DelayFuncContext);
+          end
+        else
+          AddClassRTTI(El,Src,FuncContext);
         end;
 
       end;// end of init function
@@ -15335,10 +15380,16 @@ function TPasToJSConverter.ConvertProcedureType(El: TPasProcedureType;
 //   module.$rtti.$ProcVar("name",{
 //       procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags)
 //     })
+// "of object":
 //   module.$rtti.$MethodVar("name",{
 //       procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags),
 //       methodkind: 1
 //     })
+// delayed specialization:
+//   module.$rtti.$MethodVar("name",{
+//       init: function()}{ this.procsig = rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags)},
+//       methodkind: 1
+//     })
 var
   Call, InnerCall: TJSCallExpression;
   FunName: String;
@@ -15349,6 +15400,10 @@ var
   Obj: TJSObjectLiteral;
   Prop: TJSObjectLiteralElement;
   aResolver: TPas2JSResolver;
+  Scope: TPasProcTypeScope;
+  SpecializeNeedsDelay: Boolean;
+  FuncSt: TJSFunctionDeclarationStatement;
+  AssignSt: TJSSimpleAssignStatement;
 begin
   Result:=nil;
   aResolver:=AContext.Resolver;
@@ -15359,11 +15414,16 @@ begin
   if not (El.CallingConvention in [ccDefault,ccSafeCall]) then
     DoError(20170222231532,nPasElementNotSupported,sPasElementNotSupported,
         ['calling convention '+cCallingConventions[El.CallingConvention]],El);
-  if not HasTypeInfo(El,AContext) then exit;
+  if not HasTypeInfo(El,AContext) then
+    exit; // no RTTI needed
 
   if El.Parent is TProcedureBody then
     RaiseNotSupported(El,AContext,20181231112029);
 
+  Scope:=El.CustomData as TPasProcTypeScope;
+  SpecializeNeedsDelay:=(Scope<>nil)
+           and (aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil);
+
   // module.$rtti.$ProcVar("name",function(){})
   if El.IsReferenceTo then
     FunName:=GetBIName(pbifnRTTINewRefToProcVar)
@@ -15375,9 +15435,25 @@ begin
   try
     // add "procsig: rtl.newTIProcSignature()"
     Prop:=Obj.Elements.AddElement;
-    Prop.Name:=TJSString(GetBIName(pbivnRTTIProcVar_ProcSig));
     InnerCall:=CreateCallExpression(El);
-    Prop.Expr:=InnerCall;
+
+    if SpecializeNeedsDelay then
+      begin
+      Prop.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec));
+      // init: function(){ this.procsig = rtl.newTIProcSignature(...) }
+      FuncSt:=CreateFunctionSt(El);
+      Prop.Expr:=FuncSt;
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=CreatePrimitiveDotExpr('this.'+GetBIName(pbivnRTTIProcVar_ProcSig),El);
+      AssignSt.Expr:=InnerCall;
+      FuncSt.AFunction.Body.A:=AssignSt;
+      end
+    else
+      begin
+      Prop.Name:=TJSString(GetBIName(pbivnRTTIProcVar_ProcSig));
+      Prop.Expr:=InnerCall;
+      end;
+
     InnerCall.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnRTTINewProcSig)]);
     // add array of arguments
     InnerCall.AddArg(CreateRTTIArgList(El,El.Args,AContext));
@@ -16628,6 +16704,59 @@ begin
   inc(SectionCtx.HeaderIndex);
 end;
 
+procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram;
+  Src: TJSSourceElements; AContext: TConvertContext);
+var
+  aResolver: TPas2JSResolver;
+  Hub: TPas2JSResolverHub;
+  i: Integer;
+begin
+  aResolver:=AContext.Resolver;
+  if aResolver=nil then exit;
+  if El=nil then ;
+  Hub:=aResolver.Hub as TPas2JSResolverHub;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.AddDelayedInits Hub.JSDelaySpecializeCount=',Hub.JSDelaySpecializeCount);
+  {$ENDIF}
+  for i:=0 to Hub.JSDelaySpecializeCount-1 do
+    AddDelaySpecializeInit(Hub.JSDelaySpecializes[i],Src,AContext);
+end;
+
+procedure TPasToJSConverter.AddDelaySpecializeInit(El: TPasGenericType;
+  Src: TJSSourceElements; AContext: TConvertContext);
+var
+  C: TClass;
+  Path: String;
+  Call: TJSCallExpression;
+  DotExpr: TJSDotMemberExpression;
+begin
+  if not IsElementUsed(El) then exit;
+  C:=El.ClassType;
+  if (C=TPasRecordType)
+      or (C=TPasClassType) then
+    begin
+    // pas.unitname.recordtype.$initSpec();
+    Path:=CreateReferencePath(El,AContext,rpkPathAndName)+'.'+GetBIName(pbifnClassInitSpecialize);
+    Call:=CreateCallExpression(El);
+    Call.Expr:=CreatePrimitiveDotExpr(Path,El);
+    AddToSourceElements(Src,Call);
+    end
+  else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+    begin
+    if not HasTypeInfo(El,AContext) then
+      exit; // no RTTI needed
+    // pas.unitname.$rtti.TProcF.init();
+    DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+    DotExpr.MExpr:=CreateTypeInfoRef(El,AContext,El);
+    DotExpr.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec));
+    Call:=CreateCallExpression(El);
+    Call.Expr:=DotExpr;
+    AddToSourceElements(Src,Call);
+    end
+  else
+    RaiseNotSupported(El,AContext,20200831115251);
+end;
+
 function TPasToJSConverter.CreateReferencedSet(El: TPasElement; SetExpr: TJSElement
   ): TJSElement;
 var
@@ -17041,6 +17170,25 @@ begin
   end;
 end;
 
+function TPasToJSConverter.CreateDelayedInitFunction(PosEl: TPasElement;
+  Src: TJSSourceElements; FuncContext: TFunctionContext; out
+  DelaySrc: TJSSourceElements): TFunctionContext;
+var
+  AssignSt: TJSSimpleAssignStatement;
+  FunDecl: TJSFunctionDeclarationStatement;
+begin
+  // this.$initSpec = function(){ DelaySrc }
+  AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PosEl));
+  AddToSourceElements(Src,AssignSt);
+  AssignSt.LHS:=CreatePrimitiveDotExpr('this.'+GetBIName(pbifnClassInitSpecialize),PosEl);
+  FunDecl:=CreateFunctionSt(PosEl,true,true);
+  AssignSt.Expr:=FunDecl;
+  DelaySrc:=TJSSourceElements(FunDecl.AFunction.Body.A);
+  Result:=TFunctionContext.Create(PosEl,DelaySrc,FuncContext);
+  Result.IsGlobal:=true;
+  Result.ThisPas:=PosEl;
+end;
+
 function TPasToJSConverter.CreateArrayConcat(
   ElTypeResolved: TPasResolverResult; PosEl: TPasElement;
   AContext: TConvertContext): TJSCallExpression;
@@ -23593,8 +23741,8 @@ begin
     // element is in foreign unit -> use pas.unitname
     CurModule:=Parent.GetModule;
     Result:=TransformModuleName(CurModule,true,AContext);
-    if (CurModule<>AContext.GetRootContext.PasElement.GetModule)
-        and (Parent is TImplementationSection) then
+    if (Parent.ClassType=TImplementationSection)
+        and (CurModule<>AContext.GetRootContext.PasElement.GetModule) then
       begin
       // element is in foreign implementation section (not program/library section)
       // -> use pas.unitname.$impl
@@ -24715,6 +24863,10 @@ end;
 function TPasToJSConverter.ConvertRecordType(El: TPasRecordType;
   AContext: TConvertContext): TJSElement;
 var
+  aResolver: TPas2JSResolver;
+  RecScope: TPas2JSRecordScope;
+  DelaySrc: TJSSourceElements;
+  DelayFuncContext: TFunctionContext;
   Call: TJSCallExpression;
   JSParentName: String;
   FunDecl: TJSFunctionDeclarationStatement;
@@ -24724,14 +24876,11 @@ var
   P: TPasElement;
   C: TClass;
   NewEl: TJSElement;
-  aResolver: TPas2JSResolver;
   PasVar: TPasVariable;
   PasVarType: TPasType;
   NewFields, Vars, Methods: TFPList;
-  ok, IsFull: Boolean;
+  ok, IsComplex, SpecializeNeedsDelay: Boolean;
   VarSt: TJSVariableStatement;
-  bifn: TPas2JSBuiltInName;
-  RecScope: TPas2JSRecordScope;
 begin
   Result:=nil;
   if El.Name='' then
@@ -24745,21 +24894,16 @@ begin
   NewFields:=nil;
   Vars:=nil;
   Methods:=nil;
+  DelaySrc:=nil;
+  DelayFuncContext:=nil;
   ok:=false;
   try
-    // rtl.recNewT()
-    Call:=CreateCallExpression(El);
-    bifn:=pbifnRecordCreateType;
-
     RecScope:=TPas2JSRecordScope(El.CustomData);
-    if RecScope.SpecializedFromItem<>nil then
-      begin
-      // ToDo
-      if aResolver.SpecializeNeedsDelay(RecScope.SpecializedFromItem)<>nil then
-        ;//bifn:=pbifnRecordCreateSpecializeType;
-      end;
+    SpecializeNeedsDelay:=aResolver.SpecializeNeedsDelay(RecScope.SpecializedFromItem)<>nil;
 
-    Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(bifn)]);
+    // rtl.recNewT()
+    Call:=CreateCallExpression(El);
+    Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnRecordCreateType)]);
 
     // types are stored in interface/implementation
     if El.Parent is TProcedureBody then
@@ -24809,7 +24953,7 @@ begin
     NewFields:=TFPList.Create;
     Vars:=TFPList.Create;
     Methods:=TFPList.Create;
-    IsFull:=false;
+    IsComplex:=false;
     for i:=0 to El.Members.Count-1 do
       begin
       P:=TPasElement(El.Members[i]);
@@ -24820,8 +24964,8 @@ begin
       if C=TPasVariable then
         begin
         PasVar:=TPasVariable(P);
-        if ClassVarModifiersType*TPasVariable(P).VarModifiers*[vmClass, vmStatic]<>[] then
-          IsFull:=true
+        if ClassVarModifiersType*PasVar.VarModifiers*[vmClass, vmStatic]<>[] then
+          IsComplex:=true
         else if aResolver<>nil then
           begin
           Vars.Add(PasVar);
@@ -24843,14 +24987,18 @@ begin
             // sub set
             NewFields.Add(PasVar);
             continue;
+            end
+          else
+            begin
+            // simple vars are initialized in the record type, no need to initialize them for each instance
             end;
           end;
-        NewEl:=CreateVarDecl(TPasVariable(P),FuncContext); // can be nil
+        NewEl:=CreateVarDecl(PasVar,FuncContext); // can be nil
         end
       else if C=TPasConst then
         begin
         NewEl:=ConvertConst(TPasConst(P),aContext);
-        IsFull:=true;
+        IsComplex:=true;
         end
       else if C=TPasProperty then
         NewEl:=ConvertProperty(TPasProperty(P),AContext)
@@ -24858,7 +25006,7 @@ begin
         begin
         NewEl:=CreateTypeDecl(TPasType(P),aContext);
         if (C=TPasRecordType) or (C=TPasClassType) then
-          IsFull:=true;
+          IsComplex:=true;
         end
       else if C.InheritsFrom(TPasProcedure) then
         begin
@@ -24871,18 +25019,26 @@ begin
           if (C=TPasConstructor)
               or ((aResolver<>nil) and aResolver.IsClassMethod(P)
                 and not aResolver.MethodIsStatic(TPasProcedure(P))) then
-            IsFull:=true; // needs $record
+            IsComplex:=true; // needs $record
           end;
         end
       else if C=TPasAttributes then
-        // ToDo
       else
         RaiseNotSupported(P,FuncContext,20190105105436);
       if NewEl<>nil then
-        AddToSourceElements(Src,NewEl);
+        begin
+        if SpecializeNeedsDelay and not (P is TPasProcedure) then
+          begin
+          if DelayFuncContext=nil then
+            DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
+          AddToSourceElements(DelaySrc,NewEl);
+          end
+        else
+          AddToSourceElements(Src,NewEl);
+        end;
       end;
-    if IsFull then
-      Call.AddArg(CreateLiteralBoolean(El,true));
+    if IsComplex then
+      Call.AddArg(CreateLiteralBoolean(El,true)); // needs $record
 
     // add $new function if needed
     if NewFields.Count>0 then
@@ -24901,13 +25057,23 @@ begin
 
     // add RTTI init function
     if (aResolver<>nil) and HasTypeInfo(El,FuncContext) then
-      CreateRecordRTTI(El,Src,FuncContext);
+      begin
+      if SpecializeNeedsDelay then
+        begin
+        if DelayFuncContext=nil then
+          DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
+        CreateRecordRTTI(El,DelaySrc,DelayFuncContext);
+        end
+      else
+        CreateRecordRTTI(El,Src,FuncContext);
+      end;
 
     ok:=true;
   finally
     NewFields.Free;
     Vars.Free;
     Methods.Free;
+    DelayFuncContext.Free;
     FuncContext.Free;
     if not ok then
       FreeAndNil(Result);

packages/pastojs/tests/tcgenerics.pas

@@ -17,9 +17,11 @@ type
     // generic record
     Procedure TestGen_RecordEmpty;
     Procedure TestGen_Record_ClassProc;
-    Procedure TestGen_Record_AsClassVar_Program;
-    Procedure TestGen_Record_AsClassVar_UnitImpl; // ToDo
-    // ToDo: delay using recNewS
+    Procedure TestGen_Record_ClassVarRecord_Program;
+    Procedure TestGen_Record_ClassVarRecord_UnitImpl;
+    Procedure TestGen_Record_RTTI_UnitImpl;
+    // ToDo: delay RTTI with anonymous array  a:array of T, array[1..2] of T
+    // ToDo: type alias type as parameter, TBird = type word;
 
     // generic class
     Procedure TestGen_ClassEmpty;
@@ -38,6 +40,7 @@ type
     procedure TestGen_Class_VarArgsOfType;
     procedure TestGen_Class_OverloadsInUnit;
     procedure TestGen_ClassForward_CircleRTTI;
+    Procedure TestGen_Class_ClassVarRecord_UnitImpl;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
@@ -67,11 +70,16 @@ type
     procedure TestGenProc_TypeInfo;
     procedure TestGenProc_Infer_Widen;
     procedure TestGenProc_Infer_PassAsArg;
-    // ToDo: delay create: type TRec=record end; ... r:=GenProc<TRec>();
     // ToDo: FuncName:= instead of Result:=
 
     // generic methods
     procedure TestGenMethod_ObjFPC;
+
+    // generic array
+    // procedure TestGen_ArrayOfUnitImplRec;  ToDo dynamic + static + RTTI
+
+    // generic procedure type
+    procedure TestGen_ProcType_ParamUnitImpl;
   end;
 
 implementation
@@ -157,7 +165,7 @@ begin
     '']));
 end;
 
-procedure TTestGenerics.TestGen_Record_AsClassVar_Program;
+procedure TTestGenerics.TestGen_Record_ClassVarRecord_Program;
 begin
   StartProgram(false);
   Add([
@@ -174,7 +182,7 @@ begin
   '  f.x.b:=f.x.b+10;',
   '']);
   ConvertProgram;
-  CheckSource('TestGen_Record_AsClassVar_Program',
+  CheckSource('TestGen_Record_ClassVarRecord_Program',
     LinesToStr([ // statements
     'rtl.recNewT($mod, "TBird", function () {',
     '  this.b = 0;',
@@ -202,8 +210,78 @@ begin
     '']));
 end;
 
-procedure TTestGenerics.TestGen_Record_AsClassVar_UnitImpl;
+procedure TTestGenerics.TestGen_Record_ClassVarRecord_UnitImpl;
+begin
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  generic TAnt<T> = record',
+  '    class var x: T;',
+  '    class var a: array[1..2] of T;',
+  '  end;',
+  '']),
+  LinesToStr([
+  'type',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var f: specialize TAnt<TBird>;',
+  'begin',
+  '  f.x.b:=f.x.b+10;',
+  '']));
+  Add([
+  'uses UnitA;',
+  'begin',
+  'end.']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.recNewT($mod, "TAnt$G1", function () {',
+    '    this.$initSpec = function () {',
+    '      this.x = $impl.TBird.$new();',
+    '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
+    '    };',
+    '    this.$eq = function (b) {',
+    '      return true;',
+    '    };',
+    '    this.$assign = function (s) {',
+    '    return this;',
+    '    };',
+    '  }, true);',
+    '  $mod.$init = function () {',
+    '    $impl.f.x.b = $impl.f.x.b + 10;',
+    '  };',
+    '}, null, function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.recNewT($impl, "TBird", function () {',
+    '    this.b = 0;',
+    '    this.$eq = function (b) {',
+    '      return this.b === b.b;',
+    '    };',
+    '    this.$assign = function (s) {',
+    '      this.b = s.b;',
+    '      return this;',
+    '    };',
+    '  });',
+    '  $impl.f = $mod.TAnt$G1.$new();',
+    '});']));
+  CheckSource('TestGen_Record_ClassVarRecord_UnitImpl',
+    LinesToStr([ // statements
+    'pas.UnitA.TAnt$G1.$initSpec();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_Record_RTTI_UnitImpl;
 begin
+  WithTypeInfo:=true;
   StartUnit(true);
   Add([
   'interface',
@@ -211,6 +289,7 @@ begin
   'type',
   '  generic TAnt<T> = record',
   '    class var x: T;',
+  //'    class var a,b: array of T;',
   '  end;',
   'implementation',
   'type',
@@ -218,15 +297,20 @@ begin
   '    b: word;',
   '  end;',
   'var f: specialize TAnt<TBird>;',
+  '  p: pointer;',
   'begin',
-  '  f.x.b:=f.x.b+10;',
+  '  p:=typeinfo(f);',
   '']);
   ConvertUnit;
-  CheckSource('TestGen_Record_AsClassVar_UnitImpl',
+  CheckSource('TestGen_Record_RTTI_UnitImpl',
     LinesToStr([ // statements
     'var $impl = $mod.$impl;',
     'rtl.recNewT($mod, "TAnt$G1", function () {',
-    '  this.x = $impl.TBird.$new();',
+    '  this.$initSpec = function () {',
+    '    this.x = $impl.TBird.$new();',
+    '    var $r = $mod.$rtti.$Record("TAnt$G1", {});',
+    '    $r.addField("x", $mod.$rtti["TBird"]);',
+    '  };',
     '  this.$eq = function (b) {',
     '    return true;',
     '  };',
@@ -236,7 +320,7 @@ begin
     '}, true);',
     '']),
     LinesToStr([ // $mod.$init
-    '  $impl.f.x.b = $impl.f.x.b + 10;',
+    '$impl.p = $mod.$rtti["TAnt$G1"];',
     '']),
     LinesToStr([ // statements
     'rtl.recNewT($impl, "TBird", function () {',
@@ -248,9 +332,11 @@ begin
     '    this.b = s.b;',
     '    return this;',
     '  };',
+    '  var $r = $mod.$rtti.$Record("TBird", {});',
+    '  $r.addField("b", rtl.word);',
     '});',
-    //'$mod.TAnt$G1();',
     '$impl.f = $mod.TAnt$G1.$new();',
+    '$impl.p = null;',
     '']));
 end;
 
@@ -489,7 +575,7 @@ end;
 
 procedure TTestGenerics.TestGen_Class_TypeInfo;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -952,7 +1038,7 @@ end;
 
 procedure TTestGenerics.TestGen_ClassForward_CircleRTTI;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   '{$mode objfpc}',
@@ -1025,6 +1111,69 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Class_ClassVarRecord_UnitImpl;
+begin
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  'type',
+  '  generic TAnt<T> = class',
+  '  public',
+  '    class var x: T;',
+  '    class var a: array[1..2] of T;',
+  '  end;',
+  '']),
+  LinesToStr([
+  'type',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var f: specialize TAnt<TBird>;',
+  'begin',
+  '  f.x.b:=f.x.b+10;',
+  '']));
+  Add([
+  'uses UnitA;',
+  'begin',
+  'end.']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.createClass($mod, "TAnt$G1", pas.system.TObject, function () {',
+    '    this.$initSpec = function () {',
+    '      this.x = $impl.TBird.$new();',
+    '      this.a = rtl.arraySetLength(null, $impl.TBird, 2);',
+    '    };',
+    '  });',
+    '  $mod.$init = function () {',
+    '    $impl.f.x.b = $impl.f.x.b + 10;',
+    '  };',
+    '}, null, function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.recNewT($impl, "TBird", function () {',
+    '    this.b = 0;',
+    '    this.$eq = function (b) {',
+    '      return this.b === b.b;',
+    '    };',
+    '    this.$assign = function (s) {',
+    '      this.b = s.b;',
+    '      return this;',
+    '    };',
+    '  });',
+    '  $impl.f = null;',
+    '});']));
+  CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
+    LinesToStr([ // statements
+    'pas.UnitA.TAnt$G1.$initSpec();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);
@@ -1144,7 +1293,7 @@ end;
 
 procedure TTestGenerics.TestGen_ExtClass_RTTI;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   '{$mode objfpc}',
@@ -1663,7 +1812,7 @@ end;
 
 procedure TTestGenerics.TestGenProc_TypeInfo;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$modeswitch implicitfunctionspecialization}',
@@ -1825,6 +1974,70 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ProcType_ParamUnitImpl;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  'type',
+  '  generic TAnt<T> = function(const a: T): T;',
+  '']),
+  LinesToStr([
+  'type',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var',
+  '  f: specialize TAnt<TBird>;',
+  '  b: TBird;',
+  'begin',
+  '  b:=f(b);',
+  '']));
+  Add([
+  'uses UnitA;',
+  'begin',
+  'end.']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  $mod.$rtti.$ProcVar("TAnt$G1", {',
+    '    init: function () {',
+    '      this.procsig = rtl.newTIProcSig([["a", $mod.$rtti["TBird"], 2]], $mod.$rtti["TBird"]);',
+    '    }',
+    '  });',
+    '  $mod.$init = function () {',
+    '    $impl.b.$assign($impl.f($impl.b));',
+    '  };',
+    '}, null, function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.recNewT($impl, "TBird", function () {',
+    '    this.b = 0;',
+    '    this.$eq = function (b) {',
+    '      return this.b === b.b;',
+    '    };',
+    '    this.$assign = function (s) {',
+    '      this.b = s.b;',
+    '      return this;',
+    '    };',
+    '    var $r = $mod.$rtti.$Record("TBird", {});',
+    '    $r.addField("b", rtl.word);',
+    '  });',
+    '  $impl.f = null;',
+    '  $impl.b = $impl.TBird.$new();',
+    '});']));
+  CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
+    LinesToStr([ // statements
+    'pas.UnitA.$rtti["TAnt$G1"].init();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestGenerics]);
 end.

packages/pastojs/tests/tcmodules.pas

@@ -32,7 +32,7 @@ uses
 const
   // default parser+scanner options
   po_tcmodules = po_Pas2js+[po_KeepScannerError];
-  co_tcmodules = [coNoTypeInfo];
+  co_tcmodules = [];
 type
   TSrcMarkerKind = (
     mkLabel,
@@ -132,6 +132,7 @@ type
     FSkipTests: boolean;
     FSource: TStringList;
     FFirstPasStatement: TPasImplBlock;
+    FWithTypeInfo: boolean;
     {$IFDEF EnablePasTreeGlobalRefCount}
     FElementRefCountAtSetup: int64;
     {$ENDIF}
@@ -143,6 +144,7 @@ type
     procedure OnParserLog(Sender: TObject; const Msg: String);
     procedure OnPasResolverLog(Sender: TObject; const Msg: String);
     procedure OnScannerLog(Sender: TObject; const Msg: String);
+    procedure SetWithTypeInfo(const AValue: boolean);
   protected
     procedure SetUp; override;
     function CreateConverter: TPasToJSConverter; virtual;
@@ -224,6 +226,7 @@ type
     property Parser: TTestPasParser read FParser;
     property MsgCount: integer read GetMsgCount;
     property Msgs[Index: integer]: TTestHintMessage read GetMsgs;
+    property WithTypeInfo: boolean read FWithTypeInfo write SetWithTypeInfo;
   end;
 
   { TTestModule }
@@ -1248,6 +1251,16 @@ begin
   FHintMsgs.Add(Item);
 end;
 
+procedure TCustomTestModule.SetWithTypeInfo(const AValue: boolean);
+begin
+  if FWithTypeInfo=AValue then Exit;
+  FWithTypeInfo:=AValue;
+  if AValue then
+    Converter.Options:=Converter.Options-[coNoTypeInfo]
+  else
+    Converter.Options:=Converter.Options+[coNoTypeInfo];
+end;
+
 function TCustomTestModule.LoadUnit(const aUnitName: String): TPasModule;
 var
   i: Integer;
@@ -1311,6 +1324,7 @@ begin
 
   inherited SetUp;
   FSkipTests:=false;
+  FWithTypeInfo:=false;
   FSource:=TStringList.Create;
 
   FHub:=TPas2JSResolverHub.Create(Self);
@@ -1339,9 +1353,16 @@ begin
 end;
 
 function TCustomTestModule.CreateConverter: TPasToJSConverter;
+var
+  Options: TPasToJsConverterOptions;
 begin
   Result:=TPasToJSConverter.Create;
-  Result.Options:=co_tcmodules;
+  Options:=co_tcmodules;
+  if WithTypeInfo then
+    Exclude(Options,coNoTypeInfo)
+  else
+    Include(Options,coNoTypeInfo);
+  Result.Options:=Options;
   Result.Globals:=TPasToJSConverterGlobals.Create(Result);
 end;
 
@@ -1375,6 +1396,7 @@ begin
   FHintMsgs.Clear;
   FHintMsgsGood.Clear;
   FSkipTests:=false;
+  FWithTypeInfo:=false;
   FJSRegModuleCall:=nil;
   FJSModuleCallArgs:=nil;
   FJSImplentationUses:=nil;
@@ -2070,6 +2092,7 @@ var
 begin
   aResolver:=GetResolver(Filename);
   AssertNotNull('missing resolver of unit '+Filename,aResolver);
+  AssertNotNull('missing resolver.module of unit '+Filename,aResolver.Module);
   {$IFDEF VerbosePas2JS}
   writeln('CheckUnit '+Filename+' converting ...');
   {$ENDIF}
@@ -16150,7 +16173,7 @@ end;
 
 procedure TTestModule.TestNestedClass_Alias;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -16186,7 +16209,7 @@ end;
 
 procedure TTestModule.TestNestedClass_Record;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -16252,7 +16275,7 @@ end;
 
 procedure TTestModule.TestNestedClass_Class;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -28502,7 +28525,7 @@ end;
 
 procedure TTestModule.TestRTTI_IntRange;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$modeswitch externalclass}',
@@ -28540,7 +28563,7 @@ end;
 
 procedure TTestModule.TestRTTI_Double;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$modeswitch externalclass}',
@@ -28566,7 +28589,7 @@ end;
 
 procedure TTestModule.TestRTTI_ProcType;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TProcA = procedure;');
@@ -28609,7 +28632,7 @@ end;
 
 procedure TTestModule.TestRTTI_ProcType_ArgFromOtherUnit;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
 
   AddModuleWithIntfImplSrc('unit2.pas',
     LinesToStr([
@@ -28651,7 +28674,7 @@ end;
 
 procedure TTestModule.TestRTTI_EnumAndSetType;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TFlag = (light,dark);');
@@ -28692,7 +28715,7 @@ end;
 
 procedure TTestModule.TestRTTI_EnumRange;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -28709,7 +28732,7 @@ end;
 
 procedure TTestModule.TestRTTI_AnonymousEnumType;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TFlags = set of (red, green);');
@@ -28744,7 +28767,7 @@ end;
 
 procedure TTestModule.TestRTTI_StaticArray;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TFlag = (light,dark);');
@@ -28796,7 +28819,7 @@ end;
 
 procedure TTestModule.TestRTTI_DynArray;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TArrStr = array of string;');
@@ -28828,7 +28851,7 @@ end;
 
 procedure TTestModule.TestRTTI_ArrayNestedAnonymous;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TArr = array of array of longint;');
@@ -28851,7 +28874,7 @@ end;
 
 procedure TTestModule.TestRTTI_PublishedMethodOverloadFail;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -28867,7 +28890,7 @@ end;
 
 procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -28882,7 +28905,7 @@ end;
 
 procedure TTestModule.TestRTTI_PublishedClassPropertyFail;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -28898,7 +28921,7 @@ end;
 
 procedure TTestModule.TestRTTI_PublishedClassFieldFail;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -28913,7 +28936,7 @@ end;
 
 procedure TTestModule.TestRTTI_PublishedFieldExternalFail;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('{$modeswitch externalclass}');
   Add('type');
@@ -28929,7 +28952,7 @@ end;
 
 procedure TTestModule.TestRTTI_Class_Field;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('{$modeswitch externalclass}');
   Add('type');
@@ -29009,7 +29032,7 @@ end;
 
 procedure TTestModule.TestRTTI_Class_Method;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -29045,7 +29068,7 @@ end;
 
 procedure TTestModule.TestRTTI_Class_MethodArgFlags;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -29075,7 +29098,7 @@ end;
 
 procedure TTestModule.TestRTTI_Class_Property;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('{$modeswitch externalclass}');
   Add('type');
@@ -29154,7 +29177,7 @@ end;
 
 procedure TTestModule.TestRTTI_Class_PropertyParams;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('{$modeswitch externalclass}');
   Add('type');
@@ -29189,7 +29212,7 @@ end;
 
 procedure TTestModule.TestRTTI_Class_OtherUnit_TypeAlias;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   AddModuleWithIntfImplSrc('unit1.pas',
     'type TColor = -5..5;',
     '');
@@ -29236,7 +29259,7 @@ end;
 
 procedure TTestModule.TestRTTI_Class_OmitRTTI;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   '{$modeswitch omitrtti}',
@@ -29265,7 +29288,7 @@ end;
 
 procedure TTestModule.TestRTTI_IndexModifier;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -29344,7 +29367,7 @@ end;
 
 procedure TTestModule.TestRTTI_StoredModifier;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'const',
@@ -29404,7 +29427,7 @@ end;
 
 procedure TTestModule.TestRTTI_DefaultValue;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -29531,7 +29554,7 @@ end;
 
 procedure TTestModule.TestRTTI_DefaultValueSet;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -29624,7 +29647,7 @@ end;
 
 procedure TTestModule.TestRTTI_DefaultValueRangeType;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -29674,7 +29697,7 @@ end;
 
 procedure TTestModule.TestRTTI_DefaultValueInherit;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -29721,7 +29744,7 @@ end;
 
 procedure TTestModule.TestRTTI_OverrideMethod;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -29756,7 +29779,7 @@ end;
 
 procedure TTestModule.TestRTTI_ReintroduceMethod;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -29801,7 +29824,7 @@ end;
 
 procedure TTestModule.TestRTTI_OverloadProperty;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class');
@@ -29838,7 +29861,7 @@ end;
 
 procedure TTestModule.TestRTTI_ClassForward;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TObject = class end;');
@@ -29906,7 +29929,7 @@ end;
 
 procedure TTestModule.TestRTTI_ClassOf;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TClass = class of tobject;');
@@ -29968,7 +29991,7 @@ end;
 
 procedure TTestModule.TestRTTI_Record;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  integer = longint;');
@@ -30011,7 +30034,7 @@ end;
 
 procedure TTestModule.TestRTTI_RecordAnonymousArray;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('type');
   Add('  TFloatRec = record');
@@ -30061,7 +30084,7 @@ end;
 
 procedure TTestModule.TestRTTI_LocalTypes;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'procedure DoIt;',
@@ -30099,7 +30122,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_BaseTypes;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -30173,7 +30196,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_Type_BaseTypes;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   'type',
@@ -30246,7 +30269,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_LocalFail;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add('procedure DoIt;');
   Add('type');
@@ -30265,7 +30288,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$modeswitch externalclass}',
@@ -30333,7 +30356,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add('{$modeswitch externalclass}');
   Add('type');
@@ -30399,7 +30422,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add('{$modeswitch externalclass}');
   Add('type');
@@ -30464,7 +30487,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$modeswitch externalclass}',
@@ -30535,7 +30558,7 @@ end;
 
 procedure TTestModule.TestRTTI_TypeInfo_MixedUnits_PointerAndClass;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   AddModuleWithIntfImplSrc('typinfo.pas',
     LinesToStr([
     '{$modeswitch externalclass}',
@@ -30615,7 +30638,7 @@ end;
 
 procedure TTestModule.TestRTTI_Interface_Corba;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$interfaces corba}',
@@ -30678,7 +30701,7 @@ end;
 
 procedure TTestModule.TestRTTI_Interface_COM;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$interfaces com}',
@@ -30753,7 +30776,7 @@ end;
 
 procedure TTestModule.TestRTTI_ClassHelper;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$interfaces com}',
@@ -30801,7 +30824,7 @@ end;
 
 procedure TTestModule.TestRTTI_ExternalClass;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(true,[supTypeInfo]);
   Add([
   '{$modeswitch externalclass}',
@@ -30958,7 +30981,7 @@ end;
 
 procedure TTestModule.TestAttributes_Members;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   '{$modeswitch PrefixedAttributes}',
@@ -31054,7 +31077,7 @@ end;
 
 procedure TTestModule.TestAttributes_Types;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   '{$modeswitch PrefixedAttributes}',
@@ -31124,7 +31147,7 @@ end;
 
 procedure TTestModule.TestAttributes_HelperConstructor_Fail;
 begin
-  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   '{$modeswitch PrefixedAttributes}',

utils/pas2js/dist/rtl.js

@@ -460,6 +460,7 @@ var rtl = {
       h(t,'$name');
       h(t,'$parent');
       h(t,'$module');
+      h(t,'$initSpec');
     }
     initfn.call(t);
     if (!t.$new){