[fpc-pascal] Weird FPC String Manager Bug

[Tony Whyman]

There seems to be some sort of weird race condition with the FPC 
string/memory manager. It is not easy to replicate, but the program 
Gabor Boros posted earlier today to the Lazarus list does seem to find 
the problem consistently.

The program he posted is a simple example of using MWA's Firebird Pascal 
Interface and causes an unhandled exception on program exit. This seems 
to occur after all user code has terminated and the heaptrc unit has 
reported its results. It only seems to occur when using "release" 
versions of the RTL and FCL libraries and not when using debug versions. 
A simple fix is to add "sleep(1);" to the end of the program. Just how 
weird it that!

I believe that I have isolated the problem to this code snippet - which 
looks simple enough:

procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
   Len: integer; CodePage: TSystemCodePage);
var rs: RawByteString;
begin
   system.SetString(rs,PAnsiChar(Buf),len);
   SetCodePage(rs,CodePage,false);
   S := rs;
end;

Its purpose is to set an AnsiString from text in a buffer and to set its 
codepage. If I change it to:

procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
   Len: integer; CodePage: TSystemCodePage);
var rs: RawByteString;
     i: integer;
begin
   rs := '';
   for i := 0 to len-1 do
     rs := rs + PAnsiChar(buf+i)^;
   SetCodePage(rs,CodePage,false);
   S := rs;
end;

then the bug goes away and the program completes normally. On the other 
hand, if I change it to:

procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
   Len: integer; CodePage: TSystemCodePage);
var rs: RawByteString;
begin
   SetLength(rs,len)
   if len > 0 then
     Move(Buf^,rs[1],len);
   SetCodePage(rs,CodePage,false);
   S := rs;
end;

then the exception is still raised at the end of the program. On the 
other hand, if I combine the two fixes to:

procedure TOutputBlockItem.SetString(out S: AnsiString; Buf: PByte;
   Len: integer; CodePage: TSystemCodePage);
var rs: RawByteString;
     i: integer;
begin
   SetLength(rs,len)
   if len > 0 then
     Move(Buf^,rs[1],len);
   rs := '';
   for i := 0 to len-1 do
     rs := rs + PAnsiChar(buf+i)^;
   SetCodePage(rs,CodePage,false);
   S := rs;
end;

then the program completes with no exception. My guess is that the 
problem is something to do with setting the length on a rawbytestring 
and its disposal when the rawbytestring goes out of scope. Can anyone 
see an obvious problem that I am missing?