* fixed bug #9187.

+ test.

git-svn-id: trunk@7876 -
This commit is contained in:
yury 2007-06-30 21:02:10 +00:00
parent 52458b965f
commit fd4f90d3ff
3 changed files with 26 additions and 0 deletions

1
.gitattributes vendored
View File

@ -8328,6 +8328,7 @@ tests/webtbs/tw9139a.pp svneol=native#text/plain
tests/webtbs/tw9167.pp svneol=native#text/plain
tests/webtbs/tw9174.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/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

View File

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

24
tests/webtbs/tw9187.pp Normal file
View File

@ -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.