浏览代码

* synchronised with trunk till r40575

git-svn-id: branches/debug_eh@40576 -
Jonas Maebe 6 年之前
父节点
当前提交
b41cd1eb6a
共有 99 个文件被更改,包括 2435 次插入1103 次删除
  1. 3 2
      .gitattributes
  2. 3 0
      compiler/aarch64/cpubase.pas
  3. 53 4
      compiler/aarch64/cpupara.pas
  4. 4 1
      compiler/aarch64/hlcgcpu.pas
  5. 2 2
      compiler/llvm/hlcgllvm.pas
  6. 7 6
      compiler/llvm/llvmdef.pas
  7. 24 0
      compiler/llvm/nllvminl.pas
  8. 4 6
      compiler/ncal.pas
  9. 2 2
      packages/fcl-js/src/jsbase.pp
  10. 3 3
      packages/fcl-passrc/src/pasresolveeval.pas
  11. 324 80
      packages/fcl-passrc/src/pasresolver.pp
  12. 3 4
      packages/fcl-passrc/src/pastree.pp
  13. 9 4
      packages/fcl-passrc/src/pasuseanalyzer.pas
  14. 83 59
      packages/fcl-passrc/src/pparser.pp
  15. 10 1
      packages/fcl-passrc/src/pscanner.pp
  16. 235 24
      packages/fcl-passrc/tests/tcresolver.pas
  17. 22 0
      packages/fcl-passrc/tests/tcuseanalyzer.pas
  18. 1 1
      packages/fcl-process/src/processbody.inc
  19. 20 4
      packages/fpmkunit/src/fpmkunit.pp
  20. 1 1
      packages/graph/src/inc/graphh.inc
  21. 1 1
      packages/graph/src/win32/graph.pp
  22. 284 112
      packages/pastojs/src/fppas2js.pp
  23. 281 205
      packages/pastojs/src/pas2jscompiler.pp
  24. 5 4
      packages/pastojs/src/pas2jscompilercfg.pp
  25. 2 2
      packages/pastojs/src/pas2jscompilerpp.pp
  26. 0 48
      packages/pastojs/src/pas2jsfilecache.pp
  27. 2 1
      packages/pastojs/src/pas2jsfscompiler.pp
  28. 3 1
      packages/pastojs/src/pas2jslibcompiler.pp
  29. 4 1
      packages/pastojs/src/pas2jslogger.pp
  30. 413 1
      packages/pastojs/tests/tcmodules.pas
  31. 3 4
      packages/pastojs/tests/tcprecompile.pas
  32. 1 1
      packages/pastojs/tests/tcunitsearch.pas
  33. 2 0
      packages/pastojs/tests/testpas2js.lpi
  34. 0 239
      packages/rtl-extra/src/android/unixsock.inc
  35. 4 0
      packages/rtl-extra/src/android/unxsockh.inc
  36. 6 1
      packages/rtl-objpas/src/inc/strutils.pp
  37. 28 24
      rtl/android/aarch64/sysnr.inc
  38. 33 29
      rtl/android/arm/sysnr.inc
  39. 33 29
      rtl/android/i386/sysnr.inc
  40. 28 24
      rtl/android/mips64/sysnr.inc
  41. 28 24
      rtl/android/mipsel/sysnr.inc
  42. 28 24
      rtl/android/x86_64/sysnr.inc
  43. 9 0
      rtl/inc/llvmintr.inc
  44. 2 2
      rtl/linux/bunxsysc.inc
  45. 4 0
      rtl/linux/osdefs.inc
  46. 6 0
      rtl/objpas/classes/bits.inc
  47. 1 0
      rtl/objpas/classes/classesh.inc
  48. 11 0
      rtl/objpas/sysutils/sysstr.inc
  49. 2 0
      rtl/objpas/sysutils/sysstrh.inc
  50. 7 1
      rtl/solaris/ostypes.inc
  51. 4 1
      rtl/unix/unix.pp
  52. 67 27
      tests/Makefile
  53. 1 1
      tests/Makefile.fpc
  54. 32 0
      tests/tbf/tb0588.pp
  55. 0 21
      tests/tbs/tb0588.pp
  56. 3 1
      tests/test/units/character/tgetnumericvalue.pp
  57. 3 1
      tests/test/units/character/tgetnumericvalue2.pp
  58. 1 1
      tests/test/units/character/tgetnumericvalue3.pp
  59. 1 1
      tests/test/units/character/tgetunicodecategoriesurro.pp
  60. 3 1
      tests/test/units/character/tiscontrol.pp
  61. 3 1
      tests/test/units/character/tiscontrol2.pp
  62. 1 1
      tests/test/units/character/tiscontrol3.pp
  63. 3 1
      tests/test/units/character/tisdigit.pp
  64. 3 1
      tests/test/units/character/tisdigit2.pp
  65. 1 1
      tests/test/units/character/tisdigit3.pp
  66. 1 6
      tests/test/units/character/tishighsurrogate.pp
  67. 5 1
      tests/test/units/character/tisletter.pp
  68. 5 1
      tests/test/units/character/tisletterordigit.pp
  69. 1 6
      tests/test/units/character/tislowsurrogate.pp
  70. 3 1
      tests/test/units/character/tisnumber.pp
  71. 3 1
      tests/test/units/character/tisnumber2.pp
  72. 3 1
      tests/test/units/character/tispunctuation.pp
  73. 5 1
      tests/test/units/character/tisseparator.pp
  74. 1 1
      tests/test/units/character/tissurrogate.pp
  75. 1 8
      tests/test/units/character/tissurrogatepair.pp
  76. 1 8
      tests/test/units/character/tissurrogatepair2.pp
  77. 5 1
      tests/test/units/character/tissymbol.pp
  78. 5 1
      tests/test/units/character/tisupper.pp
  79. 3 1
      tests/test/units/character/tiswhitespace.pp
  80. 5 1
      tests/test/units/character/tlowercase.pp
  81. 5 1
      tests/test/units/character/tlowercase2.pp
  82. 3 1
      tests/test/units/character/ttolower.pp
  83. 1 1
      tests/test/units/character/ttolower2.pp
  84. 1 1
      tests/test/units/character/ttolower3.pp
  85. 3 1
      tests/test/units/character/ttoupper.pp
  86. 1 1
      tests/test/units/character/ttoupper2.pp
  87. 1 1
      tests/test/units/character/ttoupper3.pp
  88. 2 0
      tests/test/units/character/tutf32convert.pp
  89. 10 4
      tests/test/units/classes/tstringlistexchange.pp
  90. 53 0
      tests/test/units/classes/ttbits.pp
  91. 11 2
      tests/test/units/strutils/tromantoint.pp
  92. 51 0
      tests/webtbs/tw33607.pp
  93. 11 0
      utils/fppkg/fpmake.pp
  94. 32 1
      utils/fppkg/fppkg.pp
  95. 13 1
      utils/pas2js/dist/rtl.js
  96. 9 2
      utils/pas2js/docs/translation.html
  97. 3 1
      utils/pas2js/nodepas2js.pp
  98. 3 0
      utils/pas2js/pas2js.lpi
  99. 5 4
      utils/pas2js/pas2js.pp

+ 3 - 2
.gitattributes

@@ -7443,7 +7443,6 @@ packages/rtl-extra/src/amiga/printer.pp svneol=native#text/plain
 packages/rtl-extra/src/amiga/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/amiga/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/android/clocale.pp svneol=native#text/plain
 packages/rtl-extra/src/android/clocale.pp svneol=native#text/plain
 packages/rtl-extra/src/android/osdefs.inc svneol=native#text/plain
 packages/rtl-extra/src/android/osdefs.inc svneol=native#text/plain
-packages/rtl-extra/src/android/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/android/unxsockh.inc svneol=native#text/plain
 packages/rtl-extra/src/android/unxsockh.inc svneol=native#text/plain
 packages/rtl-extra/src/aros/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/aros/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/beos/osdefs.inc svneol=native#text/plain
 packages/rtl-extra/src/beos/osdefs.inc svneol=native#text/plain
@@ -11083,6 +11082,7 @@ tests/tbf/tb0262.pp svneol=native#text/pascal
 tests/tbf/tb0263.pp svneol=native#text/pascal
 tests/tbf/tb0263.pp svneol=native#text/pascal
 tests/tbf/tb0264.pp svneol=native#text/pascal
 tests/tbf/tb0264.pp svneol=native#text/pascal
 tests/tbf/tb0265.pp svneol=native#text/pascal
 tests/tbf/tb0265.pp svneol=native#text/pascal
+tests/tbf/tb0588.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -11674,7 +11674,6 @@ tests/tbs/tb0584.pp svneol=native#text/pascal
 tests/tbs/tb0585.pp svneol=native#text/pascal
 tests/tbs/tb0585.pp svneol=native#text/pascal
 tests/tbs/tb0586.pp svneol=native#text/pascal
 tests/tbs/tb0586.pp svneol=native#text/pascal
 tests/tbs/tb0587.pp svneol=native#text/plain
 tests/tbs/tb0587.pp svneol=native#text/plain
-tests/tbs/tb0588.pp svneol=native#text/pascal
 tests/tbs/tb0589.pp svneol=native#text/pascal
 tests/tbs/tb0589.pp svneol=native#text/pascal
 tests/tbs/tb0590.pp svneol=native#text/pascal
 tests/tbs/tb0590.pp svneol=native#text/pascal
 tests/tbs/tb0591.pp svneol=native#text/pascal
 tests/tbs/tb0591.pp svneol=native#text/pascal
@@ -14138,6 +14137,7 @@ tests/test/units/classes/tbytesstreamtest.pp svneol=native#text/pascal
 tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
 tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
 tests/test/units/classes/tsetstream.pp svneol=native#text/plain
 tests/test/units/classes/tsetstream.pp svneol=native#text/plain
 tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal
 tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal
+tests/test/units/classes/ttbits.pp svneol=native#text/pascal
 tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
 tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
@@ -16402,6 +16402,7 @@ tests/webtbs/tw3356.pp svneol=native#text/plain
 tests/webtbs/tw33563.pp svneol=native#text/pascal
 tests/webtbs/tw33563.pp svneol=native#text/pascal
 tests/webtbs/tw33564.pp svneol=native#text/pascal
 tests/webtbs/tw33564.pp svneol=native#text/pascal
 tests/webtbs/tw3360.pp svneol=native#text/plain
 tests/webtbs/tw3360.pp svneol=native#text/plain
+tests/webtbs/tw33607.pp svneol=native#text/plain
 tests/webtbs/tw33635.pp svneol=native#text/pascal
 tests/webtbs/tw33635.pp svneol=native#text/pascal
 tests/webtbs/tw3364.pp svneol=native#text/plain
 tests/webtbs/tw3364.pp svneol=native#text/plain
 tests/webtbs/tw3366.pp svneol=native#text/plain
 tests/webtbs/tw3366.pp svneol=native#text/plain

+ 3 - 0
compiler/aarch64/cpubase.pas

@@ -369,8 +369,11 @@ unit cpubase;
           R_MMREGISTER:
           R_MMREGISTER:
             begin
             begin
               case s of
               case s of
+                { records }
+                OS_32,
                 OS_F32:
                 OS_F32:
                   cgsize2subreg:=R_SUBMMS;
                   cgsize2subreg:=R_SUBMMS;
+                OS_64,
                 OS_F64:
                 OS_F64:
                   cgsize2subreg:=R_SUBMMD;
                   cgsize2subreg:=R_SUBMMD;
                 else
                 else

+ 53 - 4
compiler/aarch64/cpupara.pas

@@ -270,7 +270,8 @@ unit cpupara;
               then indexed beyond its bounds) }
               then indexed beyond its bounds) }
           arraydef:
           arraydef:
             result:=
             result:=
-              (calloption in cdecl_pocalls) or
+              ((calloption in cdecl_pocalls) and
+               not is_dynamic_array(def)) or
               is_open_array(def) or
               is_open_array(def) or
               is_array_of_const(def) or
               is_array_of_const(def) or
               is_array_constructor(def) or
               is_array_constructor(def) or
@@ -400,11 +401,16 @@ unit cpupara;
         if (p.proccalloption in cstylearrayofconst) and
         if (p.proccalloption in cstylearrayofconst) and
            is_array_of_const(paradef) then
            is_array_of_const(paradef) then
           begin
           begin
+            result.size:=OS_NO;
+            result.def:=paradef;
+            result.alignment:=std_param_align;
+            result.intsize:=0;
             paraloc:=result.add_location;
             paraloc:=result.add_location;
             { hack: the paraloc must be valid, but is not actually used }
             { hack: the paraloc must be valid, but is not actually used }
             paraloc^.loc:=LOC_REGISTER;
             paraloc^.loc:=LOC_REGISTER;
             paraloc^.register:=NR_X0;
             paraloc^.register:=NR_X0;
             paraloc^.size:=OS_ADDR;
             paraloc^.size:=OS_ADDR;
+            paraloc^.def:=paradef;
             exit;
             exit;
           end;
           end;
 
 
@@ -532,8 +538,48 @@ unit cpupara;
              end
              end
            else
            else
              begin
              begin
+{$ifndef llvm}
                paraloc^.size:=locsize;
                paraloc^.size:=locsize;
                paraloc^.def:=locdef;
                paraloc^.def:=locdef;
+{$else llvm}
+               case locsize of
+                 OS_8,OS_16,OS_32:
+                   begin
+                     paraloc^.size:=OS_64;
+                     paraloc^.def:=u64inttype;
+                   end;
+                 OS_S8,OS_S16,OS_S32:
+                   begin
+                     paraloc^.size:=OS_S64;
+                     paraloc^.def:=s64inttype;
+                   end;
+                 OS_F32:
+                   begin
+                     paraloc^.size:=OS_F32;
+                     paraloc^.def:=s32floattype;
+                   end;
+                 OS_F64:
+                   begin
+                     paraloc^.size:=OS_F64;
+                     paraloc^.def:=s64floattype;
+                   end;
+                 else
+                   begin
+                     if is_record(locdef) or
+                        ((locdef.typ=arraydef) and
+                         not is_special_array(locdef)) then
+                       begin
+                         paraloc^.size:=OS_64;
+                         paraloc^.def:=u64inttype;
+                       end
+                     else
+                       begin
+                         paraloc^.size:=locsize;
+                         paraloc^.def:=locdef;
+                       end;
+                   end;
+               end;
+{$endif llvm}
              end;
              end;
 
 
            { paraloc loc }
            { paraloc loc }
@@ -556,7 +602,10 @@ unit cpupara;
                     (side=callerside) and
                     (side=callerside) and
                     is_ordinal(paradef) and
                     is_ordinal(paradef) and
                     (paradef.size<4) then
                     (paradef.size<4) then
-                   paraloc^.size:=OS_32;
+                   begin
+                     paraloc^.size:=OS_32;
+                     paraloc^.def:=u32inttype;
+                   end;
 
 
                  { in case it's a composite, "The argument is passed as though
                  { in case it's a composite, "The argument is passed as though
                    it had been loaded into the registers from a double-word-
                    it had been loaded into the registers from a double-word-
@@ -567,7 +616,7 @@ unit cpupara;
                  if (target_info.endian=endian_big) and
                  if (target_info.endian=endian_big) and
                     not(paraloc^.size in [OS_64,OS_S64]) and
                     not(paraloc^.size in [OS_64,OS_S64]) and
                     (paradef.typ in [setdef,recorddef,arraydef,objectdef]) then
                     (paradef.typ in [setdef,recorddef,arraydef,objectdef]) then
-                   paraloc^.shiftval:=-(8-tcgsize2size[paraloc^.size]);
+                   paraloc^.shiftval:=-(8-tcgsize2size[paraloc^.size])*8;
                end;
                end;
              LOC_MMREGISTER:
              LOC_MMREGISTER:
                begin
                begin
@@ -581,7 +630,7 @@ unit cpupara;
                   paraloc^.loc:=LOC_REFERENCE;
                   paraloc^.loc:=LOC_REFERENCE;
 
 
                   { the current stack offset may not be properly aligned in
                   { the current stack offset may not be properly aligned in
-                    case we're on Darwin have allocated a non-variadic argument
+                    case we're on Darwin and have allocated a non-variadic argument
                     < 8 bytes previously }
                     < 8 bytes previously }
                   if target_info.abi=abi_aarch64_darwin then
                   if target_info.abi=abi_aarch64_darwin then
                     curstackoffset:=align(curstackoffset,paraloc^.def.alignment);
                     curstackoffset:=align(curstackoffset,paraloc^.def.alignment);

+ 4 - 1
compiler/aarch64/hlcgcpu.pas

@@ -62,7 +62,10 @@ implementation
     begin
     begin
       tocgsize:=def_cgsize(tosize);
       tocgsize:=def_cgsize(tosize);
       if (sreg.startbit<>0) or
       if (sreg.startbit<>0) or
-         not(sreg.bitlen in [32,64]) then
+         not((sreg.subsetregsize in [OS_32,OS_S32]) and
+             (sreg.bitlen=32)) or
+         not((sreg.subsetregsize in [OS_64,OS_S64]) and
+             (sreg.bitlen=64)) then
         begin
         begin
           if is_signed(subsetsize) then
           if is_signed(subsetsize) then
             op:=A_SBFX
             op:=A_SBFX

+ 2 - 2
compiler/llvm/hlcgllvm.pas

@@ -1545,7 +1545,7 @@ implementation
                     exit;
                     exit;
                 end;
                 end;
               if fromsize<>tosize then
               if fromsize<>tosize then
-                g_ptrtypecast_ref(list,cpointerdef.create(fromsize),cpointerdef.create(tosize),href);
+                g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(tosize),href);
               { %reg = load size* %ref }
               { %reg = load size* %ref }
               list.concat(taillvm.op_reg_size_ref(la_load,reg,cpointerdef.getreusable(tosize),href));
               list.concat(taillvm.op_reg_size_ref(la_load,reg,cpointerdef.getreusable(tosize),href));
             end;
             end;
@@ -1837,7 +1837,7 @@ implementation
 
 
   function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
   function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
     begin
     begin
-      result:=make_simple_ref_ptr(list,ref,cpointerdef.create(def));
+      result:=make_simple_ref_ptr(list,ref,cpointerdef.getreusable(def));
     end;
     end;
 
 
 
 

+ 7 - 6
compiler/llvm/llvmdef.pas

@@ -690,9 +690,7 @@ implementation
           llvmextractvalueextinfo(hp.vardef,usedef,signext);
           llvmextractvalueextinfo(hp.vardef,usedef,signext);
           { implicit zero/sign extension for ABI compliance? }
           { implicit zero/sign extension for ABI compliance? }
           if not first then
           if not first then
-             encodedstr:=encodedstr+', '
-          else
-            first:=false;
+             encodedstr:=encodedstr+', ';
           llvmaddencodedtype_intern(usedef,[],encodedstr);
           llvmaddencodedtype_intern(usedef,[],encodedstr);
           { in case signextstr<>'', there should be only one paraloc -> no need
           { in case signextstr<>'', there should be only one paraloc -> no need
             to clear (reason: it means that the paraloc is larger than the
             to clear (reason: it means that the paraloc is larger than the
@@ -769,6 +767,7 @@ implementation
               encodedstr:=encodedstr+' '+llvmasmsymname(paraloc^.llvmloc.sym);
               encodedstr:=encodedstr+' '+llvmasmsymname(paraloc^.llvmloc.sym);
             end;
             end;
           paraloc:=paraloc^.next;
           paraloc:=paraloc^.next;
+          first:=false;
         until not assigned(paraloc);
         until not assigned(paraloc);
       end;
       end;
 
 
@@ -952,7 +951,7 @@ implementation
               retdeflist[i]:=retloc^.def;
               retdeflist[i]:=retloc^.def;
               dec(sizeleft,retloc^.def.size);
               dec(sizeleft,retloc^.def.size);
             end
             end
-          else
+          else if retloc^.def.size<>sizeleft then
             begin
             begin
               case sizeleft of
               case sizeleft of
                 1:
                 1:
@@ -971,8 +970,10 @@ implementation
                   retdeflist[i]:=u56inttype;
                   retdeflist[i]:=u56inttype;
                 else
                 else
                   retdeflist[i]:=retloc^.def;
                   retdeflist[i]:=retloc^.def;
-              end;
-            end;
+              end
+            end
+          else
+            retdeflist[i]:=retloc^.def;
           inc(i);
           inc(i);
           retloc:=retloc^.next;
           retloc:=retloc^.next;
         until not assigned(retloc);
         until not assigned(retloc);

+ 24 - 0
compiler/llvm/nllvminl.pas

@@ -37,6 +37,7 @@ interface
         function first_get_frame: tnode; override;
         function first_get_frame: tnode; override;
         function first_abs_real: tnode; override;
         function first_abs_real: tnode; override;
         function first_sqr_real: tnode; override;
         function first_sqr_real: tnode; override;
+        function first_sqrt_real: tnode; override;
         function first_trunc_real: tnode; override;
         function first_trunc_real: tnode; override;
        public
        public
         procedure second_length; override;
         procedure second_length; override;
@@ -156,6 +157,29 @@ implementation
       end;
       end;
 
 
 
 
+    function tllvminlinenode.first_sqrt_real: tnode;
+      var
+        intrinsic: string[20];
+      begin
+        if left.resultdef.typ<>floatdef then
+          internalerror(2018121601);
+        case tfloatdef(left.resultdef).floattype of
+          s32real:
+            intrinsic:='llvm_sqrt_f32';
+          s64real:
+            intrinsic:='llvm_sqrt_f64';
+          s80real,sc80real:
+            intrinsic:='llvm_sqrt_f80';
+          s128real:
+            intrinsic:='llvm_sqrt_f128';
+          else
+            internalerror(2018121602);
+        end;
+        result:=ccallnode.createinternfromunit('SYSTEM',intrinsic, ccallparanode.create(left,nil));
+        left:=nil;
+      end;
+
+
     function tllvminlinenode.first_trunc_real: tnode;
     function tllvminlinenode.first_trunc_real: tnode;
       begin
       begin
         { fptosi is undefined if the value is out of range -> only generate
         { fptosi is undefined if the value is out of range -> only generate

+ 4 - 6
compiler/ncal.pas

@@ -768,7 +768,7 @@ implementation
                         as a dynamic array here }
                         as a dynamic array here }
                      { first restore the actual resultdef of left }
                      { first restore the actual resultdef of left }
                      temparraydef:=left.resultdef;
                      temparraydef:=left.resultdef;
-                     left.resultdef:=parasym.vardef;
+                     left.resultdef:=resultdef;
                      { get its address }
                      { get its address }
                      lefttemp:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
                      lefttemp:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
                      addstatement(initstat,lefttemp);
                      addstatement(initstat,lefttemp);
@@ -779,21 +779,19 @@ implementation
                          caddrnode.create_internal(left)
                          caddrnode.create_internal(left)
                        )
                        )
                      );
                      );
-                     { restore the resultdef }
-                     left.resultdef:=temparraydef;
                      { now treat that address (correctly) as the original
                      { now treat that address (correctly) as the original
                        dynamic array to get its start and length }
                        dynamic array to get its start and length }
                      arraybegin:=cvecnode.create(
                      arraybegin:=cvecnode.create(
                        ctypeconvnode.create_explicit(ctemprefnode.create(lefttemp),
                        ctypeconvnode.create_explicit(ctemprefnode.create(lefttemp),
-                         left.resultdef),
+                         temparraydef),
                        genintconstnode(0)
                        genintconstnode(0)
                      );
                      );
                      arraysize:=caddnode.create(muln,
                      arraysize:=caddnode.create(muln,
                        geninlinenode(in_length_x,false,
                        geninlinenode(in_length_x,false,
                          ctypeconvnode.create_explicit(ctemprefnode.create(lefttemp),
                          ctypeconvnode.create_explicit(ctemprefnode.create(lefttemp),
-                           left.resultdef)
+                           temparraydef)
                        ),
                        ),
-                       genintconstnode(tarraydef(left.resultdef).elementdef.size)
+                       genintconstnode(tarraydef(temparraydef).elementdef.size)
                      );
                      );
                    end
                    end
                  else
                  else

+ 2 - 2
packages/fcl-js/src/jsbase.pp

@@ -26,8 +26,8 @@ uses
   Classes, SysUtils;
   Classes, SysUtils;
 
 
 const
 const
-  MinSafeIntDouble = -$10000000000000; // -4503599627370496
-  MaxSafeIntDouble =   $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
+  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
 Type
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
 
 

+ 3 - 3
packages/fcl-passrc/src/pasresolveeval.pas

@@ -340,8 +340,8 @@ const
   MinSafeIntSingle = -16777216;
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$10000000000000; // -4503599627370496
-  MaxSafeIntDouble =   $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
+  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
   MaskUIntDouble = $fffffffffffff;
   MaskUIntDouble = $fffffffffffff;
 
 
 type
 type
@@ -1249,7 +1249,7 @@ begin
           reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
           reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
           reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
           reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
           reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
           reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
-          reitIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff;
+          reitIntDouble: {$ifdef fpc}TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff{$endif};
           else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
           else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
         end;
         end;
         end;
         end;

+ 324 - 80
packages/fcl-passrc/src/pasresolver.pp

@@ -144,6 +144,7 @@ Works:
 - built-in functions pred, succ for range type and enums
 - built-in functions pred, succ for range type and enums
 - untyped parameters
 - untyped parameters
 - built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
 - built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
+- built-in procedure writestr(var s: string; Args: arguments...); varargs
 - pointer TPasPointerType
 - pointer TPasPointerType
   - nil, assigned(), typecast, class, classref, dynarray, procvar
   - nil, assigned(), typecast, class, classref, dynarray, procvar
   - forward declaration
   - forward declaration
@@ -210,8 +211,17 @@ Works:
 - type alias type overloads
 - type alias type overloads
 - $writeableconst off $J-
 - $writeableconst off $J-
 - $warn identifier ON|off|error|default
 - $warn identifier ON|off|error|default
+- anonymous methods:
+  - assign in proc and program begin and initialization   p:=procedure begin end
+  - pass as arg  doit(procedure begin end)
+  - modifiers  assembler varargs cdecl
+  - typecast
+- built-in procedure Val(const s: string; var e: enumtype; out Code: integertype);
 
 
 ToDo:
 ToDo:
+- anonymous methods:
+  - with
+  - self
 - Include/Exclude for set of int/char/bool
 - Include/Exclude for set of int/char/bool
 - set of CharRange
 - set of CharRange
 - error if property method resolution is not used
 - error if property method resolution is not used
@@ -224,7 +234,6 @@ ToDo:
   - CharSet:=[#13]
   - CharSet:=[#13]
 - proc: check if forward and impl default values match
 - proc: check if forward and impl default values match
 - call array of proc without ()
 - call array of proc without ()
-- anonymous functions
 - attributes
 - attributes
 - object
 - object
 - type helpers
 - type helpers
@@ -518,6 +527,7 @@ type
     bfStrProc,
     bfStrProc,
     bfStrFunc,
     bfStrFunc,
     bfWriteStr,
     bfWriteStr,
+    bfVal,
     bfConcatArray,
     bfConcatArray,
     bfCopyArray,
     bfCopyArray,
     bfInsertArray,
     bfInsertArray,
@@ -551,6 +561,7 @@ const
     'Str',
     'Str',
     'Str',
     'Str',
     'WriteStr',
     'WriteStr',
+    'Val',
     'Concat',
     'Concat',
     'Copy',
     'Copy',
     'Insert',
     'Insert',
@@ -1351,6 +1362,7 @@ type
     procedure AddArgument(El: TPasArgument); virtual;
     procedure AddArgument(El: TPasArgument); virtual;
     procedure AddFunctionResult(El: TPasResultElement); virtual;
     procedure AddFunctionResult(El: TPasResultElement); virtual;
     procedure AddExceptOn(El: TPasImplExceptOn); virtual;
     procedure AddExceptOn(El: TPasImplExceptOn); virtual;
+    procedure AddWithDo(El: TPasImplWithDo); virtual;
     procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
     procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
     procedure ResolveImplElement(El: TPasImplElement); virtual;
     procedure ResolveImplElement(El: TPasImplElement); virtual;
     procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
     procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
@@ -1409,6 +1421,7 @@ type
     procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
     procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
     procedure FinishExceptOnExpr; virtual;
     procedure FinishExceptOnExpr; virtual;
     procedure FinishExceptOnStatement; virtual;
     procedure FinishExceptOnStatement; virtual;
+    procedure FinishWithDo(El: TPasImplWithDo); virtual;
     procedure FinishDeclaration(El: TPasElement); virtual;
     procedure FinishDeclaration(El: TPasElement); virtual;
     procedure FinishVariable(El: TPasVariable); virtual;
     procedure FinishVariable(El: TPasVariable); virtual;
     procedure FinishPropertyOfClass(PropEl: TPasProperty); virtual;
     procedure FinishPropertyOfClass(PropEl: TPasProperty); virtual;
@@ -1581,6 +1594,10 @@ type
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure BI_WriteStrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
     procedure BI_WriteStrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
       Params: TParamsExpr); virtual;
       Params: TParamsExpr); virtual;
+    function BI_Val_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr); virtual;
     function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
     function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure BI_ConcatArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
     procedure BI_ConcatArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
@@ -1647,6 +1664,7 @@ type
     procedure CheckFoundElement(const FindData: TPRFindData;
     procedure CheckFoundElement(const FindData: TPRFindData;
       Ref: TResolvedReference); virtual;
       Ref: TResolvedReference); virtual;
     function GetVisibilityContext: TPasElement;
     function GetVisibilityContext: TPasElement;
+    procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); override;
     procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
     procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
     procedure FinishTypeAlias(var NewType: TPasType); override;
     procedure FinishTypeAlias(var NewType: TPasType); override;
     function IsUnitIntfFinished(AModule: TPasModule): boolean;
     function IsUnitIntfFinished(AModule: TPasModule): boolean;
@@ -1683,12 +1701,14 @@ type
     // scopes
     // scopes
     function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
     function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
     procedure PopScope;
     procedure PopScope;
+    procedure PopWithScope(El: TPasImplWithDo);
     procedure PushScope(Scope: TPasScope); overload;
     procedure PushScope(Scope: TPasScope); overload;
     function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
     function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
     function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
     function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
     function PushClassDotScope(var CurClassType: TPasClassType): TPasDotClassScope;
     function PushClassDotScope(var CurClassType: TPasClassType): TPasDotClassScope;
     function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotRecordScope;
     function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotRecordScope;
     function PushEnumDotScope(CurEnumType: TPasEnumType): TPasDotEnumTypeScope;
     function PushEnumDotScope(CurEnumType: TPasEnumType): TPasDotEnumTypeScope;
+    function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
     procedure ResetSubScopes(out Depth: integer);
     procedure ResetSubScopes(out Depth: integer);
     procedure RestoreSubScopes(Depth: integer);
     procedure RestoreSubScopes(Depth: integer);
     function GetInheritedExprScope(ErrorEl: TPasElement): TPasProcedureScope;
     function GetInheritedExprScope(ErrorEl: TPasElement): TPasProcedureScope;
@@ -1846,6 +1866,8 @@ type
     function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
     function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
     function IsClassMethod(El: TPasElement): boolean;
     function IsClassMethod(El: TPasElement): boolean;
     function IsClassField(El: TPasElement): boolean;
     function IsClassField(El: TPasElement): boolean;
+    function GetFunctionType(El: TPasElement): TPasFunctionType;
+    function IsMethod(El: TPasProcedure): boolean;
     function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
     function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
     function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
     function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
     function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
     function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
@@ -5748,6 +5770,11 @@ begin
   PopScope;
   PopScope;
 end;
 end;
 
 
+procedure TPasResolver.FinishWithDo(El: TPasImplWithDo);
+begin
+  PopWithScope(El);
+end;
+
 procedure TPasResolver.FinishDeclaration(El: TPasElement);
 procedure TPasResolver.FinishDeclaration(El: TPasElement);
 var
 var
   C: TClass;
   C: TClass;
@@ -7552,86 +7579,25 @@ begin
 end;
 end;
 
 
 procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
 procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
+// Note: the expressions were already resolved during parsing
+//  and the scopes were already stored in a TPasWithScope.
+//  -> simply push them onto the scope stack
 var
 var
-  i, OldScopeCount: Integer;
-  Expr, ErrorEl: TPasExpr;
-  ExprResolved: TPasResolverResult;
-  TypeEl: TPasType;
+  i: Integer;
   WithScope: TPasWithScope;
   WithScope: TPasWithScope;
-  WithExprScope: TPasWithExprScope;
-  ExprScope: TPasScope;
-  OnlyTypeMembers, IsClassOf: Boolean;
-  ClassEl: TPasClassType;
+  ExprScope: TPasWithExprScope;
 begin
 begin
-  OldScopeCount:=ScopeCount;
-  WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
+  if not (El.CustomData is TPasWithScope) then
+    RaiseInternalError(20181210175349);
+  WithScope:=TPasWithScope(El.CustomData);
   PushScope(WithScope);
   PushScope(WithScope);
-  for i:=0 to El.Expressions.Count-1 do
+  for i:=0 to WithScope.ExpressionScopes.Count-1 do
     begin
     begin
-    Expr:=TPasExpr(El.Expressions[i]);
-    ResolveExpr(Expr,rraRead);
-    ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
-    {$IFDEF VerbosePasResolver}
-    writeln('TPasResolver.ResolveImplWithDo ExprResolved=',GetResolverResultDbg(ExprResolved));
-    {$ENDIF}
-    ErrorEl:=Expr;
-    TypeEl:=ExprResolved.LoTypeEl;
-    // ToDo: use last element in Expr for error position
-    if TypeEl=nil then
-      RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
-        [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
-
-    OnlyTypeMembers:=false;
-    IsClassOf:=false;
-    if TypeEl.ClassType=TPasRecordType then
-      begin
-      ExprScope:=NoNil(TPasRecordType(TypeEl).CustomData) as TPasRecordScope;
-      if ExprResolved.IdentEl is TPasType then
-        // e.g. with TPoint do PointInCircle
-        OnlyTypeMembers:=true;
-      end
-    else if TypeEl.ClassType=TPasClassType then
-      begin
-      ExprScope:=NoNil(TPasClassType(TypeEl).CustomData) as TPasClassScope;
-      if ExprResolved.IdentEl is TPasType then
-        // e.g. with TFPMemoryImage do FindHandlerFromExtension()
-        OnlyTypeMembers:=true;
-      end
-    else if TypeEl.ClassType=TPasClassOfType then
-      begin
-      // e.g. with ImageClass do FindHandlerFromExtension()
-      ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
-      ExprScope:=ClassEl.CustomData as TPasClassScope;
-      OnlyTypeMembers:=true;
-      IsClassOf:=true;
-      end
-    else
-      RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
-        [GetElementTypeName(TypeEl)],ErrorEl);
-    WithExprScope:=ScopeClass_WithExpr.Create;
-    WithExprScope.WithScope:=WithScope;
-    WithExprScope.Index:=i;
-    WithExprScope.Expr:=Expr;
-    WithExprScope.Scope:=ExprScope;
-    if not (ExprResolved.IdentEl is TPasType) then
-      Include(WithExprScope.Flags,wesfNeedTmpVar);
-    if OnlyTypeMembers then
-      Include(WithExprScope.Flags,wesfOnlyTypeMembers);
-    if IsClassOf then
-      Include(WithExprScope.Flags,wesfIsClassOf);
-    if (not (rrfWritable in ExprResolved.Flags))
-        and (ExprResolved.BaseType=btContext)
-        and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
-      Include(WithExprScope.Flags,wesfConstParent);
-    WithScope.ExpressionScopes.Add(WithExprScope);
-    PushScope(WithExprScope);
+    ExprScope:=TPasWithExprScope(WithScope.ExpressionScopes[i]);
+    PushScope(ExprScope);
     end;
     end;
   ResolveImplElement(El.Body);
   ResolveImplElement(El.Body);
-  CheckTopScope(ScopeClass_WithExpr);
-  if TopScope<>WithScope.ExpressionScopes[WithScope.ExpressionScopes.Count-1] then
-    RaiseInternalError(20160923102846);
-  while ScopeCount>OldScopeCount do
-    PopScope;
+  PopWithScope(El);
 end;
 end;
 
 
 procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
 procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
@@ -7846,6 +7812,7 @@ begin
     ResolveRecordValues(TRecordValues(El));
     ResolveRecordValues(TRecordValues(El));
     end
     end
   else if ElClass=TProcedureExpr then
   else if ElClass=TProcedureExpr then
+    // resolved by FinishScope(stProcedure)
   else
   else
     RaiseNotYetImplemented(20170222184329,El);
     RaiseNotYetImplemented(20170222184329,El);
 
 
@@ -9364,14 +9331,34 @@ var
   CurEl: TPasElement;
   CurEl: TPasElement;
   Identifier: TPasIdentifier;
   Identifier: TPasIdentifier;
   CurClassScope: TPasClassScope;
   CurClassScope: TPasClassScope;
+  C: TClass;
 begin
 begin
   {$IFDEF VerbosePasResolver}
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.AddProcedure ',GetObjName(El));
   writeln('TPasResolver.AddProcedure ',GetObjName(El));
   {$ENDIF}
   {$ENDIF}
-  if not (TopScope is TPasIdentifierScope) then
-    RaiseInvalidScopeForElement(20160922163522,El);
-  // Note: El.ProcType is nil !  It is parsed later.
   ProcName:=El.Name;
   ProcName:=El.Name;
+  if El.Name<>'' then
+    begin
+    // named proc
+    if not (TopScope is TPasIdentifierScope) then
+      RaiseInvalidScopeForElement(20160922163522,El);
+    end
+  else
+    begin
+    // anonymous proc
+    C:=TopScope.ClassType;
+    if (C=ScopeClass_InitialFinalization)
+        or C.InheritsFrom(TPasProcedureScope)
+        or (C=TPasWithScope)
+        or (C=ScopeClass_WithExpr)
+        or (C=TPasExceptOnScope)
+        or (C=TPasForLoopScope) then
+      // ok
+    else
+      RaiseInvalidScopeForElement(20181210173134,El);
+    end;
+
+  // Note: El.ProcType is nil !  It is parsed later.
   HasDot:=Pos('.',ProcName)>1;
   HasDot:=Pos('.',ProcName)>1;
   if (not HasDot) and (ProcName<>'') then
   if (not HasDot) and (ProcName<>'') then
     AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
     AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
@@ -9503,6 +9490,16 @@ begin
   PushScope(El,TPasExceptOnScope);
   PushScope(El,TPasExceptOnScope);
 end;
 end;
 
 
+procedure TPasResolver.AddWithDo(El: TPasImplWithDo);
+var
+  WithScope: TPasWithScope;
+begin
+  if TPasWithScope.FreeOnPop then
+    RaiseInternalError(20181210162344);
+  WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
+  PushScope(WithScope);
+end;
+
 procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
 procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
 begin
 begin
   if El=nil then ;
   if El=nil then ;
@@ -13380,6 +13377,73 @@ begin
     FinishCallArgAccess(P[i],rraRead);
     FinishCallArgAccess(P[i],rraRead);
 end;
 end;
 
 
+function TPasResolver.BI_Val_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built-in procedure 'Val(const s: string; out v: valtype; out code: integer)'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first parameter: string
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if ParamResolved.BaseType in btAllStrings then
+    Result:=cExact;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20181214141250,1,Param,ParamResolved,'string',RaiseOnError));
+
+  // second parameter: var value
+  Param:=Params.Params[1];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if ResolvedElCanBeVarParam(ParamResolved,Expr) then
+    begin
+    if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
+      Result:=cExact
+    else if ParamResolved.BaseType=btContext then
+      begin
+      if ParamResolved.LoTypeEl is TPasEnumType then
+        Result:=cExact;
+      end;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20181214141704,2,Param,ParamResolved,
+         'boolean/integer/float/enum variable',RaiseOnError));
+
+  // third parameter: out Code: integer
+  Param:=Params.Params[2];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if ResolvedElCanBeVarParam(ParamResolved,Expr) then
+    begin
+    if ParamResolved.BaseType in btAllInteger then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20181214141511,3,Param,ParamResolved,'integer variable',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr);
+var
+  P: TPasExprArray;
+begin
+  if Proc=nil then ;
+  P:=Params.Params;
+  if P=nil then ;
+  FinishCallArgAccess(P[0],rraRead);
+  FinishCallArgAccess(P[1],rraOutParam);
+  FinishCallArgAccess(P[2],rraOutParam);
+end;
+
 function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
 function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
   Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
   Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
 var
 var
@@ -14158,6 +14222,8 @@ begin
     else if AClass=TPasMethodResolution then
     else if AClass=TPasMethodResolution then
     else if AClass=TPasImplExceptOn then
     else if AClass=TPasImplExceptOn then
       AddExceptOn(TPasImplExceptOn(El))
       AddExceptOn(TPasImplExceptOn(El))
+    else if AClass=TPasImplWithDo then
+      AddWithDo(TPasImplWithDo(El))
     else if AClass=TPasImplLabelMark then
     else if AClass=TPasImplLabelMark then
     else if AClass=TPasOverloadedProc then
     else if AClass=TPasOverloadedProc then
     else if (AClass=TInterfaceSection)
     else if (AClass=TInterfaceSection)
@@ -14751,6 +14817,15 @@ begin
   Result:=nil;
   Result:=nil;
 end;
 end;
 
 
+procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement);
+begin
+  case ScopeType of
+  stWithExpr: PushWithExprScope(El as TPasExpr);
+  else
+    RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil);
+  end;
+end;
+
 procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
 procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
 begin
 begin
   if IsElementSkipped(El) then exit;
   if IsElementSkipped(El) then exit;
@@ -14764,6 +14839,7 @@ begin
   stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
   stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
   stExceptOnExpr: FinishExceptOnExpr;
   stExceptOnExpr: FinishExceptOnExpr;
   stExceptOnStatement: FinishExceptOnStatement;
   stExceptOnStatement: FinishExceptOnStatement;
+  stWithExpr: FinishWithDo(El as TPasImplWithDo);
   stDeclaration: FinishDeclaration(El);
   stDeclaration: FinishDeclaration(El);
   stAncestors: FinishAncestors(El as TPasClassType);
   stAncestors: FinishAncestors(El as TPasClassType);
   stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
   stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
@@ -15138,6 +15214,10 @@ begin
     AddBuiltInProc('WriteStr','procedure WriteStr(out String; params...)',
     AddBuiltInProc('WriteStr','procedure WriteStr(out String; params...)',
         @BI_WriteStrProc_OnGetCallCompatibility,nil,nil,
         @BI_WriteStrProc_OnGetCallCompatibility,nil,nil,
         @BI_WriteStrProc_OnFinishParamsExpr,bfWriteStr,[bipfCanBeStatement]);
         @BI_WriteStrProc_OnFinishParamsExpr,bfWriteStr,[bipfCanBeStatement]);
+  if bfVal in TheBaseProcs then
+    AddBuiltInProc('Val','procedure Val(const String; var Value: bool|int|float|enum; out Int)',
+        @BI_Val_OnGetCallCompatibility,nil,nil,
+        @BI_Val_OnFinishParamsExpr,bfVal,[bipfCanBeStatement]);
   if bfConcatArray in TheBaseProcs then
   if bfConcatArray in TheBaseProcs then
     AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
     AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
         @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
         @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
@@ -15347,6 +15427,23 @@ begin
     FTopScope:=nil;
     FTopScope:=nil;
 end;
 end;
 
 
+procedure TPasResolver.PopWithScope(El: TPasImplWithDo);
+var
+  WithScope: TPasWithScope;
+  i: Integer;
+begin
+  WithScope:=El.CustomData as TPasWithScope;
+  for i:=WithScope.ExpressionScopes.Count-1 downto 0 do
+    begin
+    CheckTopScope(ScopeClass_WithExpr);
+    if TopScope<>WithScope.ExpressionScopes[i] then
+      RaiseInternalError(20160923102846);
+    PopScope;
+    end;
+  CheckTopScope(TPasWithScope);
+  PopScope;
+end;
+
 procedure TPasResolver.PushScope(Scope: TPasScope);
 procedure TPasResolver.PushScope(Scope: TPasScope);
 begin
 begin
   if Scope=nil then
   if Scope=nil then
@@ -15446,6 +15543,84 @@ begin
   PushScope(Result);
   PushScope(Result);
 end;
 end;
 
 
+function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
+var
+  WithEl: TPasImplWithDo;
+  WithScope: TPasWithScope;
+  ExprResolved: TPasResolverResult;
+  ErrorEl: TPasExpr;
+  TypeEl: TPasType;
+  OnlyTypeMembers, IsClassOf: Boolean;
+  ExprScope: TPasIdentifierScope;
+  ClassEl: TPasClassType;
+  WithExprScope: TPasWithExprScope;
+begin
+  if not (Expr.Parent is TPasImplWithDo) then
+    RaiseInternalError(20181210163412,GetObjName(Expr.Parent));
+  WithEl:=TPasImplWithDo(Expr.Parent);
+  if not (WithEl.CustomData is TPasWithScope) then
+    RaiseInternalError(20181210175526);
+  WithScope:=TPasWithScope(WithEl.CustomData);
+
+  ResolveExpr(Expr,rraRead);
+  ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.PushWithExprScope ExprResolved=',GetResolverResultDbg(ExprResolved));
+  {$ENDIF}
+  ErrorEl:=Expr;
+  TypeEl:=ExprResolved.LoTypeEl;
+  // ToDo: use last element in Expr for error position
+  if TypeEl=nil then
+    RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+      [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
+
+  OnlyTypeMembers:=false;
+  IsClassOf:=false;
+  if TypeEl.ClassType=TPasRecordType then
+    begin
+    ExprScope:=NoNil(TPasRecordType(TypeEl).CustomData) as TPasRecordScope;
+    if ExprResolved.IdentEl is TPasType then
+      // e.g. with TPoint do PointInCircle
+      OnlyTypeMembers:=true;
+    end
+  else if TypeEl.ClassType=TPasClassType then
+    begin
+    ExprScope:=NoNil(TPasClassType(TypeEl).CustomData) as TPasClassScope;
+    if ExprResolved.IdentEl is TPasType then
+      // e.g. with TFPMemoryImage do FindHandlerFromExtension()
+      OnlyTypeMembers:=true;
+    end
+  else if TypeEl.ClassType=TPasClassOfType then
+    begin
+    // e.g. with ImageClass do FindHandlerFromExtension()
+    ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
+    ExprScope:=ClassEl.CustomData as TPasClassScope;
+    OnlyTypeMembers:=true;
+    IsClassOf:=true;
+    end
+  else
+    RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+      [GetElementTypeName(TypeEl)],ErrorEl);
+  WithExprScope:=ScopeClass_WithExpr.Create;
+  WithExprScope.WithScope:=WithScope;
+  WithExprScope.Index:=WithEl.Expressions.Count;
+  WithExprScope.Expr:=Expr;
+  WithExprScope.Scope:=ExprScope;
+  if not (ExprResolved.IdentEl is TPasType) then
+    Include(WithExprScope.Flags,wesfNeedTmpVar);
+  if OnlyTypeMembers then
+    Include(WithExprScope.Flags,wesfOnlyTypeMembers);
+  if IsClassOf then
+    Include(WithExprScope.Flags,wesfIsClassOf);
+  if (not (rrfWritable in ExprResolved.Flags))
+      and (ExprResolved.BaseType=btContext)
+      and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
+    Include(WithExprScope.Flags,wesfConstParent);
+  WithScope.ExpressionScopes.Add(WithExprScope);
+  PushScope(WithExprScope);
+  Result:=WithExprScope;
+end;
+
 procedure TPasResolver.ResetSubScopes(out Depth: integer);
 procedure TPasResolver.ResetSubScopes(out Depth: integer);
 // move all sub scopes from Scopes to SubScopes
 // move all sub scopes from Scopes to SubScopes
 begin
 begin
@@ -16224,6 +16399,14 @@ begin
     else
     else
       ; // AnyProc = aRefTo -> ok
       ; // AnyProc = aRefTo -> ok
     end
     end
+  else if Proc2.Parent is TPasAnonymousProcedure then
+    begin
+    if IsAssign then
+      // NonRefTo := AnonymousProc  -> not possible
+      exit(ModifierError(ptmReferenceTo))
+    else
+      ; // AnyProc = AnonymousProc -> ok
+    end
   else
   else
     begin
     begin
     // neither Proc1 nor Proc2 is a reference-to  -> check isNested and OfObject
     // neither Proc1 nor Proc2 is a reference-to  -> check isNested and OfObject
@@ -19269,6 +19452,42 @@ begin
           else
           else
             Result:=cCompatible;
             Result:=cCompatible;
           end
           end
+        end
+      else if FromResolved.BaseType=btProc then
+        begin
+        FromTypeEl:=FromResolved.LoTypeEl;
+        if FromTypeEl is TPasProcedureType then
+          begin
+          // typecast procedure (or anonymous procedure) to proctype
+          FromProcType:=TPasProcedureType(FromTypeEl);
+          if (msDelphi in CurrentParser.CurrentModeswitches)
+              and (FromResolved.IdentEl=nil)
+              and (FromResolved.LoTypeEl.Name<>'') then
+            // Delphi forbids typecast (non anonymous) procedure to proctype
+          else if ToProcType.IsReferenceTo then
+            Result:=cCompatible
+          else if FromResolved.IdentEl=nil then
+            // anonymous proc to proctype
+            Result:=cCompatible
+          else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
+              and not (proMethodAddrAsPointer in Options) then
+            begin
+            // e.g. TProcedure(Obj.DoIt)
+            if RaiseOnError then
+              RaiseMsg(20181210151058,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
+            end
+          else if FromProcType.IsNested<>ToProcType.IsNested then
+            begin
+            if RaiseOnError then
+              RaiseMsg(20181210151102,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
+            end
+          else
+            Result:=cCompatible;
+          end;
         end;
         end;
       end
       end
     else if C=TPasPointerType then
     else if C=TPasPointerType then
@@ -20291,6 +20510,30 @@ begin
     and (El.Parent is TPasClassType);
     and (El.Parent is TPasClassType);
 end;
 end;
 
 
+function TPasResolver.GetFunctionType(El: TPasElement): TPasFunctionType;
+var
+  ProcType: TPasProcedureType;
+begin
+  if not (El is TPasProcedure) then exit(nil);
+  ProcType:=TPasProcedure(El).ProcType;
+  if ProcType is TPasFunctionType then
+    Result:=TPasFunctionType(ProcType)
+  else
+    Result:=nil;
+end;
+
+function TPasResolver.IsMethod(El: TPasProcedure): boolean;
+var
+  ProcScope: TPasProcedureScope;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if El.Parent is TPasClassType then exit(true);
+  if not (El.CustomData is TPasProcedureScope) then exit;
+  ProcScope:=TPasProcedureScope(El.CustomData);
+  Result:=IsMethod(ProcScope.DeclarationProc);
+end;
+
 function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
 function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
   const ExtName: string): boolean;
   const ExtName: string): boolean;
 var
 var
@@ -20672,9 +20915,10 @@ begin
     if not HasTypeInfo(TPasType(El.Parent)) then
     if not HasTypeInfo(TPasType(El.Parent)) then
       exit;
       exit;
     end
     end
-  else
-    if ElHasModeSwitch(El,msOmitRTTI) then
-      exit;
+  else if ElHasModeSwitch(El,msOmitRTTI) then
+    exit
+  else if El.Parent is TPasAnonymousProcedure then
+    exit;
   Result:=true;
   Result:=true;
 end;
 end;
 
 

+ 3 - 4
packages/fcl-passrc/src/pastree.pp

@@ -1988,7 +1988,7 @@ end;
 
 
 constructor TProcedureExpr.Create(AParent: TPasElement);
 constructor TProcedureExpr.Create(AParent: TPasElement);
 begin
 begin
-  inherited Create(AParent,pekProcedure, eopNone);
+  inherited Create(AParent,pekProcedure,eopNone);
 end;
 end;
 
 
 destructor TProcedureExpr.Destroy;
 destructor TProcedureExpr.Destroy;
@@ -2009,8 +2009,7 @@ procedure TProcedureExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
   const Arg: Pointer);
 begin
 begin
   inherited ForEachCall(aMethodCall, Arg);
   inherited ForEachCall(aMethodCall, Arg);
-  if Proc<>nil then
-    Proc.ForEachCall(aMethodCall,Arg);
+  ForEachChildCall(aMethodCall,Arg,Proc,false);
 end;
 end;
 
 
 { TPasImplRaise }
 { TPasImplRaise }
@@ -4497,7 +4496,7 @@ begin
       S.Add(T);
       S.Add(T);
       end;
       end;
     ProcType.GetArguments(S);
     ProcType.GetArguments(S);
-    If ProcType is TPasFunctionType
+    If (ProcType is TPasFunctionType)
         and Assigned(TPasFunctionType(Proctype).ResultEl) then
         and Assigned(TPasFunctionType(Proctype).ResultEl) then
       With TPasFunctionType(ProcType).ResultEl.ResultType do
       With TPasFunctionType(ProcType).ResultEl.ResultType do
         begin
         begin

+ 9 - 4
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1552,6 +1552,8 @@ begin
     end
     end
   else if C=TInheritedExpr then
   else if C=TInheritedExpr then
     UseInheritedExpr(TInheritedExpr(El))
     UseInheritedExpr(TInheritedExpr(El))
+  else if C=TProcedureExpr then
+    UseProcedure(TProcedureExpr(El).Proc)
   else
   else
     RaiseNotSupported(20170307085444,El);
     RaiseNotSupported(20170307085444,El);
 end;
 end;
@@ -2491,6 +2493,7 @@ var
   ProcScope: TPasProcedureScope;
   ProcScope: TPasProcedureScope;
   PosEl: TPasElement;
   PosEl: TPasElement;
   DeclProc, ImplProc: TPasProcedure;
   DeclProc, ImplProc: TPasProcedure;
+  FuncType: TPasFunctionType;
 begin
 begin
   {$IFDEF VerbosePasAnalyzer}
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
@@ -2556,12 +2559,14 @@ begin
         end;
         end;
       end;
       end;
     // check result
     // check result
-    if (El is TPasFunction) then
+    if (El.ProcType is TPasFunctionType) then
       begin
       begin
-      PosEl:=TPasFunction(El).FuncType.ResultEl;
-      if (ProcScope.ImplProc<>nil) and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
+      FuncType:=TPasFunctionType(TPasProcedure(El).ProcType);
+      PosEl:=FuncType.ResultEl;
+      if (ProcScope.ImplProc<>nil)
+          and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
         PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
         PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
-      Usage:=FindElement(TPasFunction(El).FuncType.ResultEl);
+      Usage:=FindElement(FuncType.ResultEl);
       if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
       if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
         // result was never used
         // result was never used
         EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
         EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,

+ 83 - 59
packages/fcl-passrc/src/pparser.pp

@@ -24,8 +24,14 @@
   {$IF FPC_FULLVERSION<30101}
   {$IF FPC_FULLVERSION<30101}
     {$define EmulateArrayInsert}
     {$define EmulateArrayInsert}
   {$endif}
   {$endif}
+  {$define HasFS}
 {$endif}
 {$endif}
 
 
+{$IFDEF NODEJS}
+  {$define HasFS}
+{$ENDIF}
+
+
 unit PParser;
 unit PParser;
 
 
 interface
 interface
@@ -165,6 +171,7 @@ type
     stResourceString, // e.g. TPasResString
     stResourceString, // e.g. TPasResString
     stProcedure, // also method, procedure, constructor, destructor, ...
     stProcedure, // also method, procedure, constructor, destructor, ...
     stProcedureHeader,
     stProcedureHeader,
+    stWithExpr, // calls BeginScope after parsing every WITH-expression
     stExceptOnExpr,
     stExceptOnExpr,
     stExceptOnStatement,
     stExceptOnStatement,
     stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument
     stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument
@@ -206,6 +213,7 @@ type
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
       UseParentAsResultParent: Boolean; const ASrcPos: TPasSourcePos): TPasFunctionType;
       UseParentAsResultParent: Boolean; const ASrcPos: TPasSourcePos): TPasFunctionType;
     function FindElement(const AName: String): TPasElement; virtual; abstract;
     function FindElement(const AName: String): TPasElement; virtual; abstract;
+    procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     procedure FinishTypeAlias(var aType: TPasType); virtual;
     procedure FinishTypeAlias(var aType: TPasType); virtual;
     function FindModule(const AName: String): TPasModule; virtual;
     function FindModule(const AName: String): TPasModule; virtual;
@@ -448,7 +456,7 @@ type
     procedure ParseArgList(Parent: TPasElement;
     procedure ParseArgList(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       Args: TFPList; // list of TPasArgument
       EndToken: TToken);
       EndToken: TToken);
-    procedure ParseProcedureOrFunctionHeader(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
+    procedure ParseProcedureOrFunction(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
     procedure ParseProcedureBody(Parent: TPasElement);
     procedure ParseProcedureBody(Parent: TPasElement);
     function ParseMethodResolution(Parent: TPasElement): TPasMethodResolution;
     function ParseMethodResolution(Parent: TPasElement): TPasMethodResolution;
     // Properties for external access
     // Properties for external access
@@ -803,6 +811,13 @@ begin
     visDefault, ASrcPos));
     visDefault, ASrcPos));
 end;
 end;
 
 
+procedure TPasTreeContainer.BeginScope(ScopeType: TPasScopeType; El: TPasElement
+  );
+begin
+  if ScopeType=stModule then ; // avoid compiler warning
+  if El=nil then ;
+end;
+
 procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType;
 procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType;
   El: TPasElement);
   El: TPasElement);
 begin
 begin
@@ -1155,7 +1170,6 @@ begin
         end;
         end;
     ParseExcTokenError(S);
     ParseExcTokenError(S);
     end;
     end;
-
 end;
 end;
 
 
 
 
@@ -1247,15 +1261,9 @@ end;
 function TPasParser.TokenIsAnonymousProcedureModifier(Parent: TPasElement;
 function TPasParser.TokenIsAnonymousProcedureModifier(Parent: TPasElement;
   S: String; out PM: TProcedureModifier): Boolean;
   S: String; out PM: TProcedureModifier): Boolean;
 begin
 begin
-  S:=LowerCase(S);
-  case S of
-  'assembler':
-    begin
-    PM:=pmAssembler;
-    exit(true);
-    end;
-  end;
-  Result:=false;
+  Result:=IsProcModifier(S,PM);
+  if not Result then exit;
+  Result:=PM in [pmAssembler];
   if Parent=nil then ;
   if Parent=nil then ;
 end;
 end;
 
 
@@ -1313,11 +1321,7 @@ function TPasParser.IsAnonymousProcAllowed(El: TPasElement): boolean;
 begin
 begin
   while El is TPasExpr do
   while El is TPasExpr do
     El:=El.Parent;
     El:=El.Parent;
-  if not (El is TPasImplBlock) then
-    exit(false); // only in statements
-  while El is TPasImplBlock do
-    El:=El.Parent;
-  Result:=El is TProcedureBody; // needs a parent procedure
+  Result:=El is TPasImplBlock; // only in statements
 end;
 end;
 
 
 function TPasParser.CheckPackMode: TPackMode;
 function TPasParser.CheckPackMode: TPackMode;
@@ -1814,14 +1818,14 @@ begin
     tkProcedure:
     tkProcedure:
       begin
       begin
         Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
         Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
-        ParseProcedureOrFunctionHeader(Result, TPasProcedureType(Result), ptProcedure, True);
+        ParseProcedureOrFunction(Result, TPasProcedureType(Result), ptProcedure, True);
         if CurToken = tkSemicolon then
         if CurToken = tkSemicolon then
           UngetToken;        // Unget semicolon
           UngetToken;        // Unget semicolon
       end;
       end;
     tkFunction:
     tkFunction:
       begin
       begin
         Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
         Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
-        ParseProcedureOrFunctionHeader(Result, TPasFunctionType(Result), ptFunction, True);
+        ParseProcedureOrFunction(Result, TPasFunctionType(Result), ptFunction, True);
         if CurToken = tkSemicolon then
         if CurToken = tkSemicolon then
           UngetToken;        // Unget semicolon
           UngetToken;        // Unget semicolon
       end;
       end;
@@ -2210,6 +2214,7 @@ var
   ST: TPasSpecializeType;
   ST: TPasSpecializeType;
   SrcPos, ScrPos: TPasSourcePos;
   SrcPos, ScrPos: TPasSourcePos;
   ProcType: TProcType;
   ProcType: TProcType;
+  ProcExpr: TProcedureExpr;
 
 
 begin
 begin
   Result:=nil;
   Result:=nil;
@@ -2262,22 +2267,19 @@ begin
       end;
       end;
     tkprocedure,tkfunction:
     tkprocedure,tkfunction:
       begin
       begin
+      if not IsAnonymousProcAllowed(AParent) then
+        ParseExcExpectedIdentifier;
       if CurToken=tkprocedure then
       if CurToken=tkprocedure then
         ProcType:=ptAnonymousProcedure
         ProcType:=ptAnonymousProcedure
       else
       else
         ProcType:=ptAnonymousFunction;
         ProcType:=ptAnonymousFunction;
-      if not IsAnonymousProcAllowed(AParent) then
-        ParseExcExpectedIdentifier;
-      ok:=false;
       try
       try
-        Result:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
-        TProcedureExpr(Result).Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(Result,ProcType));
-        if CurToken=tkSemicolon then
-          NextToken; // skip optional semicolon
-        ok:=true;
+        ProcExpr:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
+        ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType));
+        Result:=ProcExpr;
       finally
       finally
-        if not ok then
-          Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+        if Result=nil then
+          ProcExpr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
       end;
       end;
       exit; // do not allow postfix operators . ^. [] ()
       exit; // do not allow postfix operators . ^. [] ()
       end;
       end;
@@ -2392,11 +2394,13 @@ begin
   //    Result:=5;
   //    Result:=5;
     tknot,tkAt,tkAtAt:
     tknot,tkAt,tkAtAt:
       Result:=4;
       Result:=4;
-    tkMul, tkDivision, tkdiv, tkmod, tkand, tkShl,tkShr, tkas, tkPower :
+    tkMul, tkDivision, tkdiv, tkmod, tkand, tkShl,tkShr, tkas, tkPower, tkis:
+      // Note that "is" has same precedence as "and" in Delphi and fpc, even though
+      // some docs say otherwise. e.g. "Obj is TObj and aBool"
       Result:=3;
       Result:=3;
     tkPlus, tkMinus, tkor, tkxor:
     tkPlus, tkMinus, tkor, tkxor:
       Result:=2;
       Result:=2;
-    tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan, tkGreaterThan, tkGreaterEqualThan, tkin, tkis:
+    tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan, tkGreaterThan, tkGreaterEqualThan, tkin:
       Result:=1;
       Result:=1;
   else
   else
     Result:=0;
     Result:=0;
@@ -4140,7 +4144,7 @@ begin
     Result := TPasProcedureType(CreateElement(TPasProcedureType, TypeName, Parent, NamePos));
     Result := TPasProcedureType(CreateElement(TPasProcedureType, TypeName, Parent, NamePos));
   ok:=false;
   ok:=false;
   try
   try
-    ParseProcedureOrFunctionHeader(Result, TPasProcedureType(Result), PT, True);
+    ParseProcedureOrFunction(Result, TPasProcedureType(Result), PT, True);
     ok:=true;
     ok:=true;
   finally
   finally
     if not ok then
     if not ok then
@@ -4665,6 +4669,11 @@ begin
       tkIdentifier, // e.g. procedure assembler
       tkIdentifier, // e.g. procedure assembler
       tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
       tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
         UngetToken;
         UngetToken;
+      tkColon:
+        if ProcType=ptAnonymousFunction then
+          UngetToken
+        else
+          ParseExcTokenError('begin');
       else
       else
         ParseExcTokenError('begin');
         ParseExcTokenError('begin');
       end;
       end;
@@ -4828,7 +4837,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
+procedure TPasParser.ParseProcedureOrFunction(Parent: TPasElement;
   Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
   Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
 
 
   Function FindInSection(AName : String;ASection : TPasSection) : Boolean;
   Function FindInSection(AName : String;ASection : TPasSection) : Boolean;
@@ -4873,8 +4882,8 @@ Var
   PM : TProcedureModifier;
   PM : TProcedureModifier;
   ResultEl: TPasResultElement;
   ResultEl: TPasResultElement;
   OK: Boolean;
   OK: Boolean;
-  IsProc: Boolean; // true = procedure, false = procedure type
-  IsAnonymProc: Boolean;
+  IsProcType: Boolean; // false = procedure, true = procedure type
+  IsAnonymous: Boolean;
   PTM: TProcTypeModifier;
   PTM: TProcTypeModifier;
   ModTokenCount: Integer;
   ModTokenCount: Integer;
   LastToken: TToken;
   LastToken: TToken;
@@ -4883,8 +4892,8 @@ begin
   // Element must be non-nil. Removed all checks for not-nil.
   // Element must be non-nil. Removed all checks for not-nil.
   // If it is nil, the following fails anyway.
   // If it is nil, the following fails anyway.
   CheckProcedureArgs(Element,Element.Args,ProcType);
   CheckProcedureArgs(Element,Element.Args,ProcType);
-  IsProc:=Parent is TPasProcedure;
-  IsAnonymProc:=IsProc and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
+  IsProcType:=not (Parent is TPasProcedure);
+  IsAnonymous:=(not IsProcType) and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
   case ProcType of
   case ProcType of
     ptFunction,ptClassFunction,ptAnonymousFunction:
     ptFunction,ptClassFunction,ptAnonymousFunction:
       begin
       begin
@@ -4897,7 +4906,8 @@ begin
       // In Delphi mode, the implementation in the implementation section can be
       // In Delphi mode, the implementation in the implementation section can be
       // without result as it was declared
       // without result as it was declared
       // We actually check if the function exists in the interface section.
       // We actually check if the function exists in the interface section.
-      else if (msDelphi in CurrentModeswitches)
+      else if (not IsAnonymous)
+          and (msDelphi in CurrentModeswitches)
           and (Assigned(CurModule.ImplementationSection)
           and (Assigned(CurModule.ImplementationSection)
             or (CurModule is TPasProgram))
             or (CurModule is TPasProgram))
           then
           then
@@ -4956,12 +4966,13 @@ begin
       UnGetToken;
       UnGetToken;
     end;
     end;
   ModTokenCount:=0;
   ModTokenCount:=0;
+  //writeln('TPasParser.ParseProcedureOrFunction IsProcType=',IsProcType,' IsAnonymous=',IsAnonymous);
   Repeat
   Repeat
     inc(ModTokenCount);
     inc(ModTokenCount);
-    // Writeln(ModTokenCount, curtokentext);
+    //writeln('TPasParser.ParseProcedureOrFunction ',ModTokenCount,' ',CurToken,' ',CurTokenText);
     LastToken:=CurToken;
     LastToken:=CurToken;
     NextToken;
     NextToken;
-    if (CurToken = tkEqual) and not IsProc and (ModTokenCount<=3) then
+    if (CurToken = tkEqual) and IsProcType and (ModTokenCount<=3) then
       begin
       begin
       // for example: const p: procedure = nil;
       // for example: const p: procedure = nil;
       UngetToken;
       UngetToken;
@@ -4970,6 +4981,8 @@ begin
       end;
       end;
     If CurToken=tkSemicolon then
     If CurToken=tkSemicolon then
       begin
       begin
+      if IsAnonymous then
+        CheckToken(tkbegin); // begin expected, but ; found
       if LastToken=tkSemicolon then
       if LastToken=tkSemicolon then
         ParseExcSyntaxError;
         ParseExcSyntaxError;
       continue;
       continue;
@@ -4991,22 +5004,25 @@ begin
           NextToken; // remove offset
           NextToken; // remove offset
           end;
           end;
       end;
       end;
-      if IsProc then
-        ExpectTokens([tkSemicolon])
-      else
+      if IsProcType then
         begin
         begin
         ExpectTokens([tkSemicolon,tkEqual]);
         ExpectTokens([tkSemicolon,tkEqual]);
         if CurToken=tkEqual then
         if CurToken=tkEqual then
           UngetToken;
           UngetToken;
-        end;
+        end
+      else if IsAnonymous then
+      else
+        ExpectTokens([tkSemicolon]);
       end
       end
-    else if IsAnonymProc and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
-      HandleProcedureModifier(Parent,PM)
-    else if IsProc and not IsAnonymProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+    else if IsAnonymous and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
       HandleProcedureModifier(Parent,PM)
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
       HandleProcedureTypeModifier(Element,PTM)
       HandleProcedureTypeModifier(Element,PTM)
-    else if (CurToken=tklibrary) then // library is a token and a directive.
+    else if (not IsProcType) and (not IsAnonymous)
+        and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+      HandleProcedureModifier(Parent,PM)
+    else if (CurToken=tklibrary) and not IsProcType and not IsAnonymous then
+      // library is a token and a directive.
       begin
       begin
       Tok:=UpperCase(CurTokenString);
       Tok:=UpperCase(CurTokenString);
       NextToken;
       NextToken;
@@ -5022,10 +5038,10 @@ begin
         ExpectToken(tkSemicolon);
         ExpectToken(tkSemicolon);
         end;
         end;
       end
       end
-    else if (not IsAnonymProc) and DoCheckHint(Element) then
+    else if (not IsAnonymous) and DoCheckHint(Element) then
       // deprecated,platform,experimental,library, unimplemented etc
       // deprecated,platform,experimental,library, unimplemented etc
       ConsumeSemi
       ConsumeSemi
-    else if (CurToken=tkIdentifier) and (not IsAnonymProc)
+    else if (CurToken=tkIdentifier) and (not IsAnonymous)
         and (CompareText(CurTokenText,'alias')=0) then
         and (CompareText(CurTokenText,'alias')=0) then
       begin
       begin
       ExpectToken(tkColon);
       ExpectToken(tkColon);
@@ -5059,11 +5075,11 @@ begin
       if LastToken=tkSemicolon then
       if LastToken=tkSemicolon then
         begin
         begin
         UngetToken;
         UngetToken;
-        if IsAnonymProc and (ModTokenCount<=1) then
+        if IsAnonymous then
           ParseExcSyntaxError;
           ParseExcSyntaxError;
         break;
         break;
         end
         end
-      else if IsAnonymProc then
+      else if IsAnonymous then
         begin
         begin
         UngetToken;
         UngetToken;
         break;
         break;
@@ -5079,15 +5095,15 @@ begin
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
     TPasOperator(Parent).CorrectName;
   Engine.FinishScope(stProcedureHeader,Element);
   Engine.FinishScope(stProcedureHeader,Element);
-  if IsProc
+  if (not IsProcType)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
   and (not TPasProcedure(Parent).IsExternal)
   and ((Parent.Parent is TImplementationSection)
   and ((Parent.Parent is TImplementationSection)
      or (Parent.Parent is TProcedureBody)
      or (Parent.Parent is TProcedureBody)
-     or IsAnonymProc)
+     or IsAnonymous)
   then
   then
     ParseProcedureBody(Parent);
     ParseProcedureBody(Parent);
-  if IsProc then
+  if not IsProcType then
     Engine.FinishScope(stProcedure,Parent);
     Engine.FinishScope(stProcedure,Parent);
 end;
 end;
 
 
@@ -5380,7 +5396,9 @@ begin
   AsmBlock:=TPasImplAsmStatement(CreateElement(TPasImplAsmStatement,'',Parent));
   AsmBlock:=TPasImplAsmStatement(CreateElement(TPasImplAsmStatement,'',Parent));
   Parent.Body:=AsmBlock;
   Parent.Body:=AsmBlock;
   ParseAsmBlock(AsmBlock);
   ParseAsmBlock(AsmBlock);
-  ExpectToken(tkSemicolon);
+  NextToken;
+  if not (Parent.Parent is TPasAnonymousProcedure) then
+    CheckToken(tkSemicolon);
 end;
 end;
 
 
 procedure TPasParser.ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
 procedure TPasParser.ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
@@ -5463,9 +5481,13 @@ var
   {$ENDIF}
   {$ENDIF}
 
 
   function CloseBlock: boolean; // true if parent reached
   function CloseBlock: boolean; // true if parent reached
+  var C: TPasImplBlockClass;
   begin
   begin
-    if CurBlock.ClassType=TPasImplExceptOn then
-      Engine.FinishScope(stExceptOnStatement,CurBlock);
+    C:=TPasImplBlockClass(CurBlock.ClassType);
+    if C=TPasImplExceptOn then
+      Engine.FinishScope(stExceptOnStatement,CurBlock)
+    else if C=TPasImplWithDo then
+      Engine.FinishScope(stWithExpr,CurBlock);
     CurBlock:=CurBlock.Parent as TPasImplBlock;
     CurBlock:=CurBlock.Parent as TPasImplBlock;
     Result:=CurBlock=Parent;
     Result:=CurBlock=Parent;
   end;
   end;
@@ -5717,11 +5739,12 @@ begin
           CheckSemicolon;
           CheckSemicolon;
           SrcPos:=CurTokenPos;
           SrcPos:=CurTokenPos;
           NextToken;
           NextToken;
+          El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
           Left:=DoParseExpression(CurBlock);
           Left:=DoParseExpression(CurBlock);
           //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
           //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
-          El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
           TPasImplWithDo(El).AddExpression(Left);
           TPasImplWithDo(El).AddExpression(Left);
           Left.Parent:=El;
           Left.Parent:=El;
+          Engine.BeginScope(stWithExpr,Left);
           Left:=nil;
           Left:=nil;
           CreateBlock(TPasImplWithDo(El));
           CreateBlock(TPasImplWithDo(El));
           El:=nil;
           El:=nil;
@@ -5733,6 +5756,7 @@ begin
             Left:=DoParseExpression(CurBlock);
             Left:=DoParseExpression(CurBlock);
             //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
             //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
             TPasImplWithDo(CurBlock).AddExpression(Left);
             TPasImplWithDo(CurBlock).AddExpression(Left);
+            Engine.BeginScope(stWithExpr,Left);
             Left:=nil;
             Left:=nil;
           until false;
           until false;
         end;
         end;
@@ -6160,7 +6184,7 @@ begin
     else
     else
       Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
       Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
     end;
     end;
-    ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
+    ParseProcedureOrFunction(Result, Result.ProcType, ProcType, False);
     Result.Hints:=Result.ProcType.Hints;
     Result.Hints:=Result.ProcType.Hints;
     Result.HintMessage:=Result.ProcType.HintMessage;
     Result.HintMessage:=Result.ProcType.HintMessage;
     // + is detected as 'positive', but is in fact Add if there are 2 arguments.
     // + is detected as 'positive', but is in fact Add if there are 2 arguments.

+ 10 - 1
packages/fcl-passrc/src/pscanner.pp

@@ -486,6 +486,7 @@ type
     FIncludePaths: TStringList;
     FIncludePaths: TStringList;
     FStrictFileCase : Boolean;
     FStrictFileCase : Boolean;
   Protected
   Protected
+    function FindIncludeFileName(const aFilename: string): String; virtual; abstract;
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
     Property IncludePaths: TStringList Read FIncludePaths;
     Property IncludePaths: TStringList Read FIncludePaths;
@@ -509,7 +510,7 @@ type
     FUseStreams: Boolean;
     FUseStreams: Boolean;
     {$endif}
     {$endif}
   Protected
   Protected
-    Function FindIncludeFileName(const AName: string): String; virtual;
+    Function FindIncludeFileName(const AName: string): String; override;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
   Public
   Public
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindSourceFile(const AName: string): TLineReader; override;
@@ -530,6 +531,8 @@ type
     function FindStream(const AName: string; ScanIncludes: Boolean): TStream;
     function FindStream(const AName: string; ScanIncludes: Boolean): TStream;
     function FindStreamReader(const AName: string; ScanIncludes: Boolean): TLineReader;
     function FindStreamReader(const AName: string; ScanIncludes: Boolean): TLineReader;
     procedure SetOwnsStreams(AValue: Boolean);
     procedure SetOwnsStreams(AValue: Boolean);
+  Protected
+    function FindIncludeFileName(const aFilename: string): String; override;
   Public
   Public
     constructor Create; override;
     constructor Create; override;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -2539,6 +2542,12 @@ begin
   FOwnsStreams:=AValue;
   FOwnsStreams:=AValue;
 end;
 end;
 
 
+function TStreamResolver.FindIncludeFileName(const aFilename: string): String;
+begin
+  raise EFileNotFoundError.Create('TStreamResolver.FindIncludeFileName not supported '+aFilename);
+  Result:='';
+end;
+
 constructor TStreamResolver.Create;
 constructor TStreamResolver.Create;
 begin
 begin
   Inherited;
   Inherited;

+ 235 - 24
packages/fcl-passrc/tests/tcresolver.pas

@@ -448,23 +448,23 @@ type
     Procedure TestProc_Absolute;
     Procedure TestProc_Absolute;
 
 
     // anonymous procs
     // anonymous procs
-    // ToDo: fppas2js: check "is TPasFunction", ".FuncType", "parent is TPasProcedureBody"
     Procedure TestAnonymousProc_Assign;
     Procedure TestAnonymousProc_Assign;
-    // ToDo: does Delphi allow/require semicolon in assign?
+    Procedure TestAnonymousProc_AssignSemicolonFail;
+    Procedure TestAnonymousProc_Assign_ReferenceToMissingFail;
+    Procedure TestAnonymousProc_Assign_WrongParamListFail;
     Procedure TestAnonymousProc_Arg;
     Procedure TestAnonymousProc_Arg;
-    // ToDo: does Delphi allow/require semicolon in arg?
-    // ToDo: does Delphi allow calling directly?: function(i: word):word begin end(3)
+    Procedure TestAnonymousProc_ArgSemicolonFail;
     Procedure TestAnonymousProc_EqualFail;
     Procedure TestAnonymousProc_EqualFail;
-    // ToDo: does Delphi allow ano proc in const?
     Procedure TestAnonymousProc_ConstFail;
     Procedure TestAnonymousProc_ConstFail;
-    // ToDo: does Delphi allow assembler or calling conventions?
     Procedure TestAnonymousProc_Assembler;
     Procedure TestAnonymousProc_Assembler;
     Procedure TestAnonymousProc_NameFail;
     Procedure TestAnonymousProc_NameFail;
     Procedure TestAnonymousProc_StatementFail;
     Procedure TestAnonymousProc_StatementFail;
-    Procedure TestAnonymousProc_Typecast;// ToDo
-    // ToDo: ano in with
-    // ToDo: ano in nested
-    // ToDo: ano in ano
+    Procedure TestAnonymousProc_Typecast_ObjFPC;
+    Procedure TestAnonymousProc_Typecast_Delphi;
+    Procedure TestAnonymousProc_TypecastToResultFail;
+    Procedure TestAnonymousProc_With;
+    Procedure TestAnonymousProc_ExceptOn;
+    Procedure TestAnonymousProc_Nested;
 
 
     // record
     // record
     Procedure TestRecord;
     Procedure TestRecord;
@@ -2233,6 +2233,11 @@ begin
       if TParamsExpr(El).Params[i].Parent<>El then
       if TParamsExpr(El).Params[i].Parent<>El then
         E('TParamsExpr(El).Params[i].Parent='+GetObjName(TParamsExpr(El).Params[i].Parent)+'<>El');
         E('TParamsExpr(El).Params[i].Parent='+GetObjName(TParamsExpr(El).Params[i].Parent)+'<>El');
     end
     end
+  else if El is TProcedureExpr then
+    begin
+    if (TProcedureExpr(El).Proc<>nil) and (TProcedureExpr(El).Proc.Parent<>El) then
+      E('TProcedureExpr(El).Proc.Parent='+GetObjName(TProcedureExpr(El).Proc.Parent)+'<>El');
+    end
   else if El is TPasDeclarations then
   else if El is TPasDeclarations then
     begin
     begin
     for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
     for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
@@ -3729,7 +3734,8 @@ begin
   '  aString:=str(f);',
   '  aString:=str(f);',
   '  aString:=str(f:3);',
   '  aString:=str(f:3);',
   '  str(f,aString);',
   '  str(f,aString);',
-  '  writestr(astring,f,i);']);
+  '  writestr(astring,f,i);',
+  '  val(aString,f,i);']);
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
@@ -7168,13 +7174,67 @@ begin
   '    Result:=a+b;',
   '    Result:=a+b;',
   '    exit(b);',
   '    exit(b);',
   '    exit(Result);',
   '    exit(Result);',
-  '  end;',
-  '  a:=3;',// test semicolon
+  '  end;',// test semicolon
+  '  a:=3;',
   'end;',
   'end;',
-  'begin']);
+  'begin',
+  '  Func:=function(c:word):word begin',
+  '    Result:=3+c;',
+  '    exit(c);',
+  '    exit(Result);',
+  '  end;']);
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestAnonymousProc_AssignSemicolonFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(a: word);',
+  'var p: TProc;',
+  'begin',
+  '  p:=procedure; begin end;',
+  '  a:=3;',
+  'end;',
+  'begin']);
+  CheckParserException('Expected "begin" at token ";" in file afile.pp at line 7 column 15',
+    nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Assign_ReferenceToMissingFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = procedure;',
+  'procedure DoIt;',
+  'var p: TProc;',
+  'begin',
+  '  p:=procedure(w: word) begin end;',
+  'end;',
+  'begin']);
+  CheckResolverException('procedural type modifier "reference to" mismatch',
+    nXModifierMismatchY);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Assign_WrongParamListFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt;',
+  'var p: TProc;',
+  'begin',
+  '  p:=procedure(w: word) begin end;',
+  'end;',
+  'begin']);
+  CheckResolverException('Incompatible types, got 0 parameters, expected 1',
+    nIncompatibleTypesGotParametersExpected);
+end;
+
 procedure TTestResolver.TestAnonymousProc_Arg;
 procedure TTestResolver.TestAnonymousProc_Arg;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7190,13 +7250,30 @@ begin
   '  DoIt(function(b:word): word',
   '  DoIt(function(b:word): word',
   '    begin',
   '    begin',
   '      Result:=1+b;',
   '      Result:=1+b;',
-  '    end;);',
-  '  DoMore(procedure begin end;, procedure begin end);',
+  '    end);',
+  '  DoMore(procedure begin end, procedure begin end);',
   'end;',
   'end;',
-  'begin']);
+  'begin',
+  '  DoMore(procedure begin end, procedure begin end);',
+  '']);
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestAnonymousProc_ArgSemicolonFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  'end;',
+  'begin',
+  '  DoIt(procedure begin end;);']);
+  CheckParserException('Expected "," at token ";" in file afile.pp at line 8 column 27',
+    nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestAnonymousProc_EqualFail;
 procedure TTestResolver.TestAnonymousProc_EqualFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7209,7 +7286,7 @@ begin
   '  if w=function(b:word): word',
   '  if w=function(b:word): word',
   '    begin',
   '    begin',
   '      Result:=1+b;',
   '      Result:=1+b;',
-  '    end; then ;',
+  '    end then ;',
   'end;',
   'end;',
   'begin']);
   'begin']);
   CheckResolverException('Incompatible types: got "Procedure/Function" expected "Word"',nIncompatibleTypesGotExpected);
   CheckResolverException('Incompatible types: got "Procedure/Function" expected "Word"',nIncompatibleTypesGotExpected);
@@ -7233,10 +7310,13 @@ begin
   Add([
   Add([
   'type',
   'type',
   '  TProc = reference to procedure;',
   '  TProc = reference to procedure;',
+  '  TProcB = reference to procedure cdecl;',
   'procedure DoIt(p: TProc);',
   'procedure DoIt(p: TProc);',
+  'var b: TProcB;',
   'begin',
   'begin',
-  '  p:=procedure assembler; asm end;',
-  '  p:=procedure() assembler; asm end;',
+  '  p:=procedure assembler asm end;',
+  '  p:=procedure() assembler asm end;',
+  '  b:=procedure() cdecl assembler asm end;',
   'end;',
   'end;',
   'begin']);
   'begin']);
   ParseProgram;
   ParseProgram;
@@ -7268,18 +7348,149 @@ begin
   CheckParserException(SParserSyntaxError,nParserSyntaxError);
   CheckParserException(SParserSyntaxError,nParserSyntaxError);
 end;
 end;
 
 
-procedure TTestResolver.TestAnonymousProc_Typecast;
+procedure TTestResolver.TestAnonymousProc_Typecast_ObjFPC;
 begin
 begin
-  exit;
+  StartProgram(false);
+  Add([
+  '{$mode ObjFPC}',
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TArr = array of word;',
+  '  TFuncArr = reference to function: TArr;',
+  'procedure DoIt(p: TProc);',
+  'var',
+  '  w: word;',
+  '  a: TArr;',
+  'begin',
+  '  p:=TProc(procedure(b: smallint) begin end);',
+  '  a:=TFuncArr(function: TArr begin end)();',
+  '  w:=TFuncArr(function: TArr begin end)()[3];',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
 
 
+procedure TTestResolver.TestAnonymousProc_Typecast_Delphi;
+begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
+  '{$mode Delphi}',
   'type',
   'type',
   '  TProc = reference to procedure(w: word);',
   '  TProc = reference to procedure(w: word);',
+  '  TArr = array of word;',
+  '  TFuncArr = reference to function: TArr;',
   'procedure DoIt(p: TProc);',
   'procedure DoIt(p: TProc);',
+  'var',
+  '  w: word;',
+  '  a: TArr;',
+  'begin',
+  '  p:=TProc(procedure(b: smallint) begin end);',
+  '  a:=TFuncArr(function: TArr begin end)();',
+  '  w:=TFuncArr(function: TArr begin end)()[3];',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_TypecastToResultFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'var i: longint;',
+  'begin',
+  '  i:=longint(function(b: byte): byte begin end);',
+  'end;',
+  'begin']);
+  CheckResolverException('Illegal type conversion: "Procedure/Function" to "Longint"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestAnonymousProc_With;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TObject = class end;',
+  '  TBird = class',
+  '    {#bool}b: boolean;',
+  '  end;',
+  'procedure DoIt({#i}i: longint);',
+  'var',
+  '  {#p}p: TProc;',
+  '  {#bird}bird: TBird;',
+  'begin',
+  '  with {@bird}bird do',
+  '    {@p}p:=procedure({#w}w: word)',
+  '      begin',
+  '        {@bool}b:=true;',
+  '        {@bool}b:=({@w}w+{@i}i)>2;',
+  '      end;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_ExceptOn;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class end;',
+  '  Exception = class',
+  '    {#bool}b: boolean;',
+  '  end;',
+  'procedure DoIt;',
+  'var',
+  '  {#p}p: TProc;',
+  'begin',
+  '  try',
+  '  except',
+  '    on {#E}E: Exception do',
+  '    {@p}p:=procedure',
+  '      begin',
+  '        {@E}E.{@bool}b:=true;',
+  '      end;',
+  '  end;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_Nested;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class',
+  '    i: byte;',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TObject.DoIt;',
+  'var',
+  '  p: TProc;',
+  '  procedure Sub;',
+  '  begin',
+  '    p:=procedure',
+  '      begin',
+  '        i:=3;',
+  '        Self.i:=4;',
+  '        p:=procedure',
+  '            procedure SubSub;',
+  '            begin',
+  '              i:=13;',
+  '              Self.i:=14;',
+  '            end;',
+  '          begin',
+  '            i:=13;',
+  '            Self.i:=14;',
+  '          end;',
+  '      end;',
+  '  end;',
   'begin',
   'begin',
-  '  p:=TProc(procedure(b: byte) begin end);',
-  '  p:=TProc(procedure(b: byte) begin end;);',
   'end;',
   'end;',
   'begin']);
   'begin']);
   ParseProgram;
   ParseProgram;

+ 22 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -72,6 +72,7 @@ type
     procedure TestM_NestedFuncResult;
     procedure TestM_NestedFuncResult;
     procedure TestM_Enums;
     procedure TestM_Enums;
     procedure TestM_ProcedureType;
     procedure TestM_ProcedureType;
+    procedure TestM_AnonymousProc;
     procedure TestM_Params;
     procedure TestM_Params;
     procedure TestM_Class;
     procedure TestM_Class;
     procedure TestM_ClassForward;
     procedure TestM_ClassForward;
@@ -999,6 +1000,27 @@ begin
   AnalyzeProgram;
   AnalyzeProgram;
 end;
 end;
 
 
+procedure TTestUseAnalyzer.TestM_AnonymousProc;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#TProc_used}TProc = reference to procedure;',
+  'procedure {#DoIt_used}DoIt;',
+  'var',
+  '  {#p_used}p: TProc;',
+  '  {#i_used}i: longint;',
+  'begin',
+  '  p:=procedure',
+  '    begin',
+  '      i:=3;',
+  '    end;',
+  'end;',
+  'begin',
+  '  DoIt;']);
+  AnalyzeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestM_Params;
 procedure TTestUseAnalyzer.TestM_Params;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 1 - 1
packages/fcl-process/src/processbody.inc

@@ -80,7 +80,7 @@ Type
     Function  GetExitCode : Integer;
     Function  GetExitCode : Integer;
     Function  GetRunning : Boolean;
     Function  GetRunning : Boolean;
     Function  GetWindowRect : TRect;
     Function  GetWindowRect : TRect;
-    procedure SetCommandLine(const AValue: TProcessString);
+    procedure SetCommandLine(const AValue: TProcessString); deprecated;
     procedure SetParameters(const AValue: TProcessStrings);
     procedure SetParameters(const AValue: TProcessStrings);
     Procedure SetWindowRect (Value : TRect);
     Procedure SetWindowRect (Value : TRect);
     Procedure SetShowWindow (Value : TShowWindowOptions);
     Procedure SetShowWindow (Value : TShowWindowOptions);

+ 20 - 4
packages/fpmkunit/src/fpmkunit.pp

@@ -890,6 +890,7 @@ Type
     Property SupportBuildModes: TBuildModes read FSupportBuildModes write FSupportBuildModes;
     Property SupportBuildModes: TBuildModes read FSupportBuildModes write FSupportBuildModes;
     Property BuildMode: TBuildMode read FBuildMode;
     Property BuildMode: TBuildMode read FBuildMode;
     Property Flags: TStrings read FFlags;
     Property Flags: TStrings read FFlags;
+    Property PackageVersion: TFPVersion read FVersion;
     // Options which are passed to the compiler for packages which depend on
     // Options which are passed to the compiler for packages which depend on
     // this package.
     // this package.
     Property TransmitOptions: TStrings Read GetTransmitOptions Write SetTransmitOptions;
     Property TransmitOptions: TStrings Read GetTransmitOptions Write SetTransmitOptions;
@@ -1682,6 +1683,7 @@ ResourceString
   SWarngcclibpath         = 'Warning: Unable to determine the libgcc path.';
   SWarngcclibpath         = 'Warning: Unable to determine the libgcc path.';
   SWarnNoFCLProcessSupport= 'No FCL-Process support';
   SWarnNoFCLProcessSupport= 'No FCL-Process support';
   SWarnRetryRemDirectory     = 'Failed to remove directory "%s". Retry after a short delay';
   SWarnRetryRemDirectory     = 'Failed to remove directory "%s". Retry after a short delay';
+  SWarnRetryDeleteFile       = 'Failed to remove file "%f". Retry after a short delay';
   SWarnCombinedPathAndUDir= 'Warning: Better do not combine the SearchPath and Global/Local-UnitDir parameters';
   SWarnCombinedPathAndUDir= 'Warning: Better do not combine the SearchPath and Global/Local-UnitDir parameters';
   SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
   SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
 
 
@@ -4368,7 +4370,7 @@ begin
   else If UnixPaths then
   else If UnixPaths then
     Result:=Prefix+'share'+PathDelim+'doc'+PathDelim+'fpc-$(CompilerVersion)'+PathDelim+'$(PackageName)'
     Result:=Prefix+'share'+PathDelim+'doc'+PathDelim+'fpc-$(CompilerVersion)'+PathDelim+'$(PackageName)'
   else
   else
-    Result:=BaseInstallDir+'docs'+PathDelim+'$(PackageName)';
+    Result:=BaseInstallDir+'doc'+PathDelim+'$(PackageName)';
 end;
 end;
 
 
 
 
@@ -5830,13 +5832,27 @@ end;
 
 
 
 
 procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
 procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
+var retries : integer;
+    res : boolean;
 begin
 begin
   if not FileExists(AFileName) then
   if not FileExists(AFileName) then
     Log(vldebug,SDbgFileDoesNotExist,[AFileName])
     Log(vldebug,SDbgFileDoesNotExist,[AFileName])
-  else If Not SysUtils.DeleteFile(AFileName) then
-    Error(SErrDeletingFile,[AFileName])
   else
   else
-    Log(vlInfo,SInfoDeletedFile,[AFileName]);
+    begin
+      retries := 2;
+      res := SysUtils.DeleteFile(AFileName);
+      while not res and (retries>0) do
+        begin
+           log(vlWarning, SWarnRetryDeleteFile, [AFileName]);
+           sleep(5000);
+           dec(retries);
+           res := SysUtils.DeleteFile(AFileName);
+        end;
+     if not res then
+       Error(SErrDeletingFile,[AFileName])
+     else
+       Log(vlInfo,SInfoDeletedFile,[AFileName]);
+   end;
 end;
 end;
 
 
 procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);
 procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);

+ 1 - 1
packages/graph/src/inc/graphh.inc

@@ -618,7 +618,7 @@ TYPE
       MaxY: word;                { Max. column.                    }
       MaxY: word;                { Max. column.                    }
       DirectColor: boolean;         { Is this a direct color mode??   }
       DirectColor: boolean;         { Is this a direct color mode??   }
       Hardwarepages: byte;          { total number of image pages - 1 }
       Hardwarepages: byte;          { total number of image pages - 1 }
-      ModeName: String[18];
+      ModeName: String[32];
       { necessary hooks ... }
       { necessary hooks ... }
       DirectPutPixel : DefPixelProc;
       DirectPutPixel : DefPixelProc;
       GetPixel       : GetPixelProc;
       GetPixel       : GetPixelProc;

+ 1 - 1
packages/graph/src/win32/graph.pp

@@ -2190,7 +2190,7 @@ function queryadapterinfo : pmodeinfo;
           mode.PaletteSize := mode.MaxColor;
           mode.PaletteSize := mode.MaxColor;
           mode.DirectColor := FALSE;
           mode.DirectColor := FALSE;
           mode.MaxX := 1023;
           mode.MaxX := 1023;
-          mode.MaxY := 768;
+          mode.MaxY := 767;
           SetupWin32GUIDefault;
           SetupWin32GUIDefault;
           mode.XAspect := 10000;
           mode.XAspect := 10000;
           mode.YAspect := 10000;
           mode.YAspect := 10000;

文件差异内容过多而无法显示
+ 284 - 112
packages/pastojs/src/fppas2js.pp


+ 281 - 205
packages/pastojs/src/pas2jscompiler.pp

@@ -37,13 +37,13 @@ uses
   {$ENDIF}
   {$ENDIF}
   // !! No filesystem units here.
   // !! No filesystem units here.
   Classes, SysUtils, contnrs,
   Classes, SysUtils, contnrs,
-  jstree, jswriter, JSSrcMap,
+  jsbase, jstree, jswriter, JSSrcMap,
   PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
   PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
   FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser;
   FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser;
 
 
 const
 const
   VersionMajor = 1;
   VersionMajor = 1;
-  VersionMinor = 1;
+  VersionMinor = 3;
   VersionRelease = 1;
   VersionRelease = 1;
   VersionExtra = '';
   VersionExtra = '';
   DefaultConfigFile = 'pas2js.cfg';
   DefaultConfigFile = 'pas2js.cfg';
@@ -54,6 +54,8 @@ const
   nOptionIsEnabled = 101; sOptionIsEnabled = 'Option "%s" is %s';
   nOptionIsEnabled = 101; sOptionIsEnabled = 'Option "%s" is %s';
   nSyntaxModeIs = 102; sSyntaxModeIs = 'Syntax mode is %s';
   nSyntaxModeIs = 102; sSyntaxModeIs = 'Syntax mode is %s';
   nMacroDefined = 103; sMacroDefined = 'Macro defined: %s';
   nMacroDefined = 103; sMacroDefined = 'Macro defined: %s';
+  // 104 in unit Pas2JSFS
+  // 105 in unit Pas2JSFS
   nNameValue = 106; sNameValue = '%s: %s';
   nNameValue = 106; sNameValue = '%s: %s';
   nReadingOptionsFromFile = 107; sReadingOptionsFromFile = 'Reading options from file %s';
   nReadingOptionsFromFile = 107; sReadingOptionsFromFile = 'Reading options from file %s';
   nEndOfReadingConfigFile = 108; sEndOfReadingConfigFile = 'End of reading config file %s';
   nEndOfReadingConfigFile = 108; sEndOfReadingConfigFile = 'End of reading config file %s';
@@ -92,6 +94,7 @@ const
   nPostProcessorFailX = 141; sPostProcessorFailX = 'Post processor failed: %s';
   nPostProcessorFailX = 141; sPostProcessorFailX = 'Post processor failed: %s';
   nPostProcessorWarnX = 142; sPostProcessorWarnX = 'Post processor: %s';
   nPostProcessorWarnX = 142; sPostProcessorWarnX = 'Post processor: %s';
   nPostProcessorFinished = 143; sPostProcessorFinished = 'Post processor finished';
   nPostProcessorFinished = 143; sPostProcessorFinished = 'Post processor finished';
+  nRTLIdentifierChanged = 144; sRTLIdentifierChanged = 'RTL identifier %s changed from %s to %s';
   // Note: error numbers 201+ are used by Pas2jsFileCache
   // Note: error numbers 201+ are used by Pas2jsFileCache
 
 
 //------------------------------------------------------------------------------
 //------------------------------------------------------------------------------
@@ -423,7 +426,6 @@ type
     Procedure CallPostProcessors(Const JSFileName: String; aWriter: TPas2JSMapper); virtual; abstract;
     Procedure CallPostProcessors(Const JSFileName: String; aWriter: TPas2JSMapper); virtual; abstract;
   end;
   end;
 
 
-
   { TPas2JSConfigSupport }
   { TPas2JSConfigSupport }
 
 
   TPas2JSConfigSupport = Class(TPas2JSCompilerSupport)
   TPas2JSConfigSupport = Class(TPas2JSCompilerSupport)
@@ -443,11 +445,11 @@ type
     function FindDefaultConfig: String; virtual; abstract;
     function FindDefaultConfig: String; virtual; abstract;
     function GetReader(aFileName: string): TSourceLineReader; virtual; abstract;
     function GetReader(aFileName: string): TSourceLineReader; virtual; abstract;
   Public
   Public
-    Constructor Create(aCompiler: TPas2jsCompiler); override;
-    Destructor Destroy; override;
+    constructor Create(aCompiler: TPas2jsCompiler); override;
+    destructor Destroy; override;
     procedure LoadDefaultConfig;
     procedure LoadDefaultConfig;
-    Procedure LoadConfig(Const aFileName: String);virtual;
-    Property Compiler:  TPas2jsCompiler Read FCompiler;
+    procedure LoadConfig(Const aFileName: String);virtual;
+    property Compiler:  TPas2jsCompiler Read FCompiler;
   end;
   end;
 
 
   { TPas2JSWPOptimizer }
   { TPas2JSWPOptimizer }
@@ -459,8 +461,8 @@ type
 
 
   TPas2jsCompiler = class
   TPas2jsCompiler = class
   private
   private
-    FMainJSFileResolved: String;
-    FIsMainJSFileResolved: Boolean;
+    FAllJSIntoMainJS: Boolean;
+    FConverterGlobals: TPasToJSConverterGlobals;
     FCompilerExe: string;
     FCompilerExe: string;
     FDefines: TStrings; // Objects can be TMacroDef
     FDefines: TStrings; // Objects can be TMacroDef
     FFS: TPas2jsFS;
     FFS: TPas2jsFS;
@@ -471,25 +473,25 @@ type
     FHasShownLogo: boolean;
     FHasShownLogo: boolean;
     FLog: TPas2jsLogger;
     FLog: TPas2jsLogger;
     FMainFile: TPas2jsCompilerFile;
     FMainFile: TPas2jsCompilerFile;
+    FMainJSFileResolved: String;
+    FMainJSFileIsResolved: Boolean;
+    FMainJSFile: String;
+    FMainSrcFile: String;
     FMode: TP2jsMode;
     FMode: TP2jsMode;
     FOptions: TP2jsCompilerOptions;
     FOptions: TP2jsCompilerOptions;
     FParamMacros: TPas2jsMacroEngine;
     FParamMacros: TPas2jsMacroEngine;
     FSrcMapSourceRoot: string;
     FSrcMapSourceRoot: string;
-    FTargetPlatform: TPasToJsPlatform;
-    FTargetProcessor: TPasToJsProcessor;
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
     FWPOAnalyzer: TPas2JSWPOptimizer;
     FWPOAnalyzer: TPas2JSWPOptimizer;
     FInterfaceType: TPasClassInterfaceType;
     FInterfaceType: TPasClassInterfaceType;
-    FRTLVersionCheck: TP2jsRTLVersionCheck;
     FPrecompileGUID: TGUID;
     FPrecompileGUID: TGUID;
     FInsertFilenames: TStringList;
     FInsertFilenames: TStringList;
     FNamespaces: TStringList;
     FNamespaces: TStringList;
     FNamespacesFromCmdLine: integer;
     FNamespacesFromCmdLine: integer;
-    FAllJSIntoMainJS: Boolean;
     FConfigSupport: TPas2JSConfigSupport;
     FConfigSupport: TPas2JSConfigSupport;
-    FMainJSFile: String;
-    FMainSrcFile: String;
     FSrcMapBaseDir: string;
     FSrcMapBaseDir: string;
+    FRTLVersionCheck: TP2jsRTLVersionCheck;
+    FPostProcessorSupport: TPas2JSPostProcessorSupport;
     procedure AddInsertJSFilename(const aFilename: string);
     procedure AddInsertJSFilename(const aFilename: string);
     Procedure AddNamespaces(const Paths: string; FromCmdLine: boolean);
     Procedure AddNamespaces(const Paths: string; FromCmdLine: boolean);
     function GetDefaultNamespace: String;
     function GetDefaultNamespace: String;
@@ -504,6 +506,8 @@ type
     function GetSrcMapEnable: boolean;
     function GetSrcMapEnable: boolean;
     function GetSrcMapInclude: boolean;
     function GetSrcMapInclude: boolean;
     function GetSrcMapXSSIHeader: boolean;
     function GetSrcMapXSSIHeader: boolean;
+    function GetTargetPlatform: TPasToJsPlatform;
+    function GetTargetProcessor: TPasToJsProcessor;
     function GetWriteDebugLog: boolean;
     function GetWriteDebugLog: boolean;
     function GetWriteMsgToStdErr: boolean;
     function GetWriteMsgToStdErr: boolean;
     function HandleOptionOptimization(C: Char; aValue: String): Boolean;
     function HandleOptionOptimization(C: Char; aValue: String): Boolean;
@@ -513,6 +517,8 @@ type
     function OnMacroCfgDir(Sender: TObject; var Params: string; Lvl: integer): boolean;
     function OnMacroCfgDir(Sender: TObject; var Params: string; Lvl: integer): boolean;
     procedure RemoveInsertJSFilename(const aFilename: string);
     procedure RemoveInsertJSFilename(const aFilename: string);
     function ResolvedMainJSFile: string;
     function ResolvedMainJSFile: string;
+    procedure SetAllJSIntoMainJS(AValue: Boolean);
+    procedure SetConverterGlobals(const AValue: TPasToJSConverterGlobals);
     procedure SetCompilerExe(AValue: string);
     procedure SetCompilerExe(AValue: string);
     procedure SetFS(AValue: TPas2jsFS);
     procedure SetFS(AValue: TPas2jsFS);
     procedure SetMode(AValue: TP2jsMode);
     procedure SetMode(AValue: TP2jsMode);
@@ -536,9 +542,10 @@ type
     procedure AddDefinesForTargetProcessor;
     procedure AddDefinesForTargetProcessor;
     procedure AddReadingModule(aFile: TPas2jsCompilerFile);
     procedure AddReadingModule(aFile: TPas2jsCompilerFile);
     procedure RemoveReadingModule(aFile: TPas2jsCompilerFile);
     procedure RemoveReadingModule(aFile: TPas2jsCompilerFile);
+    procedure RegisterMessages;
   private
   private
-    FPostProcessorSupport: TPas2JSPostProcessorSupport;
     // params, cfg files
     // params, cfg files
+    FCurParam: string;
     procedure LoadConfig(CfgFilename: string);
     procedure LoadConfig(CfgFilename: string);
     procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
     procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
     procedure ReadSingleLetterOptions(const Param: string; p: integer;
     procedure ReadSingleLetterOptions(const Param: string; p: integer;
@@ -546,8 +553,6 @@ type
     procedure ReadCodeGenerationFlags(Param: String; p: integer);
     procedure ReadCodeGenerationFlags(Param: String; p: integer);
     procedure ReadSyntaxFlags(Param: String; p: integer);
     procedure ReadSyntaxFlags(Param: String; p: integer);
     procedure ReadVerbosityFlags(Param: String; p: integer);
     procedure ReadVerbosityFlags(Param: String; p: integer);
-    procedure RegisterMessages;
-    procedure SetAllJSIntoMainJS(AValue: Boolean);
   protected
   protected
     // Create various other classes. Virtual so they can be overridden in descendents
     // Create various other classes. Virtual so they can be overridden in descendents
     function CreateJSMapper: TPas2JSMapper;virtual;
     function CreateJSMapper: TPas2JSMapper;virtual;
@@ -646,6 +651,7 @@ type
     property MainFile: TPas2jsCompilerFile read FMainFile;
     property MainFile: TPas2jsCompilerFile read FMainFile;
     property Mode: TP2jsMode read FMode write SetMode;
     property Mode: TP2jsMode read FMode write SetMode;
     property Options: TP2jsCompilerOptions read FOptions write SetOptions;
     property Options: TP2jsCompilerOptions read FOptions write SetOptions;
+    property ConverterGlobals: TPasToJSConverterGlobals read FConverterGlobals write SetConverterGlobals;
     property ParamMacros: TPas2jsMacroEngine read FParamMacros;
     property ParamMacros: TPas2jsMacroEngine read FParamMacros;
     property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID;
     property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID;
     property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck;
     property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck;
@@ -659,22 +665,22 @@ type
     property ShowTriedUsedFiles: boolean read GetShowTriedUsedFiles write SetShowTriedUsedFiles;
     property ShowTriedUsedFiles: boolean read GetShowTriedUsedFiles write SetShowTriedUsedFiles;
     property ShowUsedTools: boolean read GetShowUsedTools write SetShowUsedTools;
     property ShowUsedTools: boolean read GetShowUsedTools write SetShowUsedTools;
     property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
     property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
-    property TargetPlatform: TPasToJsPlatform read FTargetPlatform write SetTargetPlatform;
-    property TargetProcessor: TPasToJsProcessor read FTargetProcessor write SetTargetProcessor;
+    property TargetPlatform: TPasToJsPlatform read GetTargetPlatform write SetTargetPlatform;
+    property TargetProcessor: TPasToJsProcessor read GetTargetProcessor write SetTargetProcessor;
     property WPOAnalyzer: TPas2JSWPOptimizer read FWPOAnalyzer; // Whole Program Optimization
     property WPOAnalyzer: TPas2JSWPOptimizer read FWPOAnalyzer; // Whole Program Optimization
     property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
     property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
     property WriteMsgToStdErr: boolean read GetWriteMsgToStdErr write SetWriteMsgToStdErr;
     property WriteMsgToStdErr: boolean read GetWriteMsgToStdErr write SetWriteMsgToStdErr;
     property AllJSIntoMainJS: Boolean Read FAllJSIntoMainJS Write SetAllJSIntoMainJS;
     property AllJSIntoMainJS: Boolean Read FAllJSIntoMainJS Write SetAllJSIntoMainJS;
     property ExitCode: longint read GetExitCode write SetExitCode;
     property ExitCode: longint read GetExitCode write SetExitCode;
     property InsertFilenames: TStringList read FInsertFilenames;
     property InsertFilenames: TStringList read FInsertFilenames;
-    Property MainJSFile: String Read FMainJSFile Write FMainJSFile;
-    Property MainSrcFile: String Read FMainSrcFile Write FMainSrcFile;
+    property MainJSFile: String Read FMainJSFile Write FMainJSFile;
+    property MainSrcFile: String Read FMainSrcFile Write FMainSrcFile;
     property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim
     property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim
     property Namespaces: TStringList read FNamespaces;
     property Namespaces: TStringList read FNamespaces;
     property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
     property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
-    // Will be freed by compiler.
-    Property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport;
-    Property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
+    // can be set optionally, will be freed by compiler
+    property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport;
+    property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
   end;
   end;
 
 
 
 
@@ -713,7 +719,6 @@ end;
 
 
 { TPas2JSCompilerSupport }
 { TPas2JSCompilerSupport }
 
 
-
 constructor TPas2JSCompilerSupport.Create(aCompiler: TPas2JSCompiler);
 constructor TPas2JSCompilerSupport.Create(aCompiler: TPas2JSCompiler);
 begin
 begin
   FCompiler:=aCompiler;
   FCompiler:=aCompiler;
@@ -735,8 +740,6 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
-
-
 { TPCUSupport }
 { TPCUSupport }
 
 
 procedure TPCUSupport.RaiseInternalError(id: TMaxPrecInt; Msg: string);
 procedure TPCUSupport.RaiseInternalError(id: TMaxPrecInt; Msg: string);
@@ -1081,10 +1084,8 @@ procedure TPas2jsCompilerFile.CreateConverter;
 begin
 begin
   if FConverter<>nil then exit;
   if FConverter<>nil then exit;
   FConverter:=TPasToJSConverter.Create;
   FConverter:=TPasToJSConverter.Create;
-  FConverter.RTLVersion:=(VersionMajor*100+VersionMinor)*100+VersionRelease;
   FConverter.Options:=GetInitialConverterOptions;
   FConverter.Options:=GetInitialConverterOptions;
-  FConverter.TargetPlatform:=Compiler.TargetPlatform;
-  FConverter.TargetProcessor:=Compiler.TargetProcessor;
+  FConverter.Globals:=Compiler.ConverterGlobals;
 end;
 end;
 
 
 procedure TPas2jsCompilerFile.OnResolverCheckSrcName(const Element: TPasElement);
 procedure TPas2jsCompilerFile.OnResolverCheckSrcName(const Element: TPasElement);
@@ -2480,6 +2481,16 @@ begin
   Result:=coSourceMapXSSIHeader in FOptions;
   Result:=coSourceMapXSSIHeader in FOptions;
 end;
 end;
 
 
+function TPas2jsCompiler.GetTargetPlatform: TPasToJsPlatform;
+begin
+  Result:=FConverterGlobals.TargetPlatform;
+end;
+
+function TPas2jsCompiler.GetTargetProcessor: TPasToJsProcessor;
+begin
+  Result:=FConverterGlobals.TargetProcessor;
+end;
+
 function TPas2jsCompiler.GetWriteDebugLog: boolean;
 function TPas2jsCompiler.GetWriteDebugLog: boolean;
 begin
 begin
   Result:=coWriteDebugLog in FOptions;
   Result:=coWriteDebugLog in FOptions;
@@ -2576,20 +2587,26 @@ begin
 end;
 end;
 
 
 procedure TPas2jsCompiler.SetTargetPlatform(const AValue: TPasToJsPlatform);
 procedure TPas2jsCompiler.SetTargetPlatform(const AValue: TPasToJsPlatform);
+var
+  OldPlatform: TPasToJsPlatform;
 begin
 begin
-  if FTargetPlatform=AValue then Exit;
-  RemoveDefine(PasToJsPlatformNames[TargetPlatform]);
-  FTargetPlatform:=AValue;
-  if FTargetPlatform=PlatformNodeJS then
+  OldPlatform:=FConverterGlobals.TargetPlatform;
+  if OldPlatform=AValue then Exit;
+  RemoveDefine(PasToJsPlatformNames[OldPlatform]);
+  FConverterGlobals.TargetPlatform:=AValue;
+  if AValue=PlatformNodeJS then
     AllJSIntoMainJS:=true;
     AllJSIntoMainJS:=true;
   AddDefinesForTargetPlatform;
   AddDefinesForTargetPlatform;
 end;
 end;
 
 
 procedure TPas2jsCompiler.SetTargetProcessor(const AValue: TPasToJsProcessor);
 procedure TPas2jsCompiler.SetTargetProcessor(const AValue: TPasToJsProcessor);
+var
+  OldTargetProcessor: TPasToJsProcessor;
 begin
 begin
-  if FTargetProcessor=AValue then Exit;
-  RemoveDefine(PasToJsProcessorNames[TargetProcessor]);
-  FTargetProcessor:=AValue;
+  OldTargetProcessor:=FConverterGlobals.TargetProcessor;
+  if OldTargetProcessor=AValue then Exit;
+  RemoveDefine(PasToJsProcessorNames[OldTargetProcessor]);
+  FConverterGlobals.TargetProcessor:=AValue;
   AddDefinesForTargetProcessor;
   AddDefinesForTargetProcessor;
 end;
 end;
 
 
@@ -2634,6 +2651,75 @@ begin
   FReadingModules.Remove(aFile);
   FReadingModules.Remove(aFile);
 end;
 end;
 
 
+procedure TPas2jsCompiler.RegisterMessages;
+var
+  LastMsgNumber: integer;
+
+  procedure r(MsgType: TMessageType; MsgNumber: integer; const MsgPattern: string);
+  var
+    s: String;
+  begin
+    if (LastMsgNumber>=0) and (MsgNumber<>LastMsgNumber+1) then
+    begin
+      if MsgNumber>LastMsgNumber+1 then
+        s:='TPas2jsCompiler.RegisterMessages: gap in registered message numbers: '+IntToStr(LastMsgNumber+1)+' '+IntToStr(MsgNumber)
+      else
+        s:='TPas2jsCompiler.RegisterMessages: not ascending order in registered message numbers: Last='+IntToStr(LastMsgNumber)+' New='+IntToStr(MsgNumber);
+      RaiseInternalError(20170504161422,s);
+    end;
+    Log.RegisterMsg(MsgType,MsgNumber,MsgPattern);
+    LastMsgNumber:=MsgNumber;
+  end;
+
+begin
+  LastMsgNumber:=-1;
+  r(mtInfo,nOptionIsEnabled,sOptionIsEnabled);
+  r(mtInfo,nSyntaxModeIs,sSyntaxModeIs);
+  r(mtInfo,nMacroDefined,sMacroDefined);
+  r(mtInfo,nUsingPath,sUsingPath);
+  r(mtNote,nFolderNotFound,sFolderNotFound);
+  r(mtInfo,nNameValue,sNameValue);
+  r(mtInfo,nReadingOptionsFromFile,sReadingOptionsFromFile);
+  r(mtInfo,nEndOfReadingConfigFile,sEndOfReadingConfigFile);
+  r(mtDebug,nInterpretingFileOption,sInterpretingFileOption);
+  r(mtFatal,nSourceFileNotFound,sSourceFileNotFound);
+  r(mtFatal,nFileIsFolder,sFileIsFolder);
+  r(mtInfo,nConfigFileSearch,sConfigFileSearch);
+  r(mtDebug,nHandlingOption,sHandlingOption);
+  r(mtDebug,nQuickHandlingOption,sQuickHandlingOption);
+  r(mtFatal,nOutputDirectoryNotFound,sOutputDirectoryNotFound);
+  r(mtError,nUnableToWriteFile,sUnableToWriteFile);
+  r(mtInfo,nWritingFile,sWritingFile);
+  r(mtFatal,nCompilationAborted,sCompilationAborted);
+  r(mtDebug,nCfgDirective,sCfgDirective);
+  r(mtError,nUnitCycle,sUnitCycle);
+  r(mtError,nOptionForbidsCompile,sOptionForbidsCompile);
+  r(mtInfo,nUnitNeedsCompileDueToUsedUnit,sUnitsNeedCompileDueToUsedUnit);
+  r(mtInfo,nUnitNeedsCompileDueToOption,sUnitsNeedCompileDueToOption);
+  r(mtInfo,nUnitNeedsCompileJSMissing,sUnitsNeedCompileJSMissing);
+  r(mtInfo,nUnitNeedsCompilePasHasChanged,sUnitsNeedCompilePasHasChanged);
+  r(mtInfo,nParsingFile,sParsingFile);
+  r(mtInfo,nCompilingFile,sCompilingFile);
+  r(mtError,nExpectedButFound,sExpectedButFound);
+  r(mtInfo,nLinesInFilesCompiled,sLinesInFilesCompiled);
+  r(mtInfo,nTargetPlatformIs,sTargetPlatformIs);
+  r(mtInfo,nTargetProcessorIs,sTargetProcessorIs);
+  r(mtInfo,nMessageEncodingIs,sMessageEncodingIs);
+  r(mtError,nUnableToTranslatePathToDir,sUnableToTranslatePathToDir);
+  r(mtInfo,nSrcMapSourceRootIs,sSrcMapSourceRootIs);
+  r(mtInfo,nSrcMapBaseDirIs,sSrcMapBaseDirIs);
+  r(mtFatal,nUnitFileNotFound,sUnitFileNotFound);
+  r(mtInfo,nClassInterfaceStyleIs,sClassInterfaceStyleIs);
+  r(mtInfo,nMacroXSetToY,sMacroXSetToY);
+  r(mtInfo,nPostProcessorInfoX,sPostProcessorInfoX);
+  r(mtInfo,nPostProcessorRunX,sPostProcessorRunX);
+  r(mtError,nPostProcessorFailX,sPostProcessorFailX);
+  r(mtWarning,nPostProcessorWarnX,sPostProcessorWarnX);
+  r(mtInfo,nPostProcessorFinished,sPostProcessorFinished);
+  r(mtInfo,nRTLIdentifierChanged,sRTLIdentifierChanged);
+  Pas2jsPParser.RegisterMessages(Log);
+end;
+
 procedure TPas2JSConfigSupport.CfgSyntaxError(const Msg: string);
 procedure TPas2JSConfigSupport.CfgSyntaxError(const Msg: string);
 begin
 begin
   Compiler.Log.Log(mtError,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0);
   Compiler.Log.Log(mtError,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0);
@@ -2641,12 +2727,10 @@ begin
 end;
 end;
 
 
 procedure TPas2jsCompiler.LoadConfig(CfgFilename: string);
 procedure TPas2jsCompiler.LoadConfig(CfgFilename: string);
-
 begin
 begin
   ConfigSupport.LoadConfig(CfgFileName);
   ConfigSupport.LoadConfig(CfgFileName);
 end;
 end;
 
 
-
 procedure TPas2JSConfigSupport.LoadConfig(Const aFileName: String);
 procedure TPas2JSConfigSupport.LoadConfig(Const aFileName: String);
 type
 type
 
 
@@ -2837,7 +2921,6 @@ begin
     Compiler.Log.LogMsgIgnoreFilter(nEndOfReadingConfigFile,[QuoteStr(aFilename)]);
     Compiler.Log.LogMsgIgnoreFilter(nEndOfReadingConfigFile,[QuoteStr(aFilename)]);
 end;
 end;
 
 
-
 procedure TPas2JSConfigSupport.LoadDefaultConfig;
 procedure TPas2JSConfigSupport.LoadDefaultConfig;
 
 
 var
 var
@@ -2851,6 +2934,8 @@ end;
 
 
 procedure TPas2jsCompiler.ParamFatal(Msg: string);
 procedure TPas2jsCompiler.ParamFatal(Msg: string);
 begin
 begin
+  if FCurParam<>'' then
+    Msg:='parameter '+FCurParam+': '+Msg;
   if Assigned(ConfigSupport) and  (ConfigSupport.CurrentCfgFilename<>'') then
   if Assigned(ConfigSupport) and  (ConfigSupport.CurrentCfgFilename<>'') then
     Log.Log(mtFatal,Msg,0,ConfigSupport.CurrentCfgFilename,ConfigSupport.CurrentCfgLineNumber,0)
     Log.Log(mtFatal,Msg,0,ConfigSupport.CurrentCfgFilename,ConfigSupport.CurrentCfgLineNumber,0)
   else
   else
@@ -2918,17 +3003,19 @@ begin
 
 
 end;
 end;
 
 
-function TPas2jsCompiler.HandleOptionJS(C: Char; aValue: String; Quick, FromCmdLine: Boolean): Boolean;
+function TPas2jsCompiler.HandleOptionJS(C: Char; aValue: String;
+  Quick, FromCmdLine: Boolean): Boolean;
 
 
 Var
 Var
-  S, ErrorMsg: String;
+  S, ErrorMsg, aName: String;
   i: Integer;
   i: Integer;
   enable: Boolean;
   enable: Boolean;
+  pbi: TPas2JSBuiltInName;
 
 
 begin
 begin
   Result:=True;
   Result:=True;
   case c of
   case c of
-  'c':
+  'c': // -Jc concatenate
     begin
     begin
       if aValue='' then
       if aValue='' then
         AllJSIntoMainJS:=true
         AllJSIntoMainJS:=true
@@ -2937,25 +3024,25 @@ begin
       else
       else
         ParamFatal('invalid value (-Jc) "'+aValue+'"');
         ParamFatal('invalid value (-Jc) "'+aValue+'"');
     end;
     end;
-  'e':
+  'e': // -Je<encoding>
     begin
     begin
-    S:=NormalizeEncoding(aValue);
-    case S of
-    {$IFDEF FPC_HAS_CPSTRING}
-    'console','system',
-    {$ENDIF}
-    'utf8', 'json':
-      if Log.Encoding<>S then begin
-        Log.Encoding:=S;
-        if FHasShownEncoding then begin
-          FHasShownEncoding:=false;
-          WriteEncoding;
+      S:=NormalizeEncoding(aValue);
+      case S of
+      {$IFDEF FPC_HAS_CPSTRING}
+      'console','system',
+      {$ENDIF}
+      'utf8', 'json':
+        if Log.Encoding<>S then begin
+          Log.Encoding:=S;
+          if FHasShownEncoding then begin
+            FHasShownEncoding:=false;
+            WriteEncoding;
+          end;
         end;
         end;
+      else ParamFatal('invalid encoding (-Je) "'+aValue+'"');
       end;
       end;
-    else ParamFatal('invalid encoding (-Je) "'+aValue+'"');
-    end;
     end;
     end;
-  'i':
+  'i': // -Ji<js-file>
     if aValue='' then
     if aValue='' then
       ParamFatal('missing insertion file "'+aValue+'"')
       ParamFatal('missing insertion file "'+aValue+'"')
     else if not Quick then
     else if not Quick then
@@ -2972,9 +3059,9 @@ begin
       end else
       end else
         AddInsertJSFilename(aValue);
         AddInsertJSFilename(aValue);
     end;
     end;
-  'l': SetOption(coLowercase,aValue<>'-');
-  'm':
-    // source map options
+  'l': // -Jl
+    SetOption(coLowercase,aValue<>'-');
+  'm': // -Jm source map options
     if aValue='' then
     if aValue='' then
       SrcMapEnable:=true
       SrcMapEnable:=true
     else if aValue[1]='-' then
     else if aValue[1]='-' then
@@ -3015,31 +3102,49 @@ begin
       // enable source maps when setting any -Jm<x> option
       // enable source maps when setting any -Jm<x> option
       SrcMapEnable:=true;
       SrcMapEnable:=true;
     end;
     end;
-  'o':
+  'o': // -Jo<flag>
     begin
     begin
-      // -Jo<flag>
       S:=aValue;
       S:=aValue;
-      if S='' then
+      if aValue='' then
         ParamFatal('missing value of -Jo option');
         ParamFatal('missing value of -Jo option');
-      Enable:=true;
-      c:=S[length(S)];
-      if c in ['+','-'] then
+      if SameText(LeftStr(S,4),'rtl-') then
       begin
       begin
-        Enable:=c='+';
-        Delete(S,length(S),1);
-      end;
-      Case lowercase(S) of
-        'searchlikefpc': FS.SearchLikeFPC:=Enable;
-        'usestrict': SetOption(coUseStrict,Enable);
-        'checkversion=main': RTLVersionCheck:=rvcMain;
-        'checkversion=system': RTLVersionCheck:=rvcSystem;
-        'checkversion=unit': RTLVersionCheck:=rvcUnit;
-      else
-        Result:=False;
+        // -Jortl-<name>=<value>   set rtl identifier
+        i:=5;
+        while (i<=length(S)) and (S[i] in ['a'..'z','A'..'Z','0'..'9','_']) do
+          inc(i);
+        if (i>length(S)) or (S[i]<>'=') then
+          ParamFatal('expected -Jortl-name=value');
+        aName:='pbi'+copy(S,5,i-5);
+        S:=copy(S,i+1,255);
+        val(aName,pbi,i);
+        if i<>0 then
+          ParamFatal('unknown rtl identifier "'+aName+'"');
+        if IsValidJSIdentifier(TJSString(ConverterGlobals.BuiltInNames[pbi]))
+            and not IsValidJSIdentifier(TJSString(S)) then
+          ParamFatal('JavaScript identifier expected');
+        if not Quick then
+          ConverterGlobals.BuiltInNames[pbi]:=S;
+      end else begin
+        Enable:=true;
+        c:=S[length(S)];
+        if c in ['+','-'] then
+        begin
+          Enable:=c='+';
+          Delete(S,length(S),1);
+        end;
+        Case lowercase(S) of
+          'searchlikefpc': FS.SearchLikeFPC:=Enable;
+          'usestrict': SetOption(coUseStrict,Enable);
+          'checkversion=main': RTLVersionCheck:=rvcMain;
+          'checkversion=system': RTLVersionCheck:=rvcSystem;
+          'checkversion=unit': RTLVersionCheck:=rvcUnit;
+        else
+          Result:=False;
+        end;
       end;
       end;
     end;
     end;
-  'p':
-    // -Jp<...>
+  'p': // -Jp<...>
     begin
     begin
     if not Assigned(PostProcessorSupport) then
     if not Assigned(PostProcessorSupport) then
       ParamFatal('-Jp: No postprocessor support available');
       ParamFatal('-Jp: No postprocessor support available');
@@ -3051,14 +3156,15 @@ begin
         PostProcessorSupport.AddPostProcessor(aValue);
         PostProcessorSupport.AddPostProcessor(aValue);
       end;
       end;
     end;
     end;
-  'u':
+  'u': // -Ju<foreign path>
     if not Quick then
     if not Quick then
       begin
       begin
       ErrorMsg:=FS.AddForeignUnitPath(aValue,FromCmdLine);
       ErrorMsg:=FS.AddForeignUnitPath(aValue,FromCmdLine);
       if ErrorMsg<>'' then
       if ErrorMsg<>'' then
         ParamFatal('invalid foreign unit path (-Ju) "'+ErrorMsg+'"');
         ParamFatal('invalid foreign unit path (-Ju) "'+ErrorMsg+'"');
       end;
       end;
-  'U': HandleOptionPCUFormat(aValue);
+  'U': // -JU...
+    HandleOptionPCUFormat(aValue);
   else
   else
     Result:=False;
     Result:=False;
   end;
   end;
@@ -3082,7 +3188,7 @@ end;
 procedure TPas2jsCompiler.HandleOptionInfo(aValue: string);
 procedure TPas2jsCompiler.HandleOptionInfo(aValue: string);
 
 
 Var
 Var
-  infoMsg: String;
+  InfoMsg: String;
 
 
   procedure AppendInfo(Add: string);
   procedure AppendInfo(Add: string);
   begin
   begin
@@ -3096,7 +3202,8 @@ Var
   C,c2: Char;
   C,c2: Char;
   pr: TPasToJsProcessor;
   pr: TPasToJsProcessor;
   pl: TPasToJsPlatform;
   pl: TPasToJsPlatform;
-
+  s: string;
+  pbi: TPas2JSBuiltInName;
 begin
 begin
   // write information and halt
   // write information and halt
   InfoMsg:='';
   InfoMsg:='';
@@ -3109,7 +3216,7 @@ begin
   P:=1;
   P:=1;
   L:=Length(aValue);
   L:=Length(aValue);
   while p<=l do
   while p<=l do
-    begin
+  begin
     C:=aValue[P];
     C:=aValue[P];
     case C of
     case C of
     'D': // wite compiler date
     'D': // wite compiler date
@@ -3120,56 +3227,67 @@ begin
       AppendInfo(GetVersion(false));
       AppendInfo(GetVersion(false));
     'S':
     'S':
       begin
       begin
-      inc(p);
-      if p>l then
-        ParamFatal('missing info option after S in "'+aValue+'".');
-      C2:=aValue[p];
-      case C2 of
-      'O': // write source OS
-        AppendInfo(GetCompiledTargetOS);
-      'P': // write source processor
-        AppendInfo(GetCompiledTargetCPU);
-      else
-        ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
-      end;
+        inc(p);
+        if p>l then
+          ParamFatal('missing info option after S in "'+aValue+'".');
+        C2:=aValue[p];
+        case C2 of
+        'O': // write source OS
+          AppendInfo(GetCompiledTargetOS);
+        'P': // write source processor
+          AppendInfo(GetCompiledTargetCPU);
+        else
+          ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
+        end;
       end;
       end;
     'T':
     'T':
       begin
       begin
-      inc(p);
-      if p>l then
-        ParamFatal('missing info option after T in "'+aValue+'".');
-      C2:=aValue[p];
-      case C2 of
-      'O': // write target platform
-        AppendInfo(PasToJsPlatformNames[TargetPlatform]);
-      'P': // write target processor
-        AppendInfo(PasToJsProcessorNames[TargetProcessor]);
-      else
-        ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
-      end;
+        inc(p);
+        if p>l then
+          ParamFatal('missing info option after T in "'+aValue+'".');
+        C2:=aValue[p];
+        case C2 of
+        'O': // write target platform
+          AppendInfo(PasToJsPlatformNames[TargetPlatform]);
+        'P': // write target processor
+          AppendInfo(PasToJsProcessorNames[TargetProcessor]);
+        else
+          ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
+        end;
       end;
       end;
     'c':
     'c':
       // write list of supported JS processors
       // write list of supported JS processors
-      for pr  in TPasToJsProcessor do
+      for pr in TPasToJsProcessor do
         Log.LogPlain(PasToJsProcessorNames[pr]);
         Log.LogPlain(PasToJsProcessorNames[pr]);
     'o':
     'o':
       begin
       begin
-      // write list of optimizations
-      Log.LogPlain('EnumNumbers');
-      Log.LogPlain('RemoveNotUsedPrivates');
-      Log.LogPlain('RemoveNotUsedDeclarations');
+        // write list of optimizations
+        Log.LogPlain('EnumNumbers');
+        Log.LogPlain('RemoveNotUsedPrivates');
+        Log.LogPlain('RemoveNotUsedDeclarations');
       end;
       end;
     't':
     't':
       // write list of supported targets
       // write list of supported targets
       for pl in TPasToJsPlatform do
       for pl in TPasToJsPlatform do
         Log.LogPlain(PasToJsPlatformNames[pl]);
         Log.LogPlain(PasToJsPlatformNames[pl]);
+    'J':
+      // write list of RTL identifiers
+      begin
+        Log.LogPlain('-JoRTL-<x> identifiers:');
+        for pbi in TPas2JSBuiltInName do
+        begin
+          str(pbi,s);
+          Delete(s,1,3);
+          Log.LogPlain('-JoRTL-'+s+'='+Pas2JSBuiltInNames[pbi]);
+        end;
+      end
     else
     else
       ParamFatal('unknown info option "'+C+'" in "'+aValue+'".');
       ParamFatal('unknown info option "'+C+'" in "'+aValue+'".');
     end;
     end;
     inc(p);
     inc(p);
-    end;
-  if infoMsg<>'' then
-    Log.LogPlain(infoMsg);
+  end;
+  if InfoMsg<>'' then
+    Log.LogPlain(InfoMsg);
 end;
 end;
 
 
 procedure TPas2jsCompiler.ReadParam(Param: string; Quick, FromCmdLine: boolean);
 procedure TPas2jsCompiler.ReadParam(Param: string; Quick, FromCmdLine: boolean);
@@ -3194,6 +3312,7 @@ begin
     else
     else
       Log.LogMsgIgnoreFilter(nHandlingOption,[QuoteStr(Param)]);
       Log.LogMsgIgnoreFilter(nHandlingOption,[QuoteStr(Param)]);
   if Param='' then exit;
   if Param='' then exit;
+  FCurParam:=Param;
   ParamMacros.Substitute(Param,Self);
   ParamMacros.Substitute(Param,Self);
   if Param='' then exit;
   if Param='' then exit;
 
 
@@ -3237,7 +3356,7 @@ begin
           end;
           end;
         end;
         end;
       'C': // code generation
       'C': // code generation
-          ReadCodeGenerationFlags(aValue,1);
+        ReadCodeGenerationFlags(aValue,1);
       'd': // define
       'd': // define
         if not Quick then
         if not Quick then
         begin
         begin
@@ -3563,79 +3682,23 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TPas2jsCompiler.RegisterMessages;
-var
-  LastMsgNumber: integer;
-
-  procedure r(MsgType: TMessageType; MsgNumber: integer; const MsgPattern: string);
-  var
-    s: String;
-  begin
-    if (LastMsgNumber>=0) and (MsgNumber<>LastMsgNumber+1) then
-      begin
-      s:='TPas2jsCompiler.RegisterMessages: gap in registered message numbers: '+IntToStr(LastMsgNumber)+' '+IntToStr(MsgNumber);
-      RaiseInternalError(20170504161422,s);
-      end;
-    Log.RegisterMsg(MsgType,MsgNumber,MsgPattern);
-    LastMsgNumber:=MsgNumber;
-  end;
-
-begin
-  LastMsgNumber:=-1;
-  r(mtInfo,nOptionIsEnabled,sOptionIsEnabled);
-  r(mtInfo,nSyntaxModeIs,sSyntaxModeIs);
-  r(mtInfo,nMacroDefined,sMacroDefined);
-  r(mtInfo,nUsingPath,sUsingPath);
-  r(mtNote,nFolderNotFound,sFolderNotFound);
-  r(mtInfo,nNameValue,sNameValue);
-  r(mtInfo,nReadingOptionsFromFile,sReadingOptionsFromFile);
-  r(mtInfo,nEndOfReadingConfigFile,sEndOfReadingConfigFile);
-  r(mtDebug,nInterpretingFileOption,sInterpretingFileOption);
-  r(mtFatal,nSourceFileNotFound,sSourceFileNotFound);
-  r(mtFatal,nFileIsFolder,sFileIsFolder);
-  r(mtInfo,nConfigFileSearch,sConfigFileSearch);
-  r(mtDebug,nHandlingOption,sHandlingOption);
-  r(mtDebug,nQuickHandlingOption,sQuickHandlingOption);
-  r(mtFatal,nOutputDirectoryNotFound,sOutputDirectoryNotFound);
-  r(mtError,nUnableToWriteFile,sUnableToWriteFile);
-  r(mtInfo,nWritingFile,sWritingFile);
-  r(mtFatal,nCompilationAborted,sCompilationAborted);
-  r(mtDebug,nCfgDirective,sCfgDirective);
-  r(mtError,nUnitCycle,sUnitCycle);
-  r(mtError,nOptionForbidsCompile,sOptionForbidsCompile);
-  r(mtInfo,nUnitNeedsCompileDueToUsedUnit,sUnitsNeedCompileDueToUsedUnit);
-  r(mtInfo,nUnitNeedsCompileDueToOption,sUnitsNeedCompileDueToOption);
-  r(mtInfo,nUnitNeedsCompileJSMissing,sUnitsNeedCompileJSMissing);
-  r(mtInfo,nUnitNeedsCompilePasHasChanged,sUnitsNeedCompilePasHasChanged);
-  r(mtInfo,nParsingFile,sParsingFile);
-  r(mtInfo,nCompilingFile,sCompilingFile);
-  r(mtError,nExpectedButFound,sExpectedButFound);
-  r(mtInfo,nLinesInFilesCompiled,sLinesInFilesCompiled);
-  r(mtInfo,nTargetPlatformIs,sTargetPlatformIs);
-  r(mtInfo,nTargetProcessorIs,sTargetProcessorIs);
-  r(mtInfo,nMessageEncodingIs,sMessageEncodingIs);
-  r(mtError,nUnableToTranslatePathToDir,sUnableToTranslatePathToDir);
-  r(mtInfo,nSrcMapSourceRootIs,sSrcMapSourceRootIs);
-  r(mtInfo,nSrcMapBaseDirIs,sSrcMapBaseDirIs);
-  r(mtFatal,nUnitFileNotFound,sUnitFileNotFound);
-  r(mtInfo,nClassInterfaceStyleIs,sClassInterfaceStyleIs);
-  r(mtInfo,nMacroXSetToY,sMacroXSetToY);
-  r(mtInfo,nPostProcessorInfoX,sPostProcessorInfoX);
-  r(mtInfo,nPostProcessorRunX,sPostProcessorRunX);
-  r(mtError,nPostProcessorFailX,sPostProcessorFailX);
-  r(mtWarning,nPostProcessorWarnX,sPostProcessorWarnX);
-  r(mtInfo,nPostProcessorFinished,sPostProcessorFinished);
-  Pas2jsPParser.RegisterMessages(Log);
-end;
-
 procedure TPas2jsCompiler.SetAllJSIntoMainJS(AValue: Boolean);
 procedure TPas2jsCompiler.SetAllJSIntoMainJS(AValue: Boolean);
 begin
 begin
   if FAllJSIntoMainJS=AValue then Exit;
   if FAllJSIntoMainJS=AValue then Exit;
   if aValue then
   if aValue then
-    FIsMainJSFileResolved:=False;
+    FMainJSFileIsResolved:=False;
   FAllJSIntoMainJS:=AValue;
   FAllJSIntoMainJS:=AValue;
 end;
 end;
 
 
+procedure TPas2jsCompiler.SetConverterGlobals(
+  const AValue: TPasToJSConverterGlobals);
+begin
+  if AValue=FConverterGlobals then exit;
+  if (FConverterGlobals<>nil) and (FConverterGlobals.Owner=Self) then
+    FreeAndNil(FConverterGlobals);
+  FConverterGlobals:=AValue;
+end;
+
 function TPas2jsCompiler.FormatPath(const aPath: String): String;
 function TPas2jsCompiler.FormatPath(const aPath: String): String;
 begin
 begin
   Result:=FS.FormatPath(aPath);
   Result:=FS.FormatPath(aPath);
@@ -3662,6 +3725,7 @@ constructor TPas2jsCompiler.Create;
 
 
 begin
 begin
   FOptions:=DefaultP2jsCompilerOptions;
   FOptions:=DefaultP2jsCompilerOptions;
+  FConverterGlobals:=TPasToJSConverterGlobals.Create(Self);
   FNamespaces:=TStringList.Create;
   FNamespaces:=TStringList.Create;
   FDefines:=TStringList.Create;
   FDefines:=TStringList.Create;
   FInsertFilenames:=TStringList.Create;
   FInsertFilenames:=TStringList.Create;
@@ -3697,6 +3761,10 @@ destructor TPas2jsCompiler.Destroy;
     FFiles.FreeItems;
     FFiles.FreeItems;
     FreeAndNil(FFiles);
     FreeAndNil(FFiles);
 
 
+    FreeAndNil(FPostProcessorSupport);
+    FreeAndNil(FConfigSupport);
+    ConverterGlobals:=nil;
+
     ClearDefines;
     ClearDefines;
     FreeAndNil(FDefines);
     FreeAndNil(FDefines);
 
 
@@ -3707,8 +3775,6 @@ destructor TPas2jsCompiler.Destroy;
       FFS:=nil;
       FFS:=nil;
 
 
     FreeAndNil(FParamMacros);
     FreeAndNil(FParamMacros);
-    FreeAndNil(FConfigSupport);
-    FreeAndNil(FPostProcessorSupport);
   end;
   end;
 
 
 begin
 begin
@@ -3790,10 +3856,9 @@ end;
 
 
 procedure TPas2jsCompiler.WritePrecompiledFormats;
 procedure TPas2jsCompiler.WritePrecompiledFormats;
 begin
 begin
-  WriteHelpLine('No support for PCU files in this class');
+  WriteHelpLine('   -JU: This pas2js does not support PCU files');
 end;
 end;
 
 
-
 procedure TPas2jsCompiler.AddNamespaces(const Paths: string;
 procedure TPas2jsCompiler.AddNamespaces(const Paths: string;
   FromCmdLine: boolean);
   FromCmdLine: boolean);
 
 
@@ -3891,9 +3956,11 @@ begin
   FOptions:=DefaultP2jsCompilerOptions;
   FOptions:=DefaultP2jsCompilerOptions;
   FRTLVersionCheck:=DefaultP2jsRTLVersionCheck;
   FRTLVersionCheck:=DefaultP2jsRTLVersionCheck;
   FMode:=p2jmObjFPC;
   FMode:=p2jmObjFPC;
-  FTargetPlatform:=PlatformBrowser;
-  FTargetProcessor:=ProcessorECMAScript5;
-  FIsMainJSFileResolved:=False;
+  FConverterGlobals.Reset;
+  FConverterGlobals.RTLVersion:=(VersionMajor*100+VersionMinor)*100+VersionRelease;
+  FConverterGlobals.TargetPlatform:=PlatformBrowser;
+  FConverterGlobals.TargetProcessor:=ProcessorECMAScript5;
+  FMainJSFileIsResolved:=False;
   Log.Reset;
   Log.Reset;
   Log.ShowMsgTypes:=GetShownMsgTypes;
   Log.ShowMsgTypes:=GetShownMsgTypes;
 
 
@@ -4111,6 +4178,7 @@ begin
   w('    -ic  : Write list of supported JS processors usable by -P<x>');
   w('    -ic  : Write list of supported JS processors usable by -P<x>');
   w('    -io  : Write list of supported optimizations usable by -Oo<x>');
   w('    -io  : Write list of supported optimizations usable by -Oo<x>');
   w('    -it  : Write list of supported targets usable by -T<x>');
   w('    -it  : Write list of supported targets usable by -T<x>');
+  w('    -iJ  : Write list of supported JavaScript identifiers -JoRTL-<x>');
   w('  -C<x>  : Code generation options. <x> is a combination of the following letters:');
   w('  -C<x>  : Code generation options. <x> is a combination of the following letters:');
   // -C3        Turn on ieee error checking for constants
   // -C3        Turn on ieee error checking for constants
   w('    o    : Overflow checking of integer operations');
   w('    o    : Overflow checking of integer operations');
@@ -4149,6 +4217,7 @@ begin
   w('     -JoCheckVersion=main: insert rtl version check into main.');
   w('     -JoCheckVersion=main: insert rtl version check into main.');
   w('     -JoCheckVersion=system: insert rtl version check into system unit init.');
   w('     -JoCheckVersion=system: insert rtl version check into system unit init.');
   w('     -JoCheckVersion=unit: insert rtl version check into every unit init.');
   w('     -JoCheckVersion=unit: insert rtl version check into every unit init.');
+  w('     -JoRTL-<y>=<z>: set RTL identifier y to value z. See -iJ.');
   w('   -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.');
   w('   -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.');
   w('   -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
   w('   -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
   WritePrecompiledFormats;
   WritePrecompiledFormats;
@@ -4272,6 +4341,7 @@ var
   i: Integer;
   i: Integer;
   S: String;
   S: String;
   M: TMacroDef;
   M: TMacroDef;
+  pbi: TPas2JSBuiltInName;
 begin
 begin
   for i:=0 to Defines.Count-1 do
   for i:=0 to Defines.Count-1 do
     begin
     begin
@@ -4282,6 +4352,14 @@ begin
     else
     else
       Log.LogMsgIgnoreFilter(nMacroDefined,[S]);
       Log.LogMsgIgnoreFilter(nMacroDefined,[S]);
     end;
     end;
+  for pbi in TPas2JSBuiltInName do
+    if Pas2JSBuiltInNames[pbi]<>ConverterGlobals.BuiltInNames[pbi] then
+    begin
+      WriteStr(S,pbi);
+      S:=copy(S,4,255);
+      Log.LogMsgIgnoreFilter(nRTLIdentifierChanged,[QuoteStr(S),
+        QuoteStr(Pas2JSBuiltInNames[pbi]),QuoteStr(ConverterGlobals.BuiltInNames[pbi])]);
+    end;
 end;
 end;
 
 
 procedure TPas2jsCompiler.WriteUsedTools;
 procedure TPas2jsCompiler.WriteUsedTools;
@@ -4307,7 +4385,7 @@ procedure TPas2jsCompiler.WriteInfo;
 begin
 begin
   WriteVersionLine;
   WriteVersionLine;
   Log.LogLn;
   Log.LogLn;
-  Log.LogPlain('Compiler date     : '+GetCompiledDate);
+  Log.LogPlain('Compiler date      : '+GetCompiledDate);
   Log.LogPlain('Compiler CPU target: '+GetCompiledTargetCPU);
   Log.LogPlain('Compiler CPU target: '+GetCompiledTargetCPU);
   Log.LogLn;
   Log.LogLn;
   Log.LogPlain('Supported targets (targets marked with ''{*}'' are under development):');
   Log.LogPlain('Supported targets (targets marked with ''{*}'' are under development):');
@@ -4540,6 +4618,16 @@ begin
     InsertFilenames.Delete(i);
     InsertFilenames.Delete(i);
 end;
 end;
 
 
+function TPas2jsCompiler.GetResolvedMainJSFile: string;
+
+begin
+  if not FMainJSFileIsResolved then
+  begin
+    FMainJSFileResolved:=ResolvedMainJSFile;
+    FMainJSFileIsResolved:=True;
+  end;
+  Result:=FMainJSFileResolved;
+end;
 
 
 function TPas2jsCompiler.GetUnitInfo(const UseUnitName, InFileName: String;
 function TPas2jsCompiler.GetUnitInfo(const UseUnitName, InFileName: String;
   PCUSupport: TPCUSupport): TFindUnitInfo;
   PCUSupport: TPCUSupport): TFindUnitInfo;
@@ -4827,7 +4915,6 @@ begin
 end;
 end;
 
 
 function TPas2jsCompiler.ResolvedMainJSFile: string;
 function TPas2jsCompiler.ResolvedMainJSFile: string;
-
 Var
 Var
   OP,UP: String;
   OP,UP: String;
 
 
@@ -4867,16 +4954,5 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TPas2jsCompiler.GetResolvedMainJSFile: string;
-
-begin
-  if not FIsMainJSFileResolved then
-  begin
-    FMainJSFileResolved:=ResolvedMainJSFile;
-    FIsMainJSFileResolved:=True;
-  end;
-  Result:=FMainJSFileResolved;
-end;
-
 end.
 end.
 
 

+ 5 - 4
packages/pastojs/src/pas2jscompilercfg.pp

@@ -16,14 +16,17 @@
   Abstract:
   Abstract:
     Config file handling for compiler, depends on filesystem.
     Config file handling for compiler, depends on filesystem.
 }
 }
-unit pas2jscompilercfg;
+unit Pas2JSCompilerCfg;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, pas2JSCompiler, pas2jsfs;
+  {$IFDEF NodeJS}
+  NodeJSFS,
+  {$ENDIF}
+  Classes, SysUtils, Pas2jsFileUtils, Pas2JSFS, Pas2jsCompiler;
 
 
 Type
 Type
   TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport)
   TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport)
@@ -33,8 +36,6 @@ Type
 
 
 implementation
 implementation
 
 
-uses pas2jsfileutils;
-
 function TPas2JSFileConfigSupport.GetReader(aFileName: string): TSourceLineReader;
 function TPas2JSFileConfigSupport.GetReader(aFileName: string): TSourceLineReader;
 
 
 Var
 Var

+ 2 - 2
packages/pastojs/src/pas2jscompilerpp.pp

@@ -14,9 +14,9 @@
  **********************************************************************
  **********************************************************************
 
 
   Abstract:
   Abstract:
-    Pas2JS compiler Preprocessor support. Can depend on filesystem.
+    Pas2JS compiler Postprocessor support. Can depend on filesystem.
 }
 }
-unit pas2jscompilerpp;
+unit Pas2JSCompilerPP;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 

+ 0 - 48
packages/pastojs/src/pas2jsfilecache.pp

@@ -234,19 +234,11 @@ type
     function FileExistsILogged(var Filename: string): integer;
     function FileExistsILogged(var Filename: string): integer;
     function FileExistsLogged(const Filename: string): boolean;
     function FileExistsLogged(const Filename: string): boolean;
     function GetOnReadDirectory: TReadDirectoryEvent;
     function GetOnReadDirectory: TReadDirectoryEvent;
-    function GetSearchLikeFPC: boolean;
-    function GetShowFullFilenames: boolean;
-    function GetShowTriedUsedFiles: boolean;
-    function GetStrictFileCase: Boolean;
     procedure RegisterMessages;
     procedure RegisterMessages;
     procedure SetBaseDirectory(AValue: string);
     procedure SetBaseDirectory(AValue: string);
     function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
     function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
       FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
       FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
     procedure SetOnReadDirectory(AValue: TReadDirectoryEvent);
     procedure SetOnReadDirectory(AValue: TReadDirectoryEvent);
-    procedure SetSearchLikeFPC(const AValue: boolean);
-    procedure SetShowFullFilenames(const AValue: boolean);
-    procedure SetShowTriedUsedFiles(const AValue: boolean);
-    procedure SetStrictFileCase(AValue: Boolean);
   protected
   protected
     function FindSourceFileName(const aFilename: string): String; override;
     function FindSourceFileName(const aFilename: string): String; override;
     function GetHasPCUSupport: Boolean; virtual;
     function GetHasPCUSupport: Boolean; virtual;
@@ -1221,26 +1213,6 @@ begin
   Result:=False;
   Result:=False;
 end;
 end;
 
 
-function TPas2jsFilesCache.GetStrictFileCase : Boolean;
-begin
-  Result:=caoStrictFileCase in Options;
-end;
-
-function TPas2jsFilesCache.GetSearchLikeFPC: boolean;
-begin
-  Result:=caoSearchLikeFPC in Options;
-end;
-
-function TPas2jsFilesCache.GetShowFullFilenames: boolean;
-begin
-  Result:=caoShowFullFilenames in Options;
-end;
-
-function TPas2jsFilesCache.GetShowTriedUsedFiles: boolean;
-begin
-  Result:=caoShowTriedUsedFiles in Options;
-end;
-
 procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string);
 procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string);
 begin
 begin
   AValue:=Pas2jsFileUtils.ExpandDirectory(AValue);
   AValue:=Pas2jsFileUtils.ExpandDirectory(AValue);
@@ -1361,26 +1333,6 @@ begin
   DirectoryCache.OnReadDirectory:=AValue;
   DirectoryCache.OnReadDirectory:=AValue;
 end;
 end;
 
 
-procedure TPas2jsFilesCache.SetSearchLikeFPC(const AValue: boolean);
-begin
-  SetOption(caoSearchLikeFPC,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetShowFullFilenames(const AValue: boolean);
-begin
-  SetOption(caoShowFullFilenames,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetShowTriedUsedFiles(const AValue: boolean);
-begin
-  SetOption(caoShowTriedUsedFiles,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetStrictFileCase(AValue: Boolean);
-begin
-  SetOption(caoStrictFileCase,aValue)
-end;
-
 function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
 function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
   ): boolean;
   ): boolean;
 {$IFDEF Pas2js}
 {$IFDEF Pas2js}

+ 2 - 1
packages/pastojs/src/pas2jsfscompiler.pp

@@ -23,7 +23,8 @@ unit Pas2JSFSCompiler;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, pastree, PScanner, PasUseAnalyzer,
+  Classes, SysUtils,
+  PasUseAnalyzer,
   Pas2jsFileCache, Pas2jsCompiler,
   Pas2jsFileCache, Pas2jsCompiler,
   Pas2JSFS,
   Pas2JSFS,
   FPPas2Js, Pas2jsFileUtils;
   FPPas2Js, Pas2jsFileUtils;

+ 3 - 1
packages/pastojs/src/pas2jslibcompiler.pp

@@ -21,7 +21,9 @@ unit pas2jslibcompiler;
 interface
 interface
 
 
 uses
 uses
-  SysUtils, Classes, FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler, pas2jscompilercfg, pas2jscompilerpp;
+  SysUtils, Classes,
+  FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler,
+  Pas2JSCompilerCfg, Pas2JSCompilerPP;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
   Compiler descendant, usable in library
   Compiler descendant, usable in library

+ 4 - 1
packages/pastojs/src/pas2jslogger.pp

@@ -29,6 +29,9 @@ interface
 uses
 uses
   {$IFDEF Pas2JS}
   {$IFDEF Pas2JS}
   JS,
   JS,
+  {$IFDEF NodeJS}
+  NodeJSFS,
+  {$ENDIF}
   {$ENDIF}
   {$ENDIF}
   pas2jsutils,
   pas2jsutils,
   {$IFDEF HASFILESYSTEM}
   {$IFDEF HASFILESYSTEM}
@@ -1072,7 +1075,7 @@ begin
   if FOutputFile<>nil then exit;
   if FOutputFile<>nil then exit;
   if OutputFilename='' then
   if OutputFilename='' then
     raise Exception.Create('Log has empty OutputFilename');
     raise Exception.Create('Log has empty OutputFilename');
-   if DirectoryExists(OutputFilename) then
+  if DirectoryExists(OutputFilename) then
     raise Exception.Create('Log is directory: "'+OutputFilename+'"');
     raise Exception.Create('Log is directory: "'+OutputFilename+'"');
 {$ENDIF}
 {$ENDIF}
   FOutputFile:=CreateTextWriter(OutputFileName);
   FOutputFile:=CreateTextWriter(OutputFileName);

+ 413 - 1
packages/pastojs/tests/tcmodules.pas

@@ -17,7 +17,7 @@
     ./testpas2js --suite=TTestModule.TestEmptyProgram
     ./testpas2js --suite=TTestModule.TestEmptyProgram
     ./testpas2js --suite=TTestModule.TestEmptyUnit
     ./testpas2js --suite=TTestModule.TestEmptyUnit
 }
 }
-unit tcmodules;
+unit TCModules;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
@@ -327,6 +327,16 @@ type
     Procedure TestProc_LocalVarAbsolute;
     Procedure TestProc_LocalVarAbsolute;
     Procedure TestProc_ReservedWords;
     Procedure TestProc_ReservedWords;
 
 
+    // anonymous functions
+    Procedure TestAnonymousProc_Assign_ObjFPC;
+    Procedure TestAnonymousProc_Assign_Delphi;
+    Procedure TestAnonymousProc_Arg;
+    Procedure TestAnonymousProc_Typecast;
+    Procedure TestAnonymousProc_With;
+    Procedure TestAnonymousProc_ExceptOn;
+    Procedure TestAnonymousProc_Nested;
+    Procedure TestAnonymousProc_NestedAssignResult;
+
     // enums, sets
     // enums, sets
     Procedure TestEnum_Name;
     Procedure TestEnum_Name;
     Procedure TestEnum_Number;
     Procedure TestEnum_Number;
@@ -3966,6 +3976,388 @@ begin
     ]));
     ]));
 end;
 end;
 
 
+procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TFunc = reference to function(x: word): word;',
+  'var Func: TFunc;',
+  'procedure DoIt(a: word);',
+  'begin',
+  '  Func:=function(b:word): word',
+  '  begin',
+  '    Result:=a+b;',
+  '    exit(b);',
+  '    exit(Result);',
+  '  end;',// test semicolon
+  '  a:=3;',
+  'end;',
+  'begin',
+  '  Func:=function(c:word):word begin',
+  '    Result:=3+c;',
+  '    exit(c);',
+  '    exit(Result);',
+  '  end;']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Assign_ObjFPC',
+    LinesToStr([ // statements
+    'this.Func = null;',
+    'this.DoIt = function (a) {',
+    '  $mod.Func = function (b) {',
+    '    var Result = 0;',
+    '    Result = a + b;',
+    '    return b;',
+    '    return Result;',
+    '    return Result;',
+    '  };',
+    '  a = 3;',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.Func = function (c) {',
+    '  var Result = 0;',
+    '  Result = 3 + c;',
+    '  return c;',
+    '  return Result;',
+    '  return Result;',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_Assign_Delphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TProc = reference to procedure(x: word);',
+  'procedure DoIt(a: word);',
+  'var Proc: TProc;',
+  'begin',
+  '  Proc:=procedure(b:word) begin end;',
+  'end;',
+  'var Proc: TProc;',
+  'begin',
+  '  Proc:=procedure(c:word) begin end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Assign_Delphi',
+    LinesToStr([ // statements
+    'this.DoIt = function (a) {',
+    '  var Proc = null;',
+    '  Proc = function (b) {',
+    '  };',
+    '};',
+    'this.Proc = null;',
+    '']),
+    LinesToStr([
+    '$mod.Proc = function (c) {',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_Arg;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TFunc = reference to function(x: word): word;',
+  'procedure DoMore(f,g: TProc);',
+  'begin',
+  'end;',
+  'procedure DoIt(f: TFunc);',
+  'begin',
+  '  DoIt(function(b:word): word',
+  '    begin',
+  '      Result:=1+b;',
+  '    end);',
+  '  DoMore(procedure begin end, procedure begin end);',
+  'end;',
+  'begin',
+  '  DoMore(procedure begin end,',
+  '    procedure assembler asm',
+  '      console.log("c");',
+  '    end);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Arg',
+    LinesToStr([ // statements
+    'this.DoMore = function (f, g) {',
+    '};',
+    'this.DoIt = function (f) {',
+    '  $mod.DoIt(function (b) {',
+    '    var Result = 0;',
+    '    Result = 1 + b;',
+    '    return Result;',
+    '  });',
+    '  $mod.DoMore(function () {',
+    '  }, function () {',
+    '  });',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoMore(function () {',
+    '}, function () {',
+    '  console.log("c");',
+    '});',
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_Typecast;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TArr = array of word;',
+  '  TFuncArr = reference to function: TArr;',
+  'procedure DoIt(p: TProc);',
+  'var',
+  '  w: word;',
+  '  a: TArr;',
+  'begin',
+  '  p:=TProc(procedure(b: smallint) begin end);',
+  '  a:=TFuncArr(function: TArr begin end)();',
+  '  w:=TFuncArr(function: TArr begin end)()[3];',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Typecast',
+    LinesToStr([ // statements
+    'this.DoIt = function (p) {',
+    '  var w = 0;',
+    '  var a = [];',
+    '  p = function (b) {',
+    '  };',
+    '  a = function () {',
+    '    var Result = [];',
+    '    return Result;',
+    '  }();',
+    '  w = function () {',
+    '    var Result = [];',
+    '    return Result;',
+    '  }()[3];',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_With;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TObject = class',
+  '    b: boolean;',
+  '  end;',
+  'var',
+  '  p: TProc;',
+  '  bird: TObject;',
+  'begin',
+  '  with bird do',
+  '    p:=procedure(w: word)',
+  '      begin',
+  '        b:=w>2;',
+  '      end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_With',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.b = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.p = null;',
+    'this.bird = null;',
+    '']),
+    LinesToStr([
+    'var $with1 = $mod.bird;',
+    '$mod.p = function (w) {',
+    '  $with1.b = w > 2;',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_ExceptOn;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class',
+  '    b: boolean;',
+  '  end;',
+  'procedure DoIt;',
+  'var',
+  '  p: TProc;',
+  'begin',
+  '  try',
+  '  except',
+  '    on E: TObject do',
+  '    p:=procedure',
+  '      begin',
+  '        E.b:=true;',
+  '      end;',
+  '  end;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_ExceptOn',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.b = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function () {',
+    '  var p = null;',
+    '  try {} catch ($e) {',
+    '    if ($mod.TObject.isPrototypeOf($e)) {',
+    '      var E = $e;',
+    '      p = function () {',
+    '        E.b = true;',
+    '      };',
+    '    } else throw $e',
+    '  };',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_Nested;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class',
+  '    i: byte;',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TObject.DoIt;',
+  'var',
+  '  p: TProc;',
+  '  procedure Sub;',
+  '  begin',
+  '    p:=procedure',
+  '      begin',
+  '        i:=3;',
+  '        Self.i:=4;',
+  '        p:=procedure',
+  '            procedure SubSub;',
+  '            begin',
+  '              i:=13;',
+  '              Self.i:=14;',
+  '            end;',
+  '          begin',
+  '            i:=13;',
+  '            Self.i:=14;',
+  '          end;',
+  '      end;',
+  '  end;',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Nested',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    var Self = this;',
+    '    var p = null;',
+    '    function Sub() {',
+    '      p = function () {',
+    '        Self.i = 3;',
+    '        Self.i = 4;',
+    '        p = function () {',
+    '          function SubSub() {',
+    '            Self.i = 13;',
+    '            Self.i = 14;',
+    '          };',
+    '          Self.i = 13;',
+    '          Self.i = 14;',
+    '        };',
+    '      };',
+    '    };',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_NestedAssignResult;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'function DoIt: TProc;',
+  '  function Sub: TProc;',
+  '  begin',
+  '    Result:=procedure',
+  '      begin',
+  '        Sub:=procedure',
+  '            procedure SubSub;',
+  '            begin',
+  '              Result:=nil;',
+  '              Sub:=nil;',
+  '              DoIt:=nil;',
+  '            end;',
+  '          begin',
+  '            Result:=nil;',
+  '            Sub:=nil;',
+  '            DoIt:=nil;',
+  '          end;',
+  '      end;',
+  '  end;',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_NestedAssignResult',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var Result = null;',
+    '  function Sub() {',
+    '    var Result$1 = null;',
+    '    Result$1 = function () {',
+    '      Result$1 = function () {',
+    '        function SubSub() {',
+    '          Result$1 = null;',
+    '          Result$1 = null;',
+    '          Result = null;',
+    '        };',
+    '        Result$1 = null;',
+    '        Result$1 = null;',
+    '        Result = null;',
+    '      };',
+    '    };',
+    '    return Result$1;',
+    '  };',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestEnum_Name;
 procedure TTestModule.TestEnum_Name;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -4045,6 +4437,14 @@ begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
   'type TMyEnum = (Red, Green);',
   'type TMyEnum = (Red, Green);',
+  'procedure DoIt(var e: TMyEnum; var i: word);',
+  'var',
+  '  v: longint;',
+  '  s: string;',
+  'begin',
+  '  val(s,e,v);',
+  '  val(s,e,i);',
+  'end;',
   'var',
   'var',
   '  e: TMyEnum;',
   '  e: TMyEnum;',
   '  i: longint;',
   '  i: longint;',
@@ -4074,6 +4474,7 @@ begin
   '  str(red,s);',
   '  str(red,s);',
   '  s:=str(e:3);',
   '  s:=str(e:3);',
   '  writestr(s,e:3,red);',
   '  writestr(s,e:3,red);',
+  '  val(s,e,i);',
   '  e:=TMyEnum(i);',
   '  e:=TMyEnum(i);',
   '  i:=longint(e);']);
   '  i:=longint(e);']);
   ConvertProgram;
   ConvertProgram;
@@ -4085,6 +4486,14 @@ begin
     '  "1":"Green",',
     '  "1":"Green",',
     '  Green:1',
     '  Green:1',
     '  };',
     '  };',
+    'this.DoIt = function (e, i) {',
+    '  var v = 0;',
+    '  var s = "";',
+    '  e.set(rtl.valEnum(s, $mod.TMyEnum, function (w) {',
+    '    v = w;',
+    '  }));',
+    '  e.set(rtl.valEnum(s, $mod.TMyEnum, i.set));',
+    '};',
     'this.e = 0;',
     'this.e = 0;',
     'this.i = 0;',
     'this.i = 0;',
     'this.s = "";',
     'this.s = "";',
@@ -4114,6 +4523,9 @@ begin
     '$mod.s = $mod.TMyEnum[$mod.TMyEnum.Red];',
     '$mod.s = $mod.TMyEnum[$mod.TMyEnum.Red];',
     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3)+$mod.TMyEnum[$mod.TMyEnum.Red];',
     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3)+$mod.TMyEnum[$mod.TMyEnum.Red];',
+    '$mod.e = rtl.valEnum($mod.s, $mod.TMyEnum, function (v) {',
+    '  $mod.i = v;',
+    '});',
     '$mod.e=$mod.i;',
     '$mod.e=$mod.i;',
     '$mod.i=$mod.e;',
     '$mod.i=$mod.e;',
     '']));
     '']));

+ 3 - 4
packages/pastojs/tests/tcprecompile.pas

@@ -17,7 +17,7 @@
     ./testpas2js --suite=TTestCLI_Precompile
     ./testpas2js --suite=TTestCLI_Precompile
     ./testpas2js --suite=TTestModule.TestEmptyUnit
     ./testpas2js --suite=TTestModule.TestEmptyUnit
 }
 }
-unit tcprecompile;
+unit TCPrecompile;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
@@ -26,7 +26,7 @@ interface
 uses
 uses
   Classes, SysUtils,
   Classes, SysUtils,
   fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler, Pas2jsCompiler,
   fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler, Pas2jsCompiler,
-  tcunitsearch, tcmodules;
+  TCUnitSearch, TCModules;
 
 
 type
 type
 
 
@@ -116,8 +116,7 @@ begin
     OrigSrc:=JSFile.Source;
     OrigSrc:=JSFile.Source;
     // compile, using .pcu files
     // compile, using .pcu files
     //for i:=0 to FileCount-1 do
     //for i:=0 to FileCount-1 do
-    //  writeln('AAA1 TCustomTestCLI_Precompile.CheckPrecompile ',i,' ',Files[i].Filename);
-
+    //  writeln('TCustomTestCLI_Precompile.CheckPrecompile ',i,' ',Files[i].Filename);
     {$IFDEF VerbosePCUFiler}
     {$IFDEF VerbosePCUFiler}
     writeln('TTestCLI_Precompile.CheckPrecompile compile using pcu files==================');
     writeln('TTestCLI_Precompile.CheckPrecompile compile using pcu files==================');
     {$ENDIF}
     {$ENDIF}

+ 1 - 1
packages/pastojs/tests/tcunitsearch.pas

@@ -18,7 +18,7 @@
     ./testpas2js --suite=TestUS_Program
     ./testpas2js --suite=TestUS_Program
     ./testpas2js --suite=TestUS_UsesEmptyFileFail
     ./testpas2js --suite=TestUS_UsesEmptyFileFail
 }
 }
-unit tcunitsearch;
+unit TCUnitSearch;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 

+ 2 - 0
packages/pastojs/tests/testpas2js.lpi

@@ -49,6 +49,7 @@
       <Unit3>
       <Unit3>
         <Filename Value="tcmodules.pas"/>
         <Filename Value="tcmodules.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCModules"/>
       </Unit3>
       </Unit3>
       <Unit4>
       <Unit4>
         <Filename Value="tcoptimizations.pas"/>
         <Filename Value="tcoptimizations.pas"/>
@@ -79,6 +80,7 @@
       <Unit10>
       <Unit10>
         <Filename Value="tcprecompile.pas"/>
         <Filename Value="tcprecompile.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCPrecompile"/>
       </Unit10>
       </Unit10>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>

+ 0 - 239
packages/rtl-extra/src/android/unixsock.inc

@@ -1,239 +0,0 @@
-{
-   This file is part of the Free Pascal run time library.
-   (c) 2004 by Marco van de Voort
-   member of the Free Pascal development team.
-
-   See the file COPYING.FPC, included in this distribution,
-   for details about the copyright.
-
-   socket call implementations for Linux
-
-   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.
-}
-
-{$if defined(cpu386)}
-  {$define NEED_SOCKETCALL}
-{$endif}
-
-{******************************************************************************
-                          Basic Socket Functions
-******************************************************************************}
-
-{$ifdef NEED_SOCKETCALL}
-
-Const
-  {
-    Arguments to the Linux Kernel system call for sockets. All
-    Socket Connected calls go through the same system call,
-    with an extra argument to determine what action to take.
-  }
-  Socket_Sys_SOCKET      = 1;
-  Socket_Sys_BIND        = 2;
-  Socket_Sys_CONNECT     = 3;
-  Socket_Sys_LISTEN      = 4;
-  Socket_Sys_ACCEPT      = 5;
-  Socket_Sys_GETSOCKNAME = 6;
-  Socket_Sys_GETPEERNAME = 7;
-  Socket_Sys_SOCKETPAIR  = 8;
-  Socket_Sys_SEND        = 9;
-  Socket_Sys_RECV        = 10;
-  Socket_Sys_SENDTO      = 11;
-  Socket_Sys_RECVFROM    = 12;
-  Socket_Sys_SHUTDOWN    = 13;
-  Socket_Sys_SETSOCKOPT  = 14;
-  Socket_Sys_GETSOCKOPT  = 15;
-  Socket_Sys_SENDMSG     = 16;
-  Socket_Sys_RECVMSG     = 17;
-
-
-Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:TSysParam):cint; inline;
-var
-  Args:array[1..6] of TSysParam;
-begin
-  args[1]:=a1;
-  args[2]:=a2;
-  args[3]:=a3;
-  args[4]:=a4;
-  args[5]:=a5;
-  args[6]:=a6;
-  SocketCall:=do_Syscall(syscall_nr_socketcall,sockcallnr,TSysParam(@args));
-  internal_socketerror:=fpgeterrno;
-end;
-
-
-function SocketCall(SockCallNr,a1,a2,a3:TSysParam):cint;inline;
-begin
-  SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
-end;
-
-function  fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
-begin
-  fpSocket:=SocketCall(Socket_Sys_socket,Domain,xtype,Protocol);
-end;
-
-function  fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
-begin
-  fpSend:=SocketCall(Socket_Sys_sendto,S,TSysParam(msg),Len,Flags,0,0);
-end;
-
-function  fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
-begin
-  fpSendto:=SocketCall(Socket_Sys_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
-end;
-
-function  fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
-begin
-  fpRecv:=SocketCall(Socket_Sys_Recvfrom,S,tsysparam(buf),len,flags,0,0);
-end;
-
-function  fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
-begin
-  fpRecvFrom:=SocketCall(Socket_Sys_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
-end;
-
-function  fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
-begin
-  fpBind:=SocketCall(Socket_Sys_Bind,S,TSysParam(addrx),addrlen);
-end;
-
-function  fplisten (s:cint; backlog : cint):cint;
-begin
-  fpListen:=SocketCall(Socket_Sys_Listen,S,backlog,0);
-end;
-
-function  fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
-begin
-  fpAccept:=SocketCall(Socket_Sys_accept,S,TSysParam(addrx),TSysParam(addrlen));
-end;
-
-function  fpconnect (s:cint; name  : psockaddr; namelen : tsocklen):cint;
-begin
-  fpConnect:=SocketCall(Socket_Sys_connect,S,TSysParam(name),namelen);
-end;
-
-function  fpshutdown (s:cint; how:cint):cint;
-begin
-  fpShutDown:=SocketCall(Socket_Sys_shutdown,S,how,0);
-end;
-
-function  fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetSockName:=SocketCall(Socket_Sys_GetSockName,S,TSysParam(name),TSysParam(namelen));
-end;
-
-function  fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetPeerName:=SocketCall(Socket_Sys_GetPeerName,S,TSysParam(name),TSysParam(namelen));
-end;
-
-function  fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
-begin
-  fpSetSockOpt:=SocketCall(Socket_Sys_SetSockOpt,S,level,optname,TSysParam(optval),optlen,0);
-end;
-
-function  fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
-begin
-  fpGetSockOpt:=SocketCall(Socket_Sys_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen),0);
-end;
-
-function  fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
-begin
-  fpSocketPair:=SocketCall(Socket_Sys_SocketPair,d,xtype,protocol,TSysParam(sv),0,0);
-end;
-
-{$else NEED_SOCKETCALL}
-
-function  fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
-begin
-  fpSocket:=do_syscall(syscall_nr_socket,Domain,xtype,Protocol);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
-begin
-  fpSend:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,0,0);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
-begin
-  fpSendto:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
-begin
-  fpRecv:=do_syscall(syscall_nr_Recvfrom,S,tsysparam(buf),len,flags,0,0);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
-begin
-  fpRecvFrom:=do_syscall(syscall_nr_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
-begin
-  fpBind:=do_syscall(syscall_nr_Bind,S,TSysParam(addrx),addrlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fplisten (s:cint; backlog : cint):cint;
-begin
-  fpListen:=do_syscall(syscall_nr_Listen,S,backlog);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
-begin
-  fpAccept:=do_syscall(syscall_nr_accept4,S,TSysParam(addrx),TSysParam(addrlen), 0);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpconnect (s:cint; name  : psockaddr; namelen : tsocklen):cint;
-begin
-  fpConnect:=do_syscall(syscall_nr_connect,S,TSysParam(name),namelen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpshutdown (s:cint; how:cint):cint;
-begin
-  fpShutDown:=do_syscall(syscall_nr_shutdown,S,how);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetSockName:=do_syscall(syscall_nr_GetSockName,S,TSysParam(name),TSysParam(namelen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetPeerName:=do_syscall(syscall_nr_GetPeerName,S,TSysParam(name),TSysParam(namelen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
-begin
-  fpSetSockOpt:=do_syscall(syscall_nr_SetSockOpt,S,level,optname,TSysParam(optval),optlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
-begin
-  fpGetSockOpt:=do_syscall(syscall_nr_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
-begin
-  fpSocketPair:=do_syscall(syscall_nr_SocketPair,d,xtype,protocol,TSysParam(sv));
-  internal_socketerror:=fpgeterrno;
-end;
-
-{$endif NEED_do_syscall}
-

+ 4 - 0
packages/rtl-extra/src/android/unxsockh.inc

@@ -13,6 +13,10 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 }
 
 
+{ Use libc for sockets since the "accept" syscall is blocked by SECCOMP,
+  but the "accept4" alternative is not available on old Android versions (2.3 and older). }
+{$define FPC_USE_LIBC}
+
 Const
 Const
 {* Supported address families. *}
 {* Supported address families. *}
   AF_UNSPEC     = 0;
   AF_UNSPEC     = 0;

+ 6 - 1
packages/rtl-objpas/src/inc/strutils.pp

@@ -2427,7 +2427,12 @@ begin
       Result := True;
       Result := True;
     Exit;
     Exit;
   end;
   end;
-  if (Len = 0) then Exit;
+  if (Len = 0) then
+  begin
+    Result:=true;
+    N:=0;
+    Exit;
+  end;
   i := 1;
   i := 1;
   N := 0;
   N := 0;
   Terminated := False;
   Terminated := False;

+ 28 - 24
rtl/android/aarch64/sysnr.inc

@@ -42,8 +42,6 @@ const
   syscall_nr_symlinkat = 36;
   syscall_nr_symlinkat = 36;
   syscall_nr_linkat = 37;
   syscall_nr_linkat = 37;
   syscall_nr_renameat = 38;
   syscall_nr_renameat = 38;
-  syscall_nr_umount2 = 39; // Blacklisted. Do not use.
-  syscall_nr_mount = 40; // Blacklisted. Do not use.
   syscall_nr_pivot_root = 41;
   syscall_nr_pivot_root = 41;
   syscall_nr_statfs = 43;
   syscall_nr_statfs = 43;
   syscall_nr_fstatfs = 44;
   syscall_nr_fstatfs = 44;
@@ -55,7 +53,6 @@ const
   syscall_nr_faccessat = 48;
   syscall_nr_faccessat = 48;
   syscall_nr_chdir = 49;
   syscall_nr_chdir = 49;
   syscall_nr_fchdir = 50;
   syscall_nr_fchdir = 50;
-  syscall_nr_chroot = 51; // Blacklisted. Do not use.
   syscall_nr_fchmod = 52;
   syscall_nr_fchmod = 52;
   syscall_nr_fchmodat = 53;
   syscall_nr_fchmodat = 53;
   syscall_nr_fchownat = 54;
   syscall_nr_fchownat = 54;
@@ -95,7 +92,6 @@ const
   syscall_nr_timerfd_settime = 86;
   syscall_nr_timerfd_settime = 86;
   syscall_nr_timerfd_gettime = 87;
   syscall_nr_timerfd_gettime = 87;
   syscall_nr_utimensat = 88;
   syscall_nr_utimensat = 88;
-  syscall_nr_acct = 89; // Blacklisted. Do not use.
   syscall_nr_capget = 90;
   syscall_nr_capget = 90;
   syscall_nr_capset = 91;
   syscall_nr_capset = 91;
   syscall_nr_personality = 92;
   syscall_nr_personality = 92;
@@ -108,19 +104,14 @@ const
   syscall_nr_nanosleep = 101;
   syscall_nr_nanosleep = 101;
   syscall_nr_getitimer = 102;
   syscall_nr_getitimer = 102;
   syscall_nr_setitimer = 103;
   syscall_nr_setitimer = 103;
-  syscall_nr_init_module = 105; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 106; // Blacklisted. Do not use.
   syscall_nr_timer_create = 107;
   syscall_nr_timer_create = 107;
   syscall_nr_timer_gettime = 108;
   syscall_nr_timer_gettime = 108;
   syscall_nr_timer_getoverrun = 109;
   syscall_nr_timer_getoverrun = 109;
   syscall_nr_timer_settime = 110;
   syscall_nr_timer_settime = 110;
   syscall_nr_timer_delete = 111;
   syscall_nr_timer_delete = 111;
-  syscall_nr_clock_settime = 112; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 113;
   syscall_nr_clock_gettime = 113;
   syscall_nr_clock_getres = 114;
   syscall_nr_clock_getres = 114;
   syscall_nr_clock_nanosleep = 115;
   syscall_nr_clock_nanosleep = 115;
-  syscall_nr_syslog = 116; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_ptrace = 117;
   syscall_nr_ptrace = 117;
   syscall_nr_sched_setparam = 118;
   syscall_nr_sched_setparam = 118;
   syscall_nr_sched_setscheduler = 119;
   syscall_nr_sched_setscheduler = 119;
@@ -146,27 +137,17 @@ const
   syscall_nr_rt_sigreturn = 139;
   syscall_nr_rt_sigreturn = 139;
   syscall_nr_setpriority = 140;
   syscall_nr_setpriority = 140;
   syscall_nr_getpriority = 141;
   syscall_nr_getpriority = 141;
-  syscall_nr_reboot = 142; // Blacklisted. Do not use.
   syscall_nr_setregid = 143;
   syscall_nr_setregid = 143;
-  syscall_nr_setgid = 144; // Blacklisted. Do not use.
-  syscall_nr_setreuid = 145; // Blacklisted. Do not use.
-  syscall_nr_setuid = 146; // Blacklisted. Do not use.
   syscall_nr_setresuid = 147;
   syscall_nr_setresuid = 147;
   syscall_nr_getresuid = 148;
   syscall_nr_getresuid = 148;
-  syscall_nr_setresgid = 149; // Blacklisted. Do not use.
   syscall_nr_getresgid = 150;
   syscall_nr_getresgid = 150;
-  syscall_nr_setfsuid = 151; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 152; // Blacklisted. Do not use.
   syscall_nr_times = 153;
   syscall_nr_times = 153;
   syscall_nr_setpgid = 154;
   syscall_nr_setpgid = 154;
   syscall_nr_getpgid = 155;
   syscall_nr_getpgid = 155;
   syscall_nr_getsid = 156;
   syscall_nr_getsid = 156;
   syscall_nr_setsid = 157;
   syscall_nr_setsid = 157;
   syscall_nr_getgroups = 158;
   syscall_nr_getgroups = 158;
-  syscall_nr_setgroups = 159; // Blacklisted. Do not use.
   syscall_nr_uname = 160;
   syscall_nr_uname = 160;
-  syscall_nr_sethostname = 161; // Blacklisted. Do not use.
-  syscall_nr_setdomainname = 162; // Blacklisted. Do not use.
   syscall_nr_getrlimit = 163;
   syscall_nr_getrlimit = 163;
   syscall_nr_setrlimit = 164;
   syscall_nr_setrlimit = 164;
   syscall_nr_getrusage = 165;
   syscall_nr_getrusage = 165;
@@ -174,8 +155,6 @@ const
   syscall_nr_prctl = 167;
   syscall_nr_prctl = 167;
   syscall_nr_getcpu = 168;
   syscall_nr_getcpu = 168;
   syscall_nr_gettimeofday = 169;
   syscall_nr_gettimeofday = 169;
-  syscall_nr_settimeofday = 170; // Blacklisted. Do not use.
-  syscall_nr_adjtimex = 171; // Blacklisted. Do not use.
   syscall_nr_getpid = 172;
   syscall_nr_getpid = 172;
   syscall_nr_getppid = 173;
   syscall_nr_getppid = 173;
   syscall_nr_getuid = 174;
   syscall_nr_getuid = 174;
@@ -207,8 +186,6 @@ const
   syscall_nr_mmap = 222;
   syscall_nr_mmap = 222;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_fadvise64 = 223;
   syscall_nr_fadvise64 = 223;
-  syscall_nr_swapon = 224; // Blacklisted. Do not use.
-  syscall_nr_swapoff = 225; // Blacklisted. Do not use.
   syscall_nr_mprotect = 226;
   syscall_nr_mprotect = 226;
   syscall_nr_msync = 227;
   syscall_nr_msync = 227;
   syscall_nr_mlock = 228;
   syscall_nr_mlock = 228;
@@ -224,7 +201,6 @@ const
   syscall_nr_wait4 = 260;
   syscall_nr_wait4 = 260;
   syscall_nr_prlimit64 = 261;
   syscall_nr_prlimit64 = 261;
   syscall_nr_prlimit = syscall_nr_prlimit64;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 266; // Blacklisted. Do not use.
   syscall_nr_syncfs = 267;
   syscall_nr_syncfs = 267;
   syscall_nr_setns = 268;
   syscall_nr_setns = 268;
   syscall_nr_sendmmsg = 269;
   syscall_nr_sendmmsg = 269;
@@ -241,3 +217,31 @@ const
   syscall_nr_copy_file_range = 285;
   syscall_nr_copy_file_range = 285;
   syscall_nr_preadv2 = 286;
   syscall_nr_preadv2 = 286;
   syscall_nr_pwritev2 = 287;
   syscall_nr_pwritev2 = 287;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_umount2 = 39 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_mount = 40 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 51 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 89 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 105 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 106 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 112 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 116 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 116 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 142 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 144 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 145 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 146 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 149 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 151 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 152 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 159 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 161 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 162 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 170 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 171 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 224 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 225 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 266 deprecated 'This syscall is blocked on Android 8+';

+ 33 - 29
rtl/android/arm/sysnr.inc

@@ -16,7 +16,6 @@ const
   syscall_nr_chdir = 12;
   syscall_nr_chdir = 12;
   syscall_nr_lseek = 19;
   syscall_nr_lseek = 19;
   syscall_nr_getpid = 20;
   syscall_nr_getpid = 20;
-  syscall_nr_mount = 21; // Blacklisted. Do not use.
   syscall_nr_getuid = 24;
   syscall_nr_getuid = 24;
   syscall_nr_ptrace = 26;
   syscall_nr_ptrace = 26;
   syscall_nr_access = 33;
   syscall_nr_access = 33;
@@ -28,52 +27,36 @@ const
   syscall_nr_pipe = 42;
   syscall_nr_pipe = 42;
   syscall_nr_times = 43;
   syscall_nr_times = 43;
   syscall_nr_brk = 45;
   syscall_nr_brk = 45;
-  syscall_nr_acct = 51; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 52; // Blacklisted. Do not use.
   syscall_nr_ioctl = 54;
   syscall_nr_ioctl = 54;
   syscall_nr_fcntl = 55;
   syscall_nr_fcntl = 55;
   syscall_nr_setpgid = 57;
   syscall_nr_setpgid = 57;
   syscall_nr_umask = 60;
   syscall_nr_umask = 60;
-  syscall_nr_chroot = 61; // Blacklisted. Do not use.
   syscall_nr_dup2 = 63;
   syscall_nr_dup2 = 63;
   syscall_nr_getppid = 64;
   syscall_nr_getppid = 64;
   syscall_nr_setsid = 66;
   syscall_nr_setsid = 66;
   syscall_nr_sigaction = 67;
   syscall_nr_sigaction = 67;
-  syscall_nr_sethostname = 74; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 75;
   syscall_nr_setrlimit = 75;
   syscall_nr_getrusage = 77;
   syscall_nr_getrusage = 77;
   syscall_nr_gettimeofday = 78;
   syscall_nr_gettimeofday = 78;
-  syscall_nr_settimeofday = 79; // Blacklisted. Do not use.
   syscall_nr_readlink = 85;
   syscall_nr_readlink = 85;
-  syscall_nr_swapon = 87; // Blacklisted. Do not use.
-  syscall_nr_reboot = 88; // Blacklisted. Do not use.
   syscall_nr_munmap = 91;
   syscall_nr_munmap = 91;
   syscall_nr_truncate = 92;
   syscall_nr_truncate = 92;
   syscall_nr_fchmod = 94;
   syscall_nr_fchmod = 94;
   syscall_nr_getpriority = 96;
   syscall_nr_getpriority = 96;
   syscall_nr_setpriority = 97;
   syscall_nr_setpriority = 97;
-  syscall_nr_syslog = 103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_setitimer = 104;
   syscall_nr_setitimer = 104;
   syscall_nr_getitimer = 105;
   syscall_nr_getitimer = 105;
   syscall_nr_wait4 = 114;
   syscall_nr_wait4 = 114;
-  syscall_nr_swapoff = 115; // Blacklisted. Do not use.
   syscall_nr_sysinfo = 116;
   syscall_nr_sysinfo = 116;
   syscall_nr_fsync = 118;
   syscall_nr_fsync = 118;
   syscall_nr_sigreturn = 119;
   syscall_nr_sigreturn = 119;
   syscall_nr_clone = 120;
   syscall_nr_clone = 120;
-  syscall_nr_setdomainname = 121; // Blacklisted. Do not use.
   syscall_nr_uname = 122;
   syscall_nr_uname = 122;
-  syscall_nr_adjtimex = 124; // Blacklisted. Do not use.
   syscall_nr_mprotect = 125;
   syscall_nr_mprotect = 125;
-  syscall_nr_init_module = 128; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 129; // Blacklisted. Do not use.
   syscall_nr_quotactl = 131;
   syscall_nr_quotactl = 131;
   syscall_nr_getpgid = 132;
   syscall_nr_getpgid = 132;
   syscall_nr_fchdir = 133;
   syscall_nr_fchdir = 133;
   syscall_nr_personality = 136;
   syscall_nr_personality = 136;
-  syscall_nr_setfsuid = 138; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 139; // Blacklisted. Do not use.
   syscall_nr__llseek = 140;
   syscall_nr__llseek = 140;
   syscall_nr_getdents = 141;
   syscall_nr_getdents = 141;
   syscall_nr__newselect = 142;
   syscall_nr__newselect = 142;
@@ -130,28 +113,18 @@ const
   syscall_nr_geteuid = syscall_nr_geteuid32;
   syscall_nr_geteuid = syscall_nr_geteuid32;
   syscall_nr_getegid32 = 202;
   syscall_nr_getegid32 = 202;
   syscall_nr_getegid = syscall_nr_getegid32;
   syscall_nr_getegid = syscall_nr_getegid32;
-  syscall_nr_setreuid32 = 203; // Blacklisted. Do not use.
-  syscall_nr_setreuid = syscall_nr_setreuid32; // Blacklisted. Do not use.
   syscall_nr_setregid32 = 204;
   syscall_nr_setregid32 = 204;
   syscall_nr_setregid = syscall_nr_setregid32;
   syscall_nr_setregid = syscall_nr_setregid32;
   syscall_nr_getgroups32 = 205;
   syscall_nr_getgroups32 = 205;
   syscall_nr_getgroups = syscall_nr_getgroups32;
   syscall_nr_getgroups = syscall_nr_getgroups32;
-  syscall_nr_setgroups32 = 206; // Blacklisted. Do not use.
-  syscall_nr_setgroups = syscall_nr_setgroups32; // Blacklisted. Do not use.
   syscall_nr_fchown32 = 207;
   syscall_nr_fchown32 = 207;
   syscall_nr_fchown = syscall_nr_fchown32;
   syscall_nr_fchown = syscall_nr_fchown32;
   syscall_nr_setresuid32 = 208;
   syscall_nr_setresuid32 = 208;
   syscall_nr_setresuid = syscall_nr_setresuid32;
   syscall_nr_setresuid = syscall_nr_setresuid32;
   syscall_nr_getresuid32 = 209;
   syscall_nr_getresuid32 = 209;
   syscall_nr_getresuid = syscall_nr_getresuid32;
   syscall_nr_getresuid = syscall_nr_getresuid32;
-  syscall_nr_setresgid32 = 210; // Blacklisted. Do not use.
-  syscall_nr_setresgid = syscall_nr_setresgid32; // Blacklisted. Do not use.
   syscall_nr_getresgid32 = 211;
   syscall_nr_getresgid32 = 211;
   syscall_nr_getresgid = syscall_nr_getresgid32;
   syscall_nr_getresgid = syscall_nr_getresgid32;
-  syscall_nr_setuid32 = 213; // Blacklisted. Do not use.
-  syscall_nr_setuid = syscall_nr_setuid32; // Blacklisted. Do not use.
-  syscall_nr_setgid32 = 214; // Blacklisted. Do not use.
-  syscall_nr_setgid = syscall_nr_setgid32; // Blacklisted. Do not use.
   syscall_nr_getdents64 = 217;
   syscall_nr_getdents64 = 217;
   syscall_nr_mincore = 219;
   syscall_nr_mincore = 219;
   syscall_nr_madvise = 220;
   syscall_nr_madvise = 220;
@@ -191,7 +164,6 @@ const
   syscall_nr_timer_gettime = 259;
   syscall_nr_timer_gettime = 259;
   syscall_nr_timer_getoverrun = 260;
   syscall_nr_timer_getoverrun = 260;
   syscall_nr_timer_delete = 261;
   syscall_nr_timer_delete = 261;
-  syscall_nr_clock_settime = 262; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 263;
   syscall_nr_clock_gettime = 263;
   syscall_nr_clock_getres = 264;
   syscall_nr_clock_getres = 264;
   syscall_nr_clock_nanosleep = 265;
   syscall_nr_clock_nanosleep = 265;
@@ -260,7 +232,6 @@ const
   syscall_nr_accept4 = 366;
   syscall_nr_accept4 = 366;
   syscall_nr_prlimit64 = 369;
   syscall_nr_prlimit64 = 369;
   syscall_nr_prlimit = syscall_nr_prlimit64;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 372; // Blacklisted. Do not use.
   syscall_nr_syncfs = 373;
   syscall_nr_syncfs = 373;
   syscall_nr_sendmmsg = 374;
   syscall_nr_sendmmsg = 374;
   syscall_nr_setns = 375;
   syscall_nr_setns = 375;
@@ -280,3 +251,36 @@ const
   syscall_nr___ARM_NR_cacheflush = 983042;
   syscall_nr___ARM_NR_cacheflush = 983042;
   syscall_nr_cacheflush = syscall_nr___ARM_NR_cacheflush;
   syscall_nr_cacheflush = syscall_nr___ARM_NR_cacheflush;
   syscall_nr___ARM_NR_set_tls = 983045;
   syscall_nr___ARM_NR_set_tls = 983045;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_mount = 21 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 51 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 52 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 61 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 74 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 79 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 87 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 88 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 115 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 124 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 128 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 129 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 138 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 139 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid32 = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups32 = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid32 = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid32 = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid32 = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 262 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 372 deprecated 'This syscall is blocked on Android 8+';

+ 33 - 29
rtl/android/i386/sysnr.inc

@@ -16,7 +16,6 @@ const
   syscall_nr_chdir = 12;
   syscall_nr_chdir = 12;
   syscall_nr_lseek = 19;
   syscall_nr_lseek = 19;
   syscall_nr_getpid = 20;
   syscall_nr_getpid = 20;
-  syscall_nr_mount = 21; // Blacklisted. Do not use.
   syscall_nr_getuid = 24;
   syscall_nr_getuid = 24;
   syscall_nr_ptrace = 26;
   syscall_nr_ptrace = 26;
   syscall_nr_access = 33;
   syscall_nr_access = 33;
@@ -28,25 +27,18 @@ const
   syscall_nr_pipe = 42;
   syscall_nr_pipe = 42;
   syscall_nr_times = 43;
   syscall_nr_times = 43;
   syscall_nr_brk = 45;
   syscall_nr_brk = 45;
-  syscall_nr_acct = 51; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 52; // Blacklisted. Do not use.
   syscall_nr_ioctl = 54;
   syscall_nr_ioctl = 54;
   syscall_nr_fcntl = 55;
   syscall_nr_fcntl = 55;
   syscall_nr_setpgid = 57;
   syscall_nr_setpgid = 57;
   syscall_nr_umask = 60;
   syscall_nr_umask = 60;
-  syscall_nr_chroot = 61; // Blacklisted. Do not use.
   syscall_nr_dup2 = 63;
   syscall_nr_dup2 = 63;
   syscall_nr_getppid = 64;
   syscall_nr_getppid = 64;
   syscall_nr_setsid = 66;
   syscall_nr_setsid = 66;
   syscall_nr_sigaction = 67;
   syscall_nr_sigaction = 67;
-  syscall_nr_sethostname = 74; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 75;
   syscall_nr_setrlimit = 75;
   syscall_nr_getrusage = 77;
   syscall_nr_getrusage = 77;
   syscall_nr_gettimeofday = 78;
   syscall_nr_gettimeofday = 78;
-  syscall_nr_settimeofday = 79; // Blacklisted. Do not use.
   syscall_nr_readlink = 85;
   syscall_nr_readlink = 85;
-  syscall_nr_swapon = 87; // Blacklisted. Do not use.
-  syscall_nr_reboot = 88; // Blacklisted. Do not use.
   syscall_nr_mmap = 90;
   syscall_nr_mmap = 90;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_munmap = 91;
   syscall_nr_munmap = 91;
@@ -55,28 +47,19 @@ const
   syscall_nr_getpriority = 96;
   syscall_nr_getpriority = 96;
   syscall_nr_setpriority = 97;
   syscall_nr_setpriority = 97;
   syscall_nr_socketcall = 102;
   syscall_nr_socketcall = 102;
-  syscall_nr_syslog = 103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_setitimer = 104;
   syscall_nr_setitimer = 104;
   syscall_nr_getitimer = 105;
   syscall_nr_getitimer = 105;
   syscall_nr_wait4 = 114;
   syscall_nr_wait4 = 114;
-  syscall_nr_swapoff = 115; // Blacklisted. Do not use.
   syscall_nr_sysinfo = 116;
   syscall_nr_sysinfo = 116;
   syscall_nr_fsync = 118;
   syscall_nr_fsync = 118;
   syscall_nr_sigreturn = 119;
   syscall_nr_sigreturn = 119;
   syscall_nr_clone = 120;
   syscall_nr_clone = 120;
-  syscall_nr_setdomainname = 121; // Blacklisted. Do not use.
   syscall_nr_uname = 122;
   syscall_nr_uname = 122;
-  syscall_nr_adjtimex = 124; // Blacklisted. Do not use.
   syscall_nr_mprotect = 125;
   syscall_nr_mprotect = 125;
-  syscall_nr_init_module = 128; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 129; // Blacklisted. Do not use.
   syscall_nr_quotactl = 131;
   syscall_nr_quotactl = 131;
   syscall_nr_getpgid = 132;
   syscall_nr_getpgid = 132;
   syscall_nr_fchdir = 133;
   syscall_nr_fchdir = 133;
   syscall_nr_personality = 136;
   syscall_nr_personality = 136;
-  syscall_nr_setfsuid = 138; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 139; // Blacklisted. Do not use.
   syscall_nr__llseek = 140;
   syscall_nr__llseek = 140;
   syscall_nr_getdents = 141;
   syscall_nr_getdents = 141;
   syscall_nr__newselect = 142;
   syscall_nr__newselect = 142;
@@ -133,28 +116,18 @@ const
   syscall_nr_geteuid = syscall_nr_geteuid32;
   syscall_nr_geteuid = syscall_nr_geteuid32;
   syscall_nr_getegid32 = 202;
   syscall_nr_getegid32 = 202;
   syscall_nr_getegid = syscall_nr_getegid32;
   syscall_nr_getegid = syscall_nr_getegid32;
-  syscall_nr_setreuid32 = 203; // Blacklisted. Do not use.
-  syscall_nr_setreuid = syscall_nr_setreuid32; // Blacklisted. Do not use.
   syscall_nr_setregid32 = 204;
   syscall_nr_setregid32 = 204;
   syscall_nr_setregid = syscall_nr_setregid32;
   syscall_nr_setregid = syscall_nr_setregid32;
   syscall_nr_getgroups32 = 205;
   syscall_nr_getgroups32 = 205;
   syscall_nr_getgroups = syscall_nr_getgroups32;
   syscall_nr_getgroups = syscall_nr_getgroups32;
-  syscall_nr_setgroups32 = 206; // Blacklisted. Do not use.
-  syscall_nr_setgroups = syscall_nr_setgroups32; // Blacklisted. Do not use.
   syscall_nr_fchown32 = 207;
   syscall_nr_fchown32 = 207;
   syscall_nr_fchown = syscall_nr_fchown32;
   syscall_nr_fchown = syscall_nr_fchown32;
   syscall_nr_setresuid32 = 208;
   syscall_nr_setresuid32 = 208;
   syscall_nr_setresuid = syscall_nr_setresuid32;
   syscall_nr_setresuid = syscall_nr_setresuid32;
   syscall_nr_getresuid32 = 209;
   syscall_nr_getresuid32 = 209;
   syscall_nr_getresuid = syscall_nr_getresuid32;
   syscall_nr_getresuid = syscall_nr_getresuid32;
-  syscall_nr_setresgid32 = 210; // Blacklisted. Do not use.
-  syscall_nr_setresgid = syscall_nr_setresgid32; // Blacklisted. Do not use.
   syscall_nr_getresgid32 = 211;
   syscall_nr_getresgid32 = 211;
   syscall_nr_getresgid = syscall_nr_getresgid32;
   syscall_nr_getresgid = syscall_nr_getresgid32;
-  syscall_nr_setuid32 = 213; // Blacklisted. Do not use.
-  syscall_nr_setuid = syscall_nr_setuid32; // Blacklisted. Do not use.
-  syscall_nr_setgid32 = 214; // Blacklisted. Do not use.
-  syscall_nr_setgid = syscall_nr_setgid32; // Blacklisted. Do not use.
   syscall_nr_mincore = 218;
   syscall_nr_mincore = 218;
   syscall_nr_madvise = 219;
   syscall_nr_madvise = 219;
   syscall_nr_getdents64 = 220;
   syscall_nr_getdents64 = 220;
@@ -195,7 +168,6 @@ const
   syscall_nr_timer_gettime = 261;
   syscall_nr_timer_gettime = 261;
   syscall_nr_timer_getoverrun = 262;
   syscall_nr_timer_getoverrun = 262;
   syscall_nr_timer_delete = 263;
   syscall_nr_timer_delete = 263;
-  syscall_nr_clock_settime = 264; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 265;
   syscall_nr_clock_gettime = 265;
   syscall_nr_clock_getres = 266;
   syscall_nr_clock_getres = 266;
   syscall_nr_clock_nanosleep = 267;
   syscall_nr_clock_nanosleep = 267;
@@ -248,7 +220,6 @@ const
   syscall_nr_perf_event_open = 336;
   syscall_nr_perf_event_open = 336;
   syscall_nr_prlimit64 = 340;
   syscall_nr_prlimit64 = 340;
   syscall_nr_prlimit = syscall_nr_prlimit64;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 343; // Blacklisted. Do not use.
   syscall_nr_syncfs = 344;
   syscall_nr_syncfs = 344;
   syscall_nr_setns = 346;
   syscall_nr_setns = 346;
   syscall_nr_process_vm_readv = 347;
   syscall_nr_process_vm_readv = 347;
@@ -264,3 +235,36 @@ const
   syscall_nr_copy_file_range = 377;
   syscall_nr_copy_file_range = 377;
   syscall_nr_preadv2 = 378;
   syscall_nr_preadv2 = 378;
   syscall_nr_pwritev2 = 379;
   syscall_nr_pwritev2 = 379;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_mount = 21 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 51 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 52 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 61 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 74 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 79 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 87 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 88 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 115 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 124 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 128 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 129 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 138 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 139 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid32 = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups32 = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid32 = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid32 = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid32 = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 264 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 343 deprecated 'This syscall is blocked on Android 8+';

+ 28 - 24
rtl/android/mips64/sysnr.inc

@@ -72,27 +72,18 @@ const
   syscall_nr_times = 5098;
   syscall_nr_times = 5098;
   syscall_nr_ptrace = 5099;
   syscall_nr_ptrace = 5099;
   syscall_nr_getuid = 5100;
   syscall_nr_getuid = 5100;
-  syscall_nr_syslog = 5101; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_getgid = 5102;
   syscall_nr_getgid = 5102;
-  syscall_nr_setuid = 5103; // Blacklisted. Do not use.
-  syscall_nr_setgid = 5104; // Blacklisted. Do not use.
   syscall_nr_geteuid = 5105;
   syscall_nr_geteuid = 5105;
   syscall_nr_getegid = 5106;
   syscall_nr_getegid = 5106;
   syscall_nr_setpgid = 5107;
   syscall_nr_setpgid = 5107;
   syscall_nr_getppid = 5108;
   syscall_nr_getppid = 5108;
   syscall_nr_setsid = 5110;
   syscall_nr_setsid = 5110;
-  syscall_nr_setreuid = 5111; // Blacklisted. Do not use.
   syscall_nr_setregid = 5112;
   syscall_nr_setregid = 5112;
   syscall_nr_getgroups = 5113;
   syscall_nr_getgroups = 5113;
-  syscall_nr_setgroups = 5114; // Blacklisted. Do not use.
   syscall_nr_setresuid = 5115;
   syscall_nr_setresuid = 5115;
   syscall_nr_getresuid = 5116;
   syscall_nr_getresuid = 5116;
-  syscall_nr_setresgid = 5117; // Blacklisted. Do not use.
   syscall_nr_getresgid = 5118;
   syscall_nr_getresgid = 5118;
   syscall_nr_getpgid = 5119;
   syscall_nr_getpgid = 5119;
-  syscall_nr_setfsuid = 5120; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 5121; // Blacklisted. Do not use.
   syscall_nr_getsid = 5122;
   syscall_nr_getsid = 5122;
   syscall_nr_capget = 5123;
   syscall_nr_capget = 5123;
   syscall_nr_capset = 5124;
   syscall_nr_capset = 5124;
@@ -119,21 +110,8 @@ const
   syscall_nr_munlockall = 5149;
   syscall_nr_munlockall = 5149;
   syscall_nr_pivot_root = 5151;
   syscall_nr_pivot_root = 5151;
   syscall_nr_prctl = 5153;
   syscall_nr_prctl = 5153;
-  syscall_nr_adjtimex = 5154; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 5155;
   syscall_nr_setrlimit = 5155;
-  syscall_nr_chroot = 5156; // Blacklisted. Do not use.
   syscall_nr_sync = 5157;
   syscall_nr_sync = 5157;
-  syscall_nr_acct = 5158; // Blacklisted. Do not use.
-  syscall_nr_settimeofday = 5159; // Blacklisted. Do not use.
-  syscall_nr_mount = 5160; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 5161; // Blacklisted. Do not use.
-  syscall_nr_swapon = 5162; // Blacklisted. Do not use.
-  syscall_nr_swapoff = 5163; // Blacklisted. Do not use.
-  syscall_nr_reboot = 5164; // Blacklisted. Do not use.
-  syscall_nr_sethostname = 5165; // Blacklisted. Do not use.
-  syscall_nr_setdomainname = 5166; // Blacklisted. Do not use.
-  syscall_nr_init_module = 5168; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 5169; // Blacklisted. Do not use.
   syscall_nr_quotactl = 5172;
   syscall_nr_quotactl = 5172;
   syscall_nr_gettid = 5178;
   syscall_nr_gettid = 5178;
   syscall_nr_readahead = 5179;
   syscall_nr_readahead = 5179;
@@ -170,7 +148,6 @@ const
   syscall_nr_timer_gettime = 5218;
   syscall_nr_timer_gettime = 5218;
   syscall_nr_timer_getoverrun = 5219;
   syscall_nr_timer_getoverrun = 5219;
   syscall_nr_timer_delete = 5220;
   syscall_nr_timer_delete = 5220;
-  syscall_nr_clock_settime = 5221; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 5222;
   syscall_nr_clock_gettime = 5222;
   syscall_nr_clock_getres = 5223;
   syscall_nr_clock_getres = 5223;
   syscall_nr_clock_nanosleep = 5224;
   syscall_nr_clock_nanosleep = 5224;
@@ -225,7 +202,6 @@ const
   syscall_nr_recvmmsg = 5294;
   syscall_nr_recvmmsg = 5294;
   syscall_nr_prlimit64 = 5297;
   syscall_nr_prlimit64 = 5297;
   syscall_nr_prlimit = syscall_nr_prlimit64;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 5300; // Blacklisted. Do not use.
   syscall_nr_syncfs = 5301;
   syscall_nr_syncfs = 5301;
   syscall_nr_sendmmsg = 5302;
   syscall_nr_sendmmsg = 5302;
   syscall_nr_setns = 5303;
   syscall_nr_setns = 5303;
@@ -243,3 +219,31 @@ const
   syscall_nr_copy_file_range = 5320;
   syscall_nr_copy_file_range = 5320;
   syscall_nr_preadv2 = 5321;
   syscall_nr_preadv2 = 5321;
   syscall_nr_pwritev2 = 5322;
   syscall_nr_pwritev2 = 5322;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_syslog = 5101 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 5101 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 5103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 5104 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 5111 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 5114 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 5117 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 5120 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 5121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 5154 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 5156 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 5158 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 5159 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_mount = 5160 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 5161 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 5162 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 5163 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 5164 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 5165 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 5166 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 5168 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 5169 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 5221 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 5300 deprecated 'This syscall is blocked on Android 8+';

+ 28 - 24
rtl/android/mipsel/sysnr.inc

@@ -15,8 +15,6 @@ const
   syscall_nr_chdir = 4012;
   syscall_nr_chdir = 4012;
   syscall_nr_lseek = 4019;
   syscall_nr_lseek = 4019;
   syscall_nr_getpid = 4020;
   syscall_nr_getpid = 4020;
-  syscall_nr_mount = 4021; // Blacklisted. Do not use.
-  syscall_nr_setuid = 4023; // Blacklisted. Do not use.
   syscall_nr_getuid = 4024;
   syscall_nr_getuid = 4024;
   syscall_nr_ptrace = 4026;
   syscall_nr_ptrace = 4026;
   syscall_nr_access = 4033;
   syscall_nr_access = 4033;
@@ -28,34 +26,24 @@ const
   syscall_nr_pipe = 4042;
   syscall_nr_pipe = 4042;
   syscall_nr_times = 4043;
   syscall_nr_times = 4043;
   syscall_nr_brk = 4045;
   syscall_nr_brk = 4045;
-  syscall_nr_setgid = 4046; // Blacklisted. Do not use.
   syscall_nr_getgid = 4047;
   syscall_nr_getgid = 4047;
   syscall_nr_geteuid = 4049;
   syscall_nr_geteuid = 4049;
   syscall_nr_getegid = 4050;
   syscall_nr_getegid = 4050;
-  syscall_nr_acct = 4051; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 4052; // Blacklisted. Do not use.
   syscall_nr_ioctl = 4054;
   syscall_nr_ioctl = 4054;
   syscall_nr_fcntl = 4055;
   syscall_nr_fcntl = 4055;
   syscall_nr_setpgid = 4057;
   syscall_nr_setpgid = 4057;
   syscall_nr_umask = 4060;
   syscall_nr_umask = 4060;
-  syscall_nr_chroot = 4061; // Blacklisted. Do not use.
   syscall_nr_dup2 = 4063;
   syscall_nr_dup2 = 4063;
   syscall_nr_getppid = 4064;
   syscall_nr_getppid = 4064;
   syscall_nr_setsid = 4066;
   syscall_nr_setsid = 4066;
   syscall_nr_sigaction = 4067;
   syscall_nr_sigaction = 4067;
-  syscall_nr_setreuid = 4070; // Blacklisted. Do not use.
   syscall_nr_setregid = 4071;
   syscall_nr_setregid = 4071;
-  syscall_nr_sethostname = 4074; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 4075;
   syscall_nr_setrlimit = 4075;
   syscall_nr_getrlimit = 4076;
   syscall_nr_getrlimit = 4076;
   syscall_nr_getrusage = 4077;
   syscall_nr_getrusage = 4077;
   syscall_nr_gettimeofday = 4078;
   syscall_nr_gettimeofday = 4078;
-  syscall_nr_settimeofday = 4079; // Blacklisted. Do not use.
   syscall_nr_getgroups = 4080;
   syscall_nr_getgroups = 4080;
-  syscall_nr_setgroups = 4081; // Blacklisted. Do not use.
   syscall_nr_readlink = 4085;
   syscall_nr_readlink = 4085;
-  syscall_nr_swapon = 4087; // Blacklisted. Do not use.
-  syscall_nr_reboot = 4088; // Blacklisted. Do not use.
   syscall_nr_mmap = 4090;
   syscall_nr_mmap = 4090;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_munmap = 4091;
   syscall_nr_munmap = 4091;
@@ -64,28 +52,19 @@ const
   syscall_nr_fchown = 4095;
   syscall_nr_fchown = 4095;
   syscall_nr_getpriority = 4096;
   syscall_nr_getpriority = 4096;
   syscall_nr_setpriority = 4097;
   syscall_nr_setpriority = 4097;
-  syscall_nr_syslog = 4103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_setitimer = 4104;
   syscall_nr_setitimer = 4104;
   syscall_nr_getitimer = 4105;
   syscall_nr_getitimer = 4105;
   syscall_nr_wait4 = 4114;
   syscall_nr_wait4 = 4114;
-  syscall_nr_swapoff = 4115; // Blacklisted. Do not use.
   syscall_nr_sysinfo = 4116;
   syscall_nr_sysinfo = 4116;
   syscall_nr_fsync = 4118;
   syscall_nr_fsync = 4118;
   syscall_nr_sigreturn = 4119;
   syscall_nr_sigreturn = 4119;
   syscall_nr_clone = 4120;
   syscall_nr_clone = 4120;
-  syscall_nr_setdomainname = 4121; // Blacklisted. Do not use.
   syscall_nr_uname = 4122;
   syscall_nr_uname = 4122;
-  syscall_nr_adjtimex = 4124; // Blacklisted. Do not use.
   syscall_nr_mprotect = 4125;
   syscall_nr_mprotect = 4125;
-  syscall_nr_init_module = 4128; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 4129; // Blacklisted. Do not use.
   syscall_nr_quotactl = 4131;
   syscall_nr_quotactl = 4131;
   syscall_nr_getpgid = 4132;
   syscall_nr_getpgid = 4132;
   syscall_nr_fchdir = 4133;
   syscall_nr_fchdir = 4133;
   syscall_nr_personality = 4136;
   syscall_nr_personality = 4136;
-  syscall_nr_setfsuid = 4138; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 4139; // Blacklisted. Do not use.
   syscall_nr__llseek = 4140;
   syscall_nr__llseek = 4140;
   syscall_nr_getdents = 4141;
   syscall_nr_getdents = 4141;
   syscall_nr__newselect = 4142;
   syscall_nr__newselect = 4142;
@@ -127,7 +106,6 @@ const
   syscall_nr_setresuid = 4185;
   syscall_nr_setresuid = 4185;
   syscall_nr_getresuid = 4186;
   syscall_nr_getresuid = 4186;
   syscall_nr_poll = 4188;
   syscall_nr_poll = 4188;
-  syscall_nr_setresgid = 4190; // Blacklisted. Do not use.
   syscall_nr_getresgid = 4191;
   syscall_nr_getresgid = 4191;
   syscall_nr_prctl = 4192;
   syscall_nr_prctl = 4192;
   syscall_nr_rt_sigreturn = 4193;
   syscall_nr_rt_sigreturn = 4193;
@@ -194,7 +172,6 @@ const
   syscall_nr_timer_gettime = 4259;
   syscall_nr_timer_gettime = 4259;
   syscall_nr_timer_getoverrun = 4260;
   syscall_nr_timer_getoverrun = 4260;
   syscall_nr_timer_delete = 4261;
   syscall_nr_timer_delete = 4261;
-  syscall_nr_clock_settime = 4262; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 4263;
   syscall_nr_clock_gettime = 4263;
   syscall_nr_clock_getres = 4264;
   syscall_nr_clock_getres = 4264;
   syscall_nr_clock_nanosleep = 4265;
   syscall_nr_clock_nanosleep = 4265;
@@ -247,7 +224,6 @@ const
   syscall_nr_recvmmsg = 4335;
   syscall_nr_recvmmsg = 4335;
   syscall_nr_prlimit64 = 4338;
   syscall_nr_prlimit64 = 4338;
   syscall_nr_prlimit = syscall_nr_prlimit64;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 4341; // Blacklisted. Do not use.
   syscall_nr_syncfs = 4342;
   syscall_nr_syncfs = 4342;
   syscall_nr_sendmmsg = 4343;
   syscall_nr_sendmmsg = 4343;
   syscall_nr_setns = 4344;
   syscall_nr_setns = 4344;
@@ -264,3 +240,31 @@ const
   syscall_nr_copy_file_range = 4360;
   syscall_nr_copy_file_range = 4360;
   syscall_nr_preadv2 = 4361;
   syscall_nr_preadv2 = 4361;
   syscall_nr_pwritev2 = 4362;
   syscall_nr_pwritev2 = 4362;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_mount = 4021 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 4023 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 4046 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 4051 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 4052 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 4061 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 4070 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 4074 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 4079 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 4081 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 4087 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 4088 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 4103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 4103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 4115 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 4121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 4124 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 4128 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 4129 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 4138 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 4139 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 4190 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 4262 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 4341 deprecated 'This syscall is blocked on Android 8+';

+ 28 - 24
rtl/android/x86_64/sysnr.inc

@@ -74,27 +74,18 @@ const
   syscall_nr_times = 100;
   syscall_nr_times = 100;
   syscall_nr_ptrace = 101;
   syscall_nr_ptrace = 101;
   syscall_nr_getuid = 102;
   syscall_nr_getuid = 102;
-  syscall_nr_syslog = 103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_getgid = 104;
   syscall_nr_getgid = 104;
-  syscall_nr_setuid = 105; // Blacklisted. Do not use.
-  syscall_nr_setgid = 106; // Blacklisted. Do not use.
   syscall_nr_geteuid = 107;
   syscall_nr_geteuid = 107;
   syscall_nr_getegid = 108;
   syscall_nr_getegid = 108;
   syscall_nr_setpgid = 109;
   syscall_nr_setpgid = 109;
   syscall_nr_getppid = 110;
   syscall_nr_getppid = 110;
   syscall_nr_setsid = 112;
   syscall_nr_setsid = 112;
-  syscall_nr_setreuid = 113; // Blacklisted. Do not use.
   syscall_nr_setregid = 114;
   syscall_nr_setregid = 114;
   syscall_nr_getgroups = 115;
   syscall_nr_getgroups = 115;
-  syscall_nr_setgroups = 116; // Blacklisted. Do not use.
   syscall_nr_setresuid = 117;
   syscall_nr_setresuid = 117;
   syscall_nr_getresuid = 118;
   syscall_nr_getresuid = 118;
-  syscall_nr_setresgid = 119; // Blacklisted. Do not use.
   syscall_nr_getresgid = 120;
   syscall_nr_getresgid = 120;
   syscall_nr_getpgid = 121;
   syscall_nr_getpgid = 121;
-  syscall_nr_setfsuid = 122; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 123; // Blacklisted. Do not use.
   syscall_nr_getsid = 124;
   syscall_nr_getsid = 124;
   syscall_nr_capget = 125;
   syscall_nr_capget = 125;
   syscall_nr_capset = 126;
   syscall_nr_capset = 126;
@@ -122,21 +113,8 @@ const
   syscall_nr_pivot_root = 155;
   syscall_nr_pivot_root = 155;
   syscall_nr_prctl = 157;
   syscall_nr_prctl = 157;
   syscall_nr_arch_prctl = 158;
   syscall_nr_arch_prctl = 158;
-  syscall_nr_adjtimex = 159; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 160;
   syscall_nr_setrlimit = 160;
-  syscall_nr_chroot = 161; // Blacklisted. Do not use.
   syscall_nr_sync = 162;
   syscall_nr_sync = 162;
-  syscall_nr_acct = 163; // Blacklisted. Do not use.
-  syscall_nr_settimeofday = 164; // Blacklisted. Do not use.
-  syscall_nr_mount = 165; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 166; // Blacklisted. Do not use.
-  syscall_nr_swapon = 167; // Blacklisted. Do not use.
-  syscall_nr_swapoff = 168; // Blacklisted. Do not use.
-  syscall_nr_reboot = 169; // Blacklisted. Do not use.
-  syscall_nr_sethostname = 170; // Blacklisted. Do not use.
-  syscall_nr_setdomainname = 171; // Blacklisted. Do not use.
-  syscall_nr_init_module = 175; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 176; // Blacklisted. Do not use.
   syscall_nr_quotactl = 179;
   syscall_nr_quotactl = 179;
   syscall_nr_gettid = 186;
   syscall_nr_gettid = 186;
   syscall_nr_readahead = 187;
   syscall_nr_readahead = 187;
@@ -170,7 +148,6 @@ const
   syscall_nr_timer_gettime = 224;
   syscall_nr_timer_gettime = 224;
   syscall_nr_timer_getoverrun = 225;
   syscall_nr_timer_getoverrun = 225;
   syscall_nr_timer_delete = 226;
   syscall_nr_timer_delete = 226;
-  syscall_nr_clock_settime = 227; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 228;
   syscall_nr_clock_gettime = 228;
   syscall_nr_clock_getres = 229;
   syscall_nr_clock_getres = 229;
   syscall_nr_clock_nanosleep = 230;
   syscall_nr_clock_nanosleep = 230;
@@ -225,7 +202,6 @@ const
   syscall_nr_recvmmsg = 299;
   syscall_nr_recvmmsg = 299;
   syscall_nr_prlimit64 = 302;
   syscall_nr_prlimit64 = 302;
   syscall_nr_prlimit = syscall_nr_prlimit64;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 305; // Blacklisted. Do not use.
   syscall_nr_syncfs = 306;
   syscall_nr_syncfs = 306;
   syscall_nr_sendmmsg = 307;
   syscall_nr_sendmmsg = 307;
   syscall_nr_setns = 308;
   syscall_nr_setns = 308;
@@ -243,3 +219,31 @@ const
   syscall_nr_copy_file_range = 326;
   syscall_nr_copy_file_range = 326;
   syscall_nr_preadv2 = 327;
   syscall_nr_preadv2 = 327;
   syscall_nr_pwritev2 = 328;
   syscall_nr_pwritev2 = 328;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_syslog = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 105 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 106 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 113 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 116 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 119 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 122 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 123 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 159 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 161 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 163 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 164 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_mount = 165 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 166 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 167 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 168 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 169 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 170 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 171 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 175 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 176 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 227 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 305 deprecated 'This syscall is blocked on Android 8+';

+ 9 - 0
rtl/inc/llvmintr.inc

@@ -22,3 +22,12 @@ function llvm_eh_typeid_for(sym: pointer): longint; compilerproc; external name
 
 
 procedure llvm_lifetime_start(size: int64; ptr: pointer); compilerproc; external name 'llvm.lifetime.start';
 procedure llvm_lifetime_start(size: int64; ptr: pointer); compilerproc; external name 'llvm.lifetime.start';
 procedure llvm_lifetime_end(size: int64; ptr: pointer); compilerproc; external name 'llvm.lifetime.end';
 procedure llvm_lifetime_end(size: int64; ptr: pointer); compilerproc; external name 'llvm.lifetime.end';
+
+function llvm_sqrt_f32(val: single): single; compilerproc; external name 'llvm.sqrt.f32';
+function llvm_sqrt_f64(val: double): double; compilerproc; external name 'llvm.sqrt.f64';
+{$ifdef SUPPORT_EXTENDED}
+function llvm_sqrt_f80(val: extended): extended; compilerproc; external name 'llvm.sqrt.f80';
+{$endif}
+{$ifdef SUPPORT_FLOAT128}
+function llvm_sqrt_f128(val: float128): float128; compilerproc; external name 'llvm.sqrt.f128';
+{$endif}

+ 2 - 2
rtl/linux/bunxsysc.inc

@@ -460,7 +460,7 @@ Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cin
   Select checks whether the file descriptor sets in readfs/writefs/exceptfs
   Select checks whether the file descriptor sets in readfs/writefs/exceptfs
   have changed.
   have changed.
 }
 }
-{$if defined(generic_linux_syscalls)}
+{$if defined(generic_linux_syscalls) and not defined(NO_SYSCALL_PSELECT6)}
 
 
 var ts : timespec;
 var ts : timespec;
     pts : PTimeSpec;
     pts : PTimeSpec;
@@ -495,7 +495,7 @@ end;
 {$endif}
 {$endif}
 
 
 function fpPoll(fds: ppollfd; nfds: cuint; timeout: clong): cint;
 function fpPoll(fds: ppollfd; nfds: cuint; timeout: clong): cint;
-{$if defined(generic_linux_syscalls)}
+{$if defined(generic_linux_syscalls) and not defined(NO_SYSCALL_PPOLL)}
 var ts : timespec;
 var ts : timespec;
 begin
 begin
   if timeout<0 then
   if timeout<0 then

+ 4 - 0
rtl/linux/osdefs.inc

@@ -107,6 +107,10 @@
 
 
 {$ifdef android}
 {$ifdef android}
   {$define generic_linux_syscalls}
   {$define generic_linux_syscalls}
+  {$ifdef cpuarm}
+    {$define NO_SYSCALL_PSELECT6}
+    {$define NO_SYSCALL_PPOLL}
+  {$endif cpuarm}
   {$define userenameat}
   {$define userenameat}
   {$undef usestime}
   {$undef usestime}
   {$undef OLDMMAP}
   {$undef OLDMMAP}

+ 6 - 0
rtl/objpas/classes/bits.inc

@@ -173,6 +173,12 @@ begin
       result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
       result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
 end;
 end;
 
 
+procedure TBits.CopyBits(BitSet : TBits);
+begin
+  setSize(bitset.Size);
+  Move(bitset.FBits^,FBits^,FSize*SizeOf(cardinal));
+end;
+
 procedure TBits.andbits(bitset : TBits);
 procedure TBits.andbits(bitset : TBits);
 var
 var
    n : longint;
    n : longint;

+ 1 - 0
rtl/objpas/classes/classesh.inc

@@ -400,6 +400,7 @@ type
       procedure SetOn(Bit : longint);
       procedure SetOn(Bit : longint);
       procedure Clear(Bit : longint);
       procedure Clear(Bit : longint);
       procedure Clearall;
       procedure Clearall;
+      procedure CopyBits(BitSet : TBits);
       procedure AndBits(BitSet : TBits);
       procedure AndBits(BitSet : TBits);
       procedure OrBits(BitSet : TBits);
       procedure OrBits(BitSet : TBits);
       procedure XorBits(BitSet : TBits);
       procedure XorBits(BitSet : TBits);

+ 11 - 0
rtl/objpas/sysutils/sysstr.inc

@@ -850,6 +850,17 @@ begin
  System.Str(Value, result);
  System.Str(Value, result);
 end ;
 end ;
 
 
+function UIntToStr(Value: QWord): string;
+
+begin
+  result:=IntTostr(Value);
+end;
+
+function UIntToStr(Value: Cardinal): string; 
+
+begin
+  System.Str(Value, result);
+end;
 
 
 {   IntToHex returns a string representing the hexadecimal value of Value   }
 {   IntToHex returns a string representing the hexadecimal value of Value   }
 
 

+ 2 - 0
rtl/objpas/sysutils/sysstrh.inc

@@ -115,6 +115,8 @@ function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDot
 function IntToStr(Value: Longint): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: Longint): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: Int64): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: Int64): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: QWord): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: QWord): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
+function UIntToStr(Value: QWord): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
+function UIntToStr(Value: Cardinal): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToHex(Value: Longint; Digits: integer): string;
 function IntToHex(Value: Longint; Digits: integer): string;
 function IntToHex(Value: Int64; Digits: integer): string;
 function IntToHex(Value: Int64; Digits: integer): string;
 function IntToHex(Value: QWord; Digits: integer): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToHex(Value: QWord; Digits: integer): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}

+ 7 - 1
rtl/solaris/ostypes.inc

@@ -170,15 +170,21 @@ CONST
     { File access modes for `open' and `fcntl'.    }
     { File access modes for `open' and `fcntl'.    }
     O_RDONLY    = 0;    { Open read-only.  }
     O_RDONLY    = 0;    { Open read-only.  }
     O_WRONLY    = 1;    { Open write-only. }
     O_WRONLY    = 1;    { Open write-only. }
-    O_RDWR      = 2;    { Open read/write. }
+    O_RDWR      = 2;    { Open read/write. }    
+    O_NDELAY    = 4;
     { Bits OR'd into the second argument to open.  }
     { Bits OR'd into the second argument to open.  }
     O_CREAT     = $100; { Create file if it doesn't exist.  }
     O_CREAT     = $100; { Create file if it doesn't exist.  }
     O_EXCL      = $400; { Fail if file already ??????.      }
     O_EXCL      = $400; { Fail if file already ??????.      }
     O_TRUNC     = $200; { Truncate file to zero length.     }
     O_TRUNC     = $200; { Truncate file to zero length.     }
     O_NOCTTY    = $800; { Don't assign a controlling terminal. }
     O_NOCTTY    = $800; { Don't assign a controlling terminal. }
+    O_XATTR     = $4000;
+    O_NOFOLLOW  = $20000;
+    O_NOLINKS   = $40000;
     { File status flags for `open' and `fcntl'.  }
     { File status flags for `open' and `fcntl'.  }
     O_APPEND    =  $08; { Writes append to the file.        }
     O_APPEND    =  $08; { Writes append to the file.        }
+    O_SYNC      =  $10;
     O_NONBLOCK  =  $80; { Non-blocking I/O.                 }
     O_NONBLOCK  =  $80; { Non-blocking I/O.                 }
+    O_LARGEFILE =  $2000;
 
 
 
 
     { mode_t possible values                                 }
     { mode_t possible values                                 }

+ 4 - 1
rtl/unix/unix.pp

@@ -914,6 +914,8 @@ var
   pl   : ^cint;
   pl   : ^cint;
 begin
 begin
   AssignStream:=-1;
   AssignStream:=-1;
+  if fpAccess(prog,X_OK)<>0 then
+    exit(-1);
   if AssignPipe(streamin,pipo)=-1 Then
   if AssignPipe(streamin,pipo)=-1 Then
    exit(-1);
    exit(-1);
   if AssignPipe(pipi,streamout)=-1 Then
   if AssignPipe(pipi,streamout)=-1 Then
@@ -985,7 +987,8 @@ var
   pl: ^cint;
   pl: ^cint;
 begin
 begin
   AssignStream := -1;
   AssignStream := -1;
-
+  if fpAccess(prog,X_OK)<>0 then
+    exit(-1);
   // Assign pipes
   // Assign pipes
   if AssignPipe(StreamIn, PipeOut)=-1 Then
   if AssignPipe(StreamIn, PipeOut)=-1 Then
    Exit(-1);
    Exit(-1);

+ 67 - 27
tests/Makefile

@@ -5,7 +5,7 @@ default: allexectests
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
 BSDs = freebsd netbsd openbsd darwin dragonfly
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
 OSNeedsComspecToRunBatch = go32v2 watcom
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 FORCE:
 .PHONY: FORCE
 .PHONY: FORCE
@@ -184,6 +184,12 @@ $(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t
 endif
 endif
 override FPCOPT+=-Cp$(SUBARCH)
 override FPCOPT+=-Cp$(SUBARCH)
 endif
 endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(SUBARCH),)
 ifeq ($(SUBARCH),)
 $(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
 $(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
@@ -226,7 +232,7 @@ endif
 export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
 export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
 ifdef FPCDIR
 ifdef FPCDIR
 override FPCDIR:=$(subst \,/,$(FPCDIR))
 override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR=wrong
 override FPCDIR=wrong
 endif
 endif
 else
 else
@@ -235,7 +241,7 @@ endif
 ifdef DEFAULT_FPCDIR
 ifdef DEFAULT_FPCDIR
 ifeq ($(FPCDIR),wrong)
 ifeq ($(FPCDIR),wrong)
 override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
 override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR=wrong
 override FPCDIR=wrong
 endif
 endif
 endif
 endif
@@ -249,11 +255,11 @@ endif
 else
 else
 override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
 override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
 override FPCDIR:=$(FPCDIR)/..
 override FPCDIR:=$(FPCDIR)/..
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR:=$(FPCDIR)/..
 override FPCDIR:=$(FPCDIR)/..
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR:=$(BASEDIR)
 override FPCDIR:=$(BASEDIR)
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR=c:/pp
 override FPCDIR=c:/pp
 endif
 endif
 endif
 endif
@@ -298,7 +304,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
 ifeq ($(UNITSDIR),)
 ifeq ($(UNITSDIR),)
 UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 endif
-PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
 ifndef FPCFPMAKE
 ifndef FPCFPMAKE
 ifdef CROSSCOMPILE
 ifdef CROSSCOMPILE
 ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
 ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
@@ -350,9 +356,6 @@ endif
 ifeq ($(FULL_TARGET),i386-solaris)
 ifeq ($(FULL_TARGET),i386-solaris)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_PROGRAMS+=gparmake createlst
-endif
 ifeq ($(FULL_TARGET),i386-netware)
 ifeq ($(FULL_TARGET),i386-netware)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
@@ -398,9 +401,6 @@ endif
 ifeq ($(FULL_TARGET),m68k-linux)
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_PROGRAMS+=gparmake createlst
-endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 ifeq ($(FULL_TARGET),m68k-netbsd)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
@@ -410,10 +410,10 @@ endif
 ifeq ($(FULL_TARGET),m68k-atari)
 ifeq ($(FULL_TARGET),m68k-atari)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
+ifeq ($(FULL_TARGET),m68k-palmos)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
-ifeq ($(FULL_TARGET),m68k-palmos)
+ifeq ($(FULL_TARGET),m68k-macos)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
 ifeq ($(FULL_TARGET),m68k-embedded)
@@ -497,6 +497,9 @@ endif
 ifeq ($(FULL_TARGET),arm-linux)
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+override TARGET_PROGRAMS+=gparmake createlst
+endif
 ifeq ($(FULL_TARGET),arm-palmos)
 ifeq ($(FULL_TARGET),arm-palmos)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
@@ -521,6 +524,9 @@ endif
 ifeq ($(FULL_TARGET),arm-android)
 ifeq ($(FULL_TARGET),arm-android)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
+ifeq ($(FULL_TARGET),arm-aros)
+override TARGET_PROGRAMS+=gparmake createlst
+endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 ifeq ($(FULL_TARGET),powerpc64-linux)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
@@ -560,6 +566,9 @@ endif
 ifeq ($(FULL_TARGET),jvm-android)
 ifeq ($(FULL_TARGET),jvm-android)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+override TARGET_PROGRAMS+=gparmake createlst
+endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 ifeq ($(FULL_TARGET),i8086-msdos)
 override TARGET_PROGRAMS+=gparmake createlst
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 endif
@@ -990,6 +999,21 @@ STATICLIBPREFIX=
 STATICLIBEXT=.a
 STATICLIBEXT=.a
 SHORTSUFFIX=d16
 SHORTSUFFIX=d16
 endif
 endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+SHORTSUFFIX=emb
+endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1272,9 +1296,6 @@ endif
 ifeq ($(FULL_TARGET),i386-solaris)
 ifeq ($(FULL_TARGET),i386-solaris)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(FULL_TARGET),i386-qnx)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),i386-netware)
 ifeq ($(FULL_TARGET),i386-netware)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
@@ -1320,9 +1341,6 @@ endif
 ifeq ($(FULL_TARGET),m68k-linux)
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 ifeq ($(FULL_TARGET),m68k-netbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
@@ -1332,10 +1350,10 @@ endif
 ifeq ($(FULL_TARGET),m68k-atari)
 ifeq ($(FULL_TARGET),m68k-atari)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
+ifeq ($(FULL_TARGET),m68k-palmos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
-ifeq ($(FULL_TARGET),m68k-palmos)
+ifeq ($(FULL_TARGET),m68k-macos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
 ifeq ($(FULL_TARGET),m68k-embedded)
@@ -1419,6 +1437,9 @@ endif
 ifeq ($(FULL_TARGET),arm-linux)
 ifeq ($(FULL_TARGET),arm-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),arm-palmos)
 ifeq ($(FULL_TARGET),arm-palmos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
@@ -1443,6 +1464,9 @@ endif
 ifeq ($(FULL_TARGET),arm-android)
 ifeq ($(FULL_TARGET),arm-android)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
+ifeq ($(FULL_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 ifeq ($(FULL_TARGET),powerpc64-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
@@ -1482,6 +1506,9 @@ endif
 ifeq ($(FULL_TARGET),jvm-android)
 ifeq ($(FULL_TARGET),jvm-android)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 ifeq ($(FULL_TARGET),i8086-msdos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_RTL=1
 endif
 endif
@@ -1565,6 +1592,7 @@ endif
 ifeq ($(OS_SOURCE),openbsd)
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
 override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 endif
 ifndef CROSSBOOTSTRAP
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
 ifneq ($(BINUTILSPREFIX),)
@@ -1577,6 +1605,7 @@ endif
 ifndef CROSSCOMPILE
 ifndef CROSSCOMPILE
 ifneq ($(BINUTILSPREFIX),)
 ifneq ($(BINUTILSPREFIX),)
 override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
 override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
 endif
 endif
 endif
 endif
 ifdef UNITDIR
 ifdef UNITDIR
@@ -1676,6 +1705,9 @@ endif
 ifdef OPT
 ifdef OPT
 override FPCOPT+=$(OPT)
 override FPCOPT+=$(OPT)
 endif
 endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
 ifdef FPCOPTDEF
 ifdef FPCOPTDEF
 override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
 override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
 endif
 endif
@@ -1818,7 +1850,11 @@ ifdef INSTALL_BUILDUNIT
 override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
 override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
 endif
 endif
 ifdef INSTALLPPUFILES
 ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
 override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
 override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
 ifneq ($(UNITTARGETDIRPREFIX),)
 ifneq ($(UNITTARGETDIRPREFIX),)
 override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
 override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
 override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
 override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
@@ -1867,7 +1903,7 @@ endif
 fpc_sourceinstall: distclean
 fpc_sourceinstall: distclean
 	$(MKDIR) $(INSTALL_SOURCEDIR)
 	$(MKDIR) $(INSTALL_SOURCEDIR)
 	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
 	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
-fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
 ifdef HASEXAMPLES
 ifdef HASEXAMPLES
 	$(MKDIR) $(INSTALL_EXAMPLEDIR)
 	$(MKDIR) $(INSTALL_EXAMPLEDIR)
 endif
 endif
@@ -1920,7 +1956,7 @@ ifdef LIB_NAME
 	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
 	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
 endif
 endif
 	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
 	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
 fpc_cleanall: $(CLEANTARGET)
 fpc_cleanall: $(CLEANTARGET)
 ifdef CLEANEXEFILES
 ifdef CLEANEXEFILES
 	-$(DEL) $(CLEANEXEFILES)
 	-$(DEL) $(CLEANEXEFILES)
@@ -1946,13 +1982,17 @@ ifneq ($(PPUEXT),.ppu)
 endif
 endif
 	-$(DELTREE) *$(SMARTEXT)
 	-$(DELTREE) *$(SMARTEXT)
 	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
 	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *_ppas$(BATCHEXT)
+	-$(DEL) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
 ifdef AOUTEXT
 ifdef AOUTEXT
 	-$(DEL) *$(AOUTEXT)
 	-$(DEL) *$(AOUTEXT)
 endif
 endif
 ifdef DEBUGSYMEXT
 ifdef DEBUGSYMEXT
 	-$(DEL) *$(DEBUGSYMEXT)
 	-$(DEL) *$(DEBUGSYMEXT)
 endif
 endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
 fpc_distclean: cleanall
 fpc_distclean: cleanall
 .PHONY: fpc_baseinfo
 .PHONY: fpc_baseinfo
 override INFORULES+=fpc_baseinfo
 override INFORULES+=fpc_baseinfo
@@ -2183,7 +2223,7 @@ export LOG:=$(TEST_OUTPUTDIR)/log
 endif
 endif
 LOGFILES=$(TEST_OUTPUTDIR)/log $(TEST_OUTPUTDIR)/longlog $(TEST_OUTPUTDIR)/faillist
 LOGFILES=$(TEST_OUTPUTDIR)/log $(TEST_OUTPUTDIR)/longlog $(TEST_OUTPUTDIR)/faillist
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
-TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows
+TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows classes character dateutil fpcunit softfpu variants
 TESTDIRECTDIRS=
 TESTDIRECTDIRS=
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2

+ 1 - 1
tests/Makefile.fpc

@@ -154,7 +154,7 @@ LOGFILES=$(TEST_OUTPUTDIR)/log $(TEST_OUTPUTDIR)/longlog $(TEST_OUTPUTDIR)/faill
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
 
 
 # Subdirs available in the test subdir
 # Subdirs available in the test subdir
-TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows
+TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows classes character dateutil fpcunit softfpu variants
 TESTDIRECTDIRS=
 TESTDIRECTDIRS=
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2

+ 32 - 0
tests/tbf/tb0588.pp

@@ -0,0 +1,32 @@
+{ %FAIL }
+{ %opt=-O4 -Sew }
+
+{ This code can generate trouble because
+  uninitialized retrun value in f method 
+  can have a pattern that generates a
+  floating point exception later.
+
+  As core decided not to generate an error in such cases,
+  this test was modified to al least test that a warning
+  is issued about non-initialized return value. }
+
+{$mode objfpc}
+uses
+  sysutils;
+type
+  tmyclass = class
+    function f : double;virtual;
+  end;
+
+function tmyclass.f : double;
+  begin
+  end;
+
+var
+  myclass : tmyclass;
+begin
+  myclass:=tmyclass.create;
+  writeln(myclass.f+myclass.f+myclass.f);
+  myclass.free;
+  writeln('ok');
+end.

+ 0 - 21
tests/tbs/tb0588.pp

@@ -1,21 +0,0 @@
-{ %opt=-O4 }
-{$mode objfpc}
-uses
-  sysutils;
-type
-  tmyclass = class
-    function f : double;virtual;
-  end;
-
-function tmyclass.f : double;
-  begin
-  end;
-
-var
-  myclass : tmyclass;
-begin
-  myclass:=tmyclass.create;
-  writeln(myclass.f+myclass.f+myclass.f);
-  myclass.free;
-  writeln('ok');
-end.

+ 3 - 1
tests/test/units/character/tgetnumericvalue.pp

@@ -12,7 +12,7 @@ program tgetnumericvalue;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -44,6 +44,8 @@ begin
   e := 1;
   e := 1;
   k := 0;
   k := 0;
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) in
     if (TCharacter.GetUnicodeCategory(uc) in
           [ TUnicodeCategory.ucDecimalNumber,
           [ TUnicodeCategory.ucDecimalNumber,

+ 3 - 1
tests/test/units/character/tgetnumericvalue2.pp

@@ -12,7 +12,7 @@ program tgetnumericvalue2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -54,6 +54,8 @@ begin
   e := 1;
   e := 1;
   k := 0;
   k := 0;
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) in
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) in
           [ TUnicodeCategory.ucDecimalNumber,
           [ TUnicodeCategory.ucDecimalNumber,

+ 1 - 1
tests/test/units/character/tgetnumericvalue3.pp

@@ -12,7 +12,7 @@ program tgetnumericvalue3;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 1 - 1
tests/test/units/character/tgetunicodecategoriesurro.pp

@@ -12,7 +12,7 @@ program tgetunicodecategoriesurro;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 3 - 1
tests/test/units/character/tiscontrol.pp

@@ -12,7 +12,7 @@ program tiscontrol;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -56,6 +56,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucControl) then begin
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucControl) then begin
       if not TCharacter.IsControl(uc) then
       if not TCharacter.IsControl(uc) then

+ 3 - 1
tests/test/units/character/tiscontrol2.pp

@@ -12,7 +12,7 @@ program tiscontrol2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -59,6 +59,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucControl) then begin
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucControl) then begin
       if not TCharacter.IsControl(uc,locCharPos) then
       if not TCharacter.IsControl(uc,locCharPos) then

+ 1 - 1
tests/test/units/character/tiscontrol3.pp

@@ -12,7 +12,7 @@ program tisdigit3;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 3 - 1
tests/test/units/character/tisdigit.pp

@@ -12,7 +12,7 @@ program tisdigit;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -49,6 +49,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucDecimalNumber) then begin
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucDecimalNumber) then begin
       if not TCharacter.IsDigit(uc) then
       if not TCharacter.IsDigit(uc) then

+ 3 - 1
tests/test/units/character/tisdigit2.pp

@@ -12,7 +12,7 @@ program tisdigit2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -52,6 +52,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucDecimalNumber) then begin
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucDecimalNumber) then begin
       if not TCharacter.IsDigit(uc,locCharPos) then
       if not TCharacter.IsDigit(uc,locCharPos) then

+ 1 - 1
tests/test/units/character/tisdigit3.pp

@@ -12,7 +12,7 @@ program tgetnumericvalue3;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 1 - 6
tests/test/units/character/tishighsurrogate.pp

@@ -12,7 +12,7 @@ program tishighsurrogate;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -36,11 +36,6 @@ begin
   Halt(Acode);
   Halt(Acode);
 end;         
 end;         
 
 
-const
-  LOW_SURROGATE_BEGIN  = Word($DC00);
-  LOW_SURROGATE_END    = Word($DFFF);
-  HIGH_SURROGATE_BEGIN = Word($D800);
-  HIGH_SURROGATE_END   = Word($DBFF);
 var
 var
   e, i , k: Integer;
   e, i , k: Integer;
   uc : UnicodeChar;
   uc : UnicodeChar;

+ 5 - 1
tests/test/units/character/tisletter.pp

@@ -12,7 +12,7 @@ program tisletter;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -56,6 +56,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) in
     if (TCharacter.GetUnicodeCategory(uc) in
           [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
           [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
@@ -78,6 +80,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if not (TCharacter.GetUnicodeCategory(uc) in
     if not (TCharacter.GetUnicodeCategory(uc) in
               [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
               [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,

+ 5 - 1
tests/test/units/character/tisletterordigit.pp

@@ -12,7 +12,7 @@ program tisletterordigit;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -63,6 +63,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) in
     if (TCharacter.GetUnicodeCategory(uc) in
           [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
           [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
@@ -79,6 +81,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if not (TCharacter.GetUnicodeCategory(uc) in
     if not (TCharacter.GetUnicodeCategory(uc) in
               [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
               [ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,

+ 1 - 6
tests/test/units/character/tislowsurrogate.pp

@@ -12,7 +12,7 @@ program tislowsurrogate;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -36,11 +36,6 @@ begin
   Halt(Acode);
   Halt(Acode);
 end;         
 end;         
 
 
-const
-  LOW_SURROGATE_BEGIN  = Word($DC00);
-  LOW_SURROGATE_END    = Word($DFFF);
-  HIGH_SURROGATE_BEGIN = Word($D800);
-  HIGH_SURROGATE_END   = Word($DBFF);
 var
 var
   e, i , k: Integer;
   e, i , k: Integer;
   uc : UnicodeChar;
   uc : UnicodeChar;

+ 3 - 1
tests/test/units/character/tisnumber.pp

@@ -12,7 +12,7 @@ program tisnumber;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata, character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -44,6 +44,8 @@ begin
   e := 1;
   e := 1;
   k := 0;
   k := 0;
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if TCharacter.IsNumber(uc) then begin
     if TCharacter.IsNumber(uc) then begin
       WriteLn('CodePoint = ',IntToHex(Ord(uc),4), ' ; IsNumber = ',TCharacter.IsNumber(uc));
       WriteLn('CodePoint = ',IntToHex(Ord(uc),4), ' ; IsNumber = ',TCharacter.IsNumber(uc));

+ 3 - 1
tests/test/units/character/tisnumber2.pp

@@ -12,7 +12,7 @@ program tisnumber2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -47,6 +47,8 @@ begin
   e := 1;
   e := 1;
   k := 0;
   k := 0;
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     if TCharacter.IsNumber(uc,locCharPos) then begin
     if TCharacter.IsNumber(uc,locCharPos) then begin
       WriteLn('CodePoint = ',IntToHex(Ord(uc[locCharPos]),4), ' ; IsNumber = ',TCharacter.IsNumber(uc,locCharPos));
       WriteLn('CodePoint = ',IntToHex(Ord(uc[locCharPos]),4), ' ; IsNumber = ',TCharacter.IsNumber(uc,locCharPos));

+ 3 - 1
tests/test/units/character/tispunctuation.pp

@@ -12,7 +12,7 @@ program tispunctuation;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -80,6 +80,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) in
     if (TCharacter.GetUnicodeCategory(uc) in
         [ TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
         [ TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,

+ 5 - 1
tests/test/units/character/tisseparator.pp

@@ -12,7 +12,7 @@ program tisseparator;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -60,6 +60,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) in
     if (TCharacter.GetUnicodeCategory(uc) in
         [ TUnicodeCategory.ucSpaceSeparator,
         [ TUnicodeCategory.ucSpaceSeparator,
@@ -75,6 +77,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if not (TCharacter.GetUnicodeCategory(uc) in
     if not (TCharacter.GetUnicodeCategory(uc) in
             [ TUnicodeCategory.ucSpaceSeparator,
             [ TUnicodeCategory.ucSpaceSeparator,

+ 1 - 1
tests/test/units/character/tissurrogate.pp

@@ -12,7 +12,7 @@ program tissurrogate;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 1 - 8
tests/test/units/character/tissurrogatepair.pp

@@ -12,7 +12,7 @@ program tissurrogatepair;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -28,13 +28,6 @@ begin
   Halt(Acode);
   Halt(Acode);
 end;
 end;
 
 
-const
-  LOW_SURROGATE_BEGIN  = Word($DC00);
-  LOW_SURROGATE_END    = Word($DFFF);
-
-  HIGH_SURROGATE_BEGIN = Word($D800);
-  HIGH_SURROGATE_END   = Word($DBFF);
-
 var
 var
   e, i , j: Integer;
   e, i , j: Integer;
 begin  
 begin  

+ 1 - 8
tests/test/units/character/tissurrogatepair2.pp

@@ -12,7 +12,7 @@ program tissurrogatepair2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -28,13 +28,6 @@ begin
   Halt(Acode);
   Halt(Acode);
 end;
 end;
 
 
-const
-  LOW_SURROGATE_BEGIN  = Word($DC00);
-  LOW_SURROGATE_END    = Word($DFFF);
-
-  HIGH_SURROGATE_BEGIN = Word($D800);
-  HIGH_SURROGATE_END   = Word($DBFF);
-
 var
 var
   e, i , j: Integer;
   e, i , j: Integer;
   s : UnicodeString;
   s : UnicodeString;

+ 5 - 1
tests/test/units/character/tissymbol.pp

@@ -12,7 +12,7 @@ program tissymbol;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -89,6 +89,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) in
     if (TCharacter.GetUnicodeCategory(uc) in
         [ TUnicodeCategory.ucMathSymbol,
         [ TUnicodeCategory.ucMathSymbol,
@@ -105,6 +107,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if not (TCharacter.GetUnicodeCategory(uc) in
     if not (TCharacter.GetUnicodeCategory(uc) in
             [ TUnicodeCategory.ucMathSymbol,
             [ TUnicodeCategory.ucMathSymbol,

+ 5 - 1
tests/test/units/character/tisupper.pp

@@ -12,7 +12,7 @@ program tisupper;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -56,6 +56,8 @@ begin
   
   
   Inc(e);     
   Inc(e);     
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i); 
     uc := UnicodeChar(i); 
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucUppercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucUppercaseLetter) then begin
       if not TCharacter.IsUpper(uc) then
       if not TCharacter.IsUpper(uc) then
@@ -65,6 +67,8 @@ begin
   
   
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i); 
     uc := UnicodeChar(i); 
     if (TCharacter.GetUnicodeCategory(uc) <> TUnicodeCategory.ucUppercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc) <> TUnicodeCategory.ucUppercaseLetter) then begin
       if TCharacter.IsUpper(uc) then
       if TCharacter.IsUpper(uc) then

+ 3 - 1
tests/test/units/character/tiswhitespace.pp

@@ -12,7 +12,7 @@ program tiswhitespace;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -86,6 +86,8 @@ begin
 
 
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i);
     uc := UnicodeChar(i);
     if (TCharacter.GetUnicodeCategory(uc) in
     if (TCharacter.GetUnicodeCategory(uc) in
         [ TUnicodeCategory.ucSpaceSeparator,
         [ TUnicodeCategory.ucSpaceSeparator,

+ 5 - 1
tests/test/units/character/tlowercase.pp

@@ -12,7 +12,7 @@ program tlowercase;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -56,6 +56,8 @@ begin
   
   
   Inc(e);     
   Inc(e);     
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i); 
     uc := UnicodeChar(i); 
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucLowercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucLowercaseLetter) then begin
       if not TCharacter.IsLower(uc) then
       if not TCharacter.IsLower(uc) then
@@ -65,6 +67,8 @@ begin
   
   
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i); 
     uc := UnicodeChar(i); 
     if (TCharacter.GetUnicodeCategory(uc) <> TUnicodeCategory.ucLowercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc) <> TUnicodeCategory.ucLowercaseLetter) then begin
       if TCharacter.IsLower(uc) then
       if TCharacter.IsLower(uc) then

+ 5 - 1
tests/test/units/character/tlowercase2.pp

@@ -12,7 +12,7 @@ program tlowercase2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -65,6 +65,8 @@ begin
   
   
   Inc(e);     
   Inc(e);     
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucLowercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucLowercaseLetter) then begin
       if not TCharacter.IsLower(uc,locCharPos) then
       if not TCharacter.IsLower(uc,locCharPos) then
@@ -74,6 +76,8 @@ begin
   
   
   Inc(e);
   Inc(e);
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     uc := strPrefix + UnicodeChar(i) + strPrefix;
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) <> TUnicodeCategory.ucLowercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc,locCharPos) <> TUnicodeCategory.ucLowercaseLetter) then begin
       if TCharacter.IsLower(uc,locCharPos) then
       if TCharacter.IsLower(uc,locCharPos) then

+ 3 - 1
tests/test/units/character/ttolower.pp

@@ -12,7 +12,7 @@ program ttolower;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -65,6 +65,8 @@ begin
   
   
   Inc(e);     
   Inc(e);     
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i); 
     uc := UnicodeChar(i); 
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucLowercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucLowercaseLetter) then begin
       if (TCharacter.ToLower(uc) <> uc) then
       if (TCharacter.ToLower(uc) <> uc) then

+ 1 - 1
tests/test/units/character/ttolower2.pp

@@ -12,7 +12,7 @@ program ttolower2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 1 - 1
tests/test/units/character/ttolower3.pp

@@ -12,7 +12,7 @@ program ttolower3;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 3 - 1
tests/test/units/character/ttoupper.pp

@@ -12,7 +12,7 @@ program ttoupper;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   
@@ -65,6 +65,8 @@ begin
   
   
   Inc(e);     
   Inc(e);     
   for i := Low(Word) to High(Word) do begin
   for i := Low(Word) to High(Word) do begin
+    { Skip all surrogate values }
+    if (i>=HIGH_SURROGATE_BEGIN) and (i<=LOW_SURROGATE_END) then continue;
     uc := UnicodeChar(i); 
     uc := UnicodeChar(i); 
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucUppercaseLetter) then begin
     if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucUppercaseLetter) then begin
       if (TCharacter.ToUpper(uc) <> uc) then
       if (TCharacter.ToUpper(uc) <> uc) then

+ 1 - 1
tests/test/units/character/ttoupper2.pp

@@ -12,7 +12,7 @@ program ttoupper2;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 1 - 1
tests/test/units/character/ttoupper3.pp

@@ -12,7 +12,7 @@ program ttoupper3;
   
   
 uses     
 uses     
   SysUtils,
   SysUtils,
-  character;
+  unicodedata,character;
     
     
 {$ifndef FPC}
 {$ifndef FPC}
   type UnicodeChar = WideChar;   
   type UnicodeChar = WideChar;   

+ 2 - 0
tests/test/units/character/tutf32convert.pp

@@ -1,5 +1,7 @@
 program tutf32convert;
 program tutf32convert;
 
 
+{$mode objfpc}
+
 {$apptype console}
 {$apptype console}
 
 
 uses
 uses

+ 10 - 4
tests/test/units/classes/tstringlistexchange.pp

@@ -64,15 +64,21 @@ begin
       msl.OnChange := @dummy.Change;
       msl.OnChange := @dummy.Change;
       msl.Sort;
       msl.Sort;
       // TMyStringList.ExchangeItems called 5 times
       // TMyStringList.ExchangeItems called 5 times
-      if msl.ExchangeCount <> 5 then
-        Halt(1);
+      // if msl.ExchangeCount <> 5 then
+      // Seems to be done in 4 exchanges
+      // Check that names are ordered correctly instead
+      if (msl[0] <> 'Alpha') or
+         (msl[1] <> 'Beta') or
+         (msl[2] <> 'Delta') or
+         (msl[3] <> 'Gamma') then
+        Halt(2);
       // OnChange called once in Sort
       // OnChange called once in Sort
       if dummy.ExchangeCount <> 1 then
       if dummy.ExchangeCount <> 1 then
-        Halt(1);
+        Halt(3);
     finally
     finally
       msl.Free;
       msl.Free;
     end;
     end;
   finally
   finally
     dummy.Free;
     dummy.Free;
   end;
   end;
-end.
+end.

+ 53 - 0
tests/test/units/classes/ttbits.pp

@@ -0,0 +1,53 @@
+program ttbits;
+
+{$MODE objfpc}{$H+}
+
+uses
+  Classes;
+
+procedure Fail;
+begin
+  Writeln('Err!');
+  Halt(1);
+end;
+
+procedure FillWithRandom(b: TBits);
+var
+  I: Integer;
+begin
+  for I := 0 to b.Size - 1 do
+    b[I] := Random(2) <> 0;
+end;
+
+procedure TestCopyBits;
+const
+  NumTests = 100;
+  MaxBits = 200;
+var
+  b1: TBits = nil;
+  b2: TBits = nil;
+  I: Integer;
+begin
+  try
+    b1 := TBits.Create;
+    b2 := TBits.Create;
+    for I := 1 to NumTests do
+    begin
+      b1.Size := Random(MaxBits);
+      FillWithRandom(b1);
+      b2.CopyBits(b1);
+      if not b1.Equals(b2) then
+        Fail;
+      if not b2.Equals(b1) then
+        Fail;
+    end;
+  finally
+    b1.Free;
+    b2.Free;
+  end;
+end;
+
+begin
+  TestCopyBits;
+  Writeln('Ok!');
+end.

+ 11 - 2
tests/test/units/strutils/tromantoint.pp

@@ -14,10 +14,16 @@ procedure RomanToIntTest(const testRoman: string;
   var
   var
     test: integer;
     test: integer;
   begin
   begin
-    test := RomanToInt(testRoman);
+    try
+      test := RomanToInt(testRoman);
+    except
+      { make sure that if an exception is generated,
+        the error is raised }
+      test:=expectation-1;
+    end;
     if test <> expectation then
     if test <> expectation then
     begin
     begin
-      writeln('Testing strUtils/RomanToInt: Test with ', testRoman, ' failed.');
+      writeln('Testing strUtils/RomanToInt: Test with "', testRoman, '" failed.');
       writeln('Returned number: ', test);
       writeln('Returned number: ', test);
       writeln('Expected number: ', expectation);
       writeln('Expected number: ', expectation);
       exitCode := 1;
       exitCode := 1;
@@ -30,6 +36,9 @@ var
   testInteger: integer;
   testInteger: integer;
 
 
 begin
 begin
+  { Check that empty string is accepted as zero vvalue }
+  RomanToIntTest('',0);
+
   for i := 1 to 2000 do
   for i := 1 to 2000 do
   begin
   begin
     testInteger := i;
     testInteger := i;

+ 51 - 0
tests/webtbs/tw33607.pp

@@ -0,0 +1,51 @@
+{$mode objfpc}{$H+}
+{$modeSwitch advancedRecords}
+
+type
+   TRectangle = record
+		   public
+		   Left, Bottom: Integer;
+		   Width, Height: Cardinal;
+
+		function ScaleAround0(const Factor: Single): TRectangle;
+		end;
+
+function TRectangle.ScaleAround0(const Factor: Single): TRectangle;
+begin
+   if Width <= 0 then
+   begin
+      Result.Width  := Width;
+      Result.Left   := Left;
+   end else
+      halt(3);
+
+   Result.Height := Height;
+   Result.Bottom := Bottom;
+end;
+
+function Rectangle(const Left, Bottom: Integer;
+		   const Width, Height: Cardinal): TRectangle;
+begin
+   Rectangle.Left := Left;
+   Rectangle.Bottom := Bottom;
+   Rectangle.Width := Width;
+   Rectangle.Height := Height;
+end;
+
+procedure test(c: qword);
+begin
+  if c<>0 then
+    halt(2);
+end;
+
+var
+   R, S	:  TRectangle;
+begin
+   R := Rectangle(10, 20, 0, 50);
+   S := R.ScaleAround0(2);
+   if s.width<>0 then
+     halt(1);
+
+  test(R.ScaleAround0(2).Width);
+end.
+

+ 11 - 0
utils/fppkg/fpmake.pp

@@ -13,6 +13,7 @@ const
 Var
 Var
   P : TPackage;
   P : TPackage;
   T : TTarget;
   T : TTarget;
+  VS: string;
 
 
 begin
 begin
   With Installer do
   With Installer do
@@ -39,6 +40,16 @@ begin
 
 
     P.SupportBuildModes:=[bmOneByOne];
     P.SupportBuildModes:=[bmOneByOne];
 
 
+    P.Options.Add('-Sm');
+    Str(P.PackageVersion.Major, VS);
+    P.Options.Add('-dpackage_version_major:='+VS);
+    Str(P.PackageVersion.Minor, VS);
+    P.Options.Add('-dpackage_version_minor:='+VS);
+    Str(P.PackageVersion.Micro, VS);
+    P.Options.Add('-dpackage_version_micro:='+VS);
+    Str(P.PackageVersion.Build, VS);
+    P.Options.Add('-dpackage_version_build:='+VS);
+
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-process');
     P.Dependencies.Add('fcl-process');

+ 32 - 1
utils/fppkg/fppkg.pp

@@ -1,11 +1,24 @@
 program fppkg;
 program fppkg;
 
 
-{$mode objfpc}{$H+}
+{$mode objfpc}{$H+}{$macro on}
 
 
 {$if defined(VER2_2) and (FPC_PATCH<1)}
 {$if defined(VER2_2) and (FPC_PATCH<1)}
   {$fatal At least FPC 2.2.1 is required to compile fppkg}
   {$fatal At least FPC 2.2.1 is required to compile fppkg}
 {$endif}
 {$endif}
 
 
+{$ifndef package_version_major}
+  {$define package_version_major:=0}
+{$endif}
+{$ifndef package_version_minor}
+  {$define package_version_minor:=0}
+{$endif}
+{$ifndef package_version_micro}
+  {$define package_version_micro:=0}
+{$endif}
+{$ifndef package_version_build}
+  {$define package_version_build:=0}
+{$endif}
+
 uses
 uses
   // General
   // General
 {$ifdef unix}
 {$ifdef unix}
@@ -28,6 +41,12 @@ uses
 {$endif}
 {$endif}
   ;
   ;
 
 
+const
+  version_major = package_version_major;
+  version_minor = package_version_minor;
+  version_micro = package_version_micro;
+  version_build = package_version_build;
+
 Type
 Type
   { TMakeTool }
   { TMakeTool }
 
 
@@ -37,6 +56,7 @@ Type
     ParaPackages : TStringList;
     ParaPackages : TStringList;
     procedure MaybeCreateLocalDirs;
     procedure MaybeCreateLocalDirs;
     procedure ShowUsage;
     procedure ShowUsage;
+    procedure ShowVersion;
   Public
   Public
     Constructor Create;
     Constructor Create;
     Destructor Destroy;override;
     Destructor Destroy;override;
@@ -94,6 +114,7 @@ begin
   Writeln('  -C --config-file   Specify the configuration file to use');
   Writeln('  -C --config-file   Specify the configuration file to use');
   Writeln('  -c --config        Set compiler configuration to use');
   Writeln('  -c --config        Set compiler configuration to use');
   Writeln('  -h --help          This help');
   Writeln('  -h --help          This help');
+  Writeln('  -V --version       Show version and exit');
   Writeln('  -v --verbose       Show more information');
   Writeln('  -v --verbose       Show more information');
   Writeln('  -d --debug         Show debugging information');
   Writeln('  -d --debug         Show debugging information');
   Writeln('  -f --force         Force installation also if the package is already installed');
   Writeln('  -f --force         Force installation also if the package is already installed');
@@ -256,6 +277,11 @@ begin
           ShowUsage;
           ShowUsage;
           halt(0);
           halt(0);
         end
         end
+      else if CheckOption(I,'V','version') then
+        begin
+          ShowVersion;
+          halt(0);
+        end
       else if (Length(Paramstr(i))>0) and (Paramstr(I)[1]='-') then
       else if (Length(Paramstr(i))>0) and (Paramstr(I)[1]='-') then
         begin
         begin
           if FirstPass then
           if FirstPass then
@@ -426,6 +452,11 @@ begin
   SetCurrentDir(OldCurrDir);
   SetCurrentDir(OldCurrDir);
 end;
 end;
 
 
+procedure TMakeTool.ShowVersion;
+begin
+  Writeln('Version: ', version_major, '.', version_minor, '.', version_micro, '-', version_build);
+end;
+
 
 
 begin
 begin
   With TMakeTool.Create do
   With TMakeTool.Create do

+ 13 - 1
utils/pas2js/dist/rtl.js

@@ -950,7 +950,7 @@ var rtl = {
     };
     };
   },
   },
 
 
-  floatToStr : function(d,w,p){
+  floatToStr: function(d,w,p){
     // input 1-3 arguments: double, width, precision
     // input 1-3 arguments: double, width, precision
     if (arguments.length>2){
     if (arguments.length>2){
       return rtl.spaceLeft(d.toFixed(p),w);
       return rtl.spaceLeft(d.toFixed(p),w);
@@ -975,6 +975,18 @@ var rtl = {
     }
     }
   },
   },
 
 
+  valEnum: function(s, enumType, setCodeFn){
+    s = s.toLowerCase();
+    for (var key in enumType){
+      if((typeof(key)==='string') && (key.toLowerCase()===s)){
+        setCodeFn(0);
+        return enumType[key];
+      }
+    }
+    setCodeFn(1);
+    return 0;
+  },
+
   initRTTI: function(){
   initRTTI: function(){
     if (rtl.debug_rtti) rtl.debug('initRTTI');
     if (rtl.debug_rtti) rtl.debug('initRTTI');
 
 

+ 9 - 2
utils/pas2js/docs/translation.html

@@ -133,6 +133,7 @@ Put + after a boolean switch option to enable it, - to disable it
     -ic   : Write list of supported JS processors usable by -P&lt;x&gt;
     -ic   : Write list of supported JS processors usable by -P&lt;x&gt;
     -io   : Write list of supported optimizations usable by -Oo&lt;x&gt;
     -io   : Write list of supported optimizations usable by -Oo&lt;x&gt;
     -it   : Write list of supported targets usable by -T&lt;x&gt;
     -it   : Write list of supported targets usable by -T&lt;x&gt;
+    -iJ  : Write list of supported JavaScript identifiers -JoRTL-&lt;x&gt;
   -C&lt;x&gt;   : Code generation options. &lt;x&gt; is a combination of the following letters:
   -C&lt;x&gt;   : Code generation options. &lt;x&gt; is a combination of the following letters:
     o     : Overflow checking
     o     : Overflow checking
     r     : Range checking
     r     : Range checking
@@ -164,6 +165,11 @@ Put + after a boolean switch option to enable it, - to disable it
    -Jo&lt;x&gt; : Enable or disable extra option. The x is case insensitive:
    -Jo&lt;x&gt; : Enable or disable extra option. The x is case insensitive:
      -JoSearchLikeFPC : search source files like FPC, default: search case insensitive.
      -JoSearchLikeFPC : search source files like FPC, default: search case insensitive.
      -JoUseStrict : add "use strict" to modules, default.
      -JoUseStrict : add "use strict" to modules, default.
+     -JoCheckVersion-: do not add rtl version check, default. (since 1.1)
+     -JoCheckVersion=main: insert rtl version check into main. (since 1.1)
+     -JoCheckVersion=system: insert rtl version check into system unit init. (since 1.1)
+     -JoCheckVersion=unit: insert rtl version check into every unit init. (since 1.1)
+     -JoRTL-&lt;x&gt;=&lt;y&gt;: set RTL identifier x to value y. See -iJ. (since 1.1)
    -Jpcmd&lt;command&gt; : Run postprocessor. For each generated js execute
    -Jpcmd&lt;command&gt; : Run postprocessor. For each generated js execute
                   command passing the js as stdin and read the new js from stdout.
                   command passing the js as stdin and read the new js from stdout.
                   This option can be added multiple times to call several
                   This option can be added multiple times to call several
@@ -2031,8 +2037,9 @@ rtl = {
 
 
     <div class="section">
     <div class="section">
     <h2 id="anonymousfunctions">Translating anonymous functions</h2>
     <h2 id="anonymousfunctions">Translating anonymous functions</h2>
-    Anonymous functions are not yet supported by pas2js. The next best thing are
-    local procedures. For example:
+    Anonymous functions are supported since pas2js 1.1.<br>
+    Note that in pas2js local procedures are closures as well. See below.<br>
+    For pas2js 1.0 the next best thing are local procedures. For example:
     <table class="sample">
     <table class="sample">
       <tbody>
       <tbody>
         <tr>
         <tr>

+ 3 - 1
utils/pas2js/nodepas2js.pp

@@ -6,7 +6,8 @@ program nodepas2js;
 uses
 uses
   JS, NodeJSApp,
   JS, NodeJSApp,
   Classes, SysUtils,
   Classes, SysUtils,
-  Pas2jsFileUtils, Pas2jsLogger, pas2jscompiler, Pas2jsfscompiler;
+  Pas2jsFileUtils, Pas2jsLogger,
+  Pas2jsCompiler, Pas2JSFSCompiler, Pas2JSCompilerCfg;
 
 
 type
 type
 
 
@@ -66,6 +67,7 @@ begin
   inherited Create(TheOwner);
   inherited Create(TheOwner);
   StopOnException:=True;
   StopOnException:=True;
   FCompiler:=TPas2jsFSCompiler.Create;
   FCompiler:=TPas2jsFSCompiler.Create;
+  FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
 end;
 end;
 
 
 destructor TPas2jsCLI.Destroy;
 destructor TPas2jsCLI.Destroy;

+ 3 - 0
utils/pas2js/pas2js.lpi

@@ -34,6 +34,7 @@
       <Unit1>
       <Unit1>
         <Filename Value="../../packages/pastojs/src/pas2jspcucompiler.pp"/>
         <Filename Value="../../packages/pastojs/src/pas2jspcucompiler.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2JSPCUCompiler"/>
       </Unit1>
       </Unit1>
       <Unit2>
       <Unit2>
         <Filename Value="../../packages/pastojs/src/pas2jscompilercfg.pp"/>
         <Filename Value="../../packages/pastojs/src/pas2jscompilercfg.pp"/>
@@ -42,6 +43,7 @@
       <Unit3>
       <Unit3>
         <Filename Value="../../packages/pastojs/src/pas2jsfs.pp"/>
         <Filename Value="../../packages/pastojs/src/pas2jsfs.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2JSFS"/>
       </Unit3>
       </Unit3>
       <Unit4>
       <Unit4>
         <Filename Value="../../packages/pastojs/src/pas2jscompilerpp.pp"/>
         <Filename Value="../../packages/pastojs/src/pas2jscompilerpp.pp"/>
@@ -50,6 +52,7 @@
       <Unit5>
       <Unit5>
         <Filename Value="../../packages/pastojs/src/pas2jsfscompiler.pp"/>
         <Filename Value="../../packages/pastojs/src/pas2jsfscompiler.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2JSFSCompiler"/>
       </Unit5>
       </Unit5>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>

+ 5 - 4
utils/pas2js/pas2js.pp

@@ -12,7 +12,8 @@ uses
   cthreads, cwstring,
   cthreads, cwstring,
   {$ENDIF}
   {$ENDIF}
   Classes, SysUtils, CustApp,
   Classes, SysUtils, CustApp,
-  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler, pas2jspcucompiler, pas2jscompilerpp, pas2JScompilercfg;
+  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler,
+  Pas2JSFSCompiler, Pas2JSCompilerPP, Pas2JSCompilerCfg;
 
 
 Type
 Type
 
 
@@ -20,14 +21,14 @@ Type
 
 
   TPas2jsCLI = class(TCustomApplication)
   TPas2jsCLI = class(TCustomApplication)
   private
   private
-    FCompiler: TPas2jsPCUCompiler;
+    FCompiler: TPas2JSFSCompiler;
     FWriteOutputToStdErr: Boolean;
     FWriteOutputToStdErr: Boolean;
   protected
   protected
     procedure DoRun; override;
     procedure DoRun; override;
   public
   public
     constructor Create(TheOwner: TComponent); override;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
-    property Compiler: TPas2jsPCUCompiler read FCompiler;
+    property Compiler: TPas2JSFSCompiler read FCompiler;
     property WriteOutputToStdErr: Boolean read FWriteOutputToStdErr write FWriteOutputToStdErr;
     property WriteOutputToStdErr: Boolean read FWriteOutputToStdErr write FWriteOutputToStdErr;
   end;
   end;
 
 
@@ -66,7 +67,7 @@ constructor TPas2jsCLI.Create(TheOwner: TComponent);
 begin
 begin
   inherited Create(TheOwner);
   inherited Create(TheOwner);
   StopOnException:=True;
   StopOnException:=True;
-  FCompiler:=TPas2jsPCUCompiler.Create;
+  FCompiler:=TPas2JSFSCompiler.Create;
   FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
   FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
   FCompiler.PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(FCompiler);
   FCompiler.PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(FCompiler);
 end;
 end;

部分文件因为文件数量过多而无法显示