Browse Source

Merged revisions 9554,9566-9568,9571,9573,9576-9577,9579,9583,9587,9632-9637,9655-9656,9658,9692,9694-9695,9697-9714,9720,9722,9729,9732-9733,9740,9745,9749-9750,9753-9757,9760-9766,9768-9770,9772-9774,9814,9822,9825,9837-9850,9852,9855-9856,9863-9864,9867,10082,10129-10130,10137-10138,10140-10146,10148-10153,10160-10161,10168,10170,10172,10176-10178,10180,10183-10184,10187-10188,10191-10192,10200-10201,10203-10204,10206,10232,10234,10238-10239,10243,10251,10253-10254,10264,10266,10271,10273,10276-10279,10286-10294,10298,10300,10309,10313,10319,10327 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r9554 | yury | 2007-12-28 01:02:35 +0100 (Fr, 28 Dez 2007) | 1 line

* Explicitly increment and decrement ref count to keep copy of destination string in fpc_AnsiStr_Concat_multi and fpc_WideStr_Concat_multi. It prevents note "Local variable "destcopy" is assigned but never used".
........
r10327 | peter | 2008-02-14 21:15:21 +0100 (Do, 14 Feb 2008) | 4 lines

* fix widestring concat multi for winlikewidestring. The
append optimization can't be used in this can because the
trick with refcnt is not supported
........

git-svn-id: branches/fixes_2_2@10522 -

florian 17 years ago
parent
commit
f0e814f9a6
4 changed files with 63 additions and 9 deletions
  1. 1 0
      .gitattributes
  2. 5 2
      rtl/inc/astrings.inc
  3. 38 7
      rtl/inc/wustrings.inc
  4. 19 0
      tests/webtbs/tw10825.pp

+ 1 - 0
.gitattributes

@@ -7898,6 +7898,7 @@ tests/webtbs/tw10790.pp svneol=native#text/plain
 tests/webtbs/tw10800.pp svneol=native#text/plain
 tests/webtbs/tw10800.pp svneol=native#text/plain
 tests/webtbs/tw1081.pp svneol=native#text/plain
 tests/webtbs/tw1081.pp svneol=native#text/plain
 tests/webtbs/tw10815.pp svneol=native#text/plain
 tests/webtbs/tw10815.pp svneol=native#text/plain
+tests/webtbs/tw10825.pp svneol=native#text/plain
 tests/webtbs/tw1090.pp svneol=native#text/plain
 tests/webtbs/tw1090.pp svneol=native#text/plain
 tests/webtbs/tw1092.pp svneol=native#text/plain
 tests/webtbs/tw1092.pp svneol=native#text/plain
 tests/webtbs/tw1096.pp svneol=native#text/plain
 tests/webtbs/tw1096.pp svneol=native#text/plain

+ 5 - 2
rtl/inc/astrings.inc

@@ -250,13 +250,14 @@ Var
   p,pc        : pointer;
   p,pc        : pointer;
   Size,NewLen,
   Size,NewLen,
   OldDestLen  : SizeInt;
   OldDestLen  : SizeInt;
-  destcopy    : ansistring;
+  destcopy    : pointer;
 begin
 begin
   if high(sarr)=0 then
   if high(sarr)=0 then
     begin
     begin
       DestS:='';
       DestS:='';
       exit;
       exit;
     end;
     end;
+  destcopy:=nil;
   lowstart:=low(sarr);
   lowstart:=low(sarr);
   if Pointer(DestS)=Pointer(sarr[lowstart]) then
   if Pointer(DestS)=Pointer(sarr[lowstart]) then
     inc(lowstart);
     inc(lowstart);
@@ -269,7 +270,8 @@ begin
           { if DestS is used somewhere in the middle of the expression,
           { if DestS is used somewhere in the middle of the expression,
             we need to make sure the original string still exists after
             we need to make sure the original string still exists after
             we empty/modify DestS                                       }
             we empty/modify DestS                                       }
-          destcopy:=dests;
+          destcopy:=pointer(dests);
+          fpc_AnsiStr_Incr_Ref(destcopy);
           lowstart:=low(sarr);
           lowstart:=low(sarr);
           break;
           break;
         end;
         end;
@@ -298,6 +300,7 @@ begin
           inc(pc,size);
           inc(pc,size);
         end;
         end;
     end;
     end;
+  fpc_AnsiStr_Decr_Ref(destcopy);
 end;
 end;
 
 
 
 

+ 38 - 7
rtl/inc/wustrings.inc

@@ -574,17 +574,24 @@ end;
 
 
 procedure fpc_WideStr_Concat_multi (var DestS:Widestring;const sarr:array of Widestring); compilerproc;
 procedure fpc_WideStr_Concat_multi (var DestS:Widestring;const sarr:array of Widestring); compilerproc;
 Var
 Var
-  lowstart,i  : Longint;
+  i           : Longint;
   p,pc        : pointer;
   p,pc        : pointer;
-  Size,NewLen,
+  Size,NewLen : SizeInt;
+{$ifndef FPC_WINLIKEWIDESTRING}
+  lowstart    : longint;
+  destcopy    : pointer;
   OldDestLen  : SizeInt;
   OldDestLen  : SizeInt;
-  destcopy    : widestring;
+{$else FPC_WINLIKEWIDESTRING}
+  DestTmp     : Widestring;
+{$endif FPC_WINLIKEWIDESTRING}
 begin
 begin
   if high(sarr)=0 then
   if high(sarr)=0 then
     begin
     begin
       DestS:='';
       DestS:='';
       exit;
       exit;
     end;
     end;
+{$ifndef FPC_WINLIKEWIDESTRING}
+  destcopy:=nil;
   lowstart:=low(sarr);
   lowstart:=low(sarr);
   if Pointer(DestS)=Pointer(sarr[lowstart]) then
   if Pointer(DestS)=Pointer(sarr[lowstart]) then
     inc(lowstart);
     inc(lowstart);
@@ -596,8 +603,11 @@ begin
         begin
         begin
           { if DestS is used somewhere in the middle of the expression,
           { if DestS is used somewhere in the middle of the expression,
             we need to make sure the original string still exists after
             we need to make sure the original string still exists after
-            we empty/modify DestS                                       }
-          destcopy:=dests;
+            we empty/modify DestS.
+            This trick only works with reference counted strings. Therefor
+            this optimization is disabled for WINLIKEWIDESTRING }
+          destcopy:=pointer(dests);
+          fpc_WideStr_Incr_Ref(destcopy);
           lowstart:=low(sarr);
           lowstart:=low(sarr);
           break;
           break;
         end;
         end;
@@ -626,6 +636,27 @@ begin
           inc(pc,size*sizeof(WideChar));
           inc(pc,size*sizeof(WideChar));
         end;
         end;
     end;
     end;
+  fpc_WideStr_Decr_Ref(destcopy);
+{$else FPC_WINLIKEWIDESTRING}
+  { First calculate size of the result so we can do
+    a single call to SetLength() }
+  NewLen:=0;
+  for i:=low(sarr) to high(sarr) do
+    inc(NewLen,length(sarr[i]));
+  SetLength(DestTmp,NewLen);
+  pc:=pwidechar(DestTmp);
+  for i:=low(sarr) to high(sarr) do
+    begin
+      p:=pointer(sarr[i]);
+      if assigned(p) then
+        begin
+          Size:=length(widestring(p));
+          Move(p^,pc^,(Size+1)*sizeof(WideChar));
+          inc(pc,size*sizeof(WideChar));
+        end;
+    end;
+  DestS:=DestTmp;
+{$endif FPC_WINLIKEWIDESTRING}
 end;
 end;
 
 
 {$endif STR_CONCAT_PROCS}
 {$endif STR_CONCAT_PROCS}
@@ -719,7 +750,7 @@ begin
   begin
   begin
     fpc_pchar_to_widestr := '';
     fpc_pchar_to_widestr := '';
     exit;
     exit;
-  end;  
+  end;
   l:=IndexChar(p^,-1,#0);
   l:=IndexChar(p^,-1,#0);
   widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
   widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
 end;
 end;
@@ -735,7 +766,7 @@ begin
       begin
       begin
         fpc_chararray_to_widestr := '';
         fpc_chararray_to_widestr := '';
         exit;
         exit;
-      end;  
+      end;
       i:=IndexChar(arr,high(arr)+1,#0);
       i:=IndexChar(arr,high(arr)+1,#0);
       if i = -1 then
       if i = -1 then
         i := high(arr)+1;
         i := high(arr)+1;

+ 19 - 0
tests/webtbs/tw10825.pp

@@ -0,0 +1,19 @@
+program stringconcat;
+//compile with -gh
+
+{$ifdef FPC}{$mode objfpc}{$h+}{$INTERFACES CORBA}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ {$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
+ sysutils;
+
+var
+ wstr1: widestring;
+begin
+ winwidestringalloc:= false;
+ //crash exist with winwidestringalloc also but with bigger application only
+ wstr1:= '123';
+ wstr1:= 'ABC'+wstr1+'abc';
+ writeln(wstr1);
+ flush(output);
+end.