[fpc-pascal] WARNING: Widestring Delete function causes crashes (FPC 2.2.0)

[Tobias Giesen]

Hello,

the Widestring Delete function in wstrings.inc accesses memory beyond 
the end of the string. This causes crashes after a while. The Delete 
function has been fixed in FPC 2.3 but the fix must be copied to the 
earlier branches too. I have submitted this as a bug in Mantis:
http://bugs.freepascal.org/view.php?id=11365

Until it is fixed, developers can just use the fixed code below instead
of the one in the System unit. You just need to find out if your 
platform uses FPC_WINLIKEWIDESTRING or not. On my platform, MacOS X,
this is not defined.

Type
  PWideRec = ^TWideRec;
  TWideRec = Packed Record
    {$ifdef FPC_WINLIKEWIDESTRING}
    Len   : DWord;
    {$else FPC_WINLIKEWIDESTRING}
    Ref : SizeInt;
    Len : SizeInt;
    {$endif FPC_WINLIKEWIDESTRING}
    First : WideChar;
  end;

Const
  WideRecLen = SizeOf(TWideRec);
  WideFirstOff = SizeOf(TWideRec)-sizeof(WideChar);
  
Procedure Delete (Var S : WideString; Index,Size: SizeInt); overload;
Var
  LS : SizeInt;
begin
  If Length(S)=0 then
     exit;
  if index<=0 then
     exit;
  LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len div sizeof(WideChar);
  if (Index<=LS) and (Size>0) then begin
     UniqueString (S);
     if Size+Index>LS then
        Size:=LS-Index+1;
     if Index+Size<=LS then begin
        Dec(Index);
        System.Move(PWideChar(S)[Index+Size],PWideChar(S)[Index],
              (LS-Index-Size+1)*sizeof(WideChar));
        end;
     Setlength(s,LS-Size);
     end;
  end;

Kind Regards,
Tobias Giesen
http://www.superflexible.com