Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@46754 -
nickysn 5 years ago
parent
commit
96052c8d92

+ 9 - 0
compiler/xtensa/ncpumat.pas

@@ -37,6 +37,7 @@ interface
 
       tcpunotnode = class(tcgnotnode)
         procedure second_boolean;override;
+        function pass_1: tnode;override;
       end;
 
       tcpuunaryminusnode = class(tcgunaryminusnode)
@@ -108,6 +109,14 @@ implementation
                                TCPUNOTNODE
 *****************************************************************************}
 
+    function tcpunotnode.pass_1 : tnode;
+      begin
+        result:=nil;
+        firstpass(left);
+        expectloc:=LOC_REGISTER;
+      end;
+
+
     procedure tcpunotnode.second_boolean;
       var
         tmpreg, hreg1, hreg2, hreg3: TRegister;

+ 3 - 2
packages/fcl-json/src/jsonreader.pp

@@ -175,9 +175,10 @@ Resourcestring
   SErrExpectedColon   = 'Expected colon (:), got token "%s".';
   //SErrEmptyElement = 'Empty element encountered.';
   SErrExpectedElementName    = 'Expected element name, got token "%s"';
-  SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
+  SExpectedCommaorBraceClose = 'Expected comma (,) or square bracket (]), got token "%s".';
   SErrInvalidNumber          = 'Number is not an integer or real number: %s';
   SErrNoScanner = 'No scanner. No source specified ?';
+  SErrorAt = 'Error at line %d, Pos %d: ';
   
 { TBaseJSONReader }
 
@@ -408,7 +409,7 @@ Var
 
 begin
   S:=Format(Msg,[CurrentTokenString]);
-  S:=Format('Error at line %d, Pos %d:',[FScanner.CurRow,FSCanner.CurColumn])+S;
+  S:=Format(SErrorAt,[FScanner.CurRow,FSCanner.CurColumn])+S;
   Raise EJSONParser.Create(S);
 end;
 

+ 10 - 6
packages/fcl-passrc/src/pasresolver.pp

@@ -5672,17 +5672,21 @@ begin
     ParentScope:=Scopes[ScopeCount-2];
     if ParentScope is TPasSectionScope then
       begin
+      // check unit interface and implementation duplicates
       OlderIdentifier:=TPasSectionScope(ParentScope).FindLocalIdentifier(aName);
-      if IsGeneric then
-        OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
-      if OlderIdentifier<>nil then
-        begin
+      repeat
+        if IsGeneric then
+          OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
+        if OlderIdentifier=nil then break;
         OlderEl:=OlderIdentifier.Element;
-        if (Identifier.Kind=pikSimple)
+        if (Identifier.Kind=pikNamespace)
+            or (OlderIdentifier.Kind=pikNamespace) then
+        else if (Identifier.Kind=pikSimple)
             or (OlderIdentifier.Kind=pikSimple) then
           RaiseMsg(20190818141630,nDuplicateIdentifier,sDuplicateIdentifier,
                    [aName,GetElementSourcePosStr(OlderEl)],El);
-        end;
+        OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
+      until OlderIdentifier=nil;
       end;
     end;
 

+ 2 - 18
packages/fcl-passrc/src/pparser.pp

@@ -14,26 +14,10 @@
 
  **********************************************************************}
 
-{$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}
-
-
 unit PParser;
 
+{$i fcl-passrc.inc}
+
 interface
 
 uses

+ 35 - 18
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);

+ 26 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -373,6 +373,7 @@ type
     Procedure TestUnit_DottedPrg;
     Procedure TestUnit_DottedUnit;
     Procedure TestUnit_DottedExpr;
+    Procedure TestUnit_DottedSystem;
     Procedure TestUnit_DuplicateDottedUsesFail;
     Procedure TestUnit_DuplicateUsesDiffName;
     Procedure TestUnit_Unit1DotUnit2Fail;
@@ -5975,6 +5976,31 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestUnit_DottedSystem;
+begin
+  AddModuleWithIntfImplSrc('System.SysUtils.pas',
+    LinesToStr([
+    'type TFlag = word;'
+    ]),
+    ''
+    );
+  AddModuleWithIntfImplSrc('UnitA.pas',
+    LinesToStr([
+    ''
+    ]),
+    LinesToStr([
+    'uses System.SysUtils;',
+    'type TSize = TFlag;',
+    'type TWidth = System.SysUtils.TFlag;',
+    'type TBird = System.integer;',
+    'type TEagle = integer;',
+    '']) );
+  StartProgram(true);
+  Add('uses UnitA;');
+  Add('begin');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestUnit_DuplicateDottedUsesFail;
 begin
   AddModuleWithIntfImplSrc('ns.unit2.pp',

+ 274 - 66
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));
@@ -15455,6 +15531,9 @@ var
   end;
 
 var
+  aResolver: TPas2JSResolver;
+  Scope: TPasArrayScope;
+  SpecializeNeedsDelay: Boolean;
   AssignSt: TJSSimpleAssignStatement;
   CallName, ArrName: String;
   Obj: TJSObjectLiteral;
@@ -15462,7 +15541,7 @@ var
   ArrLit: TJSArrayLiteral;
   Arr: TPasArrayType;
   Index: Integer;
-  ElType: TPasType;
+  ElTypeHi, ElTypeLo: TPasType;
   RangeEl: TPasExpr;
   Call: TJSCallExpression;
   RgLen, RangeEnd: TMaxPrecInt;
@@ -15476,7 +15555,6 @@ var
   BracketEx: TJSBracketMemberExpression;
   ArraySt, CloneEl: TJSElement;
   ReturnSt: TJSReturnStatement;
-  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
   aResolver:=AContext.Resolver;
@@ -15488,6 +15566,10 @@ begin
   writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El));
   {$ENDIF}
 
+  Scope:=El.CustomData as TPasArrayScope;
+  SpecializeNeedsDelay:=(Scope<>nil)
+           and (aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil);
+
   ProcScope:=nil;
   Src:=nil;
   if AContext.JSElement is TJSSourceElements then
@@ -15539,20 +15621,20 @@ begin
       BracketEx.MExpr:=CreatePrimitiveDotExpr(CloneArrName,El);
       BracketEx.Name:=CreatePrimitiveDotExpr(CloneRunName,El);
       // clone a[i]
-      ElType:=aResolver.ResolveAliasType(El.ElType);
+      ElTypeLo:=aResolver.ResolveAliasType(El.ElType);
       CloneEl:=nil;
-      if ElType is TPasArrayType then
+      if ElTypeLo is TPasArrayType then
         begin
-        if length(TPasArrayType(ElType).Ranges)=0 then
-          RaiseNotSupported(El,AContext,20180218223414,GetObjName(ElType));
-        CloneEl:=CreateCloneStaticArray(El,TPasArrayType(ElType),BracketEx,AContext);
+        if length(TPasArrayType(ElTypeLo).Ranges)=0 then
+          RaiseNotSupported(El,AContext,20180218223414,GetObjName(ElTypeLo));
+        CloneEl:=CreateCloneStaticArray(El,TPasArrayType(ElTypeLo),BracketEx,AContext);
         end
-      else if ElType is TPasRecordType then
-        CloneEl:=CreateRecordCallClone(El,TPasRecordType(ElType),BracketEx,AContext)
-      else if ElType is TPasSetType then
+      else if ElTypeLo is TPasRecordType then
+        CloneEl:=CreateRecordCallClone(El,TPasRecordType(ElTypeLo),BracketEx,AContext)
+      else if ElTypeLo is TPasSetType then
         CloneEl:=CreateReferencedSet(El,BracketEx)
       else
-        RaiseNotSupported(El,AContext,20180218223618,GetObjName(ElType));
+        RaiseNotSupported(El,AContext,20180218223618,GetObjName(ElTypeLo));
       Call.AddArg(CloneEl);
       BracketEx:=nil;
       // return r;
@@ -15603,7 +15685,8 @@ begin
       CallName:=GetBIName(pbifnRTTINewDynArray);
     Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
     try
-      ElType:=aResolver.ResolveAliasType(El.ElType);
+      ElTypeHi:=aResolver.ResolveAliasType(El.ElType,false);
+      ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
       if length(El.Ranges)>0 then
         begin
         // static array
@@ -15621,20 +15704,24 @@ begin
           inc(Index);
           if Index=length(Arr.Ranges) then
             begin
-            if ElType.ClassType<>TPasArrayType then
+            if ElTypeLo.ClassType<>TPasArrayType then
               break;
-            Arr:=TPasArrayType(ElType);
+            Arr:=TPasArrayType(ElTypeLo);
             if length(Arr.Ranges)=0 then
               RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
-            ElType:=aResolver.ResolveAliasType(Arr.ElType);
+            ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
+            ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
             Index:=0;
             end;
         until false;
         end;
       // eltype: ref
-      Prop:=Obj.Elements.AddElement;
-      Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
-      Prop.Expr:=CreateTypeInfoRef(ElType,AContext,El);
+      if not SpecializeNeedsDelay then
+        begin
+        Prop:=Obj.Elements.AddElement;
+        Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
+        Prop.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
+        end;
 
       if Src<>nil then
         begin
@@ -16628,6 +16715,90 @@ 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;
+  AssignSt: TJSSimpleAssignStatement;
+  Arr: TPasArrayType;
+  ElTypeHi, ElTypeLo: TPasType;
+  aResolver: TPas2JSResolver;
+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 if (C=TPasArrayType) then
+    begin
+    if not HasTypeInfo(El,AContext) then
+      exit; // no RTTI needed
+    // pas.unitname.$rtti.TArr.eltype=$mod.$rtti.TBird;
+    aResolver:=AContext.Resolver;
+    Arr:=TPasArrayType(El);
+    ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
+    ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
+    if length(Arr.Ranges)>0 then
+      begin
+      // static array
+      while ElTypeLo.ClassType=TPasArrayType do
+        begin
+        Arr:=TPasArrayType(ElTypeLo);
+        if length(Arr.Ranges)=0 then
+          RaiseNotSupported(Arr,AContext,20200902155418,'static array of anonymous array');
+        ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
+        ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
+        end;
+      end;
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    AssignSt.LHS:=CreateDotNameExpr(El,CreateTypeInfoRef(El,AContext,El),
+                                   TJSString(GetBIName(pbivnRTTIArray_ElType)));
+    AssignSt.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
+    AddToSourceElements(Src,AssignSt);
+    end
+  else
+    RaiseNotSupported(El,AContext,20200831115251);
+end;
+
 function TPasToJSConverter.CreateReferencedSet(El: TPasElement; SetExpr: TJSElement
   ): TJSElement;
 var
@@ -17041,6 +17212,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;
@@ -23595,8 +23785,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
@@ -24717,6 +24907,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;
@@ -24726,14 +24920,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
@@ -24747,21 +24938,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
@@ -24811,7 +24997,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]);
@@ -24822,8 +25008,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);
@@ -24845,14 +25031,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)
@@ -24860,7 +25050,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
@@ -24873,18 +25063,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
@@ -24903,13 +25101,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);

+ 299 - 16
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;
+
+    // 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,140 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ArrayOfUnitImplRec;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  'type',
+  '  generic TDyn<T> = array of T;',
+  '  generic TStatic<T> = array[1..2] of T;',
+  '']),
+  LinesToStr([
+  'type',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var',
+  '  d: specialize TDyn<TBird>;',
+  '  s: specialize TStatic<TBird>;',
+  'begin',
+  '  d[0].b:=s[1].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.$DynArray("TDyn$G1", {});',
+    '  this.TStatic$G1$clone = function (a) {',
+    '    var r = [];',
+    '    for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
+    '    return r;',
+    '  };',
+    '  $mod.$rtti.$StaticArray("TStatic$G1", {',
+    '    dims: [2]',
+    '  });',
+    '  $mod.$init = function () {',
+    '    $impl.d[0].b = $impl.s[0].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.d = [];',
+    '  $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
+    '});']));
+  CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
+    LinesToStr([ // statements
+    'pas.UnitA.$rtti["TDyn$G1"].eltype = pas.UnitA.$rtti["TBird"];',
+    'pas.UnitA.$rtti["TStatic$G1"].eltype = pas.UnitA.$rtti["TBird"];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+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.

+ 79 - 56
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}',

+ 2 - 1
rtl/objpas/sysconst.pp

@@ -68,7 +68,8 @@ const
   SInvalidBoolean        = '"%s" is not a valid boolean.';
   SInvalidCast           = 'Invalid type cast';
   SinvalidCurrency       = 'Invalid currency: "%s"';
-  SInvalidDateTime       = '%f is not a valid date/time value.';
+  SInvalidDateTime       = '"%s" is not a valid date/time value.';
+  SInvalidDateTimeFloat  = '%f is not a valid date/time value.';
   SInvalidDrive          = 'Invalid drive specified';
   SInvalidFileHandle     = 'Invalid file handle';
   SInvalidFloat          = '"%s" is an invalid float';

+ 2 - 1
rtl/objpas/sysutils/stre.inc

@@ -48,7 +48,8 @@ Const
    SInvalidArgIndex = 'Invalid argument index in format "%s"';
    SInvalidBoolean = '"%s" is not a valid boolean.';
    SInvalidCast = 'Invalid type cast';
-   SInvalidDateTime = '%f is not a valid date/time value.';
+   SInvalidDateTime = '"%s" is not a valid date/time value.';
+   SInvalidDateTimeFloat = '%f is not a valid date/time value.';
    SInvalidDrive = 'Invalid drive specified';
    SInvalidFileHandle = 'Invalid file handle';
    SInvalidFloat = '"%s" is an invalid float';

+ 1 - 1
rtl/objpas/sysutils/sysstr.inc

@@ -1924,7 +1924,7 @@ end;
 Function FloatToDateTime (Const Value : Extended) : TDateTime;
 begin
   If (Value<MinDateTime) or (Value>MaxDateTime) then
-    Raise EConvertError.CreateFmt (SInvalidDateTime,[Value]);
+    Raise EConvertError.CreateFmt (SInvalidDateTimeFloat,[Value]);
   Result:=Value;
 end;
 

+ 7 - 1
rtl/wasi/system.pp

@@ -21,8 +21,14 @@ begin
 end;
 
 function test_rtl_function(a, b: integer): integer;
+var
+  tempvar: integer;
+  tempvar2: integer;
+  pv: pbyte;
 begin
-  test_rtl_function := 0;
+  tempvar := a - b;
+  test_rtl_function := a + b;
+{  pv := @tempvar2;}
 end;
 
 end.

+ 1 - 0
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){