* synchronize with trunk

git-svn-id: branches/unicodekvm@41354 -

.gitattributes

@@ -2430,6 +2430,7 @@ packages/fcl-fpcunit/src/xmltestreport.pp svneol=native#text/plain
 packages/fcl-image/Makefile svneol=native#text/plain
 packages/fcl-image/Makefile.fpc svneol=native#text/plain
 packages/fcl-image/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-image/examples/DejaVuLGCSans.ttf -text
 packages/fcl-image/examples/Makefile svneol=native#text/plain
 packages/fcl-image/examples/Makefile.fpc svneol=native#text/plain
 packages/fcl-image/examples/createbarcode.lpi svneol=native#text/plain
@@ -2437,6 +2438,8 @@ packages/fcl-image/examples/createbarcode.lpr svneol=native#text/plain
 packages/fcl-image/examples/createqrcode.lpi svneol=native#text/plain
 packages/fcl-image/examples/createqrcode.pp svneol=native#text/plain
 packages/fcl-image/examples/drawing.pp svneol=native#text/plain
+packages/fcl-image/examples/edit-clear.png -text svneol=unset#image/png
+packages/fcl-image/examples/fpcanvasalphadraw.pp svneol=native#text/plain
 packages/fcl-image/examples/imgconv.pp svneol=native#text/plain
 packages/fcl-image/examples/interpoldemo.pp svneol=native#text/plain
 packages/fcl-image/examples/pattern.png -text svneol=unset#image/png
@@ -7029,6 +7032,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
@@ -12755,6 +12759,8 @@ tests/test/packages/fcl-db/tdb5.pp svneol=native#text/plain
 tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
 tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060a.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060b.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain

compiler/arm/cgcpu.pas

@@ -42,7 +42,9 @@ unit cgcpu;
         cgsetflags : boolean;
 
         procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override;
-        procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
+       protected
+         procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); override;
+       public
         procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
 
         procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
@@ -571,52 +573,16 @@ unit cgcpu;
       end;
 
 
-    procedure tbasecgarm.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
-      var
-        tmpref, ref: treference;
-        location: pcgparalocation;
-        sizeleft: aint;
+    procedure tbasecgarm.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
       begin
-        location := paraloc.location;
-        tmpref := r;
-        sizeleft := paraloc.intsize;
-        while assigned(location) do
+        { doubles in softemu mode have a strange order of registers and references }
+        if (cgpara.size=OS_F64) and
+           (location^.size=OS_32) then
           begin
-            paramanager.allocparaloc(list,location);
-            case location^.loc of
-              LOC_REGISTER,LOC_CREGISTER:
-                a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
-              LOC_REFERENCE:
-                begin
-                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,paraloc.alignment,[]);
-                  { doubles in softemu mode have a strange order of registers and references }
-                  if location^.size=OS_32 then
-                    g_concatcopy(list,tmpref,ref,4)
-                  else
-                    begin
-                      g_concatcopy(list,tmpref,ref,sizeleft);
-                      if assigned(location^.next) then
-                        internalerror(2005010710);
-                    end;
-                end;
-              LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                case location^.size of
-                   OS_F32, OS_F64:
-                     a_loadfpu_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
-                   else
-                     internalerror(2002072801);
-                end;
-              LOC_VOID:
-                begin
-                  // nothing to do
-                end;
-              else
-                internalerror(2002081103);
-            end;
-            inc(tmpref.offset,tcgsize2size[location^.size]);
-            dec(sizeleft,tcgsize2size[location^.size]);
-            location := location^.next;
-          end;
+            g_concatcopy(list,ref,paralocref,4)
+          end
+        else
+          inherited;
       end;
 
 

compiler/cgobj.pas

@@ -170,6 +170,9 @@ unit cgobj;
              @param(cgpara where the parameter will be stored)
           }
           procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);virtual;
+         protected
+          procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); virtual;
+         public
           {# Pass the value of a parameter, which can be located either in a register or memory location,
              to a routine.
 
@@ -1129,16 +1132,8 @@ implementation
                 end;
               LOC_REFERENCE,LOC_CREFERENCE:
                 begin
-                   if assigned(location^.next) then
-                     internalerror(2010052906);
-                   reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
-                   if (size <> OS_NO) and
-                      (tcgsize2size[size] <= sizeof(aint)) then
-                     a_load_ref_ref(list,size,location^.size,tmpref,ref)
-                   else
-                     { use concatcopy, because the parameter can be larger than }
-                     { what the OS_* constants can handle                       }
-                     g_concatcopy(list,tmpref,ref,sizeleft);
+                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
+                  a_load_ref_cgparalocref(list,size,sizeleft,tmpref,ref,cgpara,location);
                 end;
               LOC_MMREGISTER,LOC_CMMREGISTER:
                 begin
@@ -1153,6 +1148,10 @@ implementation
                      else
                        internalerror(2010053101);
                    end;
+                end;
+              LOC_FPUREGISTER,LOC_CFPUREGISTER:
+                begin
+                  a_loadfpu_ref_reg(list,size,location^.size,tmpref,location^.register);
                 end
               else
                 internalerror(2010053111);
@@ -1163,6 +1162,19 @@ implementation
           end;
       end;
 
+    procedure tcg.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
+      begin
+        if assigned(location^.next) then
+          internalerror(2010052906);
+        if (sourcesize<>OS_NO) and
+           (tcgsize2size[sourcesize]<=sizeof(aint)) then
+           a_load_ref_ref(list,sourcesize,location^.size,ref,paralocref)
+        else
+          { use concatcopy, because the parameter can be larger than }
+          { what the OS_* constants can handle                       }
+          g_concatcopy(list,ref,paralocref,sizeleft);
+       end;
+
 
     procedure tcg.a_load_loc_cgpara(list : TAsmList;const l:tlocation;const cgpara : TCGPara);
       begin

compiler/systems/t_embed.pas

@@ -1311,12 +1311,12 @@ begin
   if success and (target_info.system in [system_arm_embedded,system_avr_embedded,system_mipsel_embedded]) then
     begin
       success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O ihex '+
-        ChangeFileExt(current_module.exefilename,'.elf')+' '+
-        ChangeFileExt(current_module.exefilename,'.hex'),true,false);
+        maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.elf')))+' '+
+        maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.hex'))),true,false);
       if success then
         success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O binary '+
-          ChangeFileExt(current_module.exefilename,'.elf')+' '+
-          ChangeFileExt(current_module.exefilename,'.bin'),true,false);
+          maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.elf')))+' '+
+          maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.bin'))),true,false);
     end;
 
   MakeExecutable:=success;   { otherwise a recursive call to link method }

packages/fcl-image/examples/fpcanvasalphadraw.pp

@@ -0,0 +1,97 @@
+{
+  Sample program by Ondrey Pokorny to demonstrate drawing modes of the TFPCustomCanvas:
+    - opaque 
+    - alphablend 
+    - custom blending, using a callback (not-used in this case)
+}
+program FPCanvasAlphaDraw;
+
+uses FPImage, FPImgCanv, FPCanvas, FPReadPNG, FPWritePNG, Classes, SysUtils, freetype, ftFont;
+
+const
+  cImageName: array[TFPDrawingMode] of string = ('opaque', 'alphablend', 'not-used');
+
+var
+  xNew, xImage: TFPMemoryImage;
+  xCanvas: TFPImageCanvas;
+  xDrawingMode: TFPDrawingMode;
+  xRect: TRect;
+begin
+  ftFont.InitEngine;
+  xNew := nil;
+  xCanvas := nil;
+  xImage := nil;
+  try
+    xImage := TFPMemoryImage.Create(0, 0);
+    xImage.LoadFromFile('edit-clear.png');
+
+    for xDrawingMode := dmOpaque to dmAlphaBlend do
+    begin
+      xNew := TFPMemoryImage.Create(200, 200);
+      xCanvas := TFPImageCanvas.Create(xNew);
+
+      xCanvas.DrawingMode := xDrawingMode;
+
+      xCanvas.Pen.Style := psClear;
+      xCanvas.Brush.FPColor := colRed;
+
+      xCanvas.FillRect(0, 0, xNew.Width, xNew.Height);
+      // draw semi-transparent objects
+      xCanvas.Brush.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xRect := Rect(0, 0, 50, 50);
+      xCanvas.Ellipse(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Rectangle(xRect);
+
+      xRect := Rect(0, 50, 50, 100);
+
+      xCanvas.Pen.Style := psSolid;
+      xCanvas.Pen.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xCanvas.Pen.Width := 4;
+      xCanvas.Brush.Style := bsClear;
+
+      xCanvas.Ellipse(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Rectangle(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Polyline([
+        Point(xRect.CenterPoint.X, xRect.Top),
+        Point(xRect.Right, xRect.CenterPoint.Y),
+        Point(xRect.CenterPoint.X, xRect.Bottom),
+        Point(xRect.Left, xRect.CenterPoint.Y),
+        Point(xRect.CenterPoint.X, xRect.Top)]);
+      xRect.Offset(50, 0);
+      xCanvas.MoveTo(xRect.TopLeft);
+      xCanvas.LineTo(xRect.Right, xRect.Top);
+
+      xRect := Rect(0, 100, 50, 150);
+      xCanvas.Draw(xRect.Left, xRect.Top, xImage);
+      xRect.Offset(50, 0);
+      xCanvas.StretchDraw(xRect.Left, xRect.Top, xRect.Width, xRect.Height, xImage);
+
+      xRect := Rect(0, 150, 50, 200);
+      xCanvas.Font:=TFreeTypeFont.Create;
+      xCanvas.Font.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xCanvas.Font.Name := 'DejaVuLGCSans.ttf';
+      xCanvas.Font.Size := 15;
+      (xCanvas.Font as TFreeTypeFont).AntiAliased := True;
+      xCanvas.TextOut(xRect.Left, xRect.CenterPoint.Y, 'Hello');
+
+      xRect.Offset(100, 0);
+      (xCanvas.Font as TFreeTypeFont).AntiAliased := False;
+      xCanvas.TextOut(xRect.Left, xRect.CenterPoint.Y, 'Hello');
+
+      xNew.SaveToFile(cImageName[xDrawingMode]+'.png');
+
+      xCanvas.Font.Free;
+      xCanvas.Font := nil;
+      FreeAndNil(xNew);
+      FreeAndNil(xCanvas);
+    end;
+  finally
+    xCanvas.Free;
+    xNew.Free;
+    xImage.Free;
+  end;
+end.
+

packages/fcl-image/src/ellipses.pp

@@ -337,7 +337,7 @@ end;
 procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
 begin
   with Canv do
-    Colors[x,y] := color;
+    DrawPixel(x,y,color);
 end;
 
 procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
@@ -508,7 +508,7 @@ begin
       for r := 0 to info.infolist.count-1 do
         with PEllipseInfoData (info.infolist[r])^ do
           for y := ytopmin to ybotmax do
-            colors[x,y] := c;
+            DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -530,7 +530,7 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         for y := ytopmin to ybotmax do
           if (y mod width) = 0 then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -548,7 +548,7 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         if (x mod width) = 0 then
           for y := ytopmin to ybotmax do
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -569,7 +569,7 @@ begin
         w := width - 1 - (x mod width);
         for y := ytopmin to ybotmax do
           if (y mod width) = w then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
         end;
   finally
     info.Free;
@@ -591,7 +591,7 @@ begin
         w := (x mod width);
         for y := ytopmin to ybotmax do
           if (y mod width) = w then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
         end;
   finally
     info.Free;
@@ -616,7 +616,7 @@ begin
           begin
           wy := y mod width;
           if (wy = w1) or (wy = w2) then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
           end;
         end;
   finally
@@ -636,11 +636,11 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         if (x mod width) = 0 then
           for y := ytopmin to ybotmax do
-            canv.colors[x,y] := c
+            canv.DrawPixel(x,y,c)
         else
           for y := ytopmin to ybotmax do
             if (y mod width) = 0 then
-              canv.colors[x,y] := c;
+              canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -660,7 +660,7 @@ begin
         begin
         w := (x mod image.width);
         for y := ytopmin to ybotmax do
-          canv.colors[x,y] := Image.colors[w, (y mod image.height)];
+          canv.DrawPixel(x,y,Image.colors[w, (y mod image.height)]);
         end;
   finally
     info.Free;
@@ -692,7 +692,7 @@ begin
           yi := (y - yo) mod image.height;
           if yi < 0 then
             inc (yi, image.height);
-          canv.colors[x,y] := Image.colors[xi, yi];
+          canv.DrawPixel(x,y,Image.colors[xi, yi]);
           end;
         end;
   finally

packages/fcl-image/src/fpcanvas.inc

@@ -571,6 +571,16 @@ begin
     end;
 end;
 
+procedure TFPCustomCanvas.DrawPixel(const x, y: integer;
+  const newcolor: TFPColor);
+begin
+  case FDrawingMode of
+    dmOpaque: Colors[x,y] := newcolor;
+    dmAlphaBlend: Colors[x,y] := AlphaBlend(Colors[x,y], newcolor);
+    dmCustom: Colors[x,y] := FOnCombineColors(Colors[x,y], newcolor);
+  end;
+end;
+
 procedure TFPCustomCanvas.Erase;
 var
   x,y:Integer;
@@ -784,7 +794,7 @@ begin
     begin
     xx := r - x;
     for t := yi to ym do
-      colors [r,t] := AlphaBlend(colors [r,t], image.colors[xx,t-y]);
+      DrawPixel(r,t, image.colors[xx,t-y]);
     end;
 end;
 

packages/fcl-image/src/fpcanvas.pp

@@ -233,6 +233,9 @@ type
     function IsPointInRegion(AX, AY: Integer): Boolean; override;
   end;
 
+  TFPDrawingMode = (dmOpaque, dmAlphaBlend, dmCustom);
+  TFPCanvasCombineColors = function(const color1, color2: TFPColor): TFPColor of object;
+
   { TFPCustomCanvas }
 
   TFPCustomCanvas = class(TPersistent)
@@ -243,6 +246,8 @@ type
     FHelpers : TList;
     FLocks : integer;
     FInterpolation : TFPCustomInterpolation;
+    FDrawingMode : TFPDrawingMode;
+    FOnCombineColors : TFPCanvasCombineColors;
     function AllowFont (AFont : TFPCustomFont) : boolean;
     function AllowBrush (ABrush : TFPCustomBrush) : boolean;
     function AllowPen (APen : TFPCustomPen) : boolean;
@@ -370,6 +375,7 @@ type
     procedure Draw (x,y:integer; image:TFPCustomImage);
     procedure StretchDraw (x,y,w,h:integer; source:TFPCustomImage);
     procedure Erase;virtual;
+    procedure DrawPixel(const x, y: integer; const newcolor: TFPColor);
     // properties
     property LockCount: Integer read FLocks;
     property Font : TFPCustomFont read GetFont write SetFont;
@@ -384,6 +390,8 @@ type
     property Height : integer read GetHeight write SetHeight;
     property Width : integer read GetWidth write SetWidth;
     property ManageResources: boolean read FManageResources write FManageResources;
+    property DrawingMode : TFPDrawingMode read FDrawingMode write FDrawingMode;
+    property OnCombineColors : TFPCanvasCombineColors read FOnCombineColors write FOnCombineColors;
   end;
 
   TFPCustomDrawFont = class (TFPCustomFont)

packages/fcl-image/src/fpinterpolation.inc

@@ -17,7 +17,7 @@ begin
 
   for dx := 0 to w-1 do
     for dy := 0 to h-1 do
-      Canvas.Colors[x+dx,y+dy] := Image.Colors[dx*iw div w, dy*ih div h];
+      Canvas.DrawPixel(x+dx,y+dy, Image.Colors[dx*iw div w, dy*ih div h]);
 end;
 
 { TFPBaseInterpolation }
@@ -223,7 +223,7 @@ begin
           NewCol.blue:=Min(NewCol.blue+round(Col.blue*f),$ffff);
           NewCol.alpha:=Min(NewCol.alpha+round(Col.alpha*f),$ffff);
         end;
-        Canvas.Colors[x+dx,y+dy]:=AlphaBlend(Canvas.Colors[x+dx,y+dy], NewCol);
+        Canvas.DrawPixel(x+dx,y+dy, NewCol);
       end;
     end;
   finally

packages/fcl-image/src/ftfont.pp

@@ -353,8 +353,16 @@ procedure TFreeTypeFont.DrawChar (x,y:integer; data:PByteArray; pitch, width, he
   var
     pixelcolor: TFPColor;
   begin
-    pixelcolor := AlphaBlend(canv.colors[x,y], FPImage.FPColor(c.red, c.green,c.blue, (t+1) shl 8 - 1));
-    canv.colors[x,y] := pixelcolor;
+    case canv.DrawingMode of
+      dmOpaque:
+      begin
+        pixelcolor := FPImage.FPColor(c.red, c.green,c.blue, (t+1) shl 8 - 1); // opaque: ignore c.Alpha
+        canv.colors[x,y] := AlphaBlend(canv.colors[x,y], pixelcolor);
+      end;
+    else
+      pixelcolor := FPImage.FPColor(c.red, c.green,c.blue, ((t+1) shl 8 - 1) * c.Alpha div $ffff); // apply c.Alpha
+      canv.DrawPixel(x,y,pixelcolor);
+    end;
   end;
 
 var b,rx,ry : integer;
@@ -380,7 +388,7 @@ begin
       begin
       rb := rx mod 8;
       if (data^[b+l] and bits[rb]) <> 0 then
-        canvas.colors[x+rx,y+ry] := FPColor;
+        canvas.DrawPixel(x+rx,y+ry, FPColor);
       if rb = 7 then
         inc (l);
       end;

packages/fcl-image/src/pixtools.pp

@@ -75,7 +75,7 @@ begin
     begin
     for x := x1 to x2 do
       for y := y1 to y2 do
-        colors[x,y] := color;
+        DrawPixel(x,y,color);
     end;
 end;
 
@@ -104,7 +104,7 @@ type
 procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
 begin
   with Canv do
-    Colors[x,y] := color;
+    DrawPixel(x,y,color);
 end;
 
 procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
@@ -557,7 +557,7 @@ begin
   with image do
     for x := x1 to x2 do
       for y := y1 to y2 do
-        Canv.colors[x,y] := colors[x mod width, y mod height];
+        Canv.DrawPixel(x,y, colors[x mod width, y mod height]);
 end;
 
 procedure FillRectangleImageRel (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; const Image:TFPCustomImage);
@@ -566,7 +566,7 @@ begin
   with image do
     for x := x1 to x2 do
       for y := y1 to y2 do
-        Canv.colors[x,y] := colors[(x-x1) mod width, (y-y1) mod height];
+        Canv.DrawPixel(x,y, colors[(x-x1) mod width, (y-y1) mod height]);
 end;
 
 type
@@ -890,7 +890,7 @@ end;
 
 procedure SetFloodColor (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
 begin
-  Canv.colors[x,y] := PFPColor(data)^;
+  Canv.DrawPixel(x,y, PFPColor(data)^);
 end;
 
 procedure FillFloodColor (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
@@ -967,7 +967,7 @@ var r : PFloodHashRec;
 begin
   r := PFloodHashRec(data);
   if (y mod r^.width) = 0 then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashVer(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -975,7 +975,7 @@ var r : PFloodHashRec;
 begin
   r := PFloodHashRec(data);
   if (x mod r^.width) = 0 then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -985,7 +985,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if ((x mod w) + (y mod w)) = (w - 1) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashBDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -995,7 +995,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if (x mod w) = (y mod w) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -1005,7 +1005,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if ((x mod w) = 0) or ((y mod w) = 0) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashDiagCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -1016,7 +1016,7 @@ begin
   w := r^.width;
   if ( (x mod w) = (y mod w) ) or
      ( ((x mod w) + (y mod w)) = (w - 1) ) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure FillFloodHash (Canv:TFPCustomCanvas; x,y:integer; width:integer; SetHashColor:TFuncSetColor; const c:TFPColor);
@@ -1109,7 +1109,7 @@ var r : PFloodImageRec;
 begin
   r := PFloodImageRec(data);
   with r^.image do
-    Canv.colors[x,y] := colors[x mod width, y mod height];
+    Canv.DrawPixel(x,y,colors[x mod width, y mod height]);
 end;
 
 procedure FillFloodImage (Canv:TFPCustomCanvas; x,y :integer; const Image:TFPCustomImage);
@@ -1142,7 +1142,7 @@ begin
     yi := (y - yo) mod height;
     if yi < 0 then
       yi := height - yi;
-    Canv.colors[x,y] := colors[xi,yi];
+    Canv.DrawPixel(x,y,colors[xi,yi]);
     end;
 end;
 

packages/fcl-passrc/src/pasresolveeval.pas

@@ -183,6 +183,7 @@ const
   nHelpersCannotBeUsedAsTypes = 3117;
   nBitWiseOperationsAre32Bit = 3118;
   nImplictConversionUnicodeToAnsi = 3119;
+  nWrongTypeXInArrayConstructor = 3120;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -313,6 +314,7 @@ resourcestring
   sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
   sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
   sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
+  sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -745,11 +745,13 @@ type
     FAssertMsgConstructor: TPasConstructor;
     FRangeErrorClass: TPasClassType;
     FRangeErrorConstructor: TPasConstructor;
+    FSystemTVarRec: TPasRecordType;
     procedure SetAssertClass(const AValue: TPasClassType);
     procedure SetAssertDefConstructor(const AValue: TPasConstructor);
     procedure SetAssertMsgConstructor(const AValue: TPasConstructor);
     procedure SetRangeErrorClass(const AValue: TPasClassType);
     procedure SetRangeErrorConstructor(const AValue: TPasConstructor);
+    procedure SetSystemTVarRec(const AValue: TPasRecordType);
   public
     FirstName: string; // the 'unit1' in 'unit1', or 'ns' in 'ns.unit1'
     PendingResolvers: TFPList; // list of TPasResolver waiting for the unit interface
@@ -765,6 +767,7 @@ type
     property AssertMsgConstructor: TPasConstructor read FAssertMsgConstructor write SetAssertMsgConstructor;
     property RangeErrorClass: TPasClassType read FRangeErrorClass write SetRangeErrorClass;
     property RangeErrorConstructor: TPasConstructor read FRangeErrorConstructor write SetRangeErrorConstructor;
+    property SystemTVarRec: TPasRecordType read FSystemTVarRec write SetSystemTVarRec;
   end;
   TPasModuleScopeClass = class of TPasModuleScope;
 
@@ -1228,7 +1231,7 @@ type
     ExprEl: TPasExpr;
     Flags: TPasResolverResultFlags;
   end;
-  PPasResolvedElement = ^TPasResolverResult;
+  PPasResolverResult = ^TPasResolverResult;
 
 type
   TPasResolverComputeFlag = (
@@ -1528,10 +1531,11 @@ type
     procedure FinishArgument(El: TPasArgument); virtual;
     procedure FinishAncestors(aClass: TPasClassType); virtual;
     procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
+    procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
     procedure FinishPropertyParamAccess(Params: TParamsExpr;
-      Prop: TPasProperty);
-    procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess);
-    procedure FinishInitialFinalization(El: TPasImplBlock);
+      Prop: TPasProperty); virtual;
+    procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess); virtual;
+    procedure FinishInitialFinalization(El: TPasImplBlock); virtual;
     procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
     function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
     procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
@@ -1604,6 +1608,8 @@ type
       ErrorEl: TPasElement): boolean; virtual;
     procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
     procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
+    function FindTVarRec(ErrorEl: TPasElement): TPasRecordType; virtual;
+    function GetTVarRec(El: TPasArrayType): TPasRecordType; virtual;
   protected
     fExprEvaluator: TResExprEvaluator;
     procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: TMaxPrecInt;
@@ -1999,6 +2005,8 @@ type
     function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
     function IsOpenArray(TypeEl: TPasType): boolean;
     function IsDynOrOpenArray(TypeEl: TPasType): boolean;
+    function IsArrayOfConst(TypeEl: TPasType): boolean;
+    function GetArrayElType(ArrType: TPasArrayType): TPasType;
     function IsVarInit(Expr: TPasExpr): boolean;
     function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
     function IsClassMethod(El: TPasElement): boolean;
@@ -3713,6 +3721,16 @@ begin
     FRangeErrorConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
 end;
 
+procedure TPasModuleScope.SetSystemTVarRec(const AValue: TPasRecordType);
+begin
+  if FSystemTVarRec=AValue then Exit;
+  if FSystemTVarRec<>nil then
+    FSystemTVarRec.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
+  FSystemTVarRec:=AValue;
+  if FSystemTVarRec<>nil then
+    FSystemTVarRec.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
+end;
+
 constructor TPasModuleScope.Create;
 begin
   inherited Create;
@@ -3726,6 +3744,7 @@ begin
   AssertMsgConstructor:=nil;
   RangeErrorClass:=nil;
   RangeErrorConstructor:=nil;
+  SystemTVarRec:=nil;
   FreeAndNil(PendingResolvers);
   inherited Destroy;
 end;
@@ -5406,6 +5425,8 @@ begin
     RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
   if not (Parent.Parent is TPasDeclarations) then
     RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
+  if El.Parent<>Parent then
+    RaiseNotYetImplemented(20190215085011,Parent);
   // give anonymous sub type a name
   El.Name:=Parent.Name+AnonymousElTypePostfix;
   {$IFDEF VerbosePasResolver}
@@ -5729,9 +5750,17 @@ begin
       RaiseXExpectedButYFound(20170216151609,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
     end;
   if El.ElType=nil then
-    RaiseNotYetImplemented(20171005235610,El,'array of const');
-  CheckUseAsType(El.ElType,20190123095401,El);
-  FinishSubElementType(El,El.ElType);
+    begin
+    // array of const
+    if length(El.Ranges)>0 then
+      RaiseNotYetImplemented(20190215102529,El);
+    FindTVarRec(El);
+    end
+  else
+    begin
+    CheckUseAsType(El.ElType,20190123095401,El);
+    FinishSubElementType(El,El.ElType);
+    end;
 end;
 
 procedure TPasResolver.FinishResourcestring(El: TPasResString);
@@ -7452,6 +7481,27 @@ begin
   // El.ImplementationProc is resolved in FinishClassType
 end;
 
+procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
+  Params: TParamsExpr);
+var
+  ParamAccess: TResolvedRefAccess;
+  i: Integer;
+  ArrParams: TPasExprArray;
+begin
+  ArrParams:=Params.Params;
+  for i:=0 to length(ArrParams)-1 do
+    begin
+    ParamAccess:=rraRead;
+    if i<ProcType.Args.Count then
+      case TPasArgument(ProcType.Args[i]).Access of
+      argVar: ParamAccess:=rraVarParam;
+      argOut: ParamAccess:=rraOutParam;
+      end;
+    AccessExpr(ArrParams[i],ParamAccess);
+    end;
+  CheckCallProcCompatibility(ProcType,Params,false,true);
+end;
+
 procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
   Prop: TPasProperty);
 var
@@ -8064,7 +8114,7 @@ var
   InRange, VarRange: TResEvalValue;
   InRangeInt, VarRangeInt: TResEvalRangeInt;
   bt: TResolverBaseType;
-  TypeEl: TPasType;
+  TypeEl, ElType: TPasType;
   C: TClass;
 begin
   CreateScope(Loop,TPasForLoopScope);
@@ -8150,7 +8200,8 @@ begin
             C:=TypeEl.ClassType;
             if C=TPasArrayType then
               begin
-              ComputeElement(TPasArrayType(TypeEl).ElType,StartResolved,[rcType]);
+              ElType:=GetArrayElType(TPasArrayType(TypeEl));
+              ComputeElement(ElType,StartResolved,[rcType]);
               StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
               if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
                 RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
@@ -9080,8 +9131,8 @@ begin
       ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
       if IsProcedureType(ResolvedEl,true) then
         begin
-        CheckCallProcCompatibility(TPasProcedureType(ResolvedEl.LoTypeEl),Params,true);
         CreateReference(TPasProcedureType(ResolvedEl.LoTypeEl),Value,Access);
+        FinishProcParamAccess(TPasProcedureType(ResolvedEl.LoTypeEl),Params);
         exit;
         end
       end;
@@ -9095,31 +9146,6 @@ end;
 procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
   Params: TParamsExpr; Access: TResolvedRefAccess);
 
-  procedure FinishProcParams(ProcType: TPasProcedureType);
-  var
-    ParamAccess: TResolvedRefAccess;
-    i: Integer;
-  begin
-    if not (Access in [rraRead,rraParamToUnknownProc]) then
-      begin
-      {$IFDEF VerbosePasResolver}
-      writeln('TPasResolver.ResolveFuncParamsExpr.FinishProcParams Params=',GetObjName(Params),' NameEl=',GetObjName(NameExpr),' Access=',Access);
-      {$ENDIF}
-      RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
-      end;
-    for i:=0 to length(Params.Params)-1 do
-      begin
-      ParamAccess:=rraRead;
-      if i<ProcType.Args.Count then
-        case TPasArgument(ProcType.Args[i]).Access of
-        argVar: ParamAccess:=rraVarParam;
-        argOut: ParamAccess:=rraOutParam;
-        end;
-      AccessExpr(Params.Params[i],ParamAccess);
-      end;
-    CheckCallProcCompatibility(ProcType,Params,false,true);
-  end;
-
   procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
   var
     i: Integer;
@@ -9243,8 +9269,17 @@ begin
 
   // set param expression Access flags
   if FoundEl is TPasProcedure then
+    begin
     // now it is known which overloaded proc to call
-    FinishProcParams(TPasProcedure(FoundEl).ProcType)
+    if not (Access in [rraRead,rraParamToUnknownProc]) then
+      begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
+      {$ENDIF}
+      RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
+      end;
+    FinishProcParamAccess(TPasProcedure(FoundEl).ProcType,Params);
+    end
   else if FoundEl is TPasType then
     begin
     TypeEl:=ResolveAliasType(TPasType(FoundEl));
@@ -9307,7 +9342,14 @@ begin
     TypeEl:=ResolvedEl.LoTypeEl;
     if TypeEl is TPasProcedureType then
       begin
-      FinishProcParams(TPasProcedureType(TypeEl));
+      if not (Access in [rraRead,rraParamToUnknownProc]) then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
+        {$ENDIF}
+        RaiseMsg(20190215195439,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
+        end;
+      FinishProcParamAccess(TPasProcedureType(TypeEl),Params);
       exit;
       end;
     {$IFDEF VerbosePasResolver}
@@ -9912,6 +9954,8 @@ procedure TPasResolver.MarkArrayExprRecursive(Expr: TPasExpr;
         inc(RgIndex);
         if RgIndex>length(ArrayType.Ranges) then
           begin
+          if ArrayType.ElType=nil then
+            exit; // elements are not arrays
           ComputeElement(ArrayType.ElType,ResolvedElType,[rcType]);
           if (ResolvedElType.BaseType=btContext)
               and (ResolvedElType.LoTypeEl is TPasArrayType) then
@@ -11337,7 +11381,7 @@ procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
   end;
 
 var
-  TypeEl: TPasType;
+  TypeEl, ElType: TPasType;
   ArrayEl: TPasArrayType;
   ArgNo: Integer;
   OrigResolved: TPasResolverResult;
@@ -11426,7 +11470,8 @@ begin
         ArrayEl:=NoNil(ResolveAliasType(ArrayEl.ElType)) as TPasArrayType;
       until false;
       OrigResolved:=ResolvedEl;
-      ComputeElement(ArrayEl.ElType,ResolvedEl,Flags,StartEl);
+      ElType:=GetArrayElType(ArrayEl);
+      ComputeElement(ElType,ResolvedEl,Flags,StartEl);
       // identifier and value is the array itself
       ResolvedEl.IdentEl:=OrigResolved.IdentEl;
       ResolvedEl.ExprEl:=OrigResolved.ExprEl;
@@ -12710,6 +12755,51 @@ begin
   ModScope.RangeErrorConstructor:=aConstructor;
 end;
 
+function TPasResolver.FindTVarRec(ErrorEl: TPasElement): TPasRecordType;
+var
+  aMod, UtilsMod: TPasModule;
+  SectionScope: TPasSectionScope;
+  Identifier: TPasIdentifier;
+  El: TPasElement;
+  ModScope: TPasModuleScope;
+begin
+  aMod:=RootElement;
+  ModScope:=aMod.CustomData as TPasModuleScope;
+  Result:=ModScope.SystemTVarRec;
+  if Result<>nil then exit;
+
+  // find unit in uses clauses
+  UtilsMod:=FindUsedUnit('system',aMod);
+  if UtilsMod=nil then
+    RaiseIdentifierNotFound(20190215101210,'System.TVarRec',ErrorEl);
+
+  // find class in interface
+  if UtilsMod.InterfaceSection=nil then
+    RaiseIdentifierNotFound(20190215101231,'System.TVarRec',ErrorEl);
+
+  SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
+  Identifier:=SectionScope.FindLocalIdentifier('TVarRec');
+  if Identifier=nil then
+    RaiseIdentifierNotFound(20190215101253,'System.TVarRec',ErrorEl);
+  El:=Identifier.Element;
+  if not (El is TPasRecordType) then
+    RaiseXExpectedButYFound(20190215101310,'record TVarRec',GetElementTypeName(El),ErrorEl);
+  Result:=TPasRecordType(El);
+  ModScope.SystemTVarRec:=Result;
+end;
+
+function TPasResolver.GetTVarRec(El: TPasArrayType): TPasRecordType;
+var
+  aModule: TPasModule;
+  ModScope: TPasModuleScope;
+begin
+  aModule:=El.GetModule;
+  ModScope:=aModule.CustomData as TPasModuleScope;
+  Result:=ModScope.SystemTVarRec;
+  if Result=nil then
+    RaiseNotYetImplemented(20190215111924,El,'missing System.TVarRec');
+end;
+
 procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
   const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
   const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
@@ -14580,6 +14670,8 @@ var
   Param: TPasExpr;
   ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
   i: Integer;
+  ArrType: TPasArrayType;
+  ElType: TPasType;
 begin
   Result:=cIncompatible;
   if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
@@ -14598,7 +14690,11 @@ begin
       if ParamResolved.BaseType=btContext then
         begin
         if IsDynArray(ParamResolved.LoTypeEl) then
-          ComputeElement(TPasArrayType(ParamResolved.LoTypeEl).ElType,ElTypeResolved,[rcType]);
+          begin
+          ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
+          ElType:=GetArrayElType(ArrType);
+          ComputeElement(ElType,ElTypeResolved,[rcType]);
+          end;
         end
       else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
         SetResolverValueExpr(ElTypeResolved,ParamResolved.SubType,
@@ -14793,6 +14889,8 @@ var
   Params: TParamsExpr;
   Param, ItemParam: TPasExpr;
   ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
+  ArrType: TPasArrayType;
+  ElType: TPasType;
 begin
   Result:=cIncompatible;
   if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
@@ -14817,7 +14915,9 @@ begin
   if (ParamResolved.BaseType<>btContext)
       or not IsDynArray(ParamResolved.LoTypeEl) then
     exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
-  ComputeElement(TPasArrayType(ParamResolved.LoTypeEl).ElType,ElTypeResolved,[rcType]);
+  ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
+  ElType:=GetArrayElType(ArrType);
+  ComputeElement(ElType,ElTypeResolved,[rcType]);
   if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
     exit(cIncompatible);
 
@@ -14837,6 +14937,7 @@ var
   P: TPasExprArray;
   Param0, Param1: TPasExpr;
   ArrayResolved, ElTypeResolved: TPasResolverResult;
+  ElType: TPasType;
 begin
   if Proc=nil then ;
   P:=Params.Params;
@@ -14853,7 +14954,8 @@ begin
     if (ArrayResolved.BaseType<>btContext)
         or not IsDynArray(ArrayResolved.LoTypeEl) then
       RaiseNotYetImplemented(20180622144039,Param1);
-    ComputeElement(TPasArrayType(ArrayResolved.LoTypeEl).ElType,ElTypeResolved,[rcType]);
+    ElType:=GetArrayElType(TPasArrayType(ArrayResolved.LoTypeEl));
+    ComputeElement(ElType,ElTypeResolved,[rcType]);
     if (ElTypeResolved.BaseType=btContext)
         and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
       MarkArrayExprRecursive(Param0,TPasArrayType(ElTypeResolved.LoTypeEl));
@@ -18082,7 +18184,7 @@ begin
       exit(false);
     if length(Arr1.Ranges)>0 then
       RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
-    Result:=CheckElTypeCompatibility(Arr1.ElType,Arr2.ElType,ResolveAlias);
+    Result:=CheckElTypeCompatibility(GetArrayElType(Arr1),GetArrayElType(Arr2),ResolveAlias);
     exit;
     end;
 
@@ -19574,9 +19676,14 @@ begin
       ArrayEl:=TPasArrayType(T.LoTypeEl);
       if length(ArrayEl.Ranges)=0 then
         begin
-        Result:='array of '+ArrayEl.ElType.Name;
-        if IsOpenArray(ArrayEl) then
-          Result:='open '+Result;
+        if ArrayEl.ElType=nil then
+          Result:='array of const'
+        else
+          begin
+          Result:='array of '+ArrayEl.ElType.Name;
+          if IsOpenArray(ArrayEl) then
+            Result:='open '+Result;
+          end;
         end
       else
         Result:='static array[] of '+ArrayEl.ElType.Name;
@@ -19610,6 +19717,8 @@ function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): str
         begin
         if length(TPasArrayType(aType).Ranges)>0 then
           Result:='static array'
+        else if TPasArrayType(aType).ElType=nil then
+          Result:='array of const'
         else if IsOpenArray(aType) then
           Result:='open array'
         else
@@ -19900,12 +20009,13 @@ var
   SrcResolved, DstResolved: TPasResolverResult;
   LArray, RArray: TPasArrayType;
   GotDesc, ExpDesc: String;
+  CurTVarRec: TPasRecordType;
 
-  function RaiseIncompatType: integer;
+  function RaiseIncompatType(Id: TMaxPrecInt): integer;
   begin
     Result:=cIncompatible;
     if not RaiseOnIncompatible then exit;
-    RaiseIncompatibleTypeRes(20170216152505,nIncompatibleTypesGotExpected,
+    RaiseIncompatibleTypeRes(Id,nIncompatibleTypesGotExpected,
       [],RHS,LHS,ErrorEl);
   end;
 
@@ -19932,7 +20042,7 @@ begin
       begin
       Result:=cIncompatible;
       if not (rrfReadable in RHS.Flags) then
-        exit(RaiseIncompatType);
+        exit(RaiseIncompatType(20190215112914));
       if TPasClassType(LTypeEl).ObjKind=TPasClassType(RTypeEl).ObjKind then
         Result:=CheckSrcIsADstType(RHS,LHS)
       else if TPasClassType(LTypeEl).ObjKind=okInterface then
@@ -19950,7 +20060,7 @@ begin
           [],RTypeEl,LTypeEl,ErrorEl);
       end
     else
-      exit(RaiseIncompatType);
+      exit(RaiseIncompatType(20190215112919));
     end
   else if LTypeEl.ClassType=TPasClassOfType then
     begin
@@ -20020,15 +20130,7 @@ begin
       begin
       // DynOrOpenArr:=array
       RArray:=TPasArrayType(RTypeEl);
-      if length(RArray.Ranges)>1 then
-        begin
-        // DynOrOpenArr:=MultiDimStaticArr  -> no
-        if RaiseOnIncompatible then
-          RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
-            [],'multi dimensional static array','dynamic array',ErrorEl);
-        exit(cIncompatible);
-        end
-      else if length(RArray.Ranges)>0 then
+      if length(RArray.Ranges)=1 then
         begin
         // DynOrOpenArr:=SingleDimStaticArr
         if (msDelphi in CurrentParser.CurrentModeswitches)
@@ -20042,6 +20144,14 @@ begin
           exit(cIncompatible);
           end;
         end
+      else if length(RArray.Ranges)>1 then
+        begin
+        // DynOrOpenArr:=MultiDimStaticArr  -> no
+        if RaiseOnIncompatible then
+          RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
+            [],'multi dimensional static array','dynamic array',ErrorEl);
+        exit(cIncompatible);
+        end
       else if not (proOpenAsDynArrays in Options) then
         begin
         if IsOpenArray(LArray) then
@@ -20061,16 +20171,33 @@ begin
               and (LArray<>RArray) then
             begin
             // Delphi does not allow assigning arrays with same element types
-            if RaiseOnIncompatible then
-              RaiseIncompatibleTypeRes(20180620115515,nIncompatibleTypesGotExpected,
-                [],RHS,LHS,ErrorEl);
-            exit(cIncompatible);
+            exit(RaiseIncompatType(20190215112626));
             end;
           end;
         end;
 
       // check element type
-      if CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias) then
+      if LArray.ElType=nil then
+        begin
+        // ArrayOfConst:=SingleDimArr
+        if RArray.ElType=nil then
+          // ArrayOfConst:=ArrayOfConst
+          Result:=cExact
+        else
+          begin
+          CurTVarRec:=GetTVarRec(LArray);
+          if ResolveAliasType(RArray.ElType)=CurTVarRec then
+            // ArrayOfConst:=ArrayOfTVarRec
+            Result:=cExact
+          else
+            // ArrayOfConst:=SingleDimArr
+            exit(RaiseIncompatType(20190215112715));
+          end;
+        end
+      else if RArray.ElType=nil then
+        // ArrayOfNonConst:=ArrayOfConst
+        exit(RaiseIncompatType(20190215112907))
+      else if CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias) then
         Result:=cExact
       else if RaiseOnIncompatible then
         begin
@@ -20118,7 +20245,7 @@ begin
         exit(cIncompatible);
       end
     else
-      exit(RaiseIncompatType);
+      exit(RaiseIncompatType(20190215112924));
     end
   else if LTypeEl.ClassType=TPasPointerType then
     begin
@@ -20128,7 +20255,7 @@ begin
       Result:=CheckAssignCompatibilityPointerType(TPasPointerType(LTypeEl).DestType,
         TPasPointerType(RTypeEl).DestType,ErrorEl,false);
       if Result=cIncompatible then
-        exit(RaiseIncompatType);
+        exit(RaiseIncompatType(20190215112927));
       end;
     end
   else
@@ -20139,9 +20266,9 @@ begin
     {$ENDIF}
 
   if Result=-1 then
-    exit(RaiseIncompatType);
+    exit(RaiseIncompatType(20190215112931));
   if not (rrfReadable in RHS.Flags) then
-    exit(RaiseIncompatType);
+    exit(RaiseIncompatType(20190215112934));
 end;
 
 function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
@@ -20356,9 +20483,9 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
           exit;
           end;
         // dynarr:=dynarr -> check element type
-        ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
+        ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
         Include(ElTypeResolved.Flags,rrfWritable);
-        ComputeElement(RArrayType.ElType,ValueResolved,[rcType]);
+        ComputeElement(GetArrayElType(RArrayType),ValueResolved,[rcType]);
         Include(ValueResolved.Flags,rrfReadable);
         Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,ErrorEl,RaiseOnIncompatible);
         exit;
@@ -20540,6 +20667,12 @@ begin
   if (LHS.BaseType<>btContext) or (not (LHS.LoTypeEl is TPasArrayType)) then
     RaiseInternalError(20170222230012);
   LArrType:=TPasArrayType(LHS.LoTypeEl);
+  if (LArrType.ElType=nil) and (rrfReadable in RHS.Flags)
+      and (RHS.BaseType in [btArrayLit,btArrayOrSet]) then
+    begin
+    // ArrayOfConst:=[]
+    exit(cExact);
+    end;
 
   CheckRange(LArrType,0,RHS,ErrorEl);
 
@@ -21101,7 +21234,7 @@ function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
       ElTypeResolved.BaseType:=btNone;
       exit(true);
       end;
-    ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
+    ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
     if (ElTypeResolved.BaseType<>btContext)
         or (ElTypeResolved.LoTypeEl.ClassType<>TPasArrayType) then
       exit(false);
@@ -22082,6 +22215,7 @@ begin
     exit(false);
   if length(TPasArrayType(TypeEl).Ranges)<>0 then
     exit(false);
+  // Note: Array of Const is an open array of TVarRec
   if OptionalOpenArray and (proOpenAsDynArrays in Options) then
     Result:=true
   else
@@ -22104,6 +22238,19 @@ begin
       and (length(TPasArrayType(TypeEl).Ranges)=0);
 end;
 
+function TPasResolver.IsArrayOfConst(TypeEl: TPasType): boolean;
+begin
+  Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
+      and (TPasArrayType(TypeEl).ElType=nil);
+end;
+
+function TPasResolver.GetArrayElType(ArrType: TPasArrayType): TPasType;
+begin
+  Result:=ArrType.ElType;
+  if Result=nil then
+    Result:=GetTVarRec(ArrType);
+end;
+
 function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
 var
   C: TClass;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -250,7 +250,7 @@ type
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
-    procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); virtual;
+    function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; virtual;
     procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
     procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
     procedure UseImplElement(El: TPasImplElement); virtual;
@@ -1135,7 +1135,7 @@ begin
   UseElement(El,rraNone,true);
 end;
 
-procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
+function TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
 
   procedure UseInitFinal(ImplBlock: TPasImplBlock);
   var
@@ -1154,7 +1154,8 @@ procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
 var
   ModScope: TPasModuleScope;
 begin
-  if ElementVisited(aModule,Mode) then exit;
+  if ElementVisited(aModule,Mode) then exit(false);
+  Result:=true;
 
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode{$IFDEF pas2js},' ',aModule.PasElementId{$ENDIF});
@@ -1179,6 +1180,10 @@ begin
     UseClassOrRecType(ModScope.RangeErrorClass,paumElement);
   if ModScope.RangeErrorConstructor<>nil then
     UseProcedure(ModScope.RangeErrorConstructor);
+  // no need to use here ModScope.AssertClass, it is used by Assert
+  // no need to use here ModScope.AssertMsgConstructor
+  // no need to use here ModScope.AssertDefConstructor
+  // no need to use here ModScope.SystemTVarRec
 
   if Mode=paumElement then
     // e.g. a reference: unitname.identifier

packages/fcl-passrc/src/pparser.pp

@@ -1892,32 +1892,42 @@ begin
     case CurToken of
       tkSquaredBraceOpen:
         begin
-          repeat
-            NextToken;
-            if po_arrayrangeexpr in Options then
-              begin
-              RangeExpr:=DoParseExpression(Result);
-              Result.AddRange(RangeExpr);
-              end
-            else if CurToken<>tkSquaredBraceClose then
-               S:=S+CurTokenText;
-            if CurToken=tkSquaredBraceClose then
-              break
-            else if CurToken=tkComma then
-              continue
-            else if po_arrayrangeexpr in Options then
-              ParseExcTokenError(']');
-          until false;
-          Result.IndexRange:=S;
-          ExpectToken(tkOf);
-          Result.ElType := ParseType(Result,CurSourcePos);
+        // static array
+        if Parent is TPasArgument then
+          ParseExcTokenError('of');
+        repeat
+          NextToken;
+          if po_arrayrangeexpr in Options then
+            begin
+            RangeExpr:=DoParseExpression(Result);
+            Result.AddRange(RangeExpr);
+            end
+          else if CurToken<>tkSquaredBraceClose then
+             S:=S+CurTokenText;
+          if CurToken=tkSquaredBraceClose then
+            break
+          else if CurToken=tkComma then
+            continue
+          else if po_arrayrangeexpr in Options then
+            ParseExcTokenError(']');
+        until false;
+        Result.IndexRange:=S;
+        ExpectToken(tkOf);
+        Result.ElType := ParseType(Result,CurSourcePos);
         end;
       tkOf:
         begin
         NextToken;
         if CurToken = tkConst then
+          // array of const
+          begin
+          if not (Parent is TPasArgument) then
+            ParseExcExpectedIdentifier;
+          end
         else
           begin
+          if (CurToken=tkarray) and (Parent is TPasArgument) then
+            ParseExcExpectedIdentifier;
           UngetToken;
           Result.ElType := ParseType(Result,CurSourcePos);
           end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -103,7 +103,8 @@ type
   PTestResolverReferenceData = ^TTestResolverReferenceData;
 
   TSystemUnitPart = (
-    supTObject
+    supTObject,
+    supTVarRec
     );
   TSystemUnitParts = set of TSystemUnitPart;
 
@@ -800,9 +801,14 @@ type
     Procedure TestArray_ConstDynArrayWrite;
     Procedure TestArray_ConstOpenArrayWriteFail;
     Procedure TestArray_ForIn;
+    Procedure TestArray_Arg_AnonymousStaticFail;
+    Procedure TestArray_Arg_AnonymousMultiDimFail;
 
     // array of const
     Procedure TestArrayOfConst;
+    Procedure TestArrayOfConst_PassDynArrayOfIntFail;
+    Procedure TestArrayOfConst_AssignNilFail;
+    Procedure TestArrayOfConst_SetLengthFail;
 
     // static arrays
     Procedure TestArrayIntRange_OutOfRange;
@@ -2074,6 +2080,20 @@ begin
     '    function ToString: String; virtual;',
     '  end;']);
     end;
+  if supTVarRec in Parts then
+    begin
+    Intf.AddStrings([
+    'const',
+    '  vtInteger       = 0;',
+    '  vtBoolean       = 1;',
+    'type',
+    '  PVarRec = ^TVarRec;',
+    '  TVarRec = record',
+    '    case VType : sizeint of',
+    '    vtInteger       : (VInteger: Longint);',
+    '    vtBoolean       : (VBoolean: Boolean);',
+    '  end;']);
+    end;
   Intf.Add('var');
   Intf.Add('  ExitCode: Longint = 0;');
 
@@ -14324,14 +14344,103 @@ begin
   CheckParamsExpr_pkSet_Markers;
 end;
 
-procedure TTestResolver.TestArrayOfConst;
+procedure TTestResolver.TestArray_Arg_AnonymousStaticFail;
 begin
   StartProgram(false);
   Add([
+  'procedure DoIt(args: array[1..2] of word);',
+  'begin',
+  'end;',
+  'begin']);
+  CheckParserException('Expected "of"',nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestArray_Arg_AnonymousMultiDimFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(args: array of array of word);',
+  'begin',
+  'end;',
+  'begin']);
+  CheckParserException(SParserExpectedIdentifier,nParserExpectedIdentifier);
+end;
+
+procedure TTestResolver.TestArrayOfConst;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArrOfVarRec = array of TVarRec;',
   'procedure DoIt(args: array of const);',
-  'begin end;',
+  'var',
+  '  i: longint;',
+  '  v: TVarRec;',
+  '  a: TArrOfVarRec;',
+  '  sa: array[1..2] of TVarRec;',
+  'begin',
+  '  DoIt(args);',
+  '  DoIt(a);',
+  '  DoIt([]);',
+  '  DoIt([1]);',
+  '  DoIt([i]);',
+  '  DoIt([true,''foo'',''c'',1.3,nil,@DoIt]);',
+  '  for i:=low(args) to high(args) do begin',
+  '    v:=args[i];',
+  '    case args[i].VType of',
+  '    vtInteger: if length(args)=args[i].VInteger then ;',
+  '    end;',
+  '  end;',
+  '  for v in Args do ;',
+  '  args:=sa;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayOfConst_PassDynArrayOfIntFail;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArr = array of word;',
+  'procedure DoIt(args: array of const);',
+  'begin',
+  'end;',
+  'var a: TArr;',
+  'begin',
+  '  DoIt(a)']);
+  CheckResolverException('Incompatible type arg no. 1: Got "TArr", expected "array of const"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestArrayOfConst_AssignNilFail;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArr = array of word;',
+  'procedure DoIt(args: array of const);',
+  'begin',
+  '  args:=nil;',
+  'end;',
+  'begin']);
+  CheckResolverException('Incompatible types: got "Nil" expected "array of const"',nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArrayOfConst_SetLengthFail;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArr = array of word;',
+  'procedure DoIt(args: array of const);',
+  'begin',
+  '  SetLength(args,2);',
+  'end;',
   'begin']);
-  CheckResolverException('not yet implemented: :TPasArrayType [20171005235610] array of const',nNotYetImplemented);
+  CheckResolverException('Incompatible type arg no. 1: Got "array of const", expected "string or dynamic array variable"',
+    nIncompatibleTypeArgNo);
 end;
 
 procedure TTestResolver.TestArrayIntRange_OutOfRange;

packages/fcl-registry/src/winreg.inc

@@ -28,12 +28,12 @@ begin
   Dispose(PWinRegData(FSysData));
 end;
 
-Function PrepKey(Const S : String) : pChar;
+Function PrepKey(Const S : String) : String;
 
 begin
-  Result:=PChar(S);
-  If Result^='\' then
-    Inc(Result);
+  Result := S;
+  if (Result <> '') and (Result[1] = '\') then
+    System.Delete(Result, 1, 1);
 end;
 
 Function RelativeKey(Const S : String) : Boolean;
@@ -52,7 +52,7 @@ Var
 
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=PrepKey(Key);
   FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
                               PWideChar(u),
                               0,
@@ -71,14 +71,14 @@ function TRegistry.DeleteKey(const Key: String): Boolean;
 Var
   u: UnicodeString;
 begin
-  u:=UTF8Decode(PRepKey(Key));
+  u:=PRepKey(Key);
   FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
 function TRegistry.DeleteValue(const Name: String): Boolean;
 begin
-  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UTF8Decode(Name)));
+  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UnicodeString(Name)));
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
@@ -89,7 +89,7 @@ Var
   RD : DWord;
 
 begin
-  u := UTF8Decode(Name);
+  u := Name;
   FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
                       @RD,Buffer,lpdword(@BufSize));
   if (FLastError<>ERROR_SUCCESS) Then
@@ -110,7 +110,7 @@ Var
   RD : DWord;
 
 begin
-  u:=UTF8Decode(ValueName);
+  u:=ValueName;
   With Value do
     begin
     FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
@@ -147,7 +147,7 @@ begin
 {$ifdef WinCE}
   FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
 {$else WinCE}
-  u:=UTF8Decode(S);
+  u:=UnicodeString(S);
   FLastError:=RegOpenKeyExW(GetBaseKey(Rel),PWideChar(u),0,FAccess,Result);
 {$endif WinCE}
 end;
@@ -212,7 +212,7 @@ Var
   S: string;
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=PrepKey(Key);
   If CanCreate then
     begin
     Handle:=0;
@@ -260,7 +260,7 @@ begin
 {$ifdef WinCE}
   Result:=False;
 {$else}
-  FLastError:=RegConnectRegistryW(PWideChar(UTF8Decode(UNCName)),RootKey,newroot);
+  FLastError:=RegConnectRegistryW(PWideChar(UnicodeString(UNCName)),RootKey,newroot);
   Result:=FLastError=ERROR_SUCCESS;
   if Result then begin
     RootKey:=newroot;
@@ -422,7 +422,7 @@ Var
 
 begin
   RegDataType:=RegDataWords[RegData];
-  u:=UTF8Decode(Name);
+  u:=UnicodeString(Name);
   FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
   Result:=FLastError=ERROR_SUCCESS;
 end;

packages/fcl-xml/src/xmlconf.pp

@@ -166,6 +166,7 @@ Var
 begin
   F:=TFileStream.Create(AFileName,fmOpenread or fmShareDenyWrite);
   try
+    FFileName := '';
     ReadXMLFile(Doc, AFilename);
     FFileName:=AFileName;
   finally
@@ -398,11 +399,14 @@ procedure TXMLConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean
 begin
   if (not ForceReload) and (FFilename = AFilename) then
     exit;
-    
+
   Flush;
   FreeAndNil(Doc);
   if csLoading in ComponentState then
+  begin
+    FFilename := AFilename;
     exit;
+  end;
   if FileExists(AFilename) and not FStartEmpty then
     LoadFromFile(AFilename)
   else if not Assigned(Doc) then
@@ -425,6 +429,8 @@ begin
   if AValue <> FRootName then
   begin
     FRootName := AValue;
+    if not (ComponentState * [csLoading,csDesigning] = []) then
+      Exit;
     Root := Doc.DocumentElement;
     Cfg := Doc.CreateElement(AValue);
     while Assigned(Root.FirstChild) do
@@ -475,7 +481,7 @@ var
 begin
   for I := Length(FPathStack)-1 downto 0 do
     FPathStack[I] := '';
-  FElement := nil;    
+  FElement := nil;
   FPathDirty := False;
   FPathCount := 0;
 end;

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');

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 }
@@ -1216,7 +1218,7 @@ const
     btIntDouble,btUIntDouble,
     btCurrency  // in pas2js currency is more like an integer, instead of float
     ];
-  btAllJSValueSrcTypes = [btNil,btUntyped,btPointer]+btAllJSInteger
+  btAllJSValueSrcTypes = [btNil,btUntyped,btPointer,btSet]+btAllJSInteger
       +btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans;
   btAllJSValueTypeCastTo = btAllJSInteger
       +btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans+[btPointer];
@@ -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)
@@ -9694,8 +9808,6 @@ var
   Call: TJSCallExpression;
   NotExpr: TJSUnaryNotExpression;
   AddExpr: TJSAdditiveExpressionPlus;
-  TypeEl: TPasType;
-  C: TClass;
   Int: TMaxPrecInt;
   aResolver: TPas2JSResolver;
 begin
@@ -9958,20 +10070,6 @@ begin
       begin
       // type cast to jsvalue
       Result:=ConvertExpression(Param,AContext);
-      // Note: convert value first in case it raises an exception
-      if ParamResolved.BaseType=btContext then
-        begin
-        TypeEl:=ParamResolved.LoTypeEl;
-        C:=TypeEl.ClassType;
-        if (C=TPasClassType) or (C=TPasRecordType) then
-          begin
-          // TObject(jsvalue) -> rtl.getObject(jsvalue)
-          Call:=CreateCallExpression(El);
-          Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnGetObject)]);
-          Call.AddArg(Result);
-          Result:=Call;
-          end;
-        end;
       exit;
       end;
     end;
@@ -10107,12 +10205,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 +10228,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 +10241,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 +10269,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 +11495,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 +15008,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 +15056,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 +15073,7 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
   var
     ElTypeResolved: TPasResolverResult;
     Call: TJSCallExpression;
+    aResolver: TPas2JSResolver;
   begin
     Result:=nil;
     IsLastRange:=false;
@@ -14976,7 +15081,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 +15121,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 +15239,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 +15246,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 +15306,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 +16246,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 +16265,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);

packages/pastojs/src/pas2jscompiler.pp

@@ -38,12 +38,12 @@ 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;
-  VersionMinor = 3;
+  VersionMinor = 5;
   VersionRelease = 1;
   VersionExtra = '';
   DefaultConfigFile = 'pas2js.cfg';
@@ -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);

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;
 

packages/pastojs/src/pas2jsuseanalyzer.pp

@@ -0,0 +1,96 @@
+{
+    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, PasResolver,
+  FPPas2Js;
+
+type
+
+  { TPas2JSAnalyzer }
+
+  TPas2JSAnalyzer = class(TPasAnalyzer)
+  public
+    procedure UseExpr(El: TPasExpr); override;
+  end;
+
+implementation
+
+{ TPas2JSAnalyzer }
+
+procedure TPas2JSAnalyzer.UseExpr(El: TPasExpr);
+
+  procedure CheckArgs(Args: TFPList);
+  var
+    i: Integer;
+    ArgType: TPasType;
+    ModScope: TPas2JSModuleScope;
+    aMod: TPasModule;
+    SystemVarRecs: TPasFunction;
+  begin
+    if Args=nil then exit;
+    for i:=0 to Args.Count-1 do
+      begin
+      ArgType:=TPasArgument(Args[i]).ArgType;
+      if ArgType=nil then continue;
+      if (ArgType.ClassType=TPasArrayType)
+          and (TPasArrayType(ArgType).ElType=nil) then
+        begin
+        // array of const
+        aMod:=El.GetModule;
+        ModScope:=NoNil(aMod.CustomData) as TPas2JSModuleScope;
+        SystemVarRecs:=ModScope.SystemVarRecs;
+        if SystemVarRecs=nil then
+          RaiseNotSupported(20190216104347,El);
+        MarkImplScopeRef(El,SystemVarRecs,psraRead);
+        UseProcedure(SystemVarRecs);
+        break;
+        end;
+      end;
+  end;
+
+var
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+begin
+  if El=nil then exit;
+  inherited UseExpr(El);
+
+  Ref:=nil;
+  if El.CustomData is TResolvedReference then
+    begin
+    // this is a reference -> mark target
+    Ref:=TResolvedReference(El.CustomData);
+    Decl:=Ref.Declaration;
+    if Decl is TPasProcedure then
+      CheckArgs(TPasProcedure(Decl).ProcType.Args)
+    else if Decl.ClassType=TPasProperty then
+      CheckArgs(Resolver.GetPasPropertyArgs(TPasProperty(Decl)));
+    end;
+end;
+
+end.
+

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);

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
 
@@ -713,6 +720,7 @@ type
     // jsvalue
     Procedure TestJSValue_AssignToJSValue;
     Procedure TestJSValue_TypeCastToBaseType;
+    Procedure TestJSValue_TypecastToJSValue;
     Procedure TestJSValue_Equal;
     Procedure TestJSValue_If;
     Procedure TestJSValue_Not;
@@ -1512,36 +1520,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 +9589,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;',
@@ -17177,7 +17429,7 @@ begin
     '$mod.v = $mod.IntfVar;',
     '$mod.IntfVar = rtl.getObject($mod.v);',
     'if (rtl.isExt($mod.v, $mod.IBird, 1)) ;',
-    '$mod.v = rtl.getObject($mod.IntfVar);',
+    '$mod.v = $mod.IntfVar;',
     '$mod.v = $mod.IBird;',
     '']));
 end;
@@ -24631,6 +24883,50 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestJSValue_TypecastToJSValue;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TArr = array of word;',
+  '  TRec = record end;',
+  '  TSet = set of boolean;',
+  'procedure Fly(v: jsvalue);',
+  'begin',
+  'end;',
+  'var',
+  '  a: TArr;',
+  '  r: TRec;',
+  '  s: TSet;',
+  'begin',
+  '  Fly(jsvalue(a));',
+  '  Fly(jsvalue(r));',
+  '  Fly(jsvalue(s));',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_TypecastToJSValue',
+    LinesToStr([ // statements
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '});',
+    'this.Fly = function (v) {',
+    '};',
+    'this.a = [];',
+    'this.r = $mod.TRec.$new();',
+    'this.s = {};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Fly($mod.a);',
+    '$mod.Fly($mod.r);',
+    '$mod.Fly($mod.s);',
+    '']));
+end;
+
 procedure TTestModule.TestJSValue_Equal;
 begin
   StartProgram(false);

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,8 @@ type
     procedure TestWPO_Class_OmitPropertySetter2;
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
+    procedure TestWPO_ArrayOfConst_Use;
+    procedure TestWPO_ArrayOfConst_NotUsed;
     procedure TestWPO_Class_PropertyInOtherUnit;
     procedure TestWPO_ProgramPublicDeclaration;
     procedure TestWPO_ConstructorDefaultValueConst;
@@ -92,7 +94,7 @@ implementation
 function TCustomTestOptimizations.OnConverterIsElementUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -114,7 +116,7 @@ end;
 function TCustomTestOptimizations.OnConverterIsTypeInfoUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -137,9 +139,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 +816,60 @@ begin
   CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
 end;
 
+procedure TTestOptimizations.TestWPO_ArrayOfConst_Use;
+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_ArrayOfConst_NotUsed;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(arr: array of const);',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckUnit('system.pp',
+  LinesToStr([
+  'rtl.module("system", [], function () {',
+  '  var $mod = this;',
+  '});',
+  '']));
+end;
+
 procedure TTestOptimizations.TestWPO_Class_PropertyInOtherUnit;
 begin
   AddModuleWithIntfImplSrc('unit1.pp',

packages/pastojs/tests/tcprecompile.pas

@@ -536,7 +536,7 @@ end;
 procedure TTestCLI_Precompile.TestPCU_CheckVersionSystem;
 var
   aFile: TCLIFile;
-  s, JSFilename, ExpectedSrc: string;
+  s, JSFilename, ExpectedSrc, VerStr: string;
 begin
   AddUnit('src/system.pp',[
     'type integer = longint;'],
@@ -549,10 +549,11 @@ begin
   aFile:=FindFile(JSFilename);
   AssertNotNull('File not found '+JSFilename,aFile);
   writeln('TTestCLI_Precompile.TestPCU_CheckVersionMain ',aFile.Source);
+  VerStr:=IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease);
   ExpectedSrc:=LinesToStr([
     UTF8BOM+'rtl.module("system",[],function () {',
     '  "use strict";',
-    '  rtl.checkVersion(10301);',
+    '  rtl.checkVersion('+VerStr+');',
     '  var $mod = this;',
     '});']);
   if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then

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>

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
 

packages/rtl-console/fpmake.pp

@@ -78,6 +78,7 @@ begin
         AddInclude('keyscan.inc',AllUnixOSes);
         AddUnit   ('winevent',[win32,win64]);
         AddInclude('nwsys.inc',[netware]);
+        AddUnit   ('mouse',AllUnixOSes);
         AddUnit   ('video',[win16]);
       end;
 
@@ -87,7 +88,7 @@ begin
        AddInclude('mouseh.inc');
        AddInclude('mouse.inc');
        AddUnit   ('winevent',[win32,win64]);
-       AddUnit   ('video',[go32v2,msdos]);
+       AddUnit   ('video',[go32v2,msdos] + AllUnixOSes);
      end;
 
     T:=P.Targets.AddUnit('video.pp',VideoOSes);

packages/rtl-objpas/src/inc/strutils.pp

@@ -258,6 +258,7 @@ Type
                              sraBoyerMoore  // Algorithm optimized for long replacements.
                             );
 
+Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; out aCount : Integer; Algorithm : TStringReplaceAlgorithm = sraDefault): string; overload;
 Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; Algorithm : TStringReplaceAlgorithm = sraDefault): string; overload;
 { We need these for backwards compatibility:
   The compiler will stop searching and convert to ansistring if the widestring version of stringreplace is used.
@@ -576,8 +577,7 @@ begin
   Result:=MatchesCount>0;
 end;
 
-function StringReplaceFast(const S, OldPattern, NewPattern: string;
-  Flags: TReplaceFlags): string;
+function StringReplaceFast(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags; out aCount : Integer): string;
 const
   MATCHESCOUNTRESIZER=100; //Arbitrary value. Memory used = MATCHESCOUNTRESIZER * sizeof(SizeInt)
 var
@@ -619,6 +619,7 @@ var
     inc(MatchesCount);
   end;
 begin
+  aCount:=0;
   if (OldPattern='') or (Length(OldPattern)>Length(S)) then begin
     //This cases will never match nothing.
     Result:=S;
@@ -703,7 +704,8 @@ begin
       end;
     end;
   end;
-  //Create room enougth for the result string
+  //Create room enough for the result string
+  aCount:=MatchesCount;
   SetLength(Result,Length(S)-OldPatternSize*MatchesCount+NewPatternSize*MatchesCount);
   MatchIndex:=1;
   MatchTarget:=1;
@@ -759,7 +761,7 @@ end;
 
 *)
 
-function StringReplaceBoyerMoore(const S, OldPattern, NewPattern: string;Flags: TReplaceFlags): string;
+function StringReplaceBoyerMoore(const S, OldPattern, NewPattern: string;Flags: TReplaceFlags; out aCount : Integer): string;
 var
   Matches: SizeIntArray;
   OldPatternSize: SizeInt;
@@ -770,6 +772,7 @@ var
   MatchInternal: SizeInt;
   AdvanceIndex: SizeInt;
 begin
+  aCount:=0;
   OldPatternSize:=Length(OldPattern);
   NewPatternSize:=Length(NewPattern);
   if (OldPattern='') or (Length(OldPattern)>Length(S)) then begin
@@ -784,6 +787,7 @@ begin
   end;
 
   MatchesCount:=Length(Matches);
+  aCount:=MatchesCount;
 
   //Create room enougth for the result string
   SetLength(Result,Length(S)-OldPatternSize*MatchesCount+NewPatternSize*MatchesCount);
@@ -813,11 +817,21 @@ end;
 
 function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; Algorithm: TStringReplaceAlgorithm): string;
 
+Var
+  C : Integer;
+
+begin
+  Result:=StringReplace(S, OldPattern, NewPattern, Flags,C,Algorithm);
+end;
+
+Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; out aCount : Integer; Algorithm : TStringReplaceAlgorithm = sraDefault): string; overload;
+
+
 begin
   Case Algorithm of
-    sraDefault    : Result:=sysutils.StringReplace(S,OldPattern,NewPattern,Flags);
-    sraManySmall  : Result:=StringReplaceFast(S,OldPattern,NewPattern,Flags);
-    sraBoyerMoore : Result:=StringReplaceBoyerMoore(S,OldPattern,NewPattern,Flags);
+    sraDefault    : Result:=sysutils.StringReplace(S,OldPattern,NewPattern,Flags,aCount);
+    sraManySmall  : Result:=StringReplaceFast(S,OldPattern,NewPattern,Flags,aCount);
+    sraBoyerMoore : Result:=StringReplaceBoyerMoore(S,OldPattern,NewPattern,Flags,aCount);
   end;
 end;
 

rtl/objpas/classes/parser.inc

@@ -361,8 +361,16 @@ begin
 end;
 
 destructor TParser.Destroy;
+
+Var
+  aCount : Integer;
+
 begin
-  fStream.Position:=SourcePos;
+  if fToken=toWString then
+    aCount:=Length(fLastTokenWStr)*2
+  else
+    aCount:=Length(fLastTokenStr);
+  fStream.Position:=SourcePos-aCount;
   FreeMem(fBuf);
 end;
 

rtl/objpas/objpas.pp

@@ -118,11 +118,15 @@ Var
      { Text file support }
      Procedure AssignFile(out t:Text;p:pchar);
      Procedure AssignFile(out t:Text;c:char);
+     Procedure AssignFile(out t:Text;p:pchar; aCodePage : TSystemCodePage);
+     Procedure AssignFile(out t:Text;c:char; aCodePage : TSystemCodePage);
   {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
      Procedure AssignFile(out t:Text;const Name:UnicodeString);
+     Procedure AssignFile(out t:Text;const Name:UnicodeString; aCodePage : TSystemCodePage);
   {$endif FPC_HAS_FEATURE_WIDESTRINGS}
   {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
      Procedure AssignFile(out t:Text;const Name:RawByteString);
+     Procedure AssignFile(out t:Text;const Name:RawByteString; aCodePage : TSystemCodePage);
   {$endif FPC_HAS_FEATURE_ANSISTRINGS}
      Procedure CloseFile(Var t:Text);
 {$endif FPC_HAS_FEATURE_TEXTIO}
@@ -215,12 +219,31 @@ begin
   System.Assign (T,p);
 end;
 
+Procedure AssignFile(out t:Text;p:pchar; aCodePage : TSystemCodePage);
+begin
+  System.Assign (T,p);
+  SetTextCodePage(T,aCodePage);
+end;
+
 Procedure AssignFile(out t:Text;c:char);
 begin
   System.Assign (T,c);
 end;
 
+
+Procedure AssignFile(out t:Text;c:char; aCodePage : TSystemCodePage);
+begin
+  System.Assign (T,c);
+  SetTextCodePage(T,aCodePage);
+end;
+
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Procedure AssignFile(out t:Text;const Name:RawBytestring; aCodePage : TSystemCodePage);
+begin
+  System.Assign (T,Name);
+  SetTextCodePage(T,aCodePage);
+end;
+
 Procedure AssignFile(out t:Text;const Name:RawBytestring);
 begin
   System.Assign (T,Name);
@@ -228,6 +251,12 @@ end;
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure AssignFile(out t:Text;const Name:UnicodeString; aCodePage : TSystemCodePage);
+begin
+  System.Assign (T,Name);
+  SetTextCodePage(T,aCodePage);
+end;
+
 Procedure AssignFile(out t:Text;const Name:UnicodeString);
 begin
   System.Assign (T,Name);

rtl/objpas/sysutils/syssr.inc

@@ -1,9 +1,10 @@
 var
   OldPat,Srch: SRstring; // Srch and Oldp can contain uppercase versions of S,OldPattern
-  PatLength,NewPatLength,P,Cnt,PatCount,PrevP: Integer;
+  PatLength,NewPatLength,P,Cnt,PrevP: Integer;
   c,d: SRPChar ;
   
 begin
+  aCount:=0;
   Result:='';
   c:= NIL; d:=NIL;
   OldPat:='';
@@ -31,6 +32,7 @@ begin
     repeat
       P:=Pos(OldPat,Srch,P);
       if P>0 then begin
+        inc(aCount);
         move(NewPattern[1],Result[P],PatLength*SizeOf(SRChar));
         if not (rfReplaceAll in Flags) then exit;
         inc(P,PatLength);
@@ -40,21 +42,21 @@ begin
     //Different pattern length -> Result length will change
     //To avoid creating a lot of temporary strings, we count how many
     //replacements we're going to make.
-    P:=1; PatCount:=0;
+    P:=1;
     repeat
       P:=Pos(OldPat,Srch,P);
       if P>0 then begin
         inc(P,PatLength);
-        inc(PatCount);
+        inc(aCount);
         if not (rfReplaceAll in Flags) then break;
       end;
     until p=0;
-    if PatCount=0 then begin
+    if aCount=0 then begin
       Result:=S;
       exit;
     end;
     NewPatLength:=Length(NewPattern);
-    SetLength(Result,Length(S)+PatCount*(NewPatLength-PatLength));
+    SetLength(Result,Length(S)+aCount*(NewPatLength-PatLength));
     P:=1; PrevP:=0;
     c:=SRPChar(Result); d:=SRPChar(S);
     repeat

rtl/objpas/sysutils/sysstr.inc

@@ -76,6 +76,19 @@ begin
 Dest := Dest + S;
 end ;
 
+function IsLeadChar(C: AnsiChar): Boolean; inline;
+
+begin
+  Result:=C in LeadBytes;
+end;
+
+function IsLeadChar(B: Byte): Boolean; inline;
+
+
+begin
+  Result:=Char(B) in LeadBytes;
+end;
+
 Function InternalChangeCase(Const S : AnsiString; const Chars: TSysCharSet; const Adjustment: Longint): AnsiString;
   var
     i : Integer;
@@ -2294,6 +2307,16 @@ end;
 {$define SRCHAR:=Char}
 
 Function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
+
+Var
+  C : Integer;
+
+begin
+  Result:=StringReplace(S,OldPattern,NewPattern,Flags,C);
+end;
+
+function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags; Out aCount : Integer): string;
+
 {$i syssr.inc}
 
 {$undef INSTRINGREPLACE}

rtl/objpas/sysutils/sysstrh.inc

@@ -234,6 +234,7 @@ function TryStrToBool(const S: string; out Value: Boolean): Boolean;
 function TryStrToBool(const S: string; out Value: Boolean; Const FormatSettings: TFormatSettings): Boolean;
 
 function LastDelimiter(const Delimiters, S: string): SizeInt;
+function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags; Out aCount : Integer): string;
 function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
 Function IsDelimiter(const Delimiters, S: string; Index: SizeInt): Boolean;
 
@@ -250,6 +251,8 @@ Function CharToByteLen(const S: string; MaxLen: SizeInt): SizeInt;
 Function ByteToCharIndex(const S: string; Index: SizeInt): SizeInt;
 Function StrCharLength(const Str: PChar): SizeInt;
 function StrNextChar(const Str: PChar): PChar;
+function IsLeadChar(C: AnsiChar): Boolean; inline; overload;
+function IsLeadChar(B: Byte): Boolean; inline; overload;
 
 
 const

rtl/objpas/sysutils/sysuni.inc

@@ -540,7 +540,16 @@ end;
 {$define SRPCHAR:=PUnicodeChar}
 {$define SRCHAR:=UnicodeChar}
 
-function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString;  Flags: TReplaceFlags): UnicodeString;
+Function UnicodeStringReplace(const S, OldPattern, NewPattern: Unicodestring;  Flags: TReplaceFlags): Unicodestring;
+
+Var
+  C : Integer;
+
+begin
+  Result:=UnicodeStringReplace(S,OldPattern,NewPattern,Flags,C);
+end;
+
+function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString;  Flags: TReplaceFlags; Out aCount : Integer): UnicodeString;
 {$i syssr.inc}
 
 {$undef INUNICODESTRINGREPLACE}

rtl/objpas/sysutils/sysunih.inc

@@ -68,3 +68,5 @@ function WideBytesOf(const Value: UnicodeString): TBytes;
 function WideStringOf(const Value: TBytes): UnicodeString;
 function ByteLength(const S: UnicodeString): Integer;
 function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString;  Flags: TReplaceFlags): UnicodeString;
+function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString;  Flags: TReplaceFlags; Out aCount : Integer): UnicodeString;
+

rtl/objpas/sysutils/syswide.inc

@@ -193,11 +193,21 @@ end;
 {$define SRPChar:=PWideChar}
 {$define SRChar:=WideChar}
 
-function WideStringReplace(const S, OldPattern, NewPattern: WideString;  Flags: TReplaceFlags): WideString;
+
+Function WideStringReplace(const S, OldPattern, NewPattern: Widestring;  Flags: TReplaceFlags): Widestring;
+
+Var
+  C : Integer;
+
+begin
+  Result:=WideStringReplace(S,OldPattern,NewPattern,Flags,C);
+end;
+
+function WideStringReplace(const S, OldPattern, NewPattern: WideString;  Flags: TReplaceFlags; Out aCount : Integer): WideString;
 {$i syssr.inc}
 
 {$undef INWIDESTRINGREPLACE}
 {$undef SRString}
 {$undef SRUpperCase}
 {$undef SRPChar}
-{$undef SRChar}
+{$undef SRChar}

rtl/objpas/sysutils/syswideh.inc

@@ -35,6 +35,6 @@ function StrCopy(Dest, Source: PWideChar): PWideChar; overload;
 function StrLCopy(Dest,Source: PWideChar; MaxLen: SizeInt): PWideChar; overload;
 Function CharInSet(Ch:WideChar;Const CSet : TSysCharSet) : Boolean;
 function WideStringReplace(const S, OldPattern, NewPattern: WideString;  Flags: TReplaceFlags): WideString;
-
+function WideStringReplace(const S, OldPattern, NewPattern: WideString;  Flags: TReplaceFlags; Out aCount : Integer): WideString;
 function IsLeadChar(Ch: WideChar): Boolean; inline; overload;
 

rtl/win/sysutils.pp

@@ -1038,6 +1038,34 @@ begin
   GetlocaleFormatSettings(GetThreadLocale, DefaultFormatSettings);
 end;
 
+Procedure InitLeadBytes;
+
+var
+  I,B,C,E: Byte;
+  Info: TCPInfo;
+
+begin
+  GetCPInfo(CP_ACP,Info);
+  I:=0;
+  With Info do
+    begin
+    B:=LeadByte[i];
+    E:=LeadByte[i+1];
+    while (I<MAX_LEADBYTES) and (B<>0) and (E<>0) do
+      begin
+      for C:=B to E do
+        Include(LeadBytes,AnsiChar(C));
+      Inc(I,2);
+      if (I<MAX_LEADBYTES) then
+        begin
+        B:=LeadByte[i];
+        E:=LeadByte[i+1];
+        end;
+      end;
+    end;   
+end;
+
+
 Procedure InitInternational;
 var
   { A call to GetSystemMetrics changes the value of the 8087 Control Word on
@@ -1614,6 +1642,7 @@ Initialization
   ExceptObjProc:=@WinExceptionObject;
   ExceptClsProc:=@WinExceptionClass;
 {$endif mswindows}
+  InitLeadBytes;
   InitInternational;    { Initialize internationalization settings }
   LoadVersionInfo;
   InitSysConfigDir;

tests/test/packages/fcl-registry/tw35060a.pp

@@ -0,0 +1,154 @@
+{ %TARGET=win32,win64,wince }
+
+program tw35060a;
+
+{$apptype console}
+{$assertions on}
+{$ifdef fpc}
+{$codepage cp1252}
+{$mode objfpc}
+{$h+}
+{$endif fpc}
+
+uses
+  SysUtils, Classes, Windows, Registry;
+
+{$ifndef fpc}
+type
+  UnicodeString = WideString;
+
+function GetLastOSError: Integer;
+begin
+  Result := GetLastError;
+end;
+{$endif}
+
+const
+  ExpectedAnsiHex = 'E4 EB EF';
+  ExpectedUnicodeHex = '00E4 00EB 00EF';
+  BugID = 'FPCBug0035060';
+
+function UnicodeToHex(const S: UnicodeString): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Word(S[i]),4) + #32;
+  Result := Trim(Result);
+end;
+
+function AnsiToHex(const S: String): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Byte(S[i]),2) + #32;
+  Result := Trim(Result);
+end;
+
+
+//Creating and removing Keys using plain Windows W-API
+function PrepKeyW(Const S : UnicodeString) : pWideChar;
+begin
+  Result:=PWideChar(S);
+  If Result^='\' then
+    Inc(Result);
+end;
+
+procedure CreateKeyInHKCU(const Key: UnicodeString);
+Var
+  u: UnicodeString;
+  Disposition: Dword;
+  Handle: HKEY;
+  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
+  FLastError: LongInt;
+begin
+  SecurityAttributes := Nil;
+  u:=PrepKeyW(Key);
+  Handle := 0;
+  FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
+                              PWideChar(u),
+                              0,
+                              '',
+                              REG_OPTION_NON_VOLATILE,
+                              KEY_ALL_ACCESS,
+                              SecurityAttributes,
+                              Handle,
+                              @Disposition);
+  RegCloseKey(Handle);
+  Assert(FLastError=ERROR_SUCCESS,format('Creating key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+
+procedure CreateTestKey;
+const
+  TestKey: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+var
+  Len: Integer;
+begin
+  Len := Length(TestKey);
+  //Being a bit paranoid here?
+  Assert((Len=26) and (Word(TestKey[Len])=$EF) and (Word(TestKey[Len-1])=$EB) and (Word(TestKey[Len-2])=$E4),'Wrong encoding of TestKey');
+  CreateKeyInHKCU(TestKey);
+end;
+
+procedure RemoveTestKey;
+const
+  TestKeyFull: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+  TestKeyBugID: UnicodeString = 'Software\'+ UniCodeString(BugID);
+var
+  Key: UnicodeString;
+  FLastError: LongInt;
+begin
+  Key:=PRepKeyW(TestKeyFull);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+
+  Key:=PRepKeyW(TestKeyBugID);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+//End Registry plain API functions
+
+var
+  R: TRegistry;
+  Name, S, Key: String;
+  U: UnicodeString;
+  B: Boolean;
+  Err: Integer;
+  CP: TSystemCodePage;
+begin
+  CreateTestKey;
+  try
+    Name := 'äëï';
+    U := UnicodeString(Name);
+    S := AnsiToHex(Name);
+    Assert(S=ExpectedAnsiHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedAnsiHex,S]));
+    S := UnicodeToHex(U);
+    Assert(S=ExpectedUnicodeHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedUnicodeHex,S]));
+
+    R := TRegistry.Create(KEY_ALL_ACCESS);
+    try
+      R.RootKey := HKEY_CURRENT_USER;
+      Key := '\Software\'+BugId+'\'+Name;
+      CP := System.StringCodePage(Key);
+      Assert(CP <> 65001,format('The string that contains the key does not have CP_ACP as dynamic code page, but has codepage %d',[CP]));
+      B := R.OpenKeyReadOnly(Key);
+      Err := GetLastOSError;
+      Assert(B,format('OpenKey(''%s'') failed: "%s" [%d]',[Key,Trim(SysErrorMessage(Err)),Err]));
+      writeln(format('OpenKeyReadOnly(''%s''): OK',[Key]));
+    finally
+      R.Free;
+    end;
+
+  finally
+    RemoveTestKey;
+  end;
+end.
+

tests/test/packages/fcl-registry/tw35060b.pp

@@ -0,0 +1,155 @@
+{ %TARGET=win32,win64,wince }
+
+program tw35060b;
+
+{$apptype console}
+{$assertions on}
+{$ifdef fpc}
+{$codepage utf8}
+{$mode objfpc}
+{$h+}
+{$endif fpc}
+
+uses
+  SysUtils, Classes, Windows, Registry;
+
+{$ifndef fpc}
+type
+  UnicodeString = WideString;
+
+function GetLastOSError: Integer;
+begin
+  Result := GetLastError;
+end;
+{$endif}
+
+const
+  ExpectedUtf8Hex = 'C3 A4 C3 AB C3 AF';
+  ExpectedUnicodeHex = '00E4 00EB 00EF';
+  BugID = 'FPCBug0035060';
+
+function UnicodeToHex(const S: UnicodeString): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Word(S[i]),4) + #32;
+  Result := Trim(Result);
+end;
+
+function Utf8ToHex(const S: String): String;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 1 to length(S) do
+    Result := Result + IntToHex(Byte(S[i]),2) + #32;
+  Result := Trim(Result);
+end;
+
+
+//Creating and removing Keys using plain Windows W-API
+function PrepKeyW(Const S : UnicodeString) : pWideChar;
+begin
+  Result:=PWideChar(S);
+  If Result^='\' then
+    Inc(Result);
+end;
+
+procedure CreateKeyInHKCU(const Key: UnicodeString);
+Var
+  u: UnicodeString;
+  Disposition: Dword;
+  Handle: HKEY;
+  SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
+  FLastError: LongInt;
+begin
+  SecurityAttributes := Nil;
+  u:=PrepKeyW(Key);
+  Handle := 0;
+  FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
+                              PWideChar(u),
+                              0,
+                              '',
+                              REG_OPTION_NON_VOLATILE,
+                              KEY_ALL_ACCESS,
+                              SecurityAttributes,
+                              Handle,
+                              @Disposition);
+  RegCloseKey(Handle);
+  Assert(FLastError=ERROR_SUCCESS,format('Creating key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+
+procedure CreateTestKey;
+const
+  TestKey: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+var
+  Len: Integer;
+begin
+  Len := Length(TestKey);
+  //Being a bit paranoid here?
+  Assert((Len=26) and (Word(TestKey[Len])=$EF) and (Word(TestKey[Len-1])=$EB) and (Word(TestKey[Len-2])=$E4),'Wrong encoding of TestKey');
+  CreateKeyInHKCU(TestKey);
+end;
+
+procedure RemoveTestKey;
+const
+  TestKeyFull: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
+  TestKeyBugID: UnicodeString = 'Software\'+ UniCodeString(BugID);
+var
+  Key: UnicodeString;
+  FLastError: LongInt;
+begin
+  Key:=PRepKeyW(TestKeyFull);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+
+  Key:=PRepKeyW(TestKeyBugID);
+  FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
+  Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
+                                         [String(Key),Trim(SysErrorMessage(FLastError))]));
+end;
+
+//End Registry plain API functions
+
+var
+  R: TRegistry;
+  Name, S: String;
+  Key: Utf8String;
+  U: UnicodeString;
+  B: Boolean;
+  Err: Integer;
+  CP: TSystemCodePage;
+begin
+  CreateTestKey;
+  try
+    Name := 'äëï';
+    U := UnicodeString(Name);
+    S := Utf8ToHex(Name);
+    Assert(S=ExpectedUtf8Hex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedUtf8Hex,S]));
+    S := UnicodeToHex(U);
+    Assert(S=ExpectedUnicodeHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedUnicodeHex,S]));
+
+    R := TRegistry.Create(KEY_ALL_ACCESS);
+    try
+      R.RootKey := HKEY_CURRENT_USER;
+      Key := 'Software\'+BugId+'\'+Name;
+      CP := System.StringCodePage(Key);
+      Assert(CP = 65001,format('The string that contains the key does not have UTF-8 as dynamic code page, but has codepage %d',[CP]));
+      B := R.OpenKeyReadOnly(Key);
+      Err := GetLastOSError;
+      Assert(B,format('OpenKey(''%s'') failed: "%s" [%d]',[Key,Trim(SysErrorMessage(Err)),Err]));
+      writeln(format('OpenKeyReadOnly(''%s''): OK',[Key]));
+    finally
+      R.Free;
+    end;
+
+  finally
+    RemoveTestKey;
+  end;
+end.
+

utils/pas2jni/writer.pas

@@ -104,6 +104,7 @@ type
     procedure WriteClassTable;
 
     procedure WriteFileComment(st: TTextOutStream);
+    function FindInStringList(list: TStringList; const s: string): integer;
 
     procedure ProcessRules(d: TDef; const Prefix: string = '');
     function GetUniqueNum: integer;
@@ -358,11 +359,11 @@ end;
 
 function TWriter.DoCheckItem(const ItemName: string): TCheckItemResult;
 begin
-  if IncludeList.IndexOf(ItemName) >= 0 then
-    Result:=crInclude
+  if FindInStringList(ExcludeList, ItemName) >= 0 then
+    Result:=crExclude
   else
-    if ExcludeList.IndexOf(ItemName) >= 0 then
-      Result:=crExclude
+    if FindInStringList(IncludeList, ItemName) >= 0 then
+      Result:=crInclude
     else
       Result:=crDefault;
 end;
@@ -373,6 +374,36 @@ begin
   st.WriteLn('// Do not edit this file.');
 end;
 
+function TWriter.FindInStringList(list: TStringList; const s: string): integer;
+var
+  len, cnt: integer;
+  ss: string;
+begin
+  if list.Find(s, Result) or (Result < 0) then
+    exit;
+  if Result < list.Count then begin
+    cnt:=3;
+    if Result > 0 then
+      Dec(Result)
+    else
+      Dec(cnt);
+    if Result + cnt > list.Count then
+      Dec(cnt);
+    while cnt > 0 do begin
+      ss:=list[Result];
+      len:=Length(ss);
+      if (len > 1) and (ss[len] = '*') then begin
+        Dec(len);
+        if AnsiCompareText(Copy(s, 1, len), Copy(ss, 1, len)) = 0 then
+          exit;
+      end;
+      Inc(Result);
+      Dec(cnt);
+    end;
+  end;
+  Result:=-1;
+end;
+
 procedure TWriter.ProcessRules(d: TDef; const Prefix: string);
 var
   i: integer;
@@ -385,14 +416,11 @@ begin
         exit;
       end;
   s:=Prefix + d.Name;
-  i:=IncludeList.IndexOf(s);
-  if i >= 0 then begin
-    d.IsUsed:=True;
-  end
+  if FindInStringList(ExcludeList, s) >= 0 then
+    d.SetNotUsed
   else
-    if ExcludeList.IndexOf(s) >= 0 then begin
-      d.SetNotUsed;
-    end;
+    if FindInStringList(IncludeList, s) >= 0 then
+      d.IsUsed:=True;
   if not (d.DefType in [dtUnit, dtClass]) then
     exit;
   s:=s + '.';

utils/pas2js/compileserver.lpi

@@ -48,6 +48,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../packages/fcl-js/src;../../packages/fcl-json/src;../../packages/fcl-passrc/src;../../packages/pastojs/src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
   </CompilerOptions>

utils/pas2js/dist/rtl.js

@@ -2,7 +2,7 @@
 
 var rtl = {
 
-  version: 10301,
+  version: 10501,
 
   quiet: false,
   debug_load_units: false,

utils/pas2js/docs/translation.html

@@ -1518,7 +1518,14 @@ function(){
     <li>In Delphi/FPC an empty array is <i>nil</i>. In JS it can be <i>null</i> or <i>[]</i>.
      For compatibility comparing an array with <i>nil</i> checks for <i>length(a)>0</i>.</li>
     <li><i>function Assigned(array): boolean</i>  results true iff <i>length(array)>0</i>.</li>
-    <li>Not yet implemented: array of const.</li>
+    <li>array of const:
+      <ul>
+      <li>Works the same: vtInteger, vtBoolean, vtPointer, vtObject, vtClass, vtWideChar, vtInterface, vtUnicodeString</li>
+      <li>vtExtended is double, Delphi/FPC: PExtended</li>
+      <li>vtCurrency is currency, Delphi/FPC: PCurrency</li>
+      <li>Not supported: vtChar, vtString, vtPChar, vtPWideChar, vtAnsiString, vtVariant, vtWideString, vtInt64, vtQWord</li>
+      <li>only in pas2js: vtNativeInt, vtJSValue</li>
+      </ul></li>
     <li>Assignation using constant array, e.g. <i>a:=[1,1,2];</i></li>
     <li>String like operation: + operator concatenates arrays. e.g. <i>a:=[1]+[2];</i>.
       This is controlled by modeswitch arrayoperators, which is enabled in mode delphi.</li>
@@ -3079,7 +3086,6 @@ End.
     <div class="section">
     <h2 id="notsupportedelements">Not supported elements</h2>
     <ul>
-    <li>Array of const</li>
     <li>Attributes</li>
     <li>Class constructor, class destructor</li>
     <li>Enums with custom values</li>

utils/pas2js/httpcompiler.pp

@@ -7,7 +7,8 @@ interface
 
 uses
   sysutils, classes, fpjson, contnrs, syncobjs, custhttpapp, fpwebfile, httproute,
-  pas2jscompiler, httpdefs, dirwatch;
+  httpdefs, dirwatch,
+  Pas2JSFSCompiler, Pas2JSCompilerCfg;
 
 Const
   nErrTooManyThreads = -1;
@@ -101,6 +102,7 @@ Type
     function ScheduleCompile(const aProjectFile: String; Options : TStrings = Nil): Integer;
     procedure StartWatch(ADir: String);
     procedure Usage(Msg: String);
+    function GetDefaultMimetypes: string;
   public
     Constructor Create(AOWner : TComponent); override;
     Destructor Destroy; override;
@@ -142,13 +144,14 @@ end;
 procedure TCompileThread.Execute;
 
 Var
-  C : TPas2jsCompiler;
+  C : TPas2JSFSCompiler;
   L : TStrings;
 
 begin
   L:=Nil;
-  C:=TPas2jsCompiler.Create;
+  C:=TPas2JSFSCompiler.Create;
   Try
+    C.ConfigSupport:=TPas2JSFileConfigSupport.Create(C);
     FApp.ReportBuilding(Item);
     L:=TStringList.Create;
     L.Assign(Item.Options);
@@ -259,11 +262,25 @@ begin
   Writeln('-q --quiet          Do not write diagnostic messages');
   Writeln('-w --watch          Watch directory for changes');
   Writeln('-c --compile[=proj] Recompile project if pascal files change. Default project is app.lpr');
+  Writeln('-m --mimetypes=file filename of mimetypes. Default is ',GetDefaultMimetypes);
   Writeln('-s --simpleserver   Only serve files, do not enable compilation.');
   Halt(Ord(Msg<>''));
   {AllowWriteln-}
 end;
 
+function THTTPCompilerApplication.GetDefaultMimetypes: string;
+begin
+  {$ifdef unix}
+  Result:='/etc/mime.types';
+  {$ifdef darwin}
+  if not FileExists(Result) then
+    Result:='/private/etc/apache2/mime.types';
+  {$endif}
+  {$else}
+  Result:=ExtractFilePath(System.ParamStr(0))+'mime.types';
+  {$endif}
+end;
+
 constructor THTTPCompilerApplication.Create(AOWner: TComponent);
 begin
   inherited Create(AOWner);
@@ -403,7 +420,8 @@ begin
   end;
 end;
 
-Function THTTPCompilerApplication.ScheduleCompile(const aProjectFile : String; Options : TStrings = Nil) : Integer;
+function THTTPCompilerApplication.ScheduleCompile(const aProjectFile: String;
+  Options: TStrings): Integer;
 
 Var
   CI : TCompileItem;
@@ -479,7 +497,7 @@ begin
   AResponse.SendResponse;
 end;
 
-Function THTTPCompilerApplication.HandleCompileOptions(aDir : String) : Boolean;
+function THTTPCompilerApplication.HandleCompileOptions(aDir: String): Boolean;
 
 begin
   Result:=False;
@@ -510,14 +528,14 @@ begin
   Result:=True;
 end;
 
-Function THTTPCompilerApplication.ProcessOptions : Boolean;
+function THTTPCompilerApplication.ProcessOptions: Boolean;
 
 Var
   S,IndexPage,D : String;
 
 begin
   Result:=False;
-  S:=Checkoptions('shqd:ni:p:wP::c',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:','simpleserver']);
+  S:=Checkoptions('shqd:ni:p:wP::cm:',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:','simpleserver','mimetypes:']);
   if (S<>'') or HasOption('h','help') then
     usage(S);
   FServeOnly:=HasOption('s','serve-only');
@@ -526,11 +544,12 @@ begin
   D:=GetOptionValue('d','directory');
   if D='' then
     D:=GetCurrentDir;
-{$ifdef unix}
-  MimeTypesFile:='/etc/mime.types';
-{$else}
-  MimeTypesFile:=ExtractFilePath(System.ParamStr(0))+'mime.types';
-{$endif}
+  if HasOption('m','mimetypes') then
+    MimeTypesFile:=GetOptionValue('m','mimetypes');
+  if MimeTypesFile='' then
+    MimeTypesFile:=GetDefaultMimetypes;
+  if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
+    Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
   FBaseDir:=D;
   if not ServeOnly then
     if not HandleCompileOptions(D) then