[fpc-devel]AnsiStr bugfix by Carl

[Sergey Korshunoff]

Hello, Carl.
I lost a full day trying to get the following program to work
(FPC v1.0.5):

============================================================
{$H+} { Huge strings }

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

// {$DEFINE NO_BUG}

program bug;
var
  S, S2, S3: String;
  i1: Integer;
begin
    i1:=13;
    S:='This is text';
    S2:=Copy(S, 1, i1-1);
      {$IFDEF KYLIX}
         WriteLn( 'S2 RefCount=', LongInt(Pointer(Integer(S2)-8)^) );
      {$ELSE}
         WriteLn( 'S2 RefCount=', LongInt(Pointer(Integer(S2)-4)^) );
      {$ENDIF}
    S3:='';
    S3:=S2;
    S:='Quick brown fox';
    WriteLn( '===============================');
      {$IFDEF KYLIX}
         WriteLn( 'S2 RefCount=', LongInt(Pointer(Integer(S2)-8)^) );
         WriteLn( 'S3 RefCount=', LongInt(Pointer(Integer(S3)-8)^) );
      {$ELSE}
         WriteLn( 'S2 RefCount=', LongInt(Pointer(Integer(S2)-4)^) );
         WriteLn( 'S3 RefCount=', LongInt(Pointer(Integer(S3)-4)^) );
      {$ENDIF}
      {$IFDEF NO_BUG}
        WriteLn( 'S2=', ShortString(S2));
        WriteLn( 'S3=', ShortString(S3));
      {$ELSE}
        WriteLn( 'S2=',             S2);
        WriteLn( 'S3=',             S3);
      {$ENDIF}
    S2:=Copy(S, 1, i1-1);
    WriteLn( '===============================');
      {$IFDEF KYLIX}
         WriteLn( 'S2 RefCount=', LongInt(Pointer(Integer(S2)-8)^) );
         WriteLn( 'S3 RefCount=', LongInt(Pointer(Integer(S3)-8)^) );
      {$ELSE}
         WriteLn( 'S2 RefCount=', LongInt(Pointer(Integer(S2)-4)^) );
         WriteLn( 'S3 RefCount=', LongInt(Pointer(Integer(S3)-4)^) );
      {$ENDIF}
      {$IFDEF NO_BUG}
        WriteLn( 'S2=',ShortString(S2));
        WriteLn( 'S3=',ShortString(S3));
      {$ELSE}
        WriteLn( 'S2=',             S2);
        WriteLn( 'S3=',             S3);
      {$ENDIF}
end.
============================================================

After debugging, the following change was found in RTL:
=========================================================================
-+- 1.0.5-010314/rtl/inc/astrings.inc   Wed Jan 31 05:10:24 2001
+++ 1.0.5-010619/rtl/inc/astrings.inc   Wed Jun 13 03:38:47 2001
@@ -1,5 +1,5 @@
 {
-    $Id: astrings.inc,v 1.1.2.7 2000/12/09 22:54:06 florian Exp $
+    $Id: astrings.inc,v 1.1.2.9 2001/06/16 03:51:50 carl Exp $
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by Michael Van Canneyt,
     member of the Free Pascal development team.
@@ -130,7 +130,7 @@
 end;


-Procedure AnsiStr_Incr_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSIST
+Procedure AnsiStr_Incr_Ref ( S : PAnsiRec);[Public,Alias:'FPC_ANSISTR_
 Begin
   If S=Nil then
     exit;
@@ -692,8 +692,33 @@
   Move (Buf[0],S[1],Len);
 end;
...................
 {
   $Log: astrings.inc,v $
+  Revision 1.1.2.9  2001/06/16 03:51:50  carl
+  * bugfix of parameter ansistr_incr_ref which did not concord with x86 asm
========================================================================

But AnsiStr_Incr_Ref do not get right parameter if S is not Var.
And the following lines are broken after replacing Pointer to PAnsiRec:
  If PAnsiRec(S-FirstOff)^.Ref<=0 then exit;
  Inc(PAnsiRec(S-FirstOff)^.Ref);
In case of S:PAnsiRec this lines must be
  If PAnsiRec(Pointer(S)-FirstOff)^.Ref<=0 then exit;
  Inc(PAnsiRec(Pointer(S)-FirstOff)^.Ref);

After looking last FPC 1.0.5 updates, I do not see any changes
that correct this problem.

Carl, can you explain your bugfix idea?

Regards,
    Sergey Korshunoff