* synchronized with trunk

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

.gitattributes

@@ -15078,6 +15078,7 @@ tests/test/tcustomattr6.pp svneol=native#text/pascal
 tests/test/tcustomattr7.pp svneol=native#text/pascal
 tests/test/tcustomattr8.pp svneol=native#text/pascal
 tests/test/tcustomattr9.pp svneol=native#text/pascal
+tests/test/tcustomvar1.pp svneol=native#text/pascal
 tests/test/tdefault1.pp svneol=native#text/pascal
 tests/test/tdefault10.pp svneol=native#text/pascal
 tests/test/tdefault11.pp svneol=native#text/pascal
@@ -15163,6 +15164,7 @@ tests/test/testv8.pp svneol=native#text/plain
 tests/test/testv9.pp svneol=native#text/plain
 tests/test/texception1.pp svneol=native#text/plain
 tests/test/texception10.pp svneol=native#text/plain
+tests/test/texception11.pp svneol=native#text/pascal
 tests/test/texception2.pp svneol=native#text/plain
 tests/test/texception3.pp svneol=native#text/plain
 tests/test/texception4.pp svneol=native#text/plain
@@ -16272,6 +16274,7 @@ tests/test/units/crt/tcrt.pp svneol=native#text/plain
 tests/test/units/crt/tctrlc.pp svneol=native#text/plain
 tests/test/units/dateutil/test_scandatetime_ampm.pas svneol=native#text/plain
 tests/test/units/dateutil/testscandatetime.pas svneol=native#text/plain
+tests/test/units/dateutil/tiso8601.pp svneol=native#text/plain
 tests/test/units/dateutil/tunitdt1.pp svneol=native#text/pascal
 tests/test/units/dos/hello.pp svneol=native#text/plain
 tests/test/units/dos/tbreak.pp svneol=native#text/plain
@@ -17668,7 +17671,6 @@ tests/webtbs/tw17836.pp svneol=native#text/plain
 tests/webtbs/tw17838.pp svneol=native#text/pascal
 tests/webtbs/tw17846.pp svneol=native#text/plain
 tests/webtbs/tw17862.pp svneol=native#text/plain
-tests/webtbs/tw17904.pas svneol=native#text/plain
 tests/webtbs/tw17904.pp svneol=native#text/plain
 tests/webtbs/tw17907/main/main.pas svneol=native#text/plain
 tests/webtbs/tw17907/test.bat svneol=native#text/plain

Makefile

@@ -349,8 +349,8 @@ endif
 endif
 override PACKAGE_NAME=fpc
 override PACKAGE_VERSION=3.3.1
-REQUIREDVERSION=3.2.0
-REQUIREDVERSION2=3.2.2
+REQUIREDVERSION=3.2.2
+REQUIREDVERSION2=3.2.0
 ifndef inOS2
 override FPCDIR:=$(BASEDIR)
 export FPCDIR

Makefile.fpc

@@ -20,8 +20,8 @@ fpcdir=.
 rule=help
 
 [prerules]
-REQUIREDVERSION=3.2.0
-REQUIREDVERSION2=3.2.2
+REQUIREDVERSION=3.2.2
+REQUIREDVERSION2=3.2.0
 
 
 # make versions < 3.77 (OS2 version) are buggy

compiler/aarch64/cgcpu.pas

@@ -842,7 +842,7 @@ implementation
               reg:=makeregsize(reg,OS_64);
             fromsize:=tosize;
           end;
-        if (ref.alignment<>0) and
+        if not(target_info.system=system_aarch64_darwin) and (ref.alignment<>0) and
            (ref.alignment<tcgsize2size[tosize]) then
           begin
             a_load_reg_ref_unaligned(list,fromsize,tosize,reg,ref);
@@ -891,7 +891,7 @@ implementation
         }
         if fromsize in [OS_8,OS_16,OS_32] then
           reg:=makeregsize(reg,OS_32);
-        if (ref.alignment<>0) and
+        if not(target_info.system=system_aarch64_darwin) and (ref.alignment<>0) and
            (ref.alignment<tcgsize2size[fromsize]) then
           begin
             a_load_ref_reg_unaligned(list,fromsize,tosize,ref,reg);

compiler/aggas.pas

@@ -1323,13 +1323,17 @@ implementation
              begin
                if (tai_label(hp).labsym.is_used) then
                 begin
-                  if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
-                    begin
-                      writer.AsmWrite(#9'.private_extern ');
-                      writer.AsmWriteln(tai_label(hp).labsym.name);
-                    end;
+{$ifdef DEBUG_LABEL}
+                  writer.AsmWrite(asminfo^.comment);
+                  writer.AsmWriteLn('References = ' + tostr(tai_label(hp).labsym.getrefs));
+{$endif DEBUG_LABEL}
                   if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then
                    begin
+                     if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
+                       begin
+                         writer.AsmWrite(#9'.private_extern ');
+                         writer.AsmWriteln(tai_label(hp).labsym.name);
+                       end;
 {$ifdef arm}
                      { do no change arm mode accidently, .globl seems to reset the mode }
                      if GenerateThumbCode or GenerateThumb2Code then

compiler/arm/cgcpu.pas

@@ -3849,6 +3849,10 @@ unit cgcpu;
          stackmisalignment: pint;
          stack_parameters : Boolean;
       begin
+        { a routine not returning needs no exit code,
+          we trust this directive as arm thumb is normally used if small code shall be generated }
+        if po_noreturn in current_procinfo.procdef.procoptions then
+          exit;
         if not(nostackframe) then
           begin
             stack_parameters:=current_procinfo.procdef.stack_tainting_parameter(calleeside);
@@ -5052,6 +5056,10 @@ unit cgcpu;
          LocalSize : longint;
          stackmisalignment: pint;
       begin
+        { a routine not returning needs no exit code,
+          we trust this directive as arm thumb is normally used if small code shall be generated }
+        if po_noreturn in current_procinfo.procdef.procoptions then
+          exit;
         if not(nostackframe) then
           begin
             stackmisalignment:=0;

compiler/armgen/aoptarm.pas

@@ -1361,10 +1361,10 @@ Implementation
             to
             and reg3,reg1,x
           }
-          else if ((taicpu(p).oper[2]^.val and $ffffff00)=0) and
-            MatchInstruction(p, A_AND, [C_None], [PF_None]) and
+          else if MatchInstruction(p, A_AND, [C_None], [PF_None]) and
             GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and
-            MatchInstruction(hp1, [A_UXTB,A_UXTH], [C_None], [PF_None]) and
+            ((((taicpu(p).oper[2]^.val and $ffffff00)=0) and MatchInstruction(hp1, A_UXTB, [C_None], [PF_None])) or
+             (((taicpu(p).oper[2]^.val and $ffff0000)=0) and MatchInstruction(hp1, A_UXTH, [C_None], [PF_None]))) and
             (taicpu(hp1).ops = 2) and
             RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and
             MatchOperand(taicpu(hp1).oper[1]^, taicpu(p).oper[0]^.reg) and

compiler/avr/agavrgas.pas

@@ -96,7 +96,7 @@ unit agavrgas;
                 internalerror(2011021707)
               else if base<>NR_NO then
                 begin
-                  if addressmode=AM_PREDRECEMENT then
+                  if addressmode=AM_PREDECREMENT then
                     s:='-';
 
                   case base of

compiler/avr/cgcpu.pas

@@ -120,6 +120,7 @@ unit cgcpu;
         procedure a_op_reg_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister);
         procedure a_op_const_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister);
         procedure maybegetcpuregister(list : tasmlist; reg : tregister);
+        function addr_is_io_register(const addr: integer): boolean;
       end;
 
       tcg64favr = class(tcg64f32)
@@ -1084,6 +1085,14 @@ unit cgcpu;
           getcpuregister(list,reg);
       end;
 
+    { Returns true if dataspace address falls in I/O register range }
+    function tcgavr.addr_is_io_register(const addr: integer): boolean;
+    begin
+      result := (not(current_settings.cputype in [cpu_avrxmega3,cpu_avrtiny]) and (addr>31)) or
+                ((current_settings.cputype in [cpu_avrxmega3,cpu_avrtiny]) and (addr>=0)) and
+                (addr<cpuinfo.embedded_controllers[current_settings.controllertype].srambase);
+    end;
+
 
     function tcgavr.normalize_ref(list:TAsmList;ref: treference;tmpreg : tregister) : treference;
       var
@@ -1365,15 +1374,13 @@ unit cgcpu;
            end;
          if not conv_done then
            begin
-             // CC
-             // Write to 16 bit ioreg, first high byte then low byte
-             // sequence required for 16 bit timer registers
-             // See e.g. atmega328p manual para 15.3 Accessing 16 bit registers
-             // Avrxmega3: write low byte first then high byte
-             // See e.g. megaAVR-0 family data sheet 7.5.6 Accessing 16-bit registers
+             { Write to 16 bit ioreg, first high byte then low byte
+               sequence required for 16 bit timer registers
+               See e.g. atmega328p manual para 15.3 Accessing 16 bit registers
+               Avrxmega3: write low byte first then high byte
+               See e.g. megaAVR-0 family data sheet 7.5.6 Accessing 16-bit registers }
              if (current_settings.cputype <> cpu_avrxmega3) and
-               (fromsize in [OS_16, OS_S16]) and QuickRef and (href.offset > 31) and
-               (href.offset < cpuinfo.embedded_controllers[current_settings.controllertype].srambase) then
+               (fromsize in [OS_16, OS_S16]) and QuickRef and addr_is_io_register(href.offset) then
                begin
                  tmpreg:=GetNextReg(reg);
                  href.addressmode:=AM_UNCHANGED;
@@ -2600,24 +2607,21 @@ unit cgcpu;
                 dstref:=dest;
               end;
 
-              // CC
-              // If dest is an ioreg (31 < offset < srambase) and size = 16 bit then
-              // write high byte first, then low byte
-              // but not for avrxmega3
-              if (len = 2) and DestQuickRef and (current_settings.cputype <> cpu_avrxmega3) and
-                (dest.offset > 31) and
-                (dest.offset < cpuinfo.embedded_controllers[current_settings.controllertype].srambase) then
-                begin
-                  // If src is also a 16 bit ioreg then read low byte then high byte
-                  if SrcQuickRef and (srcref.offset > 31)
-                    and (srcref.offset < cpuinfo.embedded_controllers[current_settings.controllertype].srambase) then
-                    begin
-                      // First read source into temp registers
-                      tmpreg:=getintregister(list, OS_16);
-                      list.concat(taicpu.op_reg_ref(GetLoad(srcref),tmpreg,srcref));
-                      inc(srcref.offset);
-                      tmpreg2:=GetNextReg(tmpreg);
-                      list.concat(taicpu.op_reg_ref(GetLoad(srcref),tmpreg2,srcref));
+            { If dest is an ioreg and size = 16 bit then
+              write high byte first, then low byte
+              but not for avrxmega3 }
+            if (len = 2) and DestQuickRef and (current_settings.cputype <> cpu_avrxmega3) and
+                addr_is_io_register(dest.offset) then
+              begin
+                // If src is also a 16 bit ioreg then read low byte then high byte
+                if SrcQuickRef and addr_is_io_register(srcref.offset) then
+                  begin
+                    // First read source into temp registers
+                    tmpreg:=getintregister(list, OS_16);
+                    list.concat(taicpu.op_reg_ref(GetLoad(srcref),tmpreg,srcref));
+                    inc(srcref.offset);
+                    tmpreg2:=GetNextReg(tmpreg);
+                    list.concat(taicpu.op_reg_ref(GetLoad(srcref),tmpreg2,srcref));
 
                     // then move temp registers to dest in reverse order
                     inc(dstref.offset);
@@ -2627,8 +2631,20 @@ unit cgcpu;
                   end
                 else
                   begin
-                    srcref.addressmode:=AM_UNCHANGED;
-                    inc(srcref.offset);
+                    { avrtiny doesn't have LDD instruction, so use
+                      predecrement version of LD with pre-incremented pointer  }
+                    if current_settings.cputype = cpu_avrtiny then
+                      begin
+                        srcref.addressmode:=AM_PREDECREMENT;
+                        list.concat(taicpu.op_reg_const(A_SUBI,srcref.base,-2));
+                        list.concat(taicpu.op_reg_const(A_SBCI,GetNextReg(srcref.base),$FF));
+                      end
+                    else
+                      begin
+                        srcref.addressmode:=AM_UNCHANGED;
+                        inc(srcref.offset);
+                      end;
+
                     dstref.addressmode:=AM_UNCHANGED;
                     inc(dstref.offset);
 
@@ -2637,12 +2653,15 @@ unit cgcpu;
                     list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,GetDefaultTmpReg));
                     cg.ungetcpuregister(list,GetDefaultTmpReg);
 
-                    if not(SrcQuickRef) then
+                    if not(SrcQuickRef) and (current_settings.cputype <> cpu_avrtiny) then
                       srcref.addressmode:=AM_POSTINCREMENT
+                    else if current_settings.cputype = cpu_avrtiny then
+                      srcref.addressmode:=AM_PREDECREMENT
                     else
                       srcref.addressmode:=AM_UNCHANGED;
 
-                    dec(srcref.offset);
+                    if current_settings.cputype <> cpu_avrtiny then
+                      dec(srcref.offset);
                     dec(dstref.offset);
 
                     cg.getcpuregister(list,GetDefaultTmpReg);
@@ -2674,17 +2693,18 @@ unit cgcpu;
                   if DestQuickRef then
                     inc(dstref.offset);
                 end;
-              if not(SrcQuickRef) then
-                begin
-                  ungetcpuregister(list,srcref.base);
-                  ungetcpuregister(list,TRegister(ord(srcref.base)+1));
-                end;
-              if not(DestQuickRef) then
-                begin
-                  ungetcpuregister(list,dstref.base);
-                  ungetcpuregister(list,TRegister(ord(dstref.base)+1));
-                end;
-            end;
+
+            if not(SrcQuickRef) then
+              begin
+                ungetcpuregister(list,srcref.base);
+                ungetcpuregister(list,TRegister(ord(srcref.base)+1));
+              end;
+            if not(DestQuickRef) then
+              begin
+                ungetcpuregister(list,dstref.base);
+                ungetcpuregister(list,TRegister(ord(dstref.base)+1));
+              end;
+          end;
         end;
 
 

compiler/avr/cpubase.pas

@@ -160,7 +160,7 @@ unit cpubase;
                                 Operands
 *****************************************************************************}
 
-      taddressmode = (AM_UNCHANGED,AM_POSTINCREMENT,AM_PREDRECEMENT);
+      taddressmode = (AM_UNCHANGED,AM_POSTINCREMENT,AM_PREDECREMENT);
 
 {*****************************************************************************
                                  Constants

compiler/avr/raavr.pas

@@ -164,13 +164,13 @@ unit raavr;
        // Perhaps handle separately with a check on sub-architecture? Range check only important if smaller instruction code selected on larger arch
        (numOperands: (1 shl 2); Operands: ((typ: top_reg; rt: rt_all), (typ: top_const; max: 65535; min: 0))),
        // A_LD
-       (numOperands: (1 shl 2); Operands: ((typ: top_reg; rt: rt_all), (typ: top_reg; rt: rt_XYZ; am: [AM_UNCHANGED, AM_POSTINCREMENT, AM_PREDRECEMENT]))),
+       (numOperands: (1 shl 2); Operands: ((typ: top_reg; rt: rt_all), (typ: top_reg; rt: rt_XYZ; am: [AM_UNCHANGED, AM_POSTINCREMENT, AM_PREDECREMENT]))),
        // A_LDD
        (numOperands: (1 shl 2); Operands: ((typ: top_reg; rt: rt_all), (typ: top_reg; rt: rt_YZ; am: [AM_UNCHANGED]; minconst: 0; maxconst: 63))),
        // A_STS TODO: See LDS above
        (numOperands: (1 shl 2); Operands: ((typ: top_const; max: 65535; min: 0), (typ: top_reg; rt: rt_all))),
        // A_ST
-       (numOperands: (1 shl 2); Operands: ((typ: top_reg; rt: rt_XYZ; am: [AM_UNCHANGED, AM_POSTINCREMENT, AM_PREDRECEMENT]), (typ: top_reg; rt: rt_all))),
+       (numOperands: (1 shl 2); Operands: ((typ: top_reg; rt: rt_XYZ; am: [AM_UNCHANGED, AM_POSTINCREMENT, AM_PREDECREMENT]), (typ: top_reg; rt: rt_all))),
        // A_STD
        (numOperands: (1 shl 2); Operands: ((typ: top_reg; rt: rt_YZ; am: [AM_UNCHANGED]; minconst: 0; maxconst: 63), (typ: top_reg; rt: rt_all))),
        // A_LPM
@@ -348,7 +348,7 @@ unit raavr;
 
                         if not (err) and not(AM_UNCHANGED in AVRInstrConstraint[opcode].Operands[i].am) and
                           ((AM_POSTINCREMENT in AVRInstrConstraint[opcode].Operands[i].am) or
-                           (AM_PREDRECEMENT in AVRInstrConstraint[opcode].Operands[i].am)) then
+                           (AM_PREDECREMENT in AVRInstrConstraint[opcode].Operands[i].am)) then
                           err := not opregasref;
 
                         if not(err) and opregasref then

compiler/avr/raavrgas.pas

@@ -349,7 +349,7 @@ Unit raavrgas;
                 begin
                   { Special handling of predecrement addressing }
                   oper.InitRef;
-                  oper.opr.ref.addressmode:=AM_PREDRECEMENT;
+                  oper.opr.ref.addressmode:=AM_PREDECREMENT;
 
                   consume(AS_MINUS);
 

compiler/llvm/agllvm.pas

@@ -1601,6 +1601,11 @@ implementation
         if fputypestrllvm[current_settings.fputype]<>'' then
           optstr:=optstr+' -m'+fputypestrllvm[current_settings.fputype];
 
+        { restrict march to aarch64 for now to fix x86_64 compilation failure }
+        if (cputypestr[current_settings.cputype]<>'')
+           and (target_info.system in [system_aarch64_darwin, system_aarch64_linux]) then
+          optstr:=optstr+' -march='+cputypestr[current_settings.cputype];
+
         replace(result,'$OPT',optstr);
         inc(fnextpass);
       end;

compiler/ncal.pas

@@ -511,7 +511,7 @@ implementation
         { build up parameters and description }
         para:=tcallparanode(parametersnode);
         paramssize:=0;
-        names := #0;
+        names := '';
         while assigned(para) do
           begin
             { Skipped parameters are actually (varType=varError, vError=DISP_E_PARAMNOTFOUND).
@@ -575,12 +575,11 @@ implementation
 
         if variantdispatch then
           begin
-            { length-1, because the following names variable *always* starts
-              with #0 which will be the terminator for methodname }
-            tcb.emit_pchar_const(pchar(methodname),length(methodname)-1,true);
-            { length-1 because we added a null terminator to the string itself
-              already }
-            tcb.emit_pchar_const(pchar(names),length(names)-1,true);
+            tcb.emit_pchar_const(pchar(methodname),length(methodname),true);
+            if names<>'' then
+              { length-1 because we added a null terminator to the string itself
+                already }
+              tcb.emit_pchar_const(pchar(names),length(names)-1,true);
           end;
 
         { may be referred from other units in case of inlining -> global

compiler/options.pas

@@ -4954,9 +4954,21 @@ begin
 
   { Default alignment settings,
     1. load the defaults for the target
-    2. override with generic optimizer setting (little size)
-    3. override with the user specified -Oa }
+    2. adapt defaults specifically for the target
+    3. override with generic optimizer setting (little size)
+    4. override with the user specified -Oa }
   UpdateAlignment(init_settings.alignment,target_info.alignment);
+
+{$ifdef arm}
+  if (init_settings.instructionset=is_thumb) and not(CPUARM_HAS_THUMB2 in cpu_capabilities[init_settings.cputype]) then
+   begin
+     init_settings.alignment.procalign:=2;
+     init_settings.alignment.jumpalign:=2;
+     init_settings.alignment.coalescealign:=2;
+     init_settings.alignment.loopalign:=2;
+   end;
+{$endif arm}
+
   if (cs_opt_size in init_settings.optimizerswitches) then
    begin
      init_settings.alignment.procalign:=1;

compiler/optutils.pas

@@ -307,7 +307,9 @@ unit optutils;
               begin
                 { not sure if this is enough (FK) }
                 result:=p;
-                if not(cnf_call_never_returns in tcallnode(p).callnodeflags) then
+                if cnf_call_never_returns in tcallnode(p).callnodeflags then
+                  p.successor:=nil
+                else
                   p.successor:=succ;
               end;
             inlinen:

compiler/pexpr.pas

@@ -2989,7 +2989,7 @@ implementation
                   (token=_ASSIGNMENT) then
                   begin
                     found_arg_name:=true;
-                    p1:=cstringconstnode.createstr(storedpattern);
+                    p1:=cstringconstnode.createstr(orgstoredpattern);
                     consume(_ASSIGNMENT);
                     exit;
                   end;

compiler/ppu.pas

@@ -277,7 +277,7 @@ end;
 function tppufile.readheader: longint;
 begin
   if fsize<sizeof(tppuheader) then
-    exit(0);
+    exit(-1);
   result:=f.Read(header,sizeof(tppuheader));
   { The header is always stored in little endian order }
   { therefore swap if on a big endian machine          }

compiler/riscv/aoptcpurv.pas

@@ -249,7 +249,7 @@ implementation
                      MatchInstruction(hp1,[A_ADDI{$ifdef riscv64},A_ADDIW{$endif}]) and
                      (taicpu(hp1).ops=3) and
                      MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[1]^) and
-                     (taicpu(p).oper[2]^.typ=top_const) and
+                     (taicpu(hp1).oper[2]^.typ=top_const) and
                      is_imm12(taicpu(p).oper[2]^.val+taicpu(hp1).oper[2]^.val) and
                      (not RegModifiedBetween(taicpu(p).oper[1]^.reg, p,hp1)) and
                      RegEndOfLife(taicpu(p).oper[0]^.reg, taicpu(hp1)) then

compiler/riscv32/cpubase.pas

@@ -379,7 +379,7 @@ implementation
       begin
        is_calljmp:=false;
         case o of
-          A_JAL,A_JALR,A_Bxx:
+          A_JAL,A_JALR,A_Bxx,A_CALL:
             is_calljmp:=true;
           else
             ;

compiler/riscv64/cpubase.pas

@@ -390,7 +390,7 @@ implementation
       begin
        is_calljmp:=false;
         case o of
-          A_JAL,A_JALR,A_Bxx:
+          A_JAL,A_JALR,A_Bxx,A_CALL:
             is_calljmp:=true;
           else
             ;

compiler/systems/t_android.pas

@@ -436,14 +436,16 @@ begin
   if IsSharedLib then
     Replace(cmdstr,'$SONAME',ExtractFileName(outname));
 
-  binstr:=FindUtil(utilsprefix+BinStr);
   { We should use BFD version of LD, since GOLD version does not support INSERT command in linker scripts }
-  if binstr <> '' then begin
-    { Checking if ld.bfd exists }
-    s:=ChangeFileExt(binstr, '.bfd' + source_info.exeext);
+  s:=utilsprefix+binstr+'.bfd';
+  if (source_info.exeext<>'') then
+    s:=s+source_info.exeext;
+  s:=FindUtil(s);
     if FileExists(s, True) then
-      binstr:=s;
-  end;
+    binstr:=s
+  else
+    // fallback to ld for very old or custom binutils
+    binstr:=FindUtil(utilsprefix+BinStr);
 
   success:=DoExec(binstr,CmdStr,true,false);
 

packages/fcl-db/src/dbase/dbf_fields.pas

@@ -617,7 +617,8 @@ begin
         // Note: this field can be stored as BCD or integer, depending on FPrecision;
         // that's why we allow 0 precision
         if FSize < 1   then FSize := 1;
-        if FSize >= 20 then FSize := 20;
+        // Removed, bug report 39009
+        // if FSize >= 20 then FSize := 20;
         if FPrecision > FSize-2 then FPrecision := FSize-2; //Leave space for . and -
         if FPrecision < 0       then FPrecision := 0;
       end;

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -986,10 +986,24 @@ begin
     // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
     case DataType of
       SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize; end;
-      SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize; end;
+      SQL_VARCHAR:
+      begin
+        FieldSize:=ColumnSize;
+        if FieldSize=BLOB_BUF_SIZE then // SQL_VARCHAR declared as NVARCHAR(MAX) must be ftMemo - variable data size
+          FieldType:=ftMemo
+        else
+          FieldType:=ftString;
+      end;
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize; end;
-      SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize; end;
+      SQL_WVARCHAR:
+      begin
+        FieldSize:=ColumnSize;
+        if FieldSize=BLOB_BUF_SIZE then // SQL_WVARCHAR declared as NVARCHAR(MAX) must be ftWideMemo - variable data size
+          FieldType:=ftWideMemo
+        else
+          FieldType:=ftWideString;
+      end;
       SQL_SS_XML,
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;

packages/fcl-passrc/src/pasresolver.pp

@@ -1809,6 +1809,8 @@ type
     procedure OnRangeCheckEl(Sender: TResExprEvaluator; El: TPasElement;
       var MsgType: TMessageType); virtual;
     function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
+    function EvalLengthOfString(ParamResolved: TPasResolverResult;
+      Param: TPasExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
   protected
     // generic/specialize
     type
@@ -14917,6 +14919,7 @@ begin
       '0'..'9': i:=i*base+ord(Value[p])-ord('0');
       'A'..'Z': i:=i*base+ord(Value[p])-ord('A')+10;
       'a'..'z': i:=i*base+ord(Value[p])-ord('a')+10;
+      else break;
       end;
       inc(p);
       end;
@@ -15998,6 +16001,28 @@ begin
   end;
 end;
 
+function TPasResolver.EvalLengthOfString(ParamResolved: TPasResolverResult;
+  Param: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
+var
+  Value: TResEvalValue;
+begin
+  Result:=nil;
+  if rrfReadable in ParamResolved.Flags then
+    begin
+    Value:=Eval(Param,Flags);
+    if Value=nil then exit;
+    case Value.Kind of
+    {$ifdef FPC_HAS_CPSTRING}
+    revkString:
+      Result:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
+    {$endif}
+    revkUnicodeString:
+      Result:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
+    end;
+    ReleaseEvalValue(Value);
+    end
+end;
+
 procedure TPasResolver.AddGenericTemplateIdentifiers(
   GenericTemplateTypes: TFPList; Scope: TPasIdentifierScope);
 var
@@ -18776,7 +18801,6 @@ procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
 var
   Param, Expr: TPasExpr;
   ParamResolved: TPasResolverResult;
-  Value: TResEvalValue;
   Ranges: TPasExprArray;
   IdentEl: TPasElement;
 begin
@@ -18785,22 +18809,7 @@ begin
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[]);
   if ParamResolved.BaseType in btAllStringAndChars then
-    begin
-    if rrfReadable in ParamResolved.Flags then
-      begin
-      Value:=Eval(Param,Flags);
-      if Value=nil then exit;
-      case Value.Kind of
-      {$ifdef FPC_HAS_CPSTRING}
-      revkString:
-        Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
-      {$endif}
-      revkUnicodeString:
-        Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
-      end;
-      ReleaseEvalValue(Value);
-      end
-    end
+    Evaluated:=EvalLengthOfString(ParamResolved,Param,Flags)
   else if ParamResolved.BaseType=btContext then
     begin
     if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
@@ -19366,6 +19375,7 @@ var
   Param: TPasExpr;
   ParamResolved: TPasResolverResult;
   C: TClass;
+  bt: TResolverBaseType;
 begin
   if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
     exit(cIncompatible);
@@ -19375,12 +19385,15 @@ begin
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[]);
   Result:=cIncompatible;
-  if ParamResolved.BaseType in btAllRanges then
+  bt:=ParamResolved.BaseType;
+  if bt in btAllRanges then
     // e.g. high(char)
     Result:=cExact
-  else if ParamResolved.BaseType=btSet then
+  else if bt=btSet then
     Result:=cExact
-  else if (ParamResolved.BaseType=btContext) then
+  else if bt in btAllStrings then
+    Result:=cExact
+  else if (bt=btContext) then
     begin
     C:=ParamResolved.LoTypeEl.ClassType;
     if (C=TPasArrayType)
@@ -19436,6 +19449,12 @@ begin
     ResolvedEl.BaseType:=ResolvedEl.SubType;
     ResolvedEl.SubType:=btNone;
     end
+  else if ResolvedEl.BaseType in btAllStrings then
+    begin
+    // high(aString)
+    SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
+      FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable]);
+    end
   else
     ;// ordinal: result type is argument type
   ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
@@ -19615,6 +19634,13 @@ begin
       else
         Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
       end
+    else if bt in btAllStrings then
+      begin
+      if Proc.BuiltIn=bfLow then
+        Evaluated:=TResEvalInt.CreateValue(1)
+      else
+        Evaluated:=EvalLengthOfString(ParamResolved,Param,Flags);
+      end
     else
       begin
       {$IFDEF VerbosePasResolver}
@@ -19628,6 +19654,13 @@ begin
     // e.g. type t = 2..10;
     Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,Proc.BuiltIn=bfLow,Param);
     end
+  else if ParamResolved.BaseType in btAllStrings then
+    begin
+    if Proc.BuiltIn=bfLow then
+      Evaluated:=TResEvalInt.CreateValue(1)
+    else
+      Evaluated:=EvalLengthOfString(ParamResolved,Param,Flags);
+    end
   else
     begin
     {$IFDEF VerbosePasResolver}

packages/fcl-passrc/tests/tcresolver.pas

@@ -4957,14 +4957,21 @@ end;
 procedure TTestResolver.TestHighLow;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  bo: boolean;');
-  Add('  by: byte;');
-  Add('  ch: char;');
-  Add('begin');
-  Add('  for bo:=low(boolean) to high(boolean) do;');
-  Add('  for by:=low(byte) to high(byte) do;');
-  Add('  for ch:=low(char) to high(char) do;');
+  Add([
+  'const',
+  '  abc = ''abc'';',
+  'var',
+  '  bo: boolean;',
+  '  by: byte;',
+  '  ch: char;',
+  '  s: string;',
+  '  i: longint = high(abc);',
+  'begin',
+  '  for bo:=low(boolean) to high(boolean) do;',
+  '  for by:=low(byte) to high(byte) do;',
+  '  for ch:=low(char) to high(char) do;',
+  '  for i:=low(s) to high(s) do;',
+  '']);
   ParseProgram;
 end;
 

packages/ide/Makefile

@@ -3409,6 +3409,9 @@ endif
 ifdef LLVM
 FPMAKE_OPT+=--LLVM=1
 endif
+ifdef NOLLVM
+FPMAKE_OPT+=--NOLLVM=1
+endif
 .NOTPARALLEL:
 PPC_TARGETS=i386 m68k powerpc sparc arm x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64
 CLEAN_TARGETS=$(addsuffix _clean,$(sort $(PPC_TARGETS)))

packages/ide/Makefile.fpc

@@ -94,6 +94,10 @@ ifdef LLVM
 FPMAKE_OPT+=--LLVM=1
 endif
 
+ifdef NOLLVM
+FPMAKE_OPT+=--NOLLVM=1
+endif
+
 .NOTPARALLEL:
 
 PPC_TARGETS=i386 m68k powerpc sparc arm x86_64 powerpc64 mips mipsel avr jvm i8086 aarch64 sparc64

packages/ide/fpmake.pp

@@ -11,6 +11,7 @@ const
   NoGDBOption: boolean = false;
   GDBMIOption: boolean = false;
   GDBMI_Disabled: boolean = false;
+  LLVM_Disabled: boolean = false;
   GDBMI_DEFAULT_OSes = [aix, darwin, freebsd, haiku,linux, netbsd, openbsd, solaris, win32, win64];
 
 procedure ide_check_gdb_availability(Sender: TObject);
@@ -149,6 +150,7 @@ begin
   AddCustomFpmakeCommandlineOption('NoIDE','If value=1 or ''Y'', the IDE will be skipped');
   AddCustomFpmakeCommandlineOption('IDE','If value=1 or ''Y'', the IDE will be build for each target');
   AddCustomFpmakeCommandlineOption('LLVM','If value=1 or ''Y'', the Compiler codegenerator will use LLVM');
+  AddCustomFpmakeCommandlineOption('NoLLVM','If value=1 or ''Y'', ito explicitly disable use of LLVM');
 end;
 
 procedure add_ide(const ADirectory: string);
@@ -187,11 +189,24 @@ begin
       CompilerTarget:=StringToCPU(s)
     else
       CompilerTarget:=Defaults.CPU;
-    s:=GetCustomFpmakeCommandlineOptionValue('LLVM');
+{$ifdef CPULLVM}
+    llvm:=true;
+{$else}
+    llvm:=false;
+{$endif}
+    s := GetCustomFpmakeCommandlineOptionValue('NOLLVM');
     if (s='1') or (s='Y') then
-      llvm:=true
+     LLVM_Disabled := true;
+    if LLVM_Disabled then
+      llvm:=false
     else
-      llvm:=false;
+      begin
+        s:=GetCustomFpmakeCommandlineOptionValue('LLVM');
+        if (s='1') or (s='Y') then
+          llvm:=true
+        else
+          llvm:=false;
+      end;
     { Only try to build natively }
     { or for cross-compile if the resulting executable
       does not depend on C libs }

packages/pastojs/src/fppas2js.pp

@@ -2025,10 +2025,12 @@ type
     Function CreateCallCharCodeAt(Arg: TJSElement; aNumber: integer; El: TPasElement): TJSCallExpression; virtual;
     Function CreateCallFromCharCode(Arg: TJSElement; El: TPasElement): TJSCallExpression; virtual;
     Function CreateUsesList(UsesSection: TPasSection; AContext : TConvertContext): TJSArrayLiteral;
+    // js statement list
     Procedure AddToStatementList(var First, Last: TJSStatementList;
       Add: TJSElement; Src: TPasElement); overload;
     Procedure AddToStatementList(St: TJSStatementList; Add: TJSElement; Src: TPasElement); overload;
     Procedure PrependToStatementList(var St: TJSElement; Add: TJSElement; PosEl: TPasElement);
+    // js var
     Procedure AddToVarStatement(VarStat: TJSVariableStatement; Add: TJSElement;
       Src: TPasElement);
     Function CreateValInit(PasType: TPasType; Expr: TPasExpr; El: TPasElement;
@@ -2037,6 +2039,15 @@ type
     Function CreateVarStatement(const aName: String; Init: TJSElement;
       El: TPasElement): TJSVariableStatement; virtual;
     Function CreateVarDecl(const aName: String; Init: TJSElement; El: TPasElement): TJSVarDeclaration; virtual;
+    // misc
+    Function CreateExternalBracketAccessorCall(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateAssignStatement(LeftEl: TPasExpr; AssignContext: TAssignContext): TJSElement; virtual;
+    Function CreateGetEnumeratorLoop(El: TPasImplForLoop;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual;
+    Function CreateDotSplit(El: TPasElement; Expr: TJSElement): TJSElement; virtual;
+    Function CreatePrecompiledJS(El: TJSElement): string; virtual;
+    Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement);
     // JS literals
     Function CreateLiteralNumber(El: TPasElement; const n: TJSNumber): TJSLiteral; virtual;
     Function CreateLiteralFloat(El: TPasElement; const n: TJSNumber): TJSElement; virtual;
@@ -2126,25 +2137,18 @@ type
     Procedure AddClassConstructors(FuncContext: TFunctionContext; PosEl: TPasElement); virtual;
     Procedure AddClassMessageIds(El: TPasClassType; Src: TJSSourceElements;
       FuncContext: TFunctionContext; pbivn: TPas2JSBuiltInName); virtual;
-    // misc
+    // callbacks
     Function CreateCallback(Expr: TPasExpr; ResolvedEl: TPasResolverResult;
       aSafeCall: boolean; AContext: TConvertContext): TJSElement; virtual;
     Function CreateSafeCallback(Expr: TPasExpr; JS: TJSElement; AContext: TConvertContext): TJSElement; virtual;
-    Function CreateExternalBracketAccessorCall(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
-    Function CreateAssignStatement(LeftEl: TPasExpr; AssignContext: TAssignContext): TJSElement; virtual;
-    Function CreateGetEnumeratorLoop(El: TPasImplForLoop;
-      AContext: TConvertContext): TJSElement; virtual;
-    Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual;
+    // property
     Function CreatePropertyGet(Prop: TPasProperty; Expr: TPasExpr;
       AContext: TConvertContext; PosEl: TPasElement): TJSElement; virtual;
     Function AppendPropertyAssignArgs(Call: TJSCallExpression; Prop: TPasProperty;
       AssignContext: TAssignContext; PosEl: TPasElement): TJSCallExpression; virtual;
     Function AppendPropertyReadArgs(Call: TJSCallExpression; Prop: TPasProperty;
       aContext: TConvertContext; PosEl: TPasElement): TJSCallExpression; virtual;
-    Function CreateDotSplit(El: TPasElement; Expr: TJSElement): TJSElement; virtual;
-    Function CreatePrecompiledJS(El: TJSElement): string; virtual;
     Function CreateRaisePropReadOnly(PosEl: TPasElement): TJSElement; virtual;
-    Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement);
     // create elements for RTTI
     Function CreateTypeInfoRef(El: TPasType; AContext: TConvertContext;
       ErrorEl: TPasElement): TJSElement; virtual;
@@ -13739,6 +13743,20 @@ begin
         exit;
         end;
       end;
+    btString:
+      begin
+        writeln('AAA1 TPasToJSConverter.ConvertBuiltIn_LowHigh ',IsLow);
+      if isLow then
+        // low(aString) -> 1
+        Result:=CreateLiteralNumber(El,1)
+      else
+        begin
+        // high(aString) -> aString.length
+        Result:=ConvertExpression(Param,AContext);
+        Result:=CreateDotNameExpr(El,Result,'length');
+        end;
+      exit;
+      end;
   end;
   DoError(20170210110717,nXExpectedButYFound,sXExpectedButYFound,['enum or array',
     AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
@@ -19742,6 +19760,7 @@ end;
 
 function TPasToJSConverter.CreateDotSplit(El: TPasElement; Expr: TJSElement
   ): TJSElement;
+// create Expr.split('')
 var
   DotExpr: TJSDotMemberExpression;
   Call: TJSCallExpression;

packages/pastojs/src/pas2jsfiler.pp

@@ -80,7 +80,7 @@ unit Pas2JsFiler;
 
 {$mode objfpc}{$H+}
 
-{$IF FPC_FULLVERSION>30200}
+{$IF FPC_FULLVERSION>=30300}
 {$WARN 6060 off : case statement does not handle all possible cases}
 {$ENDIF}
 

packages/pastojs/tests/tcmodules.pas

@@ -7862,8 +7862,11 @@ begin
   '  c = string(''ä'');',
   '  d = UnicodeString(''b'');',
   '  e = UnicodeString(''ö'');',
+  '  f = low(a)+high(b);',
+  '  g: word = low(a);',
   'var',
   '  s: string = ''abc'';',
+  '  i: longint;',
   'begin',
   '  s:='''';',
   '  s:=#13#10;',
@@ -7882,6 +7885,7 @@ begin
   '  s:=concat(s);',
   '  s:=concat(s,''a'',s);',
   '  s:=#250#269;',
+  '  i:=low(s)+high(a);',
   //'  s:=#$2F804;',
   // ToDo: \uD87E\uDC04 -> \u{2F804}
   '']);
@@ -7893,7 +7897,10 @@ begin
     'this.c = "ä";',
     'this.d = "b";',
     'this.e = "ö";',
+    'this.f = 1 + this.b.length;',
+    'this.g = 1;',
     'this.s="abc";',
+    'this.i = 0;',
     '']),
     LinesToStr([
     '$mod.s="";',
@@ -7913,6 +7920,7 @@ begin
     '$mod.s = $mod.s;',
     '$mod.s = $mod.s.concat("a", $mod.s);',
     '$mod.s = "úč";',
+    '$mod.i = 1 + $mod.a.length;',
     '']));
 end;
 

packages/paszlib/src/infblock.pas

@@ -45,7 +45,7 @@ function inflate_blocks_sync_point(var s : inflate_blocks_state) : integer;
 implementation
 
 uses
-  infcodes, inftrees, infutil;
+  infcodes, inftrees, infutil{$IFDEF ZLIB_DEBUG}, SysUtils{$ENDIF};
 
 { Tables for deflate from PKZIP's appnote.txt. }
 Const

packages/paszlib/src/infcodes.pas

@@ -31,7 +31,7 @@ procedure inflate_codes_free(var c : pInflate_codes_state;
 implementation
 
 uses
-  infutil, inffast;
+  infutil, inffast{$IFDEF ZLIB_DEBUG}, SysUtils{$ENDIF};
 
 
 function inflate_codes_new (bl : cardinal;
@@ -185,7 +185,7 @@ begin
         if (t^.base >= $20) and (t^.base < $7f) then
           Tracevv('inflate:         literal '+char(t^.base))
         else
-          Tracevv('inflate:         literal '+IntToStr(t^.base));
+          Tracevv('inflate:         literal $'+IntToHex(t^.base, 2));
         {$ENDIF}          
         c^.mode := LIT;
         continue;  { break switch statement }

packages/paszlib/src/inffast.pas

@@ -29,7 +29,7 @@ function inflate_fast( bl : cardinal;
 implementation
 
 uses
-  infutil;
+  infutil{$IFDEF ZLIB_DEBUG}, SysUtils{$ENDIF};
 
 
 { Called with number of bytes left to write in window at least 258

packages/paszlib/src/zbase.pas

@@ -380,10 +380,6 @@ const
   PRESET_DICT = $20; { preset dictionary flag in zlib header }
 
 
-  {$IFDEF ZLIB_DEBUG}
-  procedure Assert(cond : boolean; msg : string);
-  {$ENDIF}
-
   procedure Trace(x : string);
   procedure Tracev(x : string);
   procedure Tracevv(x : string);
@@ -461,12 +457,6 @@ begin
   Halt(1);
 end;
 
-procedure Assert(cond : boolean; msg : string);
-begin
-  if not cond then
-    z_error(msg);
-end;
-
 procedure Trace(x : string);
 begin
   WriteLn(x);

packages/paszlib/src/zconf.inc

@@ -36,3 +36,9 @@
  {$UNDEF MAXSEG_64K}
  {$UNDEF Delphi32}
 {$ENDIF}
+
+{- $DEFINE ZLIB_DEBUG}
+
+{$IFDEF ZLIB_DEBUG}
+  {$ASSERTIONS ON}
+{$ENDIF}

packages/paszlib/src/zdeflate.pas

@@ -1502,6 +1502,27 @@ end;
 {$endif} { FASTEST }
 
 {$ifdef ZLIB_DEBUG}
+function zmemcmp(s1p, s2p : PByte; len : Cardinal) : Integer;
+var
+  j : Cardinal;
+  source,
+  dest : PByte;
+begin
+  source := s1p;
+  dest := s2p;
+  for j := 0 to pred(len) do
+  begin
+    if (source^ <> dest^) then
+    begin
+      zmemcmp := 2*Ord(source^ > dest^)-1;
+      exit;
+    end;
+    Inc(source);
+    Inc(dest);
+  end;
+  zmemcmp := 0;
+end;
+
 { ===========================================================================
   Check that the match at match_start is indeed a match. }
 

packages/paszlib/src/zstream.pp

@@ -325,6 +325,7 @@ end;
 function Tdecompressionstream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
 
 var c,off: int64;
+    buf: array[0..8191] of Byte;
 
 begin
   off:=Offset;
@@ -344,9 +345,9 @@ begin
   while off>0 do
     begin
       c:=off;
-      if c>bufsize then
-        c:=bufsize;
-      if read(Fbuffer^,c)<>c then
+      if c>SizeOf(buf) then
+        c:=SizeOf(buf);
+      if read(buf,c)<>c then
         raise Edecompressionerror.create(Sseek_failed);
       dec(off,c);
     end;

packages/rtl-objpas/src/inc/dateutil.inc

@@ -2769,7 +2769,9 @@ end;
 
 function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
 var
-  xHour, xMinute, xSecond, xMillisecond, xLength: LongInt;
+  xHour, xMinute, xSecond, xLength, res: LongInt;
+  xFractionalSecond: Extended;
+  tmp: String;
 begin
   Result := True;
   xLength := Length(aString);
@@ -2829,24 +2831,31 @@ begin
           (aString[6] = ':') and
           TryStrToInt(Copy(aString, 7, 2), xSecond) and
           TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
-    10: Result :=
-          TryStrToInt(Copy(aString, 1, 2), xHour) and
-          TryStrToInt(Copy(aString, 3, 2), xMinute) and
-          TryStrToInt(Copy(aString, 5, 2), xSecond) and
-          (aString[7] = '.') and
-          TryStrToInt(Copy(aString, 8, 3), xMillisecond) and
-          TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
-    12: Result :=
-          TryStrToInt(Copy(aString, 1, 2), xHour) and
-          (aString[3] = ':') and
-          TryStrToInt(Copy(aString, 4, 2), xMinute) and
-          (aString[6] = ':') and
-          TryStrToInt(Copy(aString, 7, 2), xSecond) and
-          (aString[9] = '.') and
-          TryStrToInt(Copy(aString, 10, 3), xMillisecond) and
-          TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
-  else
-    Result := False;
+    else
+        if xLength >= 9 then
+        begin
+          Result := 
+            TryStrToInt(Copy(aString, 1, 2), xHour) and
+            (aString[3] = ':') and
+            TryStrToInt(Copy(aString, 4, 2), xMinute) and
+            (aString[6] = ':') and
+            TryStrToInt(Copy(aString, 7, 2), xSecond) and
+            ((aString[9] = '.') or (aString[9] = ',')) and
+            TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
+          if Result then
+          begin
+            tmp := Copy(aString, 9, xLength-8);
+            if tmp <> '' then
+            begin
+              tmp[1] := '.';
+              val(tmp, xFractionalSecond, res);
+              Result := res = 0;
+              if Result then
+                outTime := outTime + xFractionalSecond * OneSecond;
+            end;
+          end;
+        end else
+          Result := false;
   end;
 
   if not Result then

rtl/embedded/arm/cortexm0_start.inc

@@ -9,7 +9,7 @@ var
 
 procedure Pascalmain; external name 'PASCALMAIN';
 
-procedure HaltProc; assembler; nostackframe; public name'_haltproc';
+procedure HaltProc; assembler; nostackframe; public name'_haltproc'; noreturn;
 asm
 .Lloop:
    b .Lloop

rtl/embedded/arm/cortexm3_start.inc

@@ -9,7 +9,7 @@ var
 
 procedure Pascalmain; external name 'PASCALMAIN';
 
-procedure HaltProc; assembler; nostackframe; public name'_haltproc';
+procedure HaltProc; assembler; nostackframe; public name'_haltproc'; noreturn;
 asm
 .Lloop:
    b .Lloop

rtl/embedded/system.pp

@@ -300,7 +300,7 @@ begin
 
 {$ifdef FPC_HAS_FEATURE_THREADING}
   { threading }
-  //InitSystemThreads; // Empty call for embedded anyway
+  InitSystemThreads;
 {$endif FPC_HAS_FEATURE_THREADING}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}

rtl/embedded/systhrd.inc

@@ -3,7 +3,7 @@
     Copyright (c) 2002 by Peter Vreman,
     member of the Free Pascal development team.
 
-    Embedded empty threading support implementation
+    Embedded threading support implementation
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -14,8 +14,116 @@
 
  **********************************************************************}
 
+
+{ resourcestrings are not supported by the system unit,
+  they are in the objpas unit and not available for fpc/tp modes }
+const
+  SNoThreads = 'This binary has no thread support compiled in.';
+  SRecompileWithThreads = 'Recompile the application with a thread-driver in the program uses clause before other units using thread.';
+
+Procedure NoThreadError;NoReturn;
+  begin
+  {$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+    If IsConsole then
+      begin
+      Writeln(StdErr,SNoThreads);
+      Writeln(StdErr,SRecompileWithThreads);
+      end;
+  {$endif FPC_HAS_FEATURE_CONSOLEIO}
+    { providing an rte on embedded makes often little sense and 
+      runerror(...) would pull in a lot of unnecessary code }
+    system_exit;
+  end;
+
+
+function  NoGetCurrentThreadId : TThreadID;
+  begin
+    if IsMultiThread then
+      NoThreadError
+    else
+      ThreadingAlreadyUsed:=true;
+    result:=TThreadID(1);
+  end;
+
+
+function NoBeginThread(sa : Pointer;stacksize : PtrUInt;
+                     ThreadFunction : tthreadfunc;p : pointer;
+                     creationFlags : dword; var ThreadId : TThreadID) : TThreadID;NoReturn;
+  begin
+    NoThreadError;
+  end;
+
+
+procedure SysInitCriticalSection(var cs);
+  begin
+  end;
+
+
+procedure SysDoneCriticalSection(var cs);
+  begin
+  end;
+
+
+procedure SysEnterCriticalSection(var cs);
+  begin
+  end;
+
+
+function SysTryEnterCriticalSection(var cs):longint;
+  begin
+  end;
+
+
+procedure SysLeaveCriticalSection(var cs);
+  begin
+  end;
+
+const
+  EmbeddedThreadManager : TThreadManager = (
+    InitManager            : Nil;
+    DoneManager            : Nil;
+    { while this is pretty hacky, it reduces the size of typical embedded programs
+     and works fine on arm and avr }
+    BeginThread            : @NoBeginThread;
+    EndThread              : TEndThreadHandler(@NoThreadError);
+    SuspendThread          : TThreadHandler(@NoThreadError);
+    ResumeThread           : TThreadHandler(@NoThreadError);
+    KillThread             : TThreadHandler(@NoThreadError);
+    CloseThread            : TThreadHandler(@NoThreadError);
+    ThreadSwitch           : TThreadSwitchHandler(@NoThreadError);
+    WaitForThreadTerminate : TWaitForThreadTerminateHandler(@NoThreadError);
+    ThreadSetPriority      : TThreadSetPriorityHandler(@NoThreadError);
+    ThreadGetPriority      : TThreadGetPriorityHandler(@NoThreadError);
+    GetCurrentThreadId     : @NoGetCurrentThreadId;
+    SetThreadDebugNameA    : TThreadSetThreadDebugNameHandlerA(@NoThreadError);
+    {$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+    SetThreadDebugNameU    : TThreadSetThreadDebugNameHandlerU(@NoThreadError);
+    {$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+    InitCriticalSection    : @SysInitCriticalSection;
+    DoneCriticalSection    : @SysDoneCriticalSection;
+    EnterCriticalSection   : @SysEnterCriticalSection;
+    TryEnterCriticalSection: @SysTryEnterCriticalSection;
+    LeaveCriticalSection   : @SysLeaveCriticalSection;
+    InitThreadVar          : TInitThreadVarHandler(@NoThreadError);
+    RelocateThreadVar      : TRelocateThreadVarHandler(@NoThreadError);
+    AllocateThreadVars     : @NoThreadError;
+    ReleaseThreadVars      : @NoThreadError;
+    BasicEventCreate       : TBasicEventCreateHandler(@NoThreadError);
+    BasicEventdestroy      : TBasicEventHandler(@NoThreadError);
+    BasicEventResetEvent   : TBasicEventHandler(@NoThreadError);
+    BasicEventSetEvent     : TBasicEventHandler(@NoThreadError);
+    BasicEventWaitFor      : TBasicEventWaitForHandler(@NoThreadError);
+    RTLEventCreate         : TRTLCreateEventHandler(@NoThreadError);
+    RTLEventdestroy        : TRTLEventHandler(@NoThreadError);
+    RTLEventSetEvent       : TRTLEventHandler(@NoThreadError);
+    RTLEventResetEvent     : TRTLEventHandler(@NoThreadError);
+    RTLEventWaitFor        : TRTLEventHandler(@NoThreadError);
+    RTLEventwaitfortimeout : TRTLEventHandlerTimeout(@NoThreadError);
+  );
+
+
 Procedure InitSystemThreads;
 begin
+  { calling SetThreadManager pulls in too much code }
+  CurrentTM:=EmbeddedThreadManager;
 end;
-
-

rtl/objpas/classes/streams.inc

@@ -1643,7 +1643,7 @@ Var
 begin
   B:=FEncoding.GetBytes(AString);
   if Length(B)>0 then
-    WriteBuffer(B[0],Length(Bytes));
+    WriteBuffer(B[0],Length(B));
 end;
 
 function TStringStream.ReadAnsiString(Count: Longint): AnsiString;

rtl/win32/seh32.inc

@@ -164,11 +164,8 @@ function __FPC_default_handler(
   var context: TContext;
   var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_DEFAULT_HANDLER'];
 var
+  Exc: TExceptObject;
   code: longint;
-  Obj: TObject;
-  Adr: Pointer;
-  Frames: PCodePointer;
-  FrameCount: Longint;
 begin
   if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
   begin
@@ -199,11 +196,11 @@ begin
       if code<0 then
         SysResetFPU;
       code:=abs(code);
-      Adr:=rec.ExceptionAddress;
-      Obj:=nil;
+      Exc.Addr:=rec.ExceptionAddress;
+      Exc.FObject:=nil;
       if Assigned(ExceptObjProc) then
-        Obj:=TObject(TExceptObjProc(ExceptObjProc)(code,rec));
-      if Obj=nil then
+        Exc.FObject:=TObject(TExceptObjProc(ExceptObjProc)(code,rec));
+      if Exc.FObject=nil then
       begin
         { This works because RtlUnwind does not actually unwind the stack on i386
           (and only on i386) }
@@ -212,26 +209,34 @@ begin
         erroraddr:=pointer(context.Eip);
         Halt(code);
       end;
-      FrameCount:=GetBacktrace(context,nil,Frames);
+      Exc.FrameCount:=GetBacktrace(context,nil,Exc.Frames);
     end
     else
     begin
-      Obj:=TObject(rec.ExceptionInformation[1]);
-      Adr:=rec.ExceptionInformation[0];
-      Frames:=PCodePointer(rec.ExceptionInformation[3]);
-      FrameCount:=ptruint(rec.ExceptionInformation[2]);
+      Exc.FObject:=TObject(rec.ExceptionInformation[1]);
+      Exc.Addr:=rec.ExceptionInformation[0];
+      Exc.Frames:=PCodePointer(rec.ExceptionInformation[3]);
+      Exc.FrameCount:=ptruint(rec.ExceptionInformation[2]);
       code:=217;
     end;
+
+    Exc.Refcount:=0;
+    Exc.SEHFrame:=@frame;
+    Exc.ExceptRec:=@rec;
+    { link to ExceptObjectStack }
+    Exc.Next:=ExceptObjectStack;
+    ExceptObjectStack:=@Exc;
+
     if Assigned(ExceptProc) then
     begin
-      ExceptProc(Obj,Adr,FrameCount,Frames);
+      ExceptProc(Exc.FObject,Exc.Addr,Exc.FrameCount,Exc.Frames);
       Halt(217);
     end
     else
     begin
       errorcode:=word(code);
       errorbase:=pointer(rec.ExceptionInformation[4]);
-      erroraddr:=pointer(Adr);
+      erroraddr:=pointer(Exc.Addr);
       Halt(code);
     end;
   end;

tests/test/tcustomvar1.pp

@@ -0,0 +1,169 @@
+program tcustomvar1;
+
+{$APPTYPE CONSOLE}
+{$MODE Delphi}
+
+uses
+  Variants, SysUtils;
+
+type
+  TSampleVariant = class(TCustomVariantType)
+  protected
+    procedure DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
+  public
+    procedure Clear(var V: TVarData); override;
+    procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean ); override;
+  end;
+
+procedure TSampleVariant.Clear(var V: TVarData);
+begin
+  V.VType:=varEmpty;
+end;
+
+procedure TSampleVariant.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
+begin
+  if Indirect and VarDataIsByRef(Source) then
+    VarDataCopyNoInd(Dest, Source)
+  else with Dest do
+    VType:=Source.VType;
+end;
+
+var
+  funcname: String;
+  argnames: array of String;
+  argtypes: array of Byte;
+  argvalues: array of Variant;
+
+procedure TSampleVariant.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
+var
+  n: AnsiString;
+  nptr: PChar;
+  arg: Pointer;
+  t: Byte;
+  i: LongInt;
+  v: Variant;
+begin
+  nptr := PChar(@CallDesc^.argtypes[CallDesc^.argcount]);
+  n := StrPas(nptr);
+  if n <> funcname then begin
+    Writeln('Func name: got: ', n, ', expected: ', funcname);
+    Halt(1);
+  end;
+  if Length(argnames) <> CallDesc^.namedargcount then
+    Halt(1);
+  nptr := nptr + Length(n) + 1;
+  arg := Params;
+  for i := 0 to CallDesc^.namedargcount - 1 do begin
+    n := StrPas(nptr);
+    if n <> argnames[i] then begin
+      Writeln('Arg ', i, ': got: ', n, ', expected: ', argnames[i]);
+      Halt(1);
+    end;
+    if CallDesc^.argtypes[i] <> argtypes[i] then begin
+      Writeln('Arg ', i, ' type: got: ', CallDesc^.ArgTypes[i], ', expected: ', argtypes[i]);
+      Halt(1);
+    end;
+    t := argtypes[i] and $7f;
+    if argtypes[i] and $80 <> 0 then begin
+      TVarData(v).VType := t or varByRef;
+      TVarData(v).VPointer := PPointer(arg)^;
+    end else begin
+      TVarData(v).VType := t;
+      case t of
+        varStrArg: begin
+          TVarData(v).VType := varString;
+          AnsiString(TVarData(v).VString) := AnsiString(StrPas(PPWideChar(arg)^));
+        end;
+        varUStrArg: begin
+          TVarData(v).VType := varUString;
+          UnicodeString(TVarData(v).VUString) := StrPas(PPWideChar(arg)^);
+        end;
+        varSingle,
+        varSmallint,
+        varInteger,
+        varLongWord,
+        varBoolean,
+        varShortInt,
+        varByte,
+        varWord:
+          TVarData(v).VInteger := PInteger(arg)^;
+        else
+          TVarData(v).VAny := PPointer(arg)^;
+      end;
+    end;
+    if (not VarIsStr(v) and (v <> argvalues[i])) or (VarIsStr(v) and (UnicodeString(v) <> UnicodeString(argvalues[i]))) then begin
+      Writeln('Arg ', i, ' value: got: ', String(v), ', expected: ', String(argvalues[i]));
+      Halt(1);
+    end;
+    nptr := nptr + Length(n) + 1;
+    arg := PByte(arg) + SizeOf(Pointer);
+    { unset so that VarClear doesn't try to free the constant WideChar }
+    TVarData(v).vtype:=varEmpty;
+  end;
+end;
+
+function ConvertArgType(aType: Word): Byte;
+var
+  ref: Boolean;
+begin
+  ref := (aType and varByRef) <> 0;
+  aType := aType and not varByRef;
+  case aType of
+    {$ifndef windows}
+    varOleStr:
+      Result := varUStrArg;
+    {$endif}
+    varString:
+    {$ifdef windows}
+      Result := varOleStr;
+    {$else}
+      Result := varUStrArg; { not varStrArg }
+    {$endif}
+    varUString:
+    {$ifdef windows}
+      Result := varOleStr;
+    {$else}
+      Result := varUStrArg;
+    {$endif}
+    otherwise
+      Result := aType;
+  end;
+  if ref then
+    Result := Result or $80;
+end;
+
+var
+  SampleVariant: TSampleVariant;
+  v, v1: Variant;
+
+begin
+  SampleVariant:=TSampleVariant.Create;
+  TVarData(v).VType:=SampleVariant.VarType;
+
+  funcname := 'SomeProc';
+  SetLength(argnames, 0);
+  v.SomeProc;
+
+  funcname := 'SomeFunc';
+  SetLength(argnames, 0);
+  v1 := v.SomeFunc;
+
+  funcname := 'Begin';
+  SetLength(argnames, 2);
+  SetLength(argtypes, 2);
+  SetLength(argvalues, 2);
+  { the parameters are passed right-to-left }
+  argnames[1] := 'Date';
+  argnames[0] := 'Foobar';
+  argvalues[1] := 42;
+  argvalues[0] := UnicodeString('Hello');
+  argtypes[1] := ConvertArgType(TVarData(argvalues[1]).VType);
+  argtypes[0] := ConvertArgType(TVarData(argvalues[0]).VType);
+  v.&Begin(Date:=42,Foobar:='Hello');
+
+  funcname := '_';
+  SetLength(argnames, 0);
+  v._;
+
+  writeln('ok');
+end.

tests/test/texception11.pp

@@ -0,0 +1,25 @@
+program texception11;
+
+{$mode objfpc}
+
+uses
+  SysUtils;
+
+type
+  ETest = class(Exception);
+
+procedure TestExcept(Obj : TObject; Addr : CodePointer; FrameCount:Longint; Frame: PCodePointer);
+begin
+  if not (Obj is ETest) then
+    Halt(1);
+  if not (ExceptObject is ETest) then
+    Halt(2);
+  { explicitely halt with exit code 0 }
+  Halt(0);
+end;
+
+begin
+  ExceptProc := @TestExcept;
+
+  raise ETest.Create('');
+end.

tests/test/units/dateutil/tiso8601.pp

@@ -0,0 +1,48 @@
+{ %OPT=-Mobjfpc }
+program tiso8601;
+
+uses
+  SysUtils, DateUtils;
+
+const
+  sd6 = '2021-05-22T13:57:49.191021Z';
+  sd3 = '2021-05-22T13:57:49.191Z';
+  sd2 = '2021-05-22T13:57:49.19Z';
+  sd1 = '2021-05-22T13:57:49.1Z';
+
+  sc6 = '2021-05-22T13:57:49,191021Z';
+  sc3 = '2021-05-22T13:57:49,191Z';
+  sc2 = '2021-05-22T13:57:49,19Z';
+  sc1 = '2021-05-22T13:57:49,1Z';
+
+var
+  dt1, dt2, dt3, dt6: TDateTime;
+  hasErrors : boolean;
+
+  procedure Test(s: String);
+  var
+    dt: TDateTime;
+  begin
+    Write(s:30, ' ---> ');
+    try
+      dt := ISO8601ToDate(s, true);
+      WriteLn(dt:0:15);
+    except
+      WriteLn('ERROR');
+      hasErrors:=True;
+    end;
+  end;
+
+begin
+  HasErrors:=False;
+  Test(sd1);
+  Test(sd2);
+  Test(sd3);
+  Test(sd6);
+
+  Test(sc1);
+  Test(sc2);
+  Test(sc3);
+  Test(sc6);
+  Halt(Ord(HasErrors));
+end.

tests/webtbs/tw17904.pas

@@ -1,198 +0,0 @@
-
-{$ifdef fpc}{$mode objfpc}{$h+}{$endif}
-{$apptype console}
-
-uses Variants, SysUtils;
-
-type
-  TTest = class(TCustomVariantType)
-    procedure Clear(var V: TVarData); override;
-    procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
-    procedure DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
-  end;
-
-procedure TTest.Clear(var V: TVarData);
-begin
-end;
-
-procedure TTest.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
-begin
-end;
-
-procedure TTest.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
-var
-  tmp: Word;
-begin
-  if (CallDesc^.ArgCount =2) and Assigned(Dest) then
-  begin
-    //writeln(HexStr(PPointer(Params)^), ' ', HexStr(PPointer(Params)[1]));
-    WordRec(tmp).Lo := CallDesc^.ArgTypes[0];
-    WordRec(tmp).Hi := CallDesc^.ArgTypes[1];
-    // !! FPC passes args right-to-left, Delphi does same left-to-right
-    // Moreover, IDispatch needs args right-to-left, and Variant Dispatch needs left-to-right. Nice, huh?
-    {$ifdef fpc}
-    tmp := Swap(tmp);
-    {$endif}
-    Variant(Dest^) := tmp;
-  end;  
-end;
-
-type
-  TTestClass=class
-    u8: byte;
-    u16: word;
-    u32: longword;
-{$ifdef fpc}
-    u64: qword;
-{$endif}
-    s8: shortint;
-    s16: smallint;
-    s32: longint;
-    s64: int64;
-
-    cy: currency;
-
-    b: boolean;
-    bb: bytebool;
-    wb: wordbool;
-    lb: longbool;
-
-    sgl: single;
-    dbl: double;
-    ext: extended;
-    dt: TDateTime;
-
-    fsstr: shortstring;
-    fastr: ansistring;
-    fwstr: widestring;
-{$ifdef fpc}
-    fustr: unicodestring;
-{$endif}
-
-    fvar: Variant;
-    fintf: IInterface;
-    fdisp: IDispatch;
-
-    property u8prop: Byte read u8;
-    property u16prop: Word read u16;
-    property u32prop: LongWord read u32;
-{$ifdef fpc}
-    property u64prop: QWord read u64;
-{$endif}
-    property s8prop: ShortInt read s8;
-    property s16prop: SmallInt read s16;
-    property s32prop: LongInt read s32;
-    property s64prop: Int64 read s64;
-
-    property cyprop: currency read cy;
-    property bprop: boolean read b;
-    property bbprop: bytebool read bb;
-    property wbprop: wordbool read wb;
-    property lbprop: longbool read lb;
-
-    property sglprop: single read sgl;
-    property dblprop: double read dbl;
-    property extprop: extended read ext;
-    property dtprop: TDateTime read dt;
-
-    property varprop: Variant read fvar;
-    property intfprop: IInterface read fintf;
-    property dispprop: IDispatch read fdisp;
-
-    property sstr: shortstring read fsstr;
-    property astr: ansistring read fastr;
-    property wstr: widestring read fwstr;
-{$ifdef fpc}
-    property ustr: unicodestring read fustr;
-{$endif}
-  end;
-
-var
-  cv: TCustomVariantType;
-  code: Integer;
-  cl: TTestClass;
-  v: Variant;
-
-// using negative values of Expected to check that arg is passed by-value only
-procedure test(const id: string; const act: Variant; expected: Integer);
-var
-  tmp: word;
-  absexp: Integer;
-begin
-  tmp := act;
-  absexp := abs(expected);
-  write(id, WordRec(tmp).Lo,', ', WordRec(tmp).Hi);
-  if (expected >= 0) and (WordRec(tmp).Lo <> (expected or $80)) then
-  begin
-    write(' BYREF failed');
-    Code := Code or 1;
-  end;  
-  if WordRec(tmp).Hi <> absexp then
-  begin
-    write(' BYVAL failed');
-    Code := Code or 2;
-  end;
-  writeln;
-end;
-
-begin
-  Code := 0;
-  cv := TTest.Create;
-  cl := TTestClass.Create;
-  TVarData(v).vType := cv.VarType;
-
-  test('u8:    ', v.foo(cl.u8, cl.u8prop), varbyte);
-  
-  test('u16:    ', v.foo(cl.u16, cl.u16prop), varword);       // (Uncertain) D7: treated as Integer
-  test('u32:    ', v.foo(cl.u32, cl.u32prop), varlongword);   // (Uncertain) D7: treated as Integer ByRef
-  test('s8:     ', v.foo(cl.s8, cl.s8prop), varshortint);     // (Uncertain) D7: treated as Integer
-
-  test('s16:    ', v.foo(cl.s16, cl.s16prop), varsmallint);
-  test('s32:    ', v.foo(cl.s32, cl.s32prop), varinteger);
-  test('s64:    ', v.foo(cl.s64, cl.s64prop), varint64);
-{$ifdef fpc}
-  test('u64:    ', v.foo(cl.u64, cl.u64prop), varword64);
-{$endif}
-  
-  test('wordbool:', v.foo(cl.wb, cl.wbprop), varBoolean);
-  test('curncy:  ', v.foo(cl.cy, cl.cyprop), varCurrency);
-  
-  test('single:  ', v.foo(cl.sgl, cl.sglprop), varSingle);
-  test('double:  ', v.foo(cl.dbl, cl.dblprop), varDouble);
-  test('extended:', v.foo(cl.ext, cl.extprop), -varDouble);  // not a COM type, passed by value
-  
-  test('date:    ', v.foo(cl.dt, cl.dtprop), varDate);
-
-  test('ansistr: ', v.foo(cl.fastr, cl.astr), varStrArg);
-  test('widestr: ', v.foo(cl.fwstr, cl.wstr), varOleStr);
-{$ifdef fpc}
-  test('unistr:  ', v.foo(cl.fustr, cl.ustr), varUStrArg);
-{$endif}
-  test('variant: ', v.foo(cl.fvar, cl.varprop), varVariant);
-  
-  test('IUnknown:', v.foo(cl.fintf, cl.intfprop), varUnknown);
-  test('IDispatch:', v.foo(cl.fdisp, cl.dispprop), varDispatch);
-  
-  // not an COM type, passed by value; Delphi uses varStrArg
-  test('shortstr:', v.foo(cl.fsstr, cl.sstr), -varOleStr);
-  // not an COM type, passed by value
-  test('longbool:', v.foo(cl.lb, cl.lbprop), -varBoolean);
-
-  // typecasted ordinals (only one arg is actually used)
-  test('u8+cast: ', v.foo(byte(55), byte(55)), -varByte);
-  test('u16+cast:', v.foo(word(55), word(55)), -varWord);
-  test('u32+cast:', v.foo(longword(55), longword(55)), -varLongWord);
-{$ifdef fpc}
-  test('u64+cast:', v.foo(qword(55), qword(55)), -varQWord);
-{$endif}
-  test('s8+cast:', v.foo(shortint(55), shortint(55)), -varShortInt);
-  test('s16+cast:', v.foo(smallint(55), smallint(55)), -varSmallInt);
-  test('s32+cast:', v.foo(longint(55), longint(55)), -varInteger);
-  test('s64+cast:', v.foo(int64(55), int64(55)), -varInt64);
-
-  cl.Free;
-  if Code <> 0 then
-    writeln('Errors: ', Code);
-  Halt(Code);
-
-end.