Browse Source

pastojs: array of const

git-svn-id: trunk@41327 -
Mattias Gaertner 6 years ago
parent
commit
d4512cc714

+ 1 - 0
.gitattributes

@@ -7029,6 +7029,7 @@ packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain

+ 1 - 0
packages/pastojs/fpmake.pp

@@ -55,6 +55,7 @@ begin
       T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
     T:=P.Targets.AddUnit('pas2jslogger.pp');
     T:=P.Targets.AddUnit('pas2jspparser.pp');
+    T:=P.Targets.AddUnit('pas2jsuseanalyzer.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
     T:=P.Targets.AddUnit('pas2jsfscompiler.pp');
       T.Dependencies.AddUnit('pas2jscompiler');

+ 258 - 27
packages/pastojs/src/fppas2js.pp

@@ -87,6 +87,7 @@ Works:
   - skip clone record of new record
   - use rtl.recNewT to create a record type
   - use TRec.$new to instantiate records, using Object.create to instantiate
+  - record field external name
   - advanced records:
     - public, private, strict private
     - class var
@@ -396,6 +397,7 @@ Works:
   - pass property getter field, property getter function,
   - pass class property, static class property
   - pass array property
+- array of const, TVarRec
 
 ToDos:
 - cmd line param to set modeswitch
@@ -418,7 +420,6 @@ ToDos:
 - range check:
    arr[i]:=value  check if value is in range
    astring[i]:=value check if value is in range
-- record field external name
 - 1 as TEnum, ERangeError
 - ifthen<T>
 - stdcall of methods: pass original 'this' as first parameter
@@ -1067,6 +1068,7 @@ type
 
   TPas2JSModuleScope = class(TPasModuleScope)
   public
+    SystemVarRecs: TPasFunction;
   end;
 
   { TPas2JSSectionScope }
@@ -1304,6 +1306,12 @@ type
     procedure FinishArgument(El: TPasArgument); override;
     procedure FinishProcedureType(El: TPasProcedureType); override;
     procedure FinishProperty(PropEl: TPasProperty); override;
+    procedure FinishProcParamAccess(ProcType: TPasProcedureType;
+      Params: TParamsExpr); override;
+    procedure FinishPropertyParamAccess(Params: TParamsExpr; Prop: TPasProperty
+      ); override;
+    procedure FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement);
+    function FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement): TPasFunction; virtual;
     procedure CheckExternalClassConstructor(Ref: TResolvedReference); virtual;
     procedure CheckConditionExpr(El: TPasExpr;
       const ResolvedEl: TPasResolverResult); override;
@@ -1974,6 +1982,31 @@ type
         otUIntDouble  // 7 NativeUInt
         );
     Function GetOrdType(MinValue, MaxValue: TMaxPrecInt; ErrorEl: TPasElement): TOrdType; virtual;
+  Public
+    // array of const, TVarRec
+    const
+      pas2js_vtInteger       = 0;
+      pas2js_vtBoolean       = 1;
+      //vtChar          = 2; // Delphi/FPC: ansichar
+      pas2js_vtExtended      = 3; // Note: double in pas2js, PExtended in Delphi/FPC
+      //vtString        = 4; // Delphi/FPC: PShortString
+      pas2js_vtPointer       = 5;
+      //vtPChar         = 6;
+      pas2js_vtObject        = 7;
+      pas2js_vtClass         = 8;
+      pas2js_vtWideChar      = 9;
+      //vtPWideChar     = 10;
+      //vtAnsiString    = 11;
+      pas2js_vtCurrency      = 12; // Note: currency in pas2js, PCurrency in Delphi/FPC
+      //vtVariant       = 13;
+      pas2js_vtInterface     = 14;
+      //vtWideString    = 15;
+      //vtInt64         = 16;
+      //vtQWord         = 17;
+      pas2js_vtUnicodeString = 18;
+      // only pas2js, not in Delphi/FPC:
+      pas2js_vtNativeInt     = 19;
+      pas2js_vtJSValue       = 20;
   Public
     Constructor Create;
     Destructor Destroy; override;
@@ -3952,6 +3985,87 @@ begin
     end;
 end;
 
+procedure TPas2JSResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
+  Params: TParamsExpr);
+begin
+  inherited FinishProcParamAccess(ProcType, Params);
+  FindCreatorArrayOfConst(ProcType.Args,Params);
+end;
+
+procedure TPas2JSResolver.FinishPropertyParamAccess(Params: TParamsExpr;
+  Prop: TPasProperty);
+var
+  Args: TFPList;
+begin
+  inherited FinishPropertyParamAccess(Params, Prop);
+  Args:=GetPasPropertyArgs(Prop);
+  if Args=nil then
+    RaiseNotYetImplemented(20190215210914,Params,GetObjName(Prop));
+  FindCreatorArrayOfConst(Args,Params);
+end;
+
+procedure TPas2JSResolver.FindCreatorArrayOfConst(Args: TFPList;
+  ErrorEl: TPasElement);
+var
+  i: Integer;
+  Arg: TPasArgument;
+begin
+  for i:=0 to Args.Count-1 do
+    begin
+    Arg:=TPasArgument(Args[i]);
+    if not IsArrayOfConst(Arg.ArgType) then continue;
+    FindProc_ArrLitToArrayOfConst(ErrorEl);
+    end;
+end;
+
+function TPas2JSResolver.FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement
+  ): TPasFunction;
+var
+  aMod, UtilsMod: TPasModule;
+  ModScope: TPas2JSModuleScope;
+  SectionScope: TPasSectionScope;
+  Identifier: TPasIdentifier;
+  El: TPasElement;
+  FuncType: TPasFunctionType;
+begin
+  aMod:=RootElement;
+  ModScope:=aMod.CustomData as TPas2JSModuleScope;
+  Result:=ModScope.SystemVarRecs;
+  if Result<>nil then exit;
+
+  // find unit in uses clauses
+  UtilsMod:=FindUsedUnit('system',aMod);
+  if UtilsMod=nil then
+    RaiseIdentifierNotFound(20190215211531,'System.VarRecs',ErrorEl);
+
+  // find class in interface
+  if UtilsMod.InterfaceSection=nil then
+    RaiseIdentifierNotFound(20190215211538,'System.VarRecs',ErrorEl);
+
+  // find function VarRecs
+  SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
+  Identifier:=SectionScope.FindLocalIdentifier('VarRecs');
+  if Identifier=nil then
+    RaiseIdentifierNotFound(20190215211551,'System.VarRecs',ErrorEl);
+  El:=Identifier.Element;
+  if El.ClassType<>TPasFunction then
+    RaiseXExpectedButYFound(20190215211559,'function System.VarRecs',GetElementTypeName(El),ErrorEl);
+  Result:=TPasFunction(El);
+  ModScope.SystemVarRecs:=Result;
+
+  // check signature
+  FuncType:=Result.ProcType as TPasFunctionType;
+  if FuncType.Args.Count>0 then
+    RaiseXExpectedButYFound(20190215211953,'function System.VarRecs with 0 args',
+      IntToStr(FuncType.Args.Count),ErrorEl);
+  if FuncType.Modifiers<>[ptmVarargs] then
+    RaiseXExpectedButYFound(20190215212151,'function System.VarRecs; varargs',
+      '?',ErrorEl);
+  if FuncType.CallingConvention<>ccDefault then
+    RaiseXExpectedButYFound(20190215211824,'function System.VarRecs with default calling convention',
+      cCallingConventions[FuncType.CallingConvention],ErrorEl);
+end;
+
 procedure TPas2JSResolver.CheckExternalClassConstructor(Ref: TResolvedReference
   );
 var
@@ -4253,7 +4367,7 @@ begin
         exit;
       if (RHS.BaseType<>btContext) or (RTypeEl.ClassType<>TPasArrayType) then
         exit;
-      ComputeElement(LArray.ElType,ElTypeResolved,[rcType]);
+      ComputeElement(GetArrayElType(LArray),ElTypeResolved,[rcType]);
       if IsJSBaseType(ElTypeResolved,pbtJSValue) then
         begin
         // array of jsvalue := array
@@ -8555,7 +8669,7 @@ var
           break;
         // continue in sub array
         ArrayEl:=AContext.Resolver.ResolveAliasType(ArrayEl.ElType) as TPasArrayType;
-      until false;
+      until ArrayEl=nil;
 
       IsRangeCheck:=NeedRangeCheck
                 and (bsRangeChecks in AContext.ScannerBoolSwitches)
@@ -10107,12 +10221,14 @@ var
   AssignContext: TAssignContext;
   ElType, TypeEl: TPasType;
   i: Integer;
+  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
   Param0:=El.Params[0];
   if AContext.Access<>caRead then
     RaiseInconsistency(20170213213621,El);
-  AContext.Resolver.ComputeElement(Param0,ResolvedParam0,[rcNoImplicitProc]);
+  aResolver:=AContext.Resolver;
+  aResolver.ComputeElement(Param0,ResolvedParam0,[rcNoImplicitProc]);
   {$IFDEF VerbosePasResolver}
   writeln('TPasToJSConverter.ConvertBuiltInSetLength ',GetResolverResultDbg(ResolvedParam0));
   {$ENDIF}
@@ -10128,7 +10244,7 @@ begin
     // ->  AnArray = rtl.setArrayLength(AnArray,defaultvalue,dim1,dim2,...)
     AssignContext:=TAssignContext.Create(El,nil,AContext);
     try
-      AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
+      aResolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
       AssignContext.RightResolved:=ResolvedParam0;
 
       // create right side
@@ -10141,10 +10257,10 @@ begin
       // 2nd param: default value
       for i:=3 to length(El.Params) do
         begin
-        ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
+        ElType:=aResolver.ResolveAliasType(aResolver.GetArrayElType(ArrayType));
         ArrayType:=ElType as TPasArrayType;
         end;
-      ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
+      ElType:=aResolver.ResolveAliasType(aResolver.GetArrayElType(ArrayType));
       if ElType.ClassType=TPasRecordType then
         ValInit:=CreateReferencePathExpr(ElType,AContext)
       else
@@ -10169,7 +10285,7 @@ begin
     {$ENDIF}
     AssignContext:=TAssignContext.Create(El,nil,AContext);
     try
-      AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
+      aResolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
       AssignContext.RightResolved:=AssignContext.LeftResolved;
 
       // create right side  rtl.strSetLength(aString,NewLen)
@@ -11395,17 +11511,19 @@ var
   TypeParam: TJSElement;
   Call: TJSCallExpression;
   ArrayType: TPasArrayType;
+  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
   Call:=nil;
   try
     Param:=El.Params[0];
-    AContext.Resolver.ComputeElement(El,ParamResolved,[]);
+    aResolver.ComputeElement(El,ParamResolved,[]);
     if (ParamResolved.BaseType=btContext)
         and (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
       begin
       ArrayType:=TPasArrayType(ParamResolved.LoTypeEl);
-      AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
+      aResolver.ComputeElement(aResolver.GetArrayElType(ArrayType),ElTypeResolved,[rcType]);
       end
     else if ParamResolved.BaseType=btArrayLit then
       begin
@@ -14906,16 +15024,23 @@ function TPasToJSConverter.CreateArrayConcat(ArrayType: TPasArrayType;
   PosEl: TPasElement; AContext: TConvertContext): TJSCallExpression;
 var
   ElTypeResolved: TPasResolverResult;
+  aResolver: TPas2JSResolver;
 begin
   if length(ArrayType.Ranges)>1 then
     RaiseNotSupported(PosEl,AContext,20170331001021);
-  AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
+  aResolver:=AContext.Resolver;
+  aResolver.ComputeElement(aResolver.GetArrayElType(ArrayType),ElTypeResolved,[rcType]);
   Result:=CreateArrayConcat(ElTypeResolved,PosEl,AContext);
 end;
 
 function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
   Expr: TPasExpr; El: TPasElement; AContext: TConvertContext): TJSElement;
 
+  function IsAdd(AnExpr: TPasExpr): Boolean;
+  begin
+    Result:=(AnExpr.ClassType=TBinaryExpr) and (AnExpr.OpCode=eopAdd);
+  end;
+
   function ConvertArrayExpr(CurArrType: TPasArrayType; RgIndex: integer;
     CurExpr: TPasExpr): TJSElement;
   var
@@ -14947,11 +15072,6 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
         end;
     end;
 
-    function IsAdd(AnExpr: TPasExpr): Boolean;
-    begin
-      Result:=(AnExpr.ClassType=TBinaryExpr) and (AnExpr.OpCode=eopAdd);
-    end;
-
     procedure TraverseAdd(Bin: TBinaryExpr; ConcatCall: TJSCallExpression);
     // A+B -> A,B
     // (A+B)+C -> A,B,C
@@ -14969,6 +15089,7 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
   var
     ElTypeResolved: TPasResolverResult;
     Call: TJSCallExpression;
+    aResolver: TPas2JSResolver;
   begin
     Result:=nil;
     IsLastRange:=false;
@@ -14976,7 +15097,8 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
     NextRgIndex:=RgIndex+1;
     if RgIndex>=length(CurArrType.Ranges)-1 then
       begin
-      AContext.Resolver.ComputeElement(CurArrType.ElType,ElTypeResolved,[rcType]);
+      aResolver:=AContext.Resolver;
+      aResolver.ComputeElement(aResolver.GetArrayElType(CurArrType),ElTypeResolved,[rcType]);
       if (ElTypeResolved.BaseType=btContext)
           and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
         begin
@@ -15015,6 +15137,112 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
     Result:=ConvertExpression(CurExpr,AContext);
   end;
 
+  function ConvertExprToVarRec(CurExpr: TPasExpr): TJSElement;
+  // convert [true,Int] to  system.varrecs(1,true,0,Int)
+  var
+    aResolver: TPas2JSResolver;
+    Param: TPasExpr;
+    ParamResolved: TPasResolverResult;
+
+    procedure RaiseWrongTypeInArrayConstructor(id: TMaxPrecInt);
+    begin
+      aResolver.RaiseMsg(id,nWrongTypeXInArrayConstructor,sWrongTypeXInArrayConstructor,
+        [aResolver.GetResolverResultDescription(ParamResolved)],Param);
+    end;
+
+  var
+    Params: TParamsExpr;
+    ModScope: TPas2JSModuleScope;
+    Call: TJSCallExpression;
+    i, VType: Integer;
+    LoTypeEl: TPasType;
+    ParamsArr: TPasExprArray;
+  begin
+    Result:=nil;
+    aResolver:=AContext.Resolver;
+    if IsAdd(CurExpr) then
+      aResolver.RaiseMsg(20190215222435,nXExpectedButYFound,sXExpectedButYFound,
+        ['array of const',GetElementTypeName(CurExpr)],CurExpr);
+    if (not (CurExpr is TParamsExpr)) or (TParamsExpr(CurExpr).Kind<>pekSet) then
+      begin
+      // e.g. Format(args)
+      Result:=ConvertExpression(CurExpr,AContext);
+      exit;
+      end;
+    Params:=TParamsExpr(CurExpr);
+    ParamsArr:=Params.Params;
+    if length(ParamsArr)=0 then
+      begin
+      // e.g. Format([])
+      Result:=CreateElement(TJSArrayLiteral,Params);
+      exit;
+      end;
+
+    ModScope:=NoNil(aResolver.RootElement.CustomData) as TPas2JSModuleScope;
+    if ModScope.SystemVarRecs=nil then
+      RaiseNotSupported(Params,AContext,20190215215148);
+    Call:=CreateCallExpression(Params);
+    try
+      Call.Expr:=CreateReferencePathExpr(ModScope.SystemVarRecs,AContext);
+      for i:=0 to length(ParamsArr)-1 do
+        begin
+        Param:=ParamsArr[i];
+        aResolver.ComputeElement(Param,ParamResolved,[]);
+        if not (rrfReadable in ParamResolved.Flags) then
+          begin
+          if (ParamResolved.BaseType=btContext)
+              and (ParamResolved.IdentEl is TPasClassType)
+              and (TPasClassType(ParamResolved.IdentEl).ObjKind=okClass) then
+            VType:=pas2js_vtClass
+          else
+            RaiseWrongTypeInArrayConstructor(20190215221549);
+          end
+        else if ParamResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongint] then
+          VType:=pas2js_vtInteger
+        else if ParamResolved.BaseType in [btLongWord,btUIntDouble,btIntDouble] then
+          VType:=pas2js_vtNativeInt
+        else if ParamResolved.BaseType in btAllJSBooleans then
+          VType:=pas2js_vtBoolean
+        else if ParamResolved.BaseType in btAllJSFloats then
+          VType:=pas2js_vtExtended
+        else if ParamResolved.BaseType in btAllJSChars then
+          VType:=pas2js_vtWideChar
+        else if ParamResolved.BaseType in btAllJSStrings then
+          VType:=pas2js_vtUnicodeString
+        else if ParamResolved.BaseType in [btNil,btPointer] then
+          VType:=pas2js_vtPointer
+        else if ParamResolved.BaseType=btCurrency then
+          VType:=pas2js_vtCurrency
+        else if ParamResolved.BaseType=btContext then
+          begin
+          LoTypeEl:=ParamResolved.LoTypeEl;
+          if LoTypeEl.ClassType=TPasClassType then
+            case TPasClassType(LoTypeEl).ObjKind of
+            okClass: VType:=pas2js_vtObject;
+            okInterface: VType:=pas2js_vtInterface;
+            else
+              RaiseWrongTypeInArrayConstructor(20190215221106);
+            end
+          else if LoTypeEl.ClassType=TPasClassOfType then
+            VType:=pas2js_vtClass
+          else
+            RaiseWrongTypeInArrayConstructor(20190215221122);
+          end
+        else if (ParamResolved.BaseType=btCustom)
+            and aResolver.IsJSBaseType(ParamResolved,pbtJSValue) then
+          VType:=pas2js_vtJSValue
+        else
+          RaiseWrongTypeInArrayConstructor(20190215221457);
+        Call.AddArg(CreateLiteralNumber(Param,VType));
+        Call.AddArg(ConvertExpression(Param,AContext));
+        end;
+      Result:=Call;
+    finally
+      if Result=nil then
+        Call.Free;
+    end;
+  end;
+
 var
   Call: TJSCallExpression;
   ArrLit: TJSArrayLiteral;
@@ -15027,7 +15255,6 @@ var
   US: TJSString;
   DimLits: TObjectList;
   aResolver: TPas2JSResolver;
-  CompFlags: TPasResolverComputeFlags;
 begin
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.CreateArrayInit ',GetObjName(ArrayType),' ',ArrayType.ParentPath,' Expr=',GetObjName(Expr));
@@ -15035,18 +15262,19 @@ begin
   aResolver:=AContext.Resolver;
   if Assigned(Expr) then
     begin
-    // init array with constant(s)
+    // init array with expression
     if aResolver=nil then
       DoError(20161024192739,nInitializedArraysNotSupported,sInitializedArraysNotSupported,[],ArrayType);
-    if aResolver.ExprEvaluator.IsConst(Expr) then
-      CompFlags:=[rcConstant]
-    else
-      CompFlags:=[];
-    aResolver.ComputeElement(Expr,ExprResolved,CompFlags);
+    aResolver.ComputeElement(Expr,ExprResolved,[]);
     if (ExprResolved.BaseType in [btArrayOrSet,btArrayLit])
         or ((ExprResolved.BaseType=btContext)
           and (ExprResolved.LoTypeEl.ClassType=TPasArrayType)) then
-      Result:=ConvertArrayExpr(ArrayType,0,Expr)
+      begin
+      if ArrayType.ElType=nil then
+        Result:=ConvertExprToVarRec(Expr)
+      else
+        Result:=ConvertArrayExpr(ArrayType,0,Expr);
+      end
     else if ExprResolved.BaseType in btAllStringAndChars then
       begin
       US:=StrToJSString(aResolver.ComputeConstString(Expr,false,true));
@@ -15094,7 +15322,7 @@ begin
           Lit:=CreateLiteralNumber(El,DimSize);
           DimLits.Add(Lit);
           end;
-        aResolver.ComputeElement(CurArrayType.ElType,ElTypeResolved,[rcType]);
+        aResolver.ComputeElement(aResolver.GetArrayElType(CurArrayType),ElTypeResolved,[rcType]);
         if (ElTypeResolved.LoTypeEl is TPasArrayType) then
           begin
           CurArrayType:=TPasArrayType(ElTypeResolved.LoTypeEl);
@@ -16034,7 +16262,9 @@ var
   ArgName: String;
   Flags: Integer;
   ArrType: TPasArrayType;
+  aResolver: TPas2JSResolver;
 begin
+  aResolver:=AContext.Resolver;
   // for each param add  "["argname",argtype,flags]"  Note: flags only if >0
   Param:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Arg));
   TargetParams.Elements.AddElement.Expr:=Param;
@@ -16051,7 +16281,8 @@ begin
     // open array param
     inc(Flags,pfArray);
     ArrType:=TPasArrayType(Arg.ArgType);
-    Param.Elements.AddElement.Expr:=CreateTypeInfoRef(ArrType.ElType,AContext,Arg);
+    Param.Elements.AddElement.Expr:=
+              CreateTypeInfoRef(aResolver.GetArrayElType(ArrType),AContext,Arg);
     end
   else
     Param.Elements.AddElement.Expr:=CreateTypeInfoRef(Arg.ArgType,AContext,Arg);

+ 10 - 15
packages/pastojs/src/pas2jscompiler.pp

@@ -38,8 +38,8 @@ uses
   // !! No filesystem units here.
   Classes, SysUtils, contnrs,
   jsbase, jstree, jswriter, JSSrcMap,
-  PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
-  FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser;
+  PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
+  FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
 
 const
   VersionMajor = 1;
@@ -346,7 +346,7 @@ type
     FScanner: TPas2jsPasScanner;
     FShowDebug: boolean;
     FUnitFilename: string;
-    FUseAnalyzer: TPasAnalyzer;
+    FUseAnalyzer: TPas2JSAnalyzer;
     FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
     function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
     function GetUsedByCount(Section: TUsedBySection): integer;
@@ -413,7 +413,7 @@ type
     property Scanner: TPas2jsPasScanner read FScanner;
     property ShowDebug: boolean read FShowDebug write FShowDebug;
     property UnitFilename: string read FUnitFilename;
-    property UseAnalyzer: TPasAnalyzer read FUseAnalyzer; // unit analysis
+    property UseAnalyzer: TPas2JSAnalyzer read FUseAnalyzer; // unit analysis
     property UsedByCount[Section: TUsedBySection]: integer read GetUsedByCount;
     property UsedBy[Section: TUsedBySection; Index: integer]: TPas2jsCompilerFile read GetUsedBy;
   end;
@@ -454,11 +454,6 @@ type
     property Compiler:  TPas2jsCompiler Read FCompiler;
   end;
 
-  { TPas2JSWPOptimizer }
-
-  TPas2JSWPOptimizer = class(TPasAnalyzer)
-  end;
-
   { TPas2jsCompiler }
 
   TPas2jsCompiler = class
@@ -484,7 +479,7 @@ type
     FParamMacros: TPas2jsMacroEngine;
     FSrcMapSourceRoot: string;
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
-    FWPOAnalyzer: TPas2JSWPOptimizer;
+    FWPOAnalyzer: TPas2JSAnalyzer;
     FInterfaceType: TPasClassInterfaceType;
     FPrecompileGUID: TGUID;
     FInsertFilenames: TStringList;
@@ -564,7 +559,7 @@ type
     function CreateLog: TPas2jsLogger; virtual;
     function CreateMacroEngine: TPas2jsMacroEngine;virtual;
     function CreateSrcMap(const aFileName: String): TPas2JSSrcMap; virtual;
-    function CreateOptimizer: TPas2JSWPOptimizer;
+    function CreateOptimizer: TPas2JSAnalyzer;
     // These are mandatory !
     function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract;
     function CreateFS: TPas2JSFS; virtual; abstract;
@@ -672,7 +667,7 @@ type
     property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
     property TargetPlatform: TPasToJsPlatform read GetTargetPlatform write SetTargetPlatform;
     property TargetProcessor: TPasToJsProcessor read GetTargetProcessor write SetTargetProcessor;
-    property WPOAnalyzer: TPas2JSWPOptimizer read FWPOAnalyzer; // Whole Program Optimization
+    property WPOAnalyzer: TPas2JSAnalyzer read FWPOAnalyzer; // Whole Program Optimization
     property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
     property WriteMsgToStdErr: boolean read GetWriteMsgToStdErr write SetWriteMsgToStdErr;
     property AllJSIntoMainJS: Boolean Read FAllJSIntoMainJS Write SetAllJSIntoMainJS;
@@ -936,7 +931,7 @@ begin
   for ub in TUsedBySection do
     FUsedBy[ub]:=TFPList.Create;
 
-  FUseAnalyzer:=TPasAnalyzer.Create;
+  FUseAnalyzer:=TPas2JSAnalyzer.Create;
   FUseAnalyzer.OnMessage:=@OnUseAnalyzerMessage;
   FUseAnalyzer.Resolver:=FPasResolver;
 
@@ -1938,10 +1933,10 @@ begin
   Result:=aFile.NeedBuild;
 end;
 
-function TPas2jsCompiler.CreateOptimizer: TPas2JSWPOptimizer;
+function TPas2jsCompiler.CreateOptimizer: TPas2JSAnalyzer;
 
 begin
-  Result:=TPas2JSWPOptimizer.Create;
+  Result:=TPas2JSAnalyzer.Create;
 end;
 
 procedure TPas2jsCompiler.OptimizeProgram(aFile: TPas2jsCompilerFile);

+ 28 - 0
packages/pastojs/src/pas2jsfiler.pp

@@ -860,6 +860,8 @@ type
     procedure Set_ModScope_AssertMsgConstructor(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorClass(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
+    procedure Set_ModScope_SystemTVarRec(RefEl: TPasElement; Data: TObject);
+    procedure Set_ModScope_SystemVarRecs(RefEl: TPasElement; Data: TObject);
     procedure Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement; Data: TObject);
     procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
@@ -2511,6 +2513,8 @@ begin
   AddReferenceToObj(Obj,'AssertMsgConstructor',Scope.AssertMsgConstructor);
   AddReferenceToObj(Obj,'RangeErrorClass',Scope.RangeErrorClass);
   AddReferenceToObj(Obj,'RangeErrorConstructor',Scope.RangeErrorConstructor);
+  AddReferenceToObj(Obj,'SystemTVarRec',Scope.SystemTVarRec);
+  AddReferenceToObj(Obj,'SystemVarRecs',Scope.SystemVarRecs);
   WritePasScope(Obj,Scope,aContext);
 end;
 
@@ -4399,6 +4403,28 @@ begin
     RaiseMsg(20180211123100,Scope.Element,GetObjName(RefEl));
 end;
 
+procedure TPCUReader.Set_ModScope_SystemTVarRec(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPas2JSModuleScope absolute Data;
+begin
+  if RefEl is TPasRecordType then
+    Scope.SystemTVarRec:=TPasRecordType(RefEl)
+  else
+    RaiseMsg(20190215230826,Scope.Element,GetObjName(RefEl));
+end;
+
+procedure TPCUReader.Set_ModScope_SystemVarRecs(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPas2JSModuleScope absolute Data;
+begin
+  if RefEl is TPasFunction then
+    Scope.SystemVarRecs:=TPasFunction(RefEl)
+  else
+    RaiseMsg(20190215230857,Scope.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement;
   Data: TObject);
 var
@@ -6262,6 +6288,8 @@ begin
   ReadElementReference(Obj,Scope,'AssertMsgConstructor',@Set_ModScope_AssertMsgConstructor);
   ReadElementReference(Obj,Scope,'RangeErrorClass',@Set_ModScope_RangeErrorClass);
   ReadElementReference(Obj,Scope,'RangeErrorConstructor',@Set_ModScope_RangeErrorConstructor);
+  ReadElementReference(Obj,Scope,'SystemTVarRec',@Set_ModScope_SystemTVarRec);
+  ReadElementReference(Obj,Scope,'SystemVarRecs',@Set_ModScope_SystemVarRecs);
   ReadPasScope(Obj,Scope,aContext);
 end;
 

+ 58 - 0
packages/pastojs/src/pas2jsuseanalyzer.pp

@@ -0,0 +1,58 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2019  Mattias Gaertner  [email protected]
+
+    Pascal to Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+  Abstract:
+    Extends the FCL Pascal use analyzer for the language subset of pas2js.
+}
+unit Pas2jsUseAnalyzer;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses
+  Classes, SysUtils,
+  PasUseAnalyzer, PasTree,
+  FPPas2Js;
+
+type
+
+  { TPas2JSAnalyzer }
+
+  TPas2JSAnalyzer = class(TPasAnalyzer)
+  public
+    function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
+      override;
+  end;
+
+implementation
+
+{ TPas2JSAnalyzer }
+
+function TPas2JSAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode
+  ): boolean;
+var
+  ModScope: TPas2JSModuleScope;
+begin
+  Result:=inherited UseModule(aModule, Mode);
+  if not Result then exit;
+  ModScope:=aModule.CustomData as TPas2JSModuleScope;
+  if ModScope.SystemVarRecs<>nil then
+    UseProcedure(ModScope.SystemVarRecs);
+end;
+
+end.
+

+ 29 - 8
packages/pastojs/tests/tcfiler.pas

@@ -24,9 +24,10 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testregistry,
+  jstree,
   PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
-  FPPas2Js, Pas2JsFiler,
-  tcmodules, jstree;
+  Pas2jsUseAnalyzer, FPPas2Js, Pas2JsFiler,
+  tcmodules;
 
 type
 
@@ -34,11 +35,11 @@ type
 
   TCustomTestPrecompile = Class(TCustomTestModule)
   private
-    FAnalyzer: TPasAnalyzer;
+    FAnalyzer: TPas2JSAnalyzer;
     FInitialFlags: TPCUInitialFlags;
     FPCUReader: TPCUReader;
     FPCUWriter: TPCUWriter;
-    FRestAnalyzer: TPasAnalyzer;
+    FRestAnalyzer: TPas2JSAnalyzer;
     procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar;
       out Count: integer);
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
@@ -121,8 +122,8 @@ type
     procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
     procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
   public
-    property Analyzer: TPasAnalyzer read FAnalyzer;
-    property RestAnalyzer: TPasAnalyzer read FRestAnalyzer;
+    property Analyzer: TPas2JSAnalyzer read FAnalyzer;
+    property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
     property PCUWriter: TPCUWriter read FPCUWriter write FPCUWriter;
     property PCUReader: TPCUReader read FPCUReader write FPCUReader;
     property InitialFlags: TPCUInitialFlags read FInitialFlags;
@@ -155,6 +156,7 @@ type
     procedure TestPC_Proc_Arg;
     procedure TestPC_ProcType;
     procedure TestPC_Proc_Anonymous;
+    procedure TestPC_Proc_ArrayOfConst;
     procedure TestPC_Class;
     procedure TestPC_ClassForward;
     procedure TestPC_ClassConstructor;
@@ -278,7 +280,7 @@ procedure TCustomTestPrecompile.SetUp;
 begin
   inherited SetUp;
   FInitialFlags:=TPCUInitialFlags.Create;
-  FAnalyzer:=TPasAnalyzer.Create;
+  FAnalyzer:=TPas2JSAnalyzer.Create;
   Analyzer.Resolver:=Engine;
   Analyzer.Options:=Analyzer.Options+[paoImplReferences];
   Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
@@ -378,7 +380,7 @@ begin
     end;
 
     // analyze
-    FRestAnalyzer:=TPasAnalyzer.Create;
+    FRestAnalyzer:=TPas2JSAnalyzer.Create;
     FRestAnalyzer.Resolver:=RestResolver;
     try
       RestAnalyzer.AnalyzeModule(RestResolver.RootElement);
@@ -617,6 +619,8 @@ begin
   CheckRestoredReference(Path+'.AssertMsgConstructor',Orig.AssertMsgConstructor,Rest.AssertMsgConstructor);
   CheckRestoredReference(Path+'.RangeErrorClass',Orig.RangeErrorClass,Rest.RangeErrorClass);
   CheckRestoredReference(Path+'.RangeErrorConstructor',Orig.RangeErrorConstructor,Rest.RangeErrorConstructor);
+  CheckRestoredReference(Path+'.SystemTVarRec',Orig.SystemTVarRec,Rest.SystemTVarRec);
+  CheckRestoredReference(Path+'.SystemVarRecs',Orig.SystemVarRecs,Rest.SystemVarRecs);
   CheckRestoredPasScope(Path,Orig,Rest);
 end;
 
@@ -2021,6 +2025,23 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Proc_ArrayOfConst;
+begin
+  StartUnit(true,[supTVarRec]);
+  Add([
+  'interface',
+  'procedure Fly(arr: array of const);',
+  'implementation',
+  'procedure Fly(arr: array of const);',
+  'begin',
+  '  if arr[1].VType=1 then ;',
+  '  if arr[2].VInteger=1 then ;',
+  '  Fly([true,0.3]);',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Class;
 begin
   StartUnit(false);

+ 274 - 23
packages/pastojs/tests/tcmodules.pas

@@ -49,6 +49,12 @@ type
     Next: PSrcMarker;
   end;
 
+  TSystemUnitPart = (
+    supTObject,
+    supTVarRec
+    );
+  TSystemUnitParts = set of TSystemUnitPart;
+
   { TTestHintMessage }
 
   TTestHintMessage = class
@@ -153,9 +159,9 @@ type
     function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
     function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
       ImplementationSrc: string): TTestEnginePasResolver; virtual;
-    procedure AddSystemUnit; virtual;
-    procedure StartProgram(NeedSystemUnit: boolean); virtual;
-    procedure StartUnit(NeedSystemUnit: boolean); virtual;
+    procedure AddSystemUnit(Parts: TSystemUnitParts = []); virtual;
+    procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
+    procedure StartUnit(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
     procedure ConvertModule; virtual;
     procedure ConvertProgram; virtual;
     procedure ConvertUnit; virtual;
@@ -412,8 +418,6 @@ type
     Procedure TestArrayOfRecord;
     Procedure TestArray_StaticRecord;
     Procedure TestArrayOfSet;
-    // call(set)  literal and clone var
-    // call([set])   literal and clone var
     Procedure TestArray_DynAsParam;
     Procedure TestArray_StaticAsParam;
     Procedure TestArrayElement_AsParams;
@@ -434,6 +438,10 @@ type
     Procedure TestArray_ForInArrOfString;
     Procedure TestExternalClass_TypeCastArrayToExternalClass;
     Procedure TestExternalClass_TypeCastArrayFromExternalClass;
+    Procedure TestArrayOfConst_TVarRec;
+    Procedure TestArrayOfConst_PassBaseTypes;
+    Procedure TestArrayOfConst_PassObj;
+    // ToDo: tcfiler TPasModuleScope.SystemTVarRec TPas2JSModuleScope.SystemVarRecs
 
     // record
     Procedure TestRecord_Empty;
@@ -452,7 +460,6 @@ type
     Procedure TestRecord_Const;
     Procedure TestRecord_TypecastFail;
     Procedure TestRecord_InFunction;
-    // ToDo: Procedure TestRecord_ExternalField;
     // ToDo: RTTI of local record
     // ToDo: pcu local record, name clash and rtti
 
@@ -1512,36 +1519,136 @@ begin
   Result:=AddModuleWithSrc(aFilename,Src);
 end;
 
-procedure TCustomTestModule.AddSystemUnit;
-begin
-  AddModuleWithIntfImplSrc('system.pp',
-    // interface
-    LinesToStr([
+procedure TCustomTestModule.AddSystemUnit(Parts: TSystemUnitParts);
+var
+  Intf, Impl: TStringList;
+begin
+  Intf:=TStringList.Create;
+  // interface
+  if supTVarRec in Parts then
+    Intf.Add('{$modeswitch externalclass}');
+  Intf.Add('type');
+  Intf.Add('  integer=longint;');
+  Intf.Add('  sizeint=nativeint;');
+    //'const',
+    //'  LineEnding = #10;',
+    //'  DirectorySeparator = ''/'';',
+    //'  DriveSeparator = '''';',
+    //'  AllowDirectorySeparators : set of char = [''\'',''/''];',
+    //'  AllowDriveSeparators : set of char = [];',
+  if supTObject in Parts then
+    Intf.AddStrings([
     'type',
-    '  integer=longint;',
+    '  TClass = class of TObject;',
+    '  TObject = class',
+    '    constructor Create;',
+    '    destructor Destroy; virtual;',
+    '    class function ClassType: TClass; assembler;',
+    '    class function ClassName: String; assembler;',
+    '    class function ClassNameIs(const Name: string): boolean;',
+    '    class function ClassParent: TClass; assembler;',
+    '    class function InheritsFrom(aClass: TClass): boolean; assembler;',
+    '    class function UnitName: String; assembler;',
+    '    procedure AfterConstruction; virtual;',
+    '    procedure BeforeDestruction;virtual;',
+    '    function Equals(Obj: TObject): boolean; virtual;',
+    '    function ToString: String; virtual;',
+    '  end;']);
+  if supTVarRec in Parts then
+    Intf.AddStrings([
+    'const',
+    '  vtInteger       = 0;',
+    '  vtBoolean       = 1;',
+    '  vtJSValue       = 19;',
+    'type',
+    '  PVarRec = ^TVarRec;',
+    '  TVarRec = record',
+    '    VType : byte;',
+    '    VJSValue: JSValue;',
+    '    vInteger: longint external name ''VJSValue'';',
+    '    vBoolean: boolean external name ''VJSValue'';',
+    '  end;',
+    '  TVarRecArray = array of TVarRec;',
+    'function VarRecs: TVarRecArray; varargs;',
+    '']);
+  Intf.Add('var');
+  Intf.Add('  ExitCode: Longint = 0;');
+
+  // implementation
+  Impl:=TStringList.Create;
+  if supTObject in Parts then
+    Impl.AddStrings([
+      '// needed by ClassNameIs, the real SameText is in SysUtils',
+      'function SameText(const s1, s2: String): Boolean; assembler;',
+      'asm',
+      'end;',
+      'constructor TObject.Create; begin end;',
+      'destructor TObject.Destroy; begin end;',
+      'class function TObject.ClassType: TClass; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.ClassName: String; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.ClassNameIs(const Name: string): boolean;',
+      'begin',
+      '  Result:=SameText(Name,ClassName);',
+      'end;',
+      'class function TObject.ClassParent: TClass; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.InheritsFrom(aClass: TClass): boolean; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.UnitName: String; assembler;',
+      'asm',
+      'end;',
+      'procedure TObject.AfterConstruction; begin end;',
+      'procedure TObject.BeforeDestruction; begin end;',
+      'function TObject.Equals(Obj: TObject): boolean;',
+      'begin',
+      '  Result:=Obj=Self;',
+      'end;',
+      'function TObject.ToString: String;',
+      'begin',
+      '  Result:=ClassName;',
+      'end;'
+      ]);
+  if supTVarRec in Parts then
+    Impl.AddStrings([
+    'function VarRecs: TVarRecArray; varargs;',
     'var',
-    '  ExitCode: Longint;',
-    ''
-    // implementation
-    ]),LinesToStr([
-    ''
-    ]));
+    '  v: PVarRec;',
+    'begin',
+    '  v^.VType:=1;',
+    '  v^.VJSValue:=2;',
+    'end;',
+    '']);
+
+  try
+    AddModuleWithIntfImplSrc('system.pp',Intf.Text,Impl.Text);
+  finally
+    Intf.Free;
+    Impl.Free;
+  end;
 end;
 
-procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean);
+procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean;
+  SystemUnitParts: TSystemUnitParts);
 begin
   if NeedSystemUnit then
-    AddSystemUnit
+    AddSystemUnit(SystemUnitParts)
   else
     Parser.ImplicitUses.Clear;
   Add('program '+ExtractFileUnitName(Filename)+';');
   Add('');
 end;
 
-procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean);
+procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean;
+  SystemUnitParts: TSystemUnitParts);
 begin
   if NeedSystemUnit then
-    AddSystemUnit
+    AddSystemUnit(SystemUnitParts)
   else
     Parser.ImplicitUses.Clear;
   Add('unit Test1;');
@@ -9481,10 +9588,154 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArrayOfConst_TVarRec;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(args: array of const);',
+  'var',
+  '  i: longint;',
+  '  v: TVarRec;',
+  'begin',
+  '  for i:=low(args) to high(args) do begin',
+  '    v:=args[i];',
+  '    case v.vtype of',
+  '    vtInteger: if length(args)=args[i].vInteger then ;',
+  '    end;',
+  '  end;',
+  '  for v in args do ;',
+  '  args:=nil;',
+  '  SetLength(args,2);',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestArrayOfConst_TVarRec',
+    LinesToStr([ // statements
+    'this.Say = function (args) {',
+    '  var i = 0;',
+    '  var v = pas.system.TVarRec.$new();',
+    '  for (var $l1 = 0, $end2 = rtl.length(args) - 1; $l1 <= $end2; $l1++) {',
+    '    i = $l1;',
+    '    v.$assign(args[i]);',
+    '    var $tmp3 = v.VType;',
+    '    if ($tmp3 === 0) if (rtl.length(args) === args[i].VJSValue) ;',
+    '  };',
+    '  for (var $in4 = args, $l5 = 0, $end6 = rtl.length($in4) - 1; $l5 <= $end6; $l5++) v = $in4[$l5];',
+    '  args = [];',
+    '  args = rtl.arraySetLength(args, pas.system.TVarRec, 2);',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    ]));
+end;
+
+procedure TTestModule.TestArrayOfConst_PassBaseTypes;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(args: array of const);',
+  'begin',
+  '  Say(args);',
+  'end;',
+  'var',
+  '  p: Pointer;',
+  '  j: jsvalue;',
+  '  c: currency;',
+  'begin',
+  '  Say([]);',
+  '  Say([1]);',
+  '  Say([''c'',''foo'',nil,true,1.3,p,j,c]);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArrayOfConst_PassBaseTypes',
+    LinesToStr([ // statements
+    'this.Say = function (args) {',
+    '  $mod.Say(args);',
+    '};',
+    'this.p = null;',
+    'this.j = undefined;',
+    'this.c = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Say([]);',
+    '$mod.Say(pas.system.VarRecs(0, 1));',
+    '$mod.Say(pas.system.VarRecs(',
+    '  9,',
+    '  "c",',
+    '  18,',
+    '  "foo",',
+    '  5,',
+    '  null,',
+    '  1,',
+    '  true,',
+    '  3,',
+    '  1.3,',
+    '  5,',
+    '  $mod.p,',
+    '  20,',
+    '  $mod.j,',
+    '  12,',
+    '  $mod.c',
+    '  ));',
+    '']));
+end;
+
+procedure TTestModule.TestArrayOfConst_PassObj;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  '{$interfaces corba}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TClass = class of TObject;',
+  '  IUnknown = interface',
+  '  end;',
+  'procedure Say(args: array of const);',
+  'begin',
+  'end;',
+  'var',
+  '  o: TObject;',
+  '  c: TClass;',
+  '  i: IUnknown;',
+  'begin',
+  '  Say([o,c,TObject]);',
+  '  Say([nil,i]);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArrayOfConst_PassObj',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createInterface($mod, "IUnknown", "{B92D5841-758A-322B-B800-000000000000}", [], null);',
+    'this.Say = function (args) {',
+    '};',
+    'this.o = null;',
+    'this.c = null;',
+    'this.i = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Say(pas.system.VarRecs(',
+    '  7,',
+    '  $mod.o,',
+    '  8,',
+    '  $mod.c,',
+    '  8,',
+    '  $mod.TObject',
+    '));',
+    '$mod.Say(pas.system.VarRecs(5, null, 14, $mod.i));',
+    '']));
+end;
+
 procedure TTestModule.TestRecord_Empty;
 begin
   StartProgram(false);
-  Add(['type',
+  Add([
+  'type',
   '  TRecA = record',
   '  end;',
   'var a,b: TRecA;',

+ 46 - 9
packages/pastojs/tests/tcoptimizations.pas

@@ -25,7 +25,7 @@ interface
 
 uses
   Classes, SysUtils, testregistry, fppas2js, pastree,
-  PScanner, PasUseAnalyzer, PasResolver, PasResolveEval,
+  PScanner, Pas2jsUseAnalyzer, PasResolver, PasResolveEval,
   tcmodules;
 
 type
@@ -34,8 +34,8 @@ type
 
   TCustomTestOptimizations = class(TCustomTestModule)
   private
-    FAnalyzerModule: TPasAnalyzer;
-    FAnalyzerProgram: TPasAnalyzer;
+    FAnalyzerModule: TPas2JSAnalyzer;
+    FAnalyzerProgram: TPas2JSAnalyzer;
     FWholeProgramOptimization: boolean;
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
@@ -46,8 +46,8 @@ type
     procedure ParseProgram; override;
     function CreateConverter: TPasToJSConverter; override;
   public
-    property AnalyzerModule: TPasAnalyzer read FAnalyzerModule;
-    property AnalyzerProgram: TPasAnalyzer read FAnalyzerProgram;
+    property AnalyzerModule: TPas2JSAnalyzer read FAnalyzerModule;
+    property AnalyzerProgram: TPas2JSAnalyzer read FAnalyzerProgram;
     property WholeProgramOptimization: boolean read FWholeProgramOptimization
         write FWholeProgramOptimization;
   end;
@@ -78,6 +78,7 @@ type
     procedure TestWPO_Class_OmitPropertySetter2;
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
+    procedure TestWPO_ArrayOfConst;
     procedure TestWPO_Class_PropertyInOtherUnit;
     procedure TestWPO_ProgramPublicDeclaration;
     procedure TestWPO_ConstructorDefaultValueConst;
@@ -92,7 +93,7 @@ implementation
 function TCustomTestOptimizations.OnConverterIsElementUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -114,7 +115,7 @@ end;
 function TCustomTestOptimizations.OnConverterIsTypeInfoUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -137,9 +138,9 @@ procedure TCustomTestOptimizations.SetUp;
 begin
   inherited SetUp;
   FWholeProgramOptimization:=false;
-  FAnalyzerModule:=TPasAnalyzer.Create;
+  FAnalyzerModule:=TPas2JSAnalyzer.Create;
   FAnalyzerModule.Resolver:=Engine;
-  FAnalyzerProgram:=TPasAnalyzer.Create;
+  FAnalyzerProgram:=TPas2JSAnalyzer.Create;
   FAnalyzerProgram.Resolver:=Engine;
 end;
 
@@ -814,6 +815,42 @@ begin
   CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
 end;
 
+procedure TTestOptimizations.TestWPO_ArrayOfConst;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(arr: array of const);',
+  'begin end;',
+  'begin',
+  '  Say([true]);']);
+  ConvertProgram;
+  CheckUnit('system.pp',
+  LinesToStr([
+  'rtl.module("system", [], function () {',
+  '  var $mod = this;',
+  '  rtl.recNewT($mod, "TVarRec", function () {',
+  '    this.VType = 0;',
+  '    this.VJSValue = undefined;',
+  '    this.$eq = function (b) {',
+  '      return (this.VType === b.VType) && (this.VJSValue === b.VJSValue);',
+  '    };',
+  '    this.$assign = function (s) {',
+  '      this.VType = s.VType;',
+  '      this.VJSValue = s.VJSValue;',
+  '      return this;',
+  '    };',
+  '  });',
+  '  this.VarRecs = function () {',
+  '    var Result = [];',
+  '    var v = null;',
+  '    v.VType = 1;',
+  '    v.VJSValue = 2;',
+  '    return Result;',
+  '  };',
+  '});',
+  '']));
+end;
+
 procedure TTestOptimizations.TestWPO_Class_PropertyInOtherUnit;
 begin
   AddModuleWithIntfImplSrc('unit1.pp',

+ 6 - 1
packages/pastojs/tests/testpas2js.lpi

@@ -32,7 +32,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="11">
+    <Units Count="12">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -83,6 +83,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TCPrecompile"/>
       </Unit10>
+      <Unit11>
+        <Filename Value="../src/pas2jsuseanalyzer.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2jsUseAnalyzer"/>
+      </Unit11>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 1 - 1
packages/pastojs/tests/testpas2js.pp

@@ -21,7 +21,7 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap,
-  tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile;
+  tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile, pas2jsuseanalyzer;
 
 type