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 năm trước cách đây
mục cha
commit
f0e814f9a6
4 tập tin đã thay đổi với 63 bổ sung9 xóa
  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/tw1081.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/tw1092.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;
   Size,NewLen,
   OldDestLen  : SizeInt;
-  destcopy    : ansistring;
+  destcopy    : pointer;
 begin
   if high(sarr)=0 then
     begin
       DestS:='';
       exit;
     end;
+  destcopy:=nil;
   lowstart:=low(sarr);
   if Pointer(DestS)=Pointer(sarr[lowstart]) then
     inc(lowstart);
@@ -269,7 +270,8 @@ begin
           { if DestS is used somewhere in the middle of the expression,
             we need to make sure the original string still exists after
             we empty/modify DestS                                       }
-          destcopy:=dests;
+          destcopy:=pointer(dests);
+          fpc_AnsiStr_Incr_Ref(destcopy);
           lowstart:=low(sarr);
           break;
         end;
@@ -298,6 +300,7 @@ begin
           inc(pc,size);
         end;
     end;
+  fpc_AnsiStr_Decr_Ref(destcopy);
 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;
 Var
-  lowstart,i  : Longint;
+  i           : Longint;
   p,pc        : pointer;
-  Size,NewLen,
+  Size,NewLen : SizeInt;
+{$ifndef FPC_WINLIKEWIDESTRING}
+  lowstart    : longint;
+  destcopy    : pointer;
   OldDestLen  : SizeInt;
-  destcopy    : widestring;
+{$else FPC_WINLIKEWIDESTRING}
+  DestTmp     : Widestring;
+{$endif FPC_WINLIKEWIDESTRING}
 begin
   if high(sarr)=0 then
     begin
       DestS:='';
       exit;
     end;
+{$ifndef FPC_WINLIKEWIDESTRING}
+  destcopy:=nil;
   lowstart:=low(sarr);
   if Pointer(DestS)=Pointer(sarr[lowstart]) then
     inc(lowstart);
@@ -596,8 +603,11 @@ begin
         begin
           { if DestS is used somewhere in the middle of the expression,
             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);
           break;
         end;
@@ -626,6 +636,27 @@ begin
           inc(pc,size*sizeof(WideChar));
         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;
 
 {$endif STR_CONCAT_PROCS}
@@ -719,7 +750,7 @@ begin
   begin
     fpc_pchar_to_widestr := '';
     exit;
-  end;  
+  end;
   l:=IndexChar(p^,-1,#0);
   widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
 end;
@@ -735,7 +766,7 @@ begin
       begin
         fpc_chararray_to_widestr := '';
         exit;
-      end;  
+      end;
       i:=IndexChar(arr,high(arr)+1,#0);
       if i = -1 then
         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.