Browse Source

Merged revisions 7876 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r7876 | yury | 2007-07-01 00:02:10 +0300 (Вс, 01 июл 2007) | 2 lines

* fixed bug #9187.
+ test.
........

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

yury 18 years ago
parent
commit
eeb0b484b8
3 changed files with 26 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 1 0
      rtl/inc/wstrings.inc
  3. 24 0
      tests/webtbs/tw9187.pp

+ 1 - 0
.gitattributes

@@ -8149,6 +8149,7 @@ tests/webtbs/tw9098.pp svneol=native#text/plain
 tests/webtbs/tw9107.pp svneol=native#text/plain
 tests/webtbs/tw9107.pp svneol=native#text/plain
 tests/webtbs/tw9174.pp svneol=native#text/plain
 tests/webtbs/tw9174.pp svneol=native#text/plain
 tests/webtbs/tw9179.pp svneol=native#text/plain
 tests/webtbs/tw9179.pp svneol=native#text/plain
+tests/webtbs/tw9187.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 1 - 0
rtl/inc/wstrings.inc

@@ -381,6 +381,7 @@ Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_
 }
 }
 begin
 begin
 {$ifdef FPC_WINLIKEWIDESTRING}
 {$ifdef FPC_WINLIKEWIDESTRING}
+  if S1=S2 then exit;
   { Decrease the reference count on the old S1 }
   { Decrease the reference count on the old S1 }
   fpc_widestr_decr_ref (S1);
   fpc_widestr_decr_ref (S1);
   if S2<>nil then
   if S2<>nil then

+ 24 - 0
tests/webtbs/tw9187.pp

@@ -0,0 +1,24 @@
+var
+ wstr1: widestring;
+
+procedure testproc(const avalue: widestring);
+begin
+ wstr1:= avalue;
+end;
+
+var
+  i: longint;
+  w2: widestring;
+
+begin
+ setlength(w2, 200000);
+ for i:=1 to length(w2) do
+   w2[i]:=Chr(i mod $60 + $20);
+ wstr1:=w2;
+ testproc(wstr1);
+ if wstr1<>w2 then begin
+   writeln('Test failed!');
+   Halt(1);
+ end;
+ writeln('Test OK.');
+end.