mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-02 00:53:40 +02:00
b178b08ba7
http://svn.freepascal.org/svn/fpc/branches/unicodestring ........ r11665 | florian | 2008-08-30 13:30:17 +0200 (Sat, 30 Aug 2008) | 1 line * continued to work on unicodestring type support ........ r11666 | florian | 2008-08-30 19:02:26 +0200 (Sat, 30 Aug 2008) | 2 lines * expectloc for wide/ansi/unicode strings is LOC_CONSTANT or LOC_REGISTER now ........ r11667 | florian | 2008-08-30 20:42:37 +0200 (Sat, 30 Aug 2008) | 1 line * more unicodestring stuff fixed, test results on win32 are already good ........ r11670 | florian | 2008-08-30 23:21:48 +0200 (Sat, 30 Aug 2008) | 2 lines * first fixes for unix bootstrapping ........ r11683 | ivost | 2008-09-01 12:46:39 +0200 (Mon, 01 Sep 2008) | 2 lines * fixed 64bit bug in iconvenc.pas ........ r11689 | florian | 2008-09-01 23:12:34 +0200 (Mon, 01 Sep 2008) | 1 line * fixed several errors when building on unix ........ r11694 | florian | 2008-09-03 20:32:43 +0200 (Wed, 03 Sep 2008) | 1 line * fixed unix compilation ........ r11695 | florian | 2008-09-03 21:01:04 +0200 (Wed, 03 Sep 2008) | 1 line * bootstrapping fix ........ r11696 | florian | 2008-09-03 21:07:18 +0200 (Wed, 03 Sep 2008) | 1 line * more bootstrapping fixed ........ r11698 | florian | 2008-09-03 22:47:54 +0200 (Wed, 03 Sep 2008) | 1 line + two missing compiler procs exported ........ r11701 | florian | 2008-09-04 16:42:34 +0200 (Thu, 04 Sep 2008) | 2 lines + lazarus project for the linux rtl ........ r11702 | florian | 2008-09-04 16:43:27 +0200 (Thu, 04 Sep 2008) | 2 lines + set unicode string procedures ........ r11707 | florian | 2008-09-04 23:23:02 +0200 (Thu, 04 Sep 2008) | 2 lines * fixed several type casting stuff ........ r11712 | florian | 2008-09-05 22:46:03 +0200 (Fri, 05 Sep 2008) | 1 line * fixed unicodestring compilation on windows after recent unix changes ........ r11713 | florian | 2008-09-05 23:35:12 +0200 (Fri, 05 Sep 2008) | 1 line + UnicodeString support for Variants ........ r11715 | florian | 2008-09-06 20:59:54 +0200 (Sat, 06 Sep 2008) | 1 line * patch by Martin Schreiber for UnicodeString streaming ........ r11716 | florian | 2008-09-06 22:22:55 +0200 (Sat, 06 Sep 2008) | 2 lines * fixed test ........ r11717 | florian | 2008-09-07 10:25:51 +0200 (Sun, 07 Sep 2008) | 1 line * fixed typo when converting tunicodestring to punicodechar ........ r11718 | florian | 2008-09-07 11:29:52 +0200 (Sun, 07 Sep 2008) | 3 lines * fixed writing of UnicodeString properties * moved some helper routines to unicode headers ........ r11734 | florian | 2008-09-09 22:38:55 +0200 (Tue, 09 Sep 2008) | 1 line * fixed bootstrapping ........ r11735 | florian | 2008-09-10 11:25:28 +0200 (Wed, 10 Sep 2008) | 2 lines * first fixes for persisten unicodestrings ........ r11736 | florian | 2008-09-10 14:31:00 +0200 (Wed, 10 Sep 2008) | 3 lines Initialized merge tracking via "svnmerge" with revisions "1-11663" from http://svn.freepascal.org/svn/fpc/trunk ........ r11737 | florian | 2008-09-10 21:06:57 +0200 (Wed, 10 Sep 2008) | 3 lines * fixed unicodestring <-> variant handling * fixed unicodestring property reading ........ git-svn-id: trunk@11739 -
93 lines
2.2 KiB
ObjectPascal
93 lines
2.2 KiB
ObjectPascal
|
|
{$ifdef fpc}
|
|
{$mode objfpc}
|
|
{$endif fpc}
|
|
|
|
uses
|
|
{$ifdef unix}
|
|
cthreads, cwstring,
|
|
{$endif}
|
|
Classes, SysUtils;
|
|
|
|
type
|
|
tc = class(tthread)
|
|
orgstr: ansistring;
|
|
cnvstr: unicodestring;
|
|
constructor create(const s: ansistring; const w: unicodestring);
|
|
procedure execute; override;
|
|
end;
|
|
|
|
const
|
|
// string with an invalid utf-8 code sequence
|
|
str1 = #$c1#$34'Życie'#$c1#$34' jest jak papier '#$c1#$34'toaletowy'#$c1#$34' : długie, szare i '#$c1#$34'do'#$c1#$34' dupy';
|
|
str2 = 'Życie '#$c1#$34'jest'#$c1#$34' jak papier toaletowy : '#$c1#$34'długie'#$c1#$34', szare i do '#$c1#$34'dupy'#$c1#$34'222222222222222222222222222222222222222222222222';
|
|
str3 = 'Życie jest '#$c1#$34'jak'#$c1#$34' papier 333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333 toaletowy : długie, '#$c1#$34'szare'#$c1#$34' i do dupy';
|
|
str4 = 'Życie jest 4444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444444 jak '#$c1#$34'papier'#$c1#$34' toaletowy : długie, szare '#$c1#$34'i'#$c1#$34' do dupy';
|
|
count = 20000;
|
|
|
|
var
|
|
wstr: unicodestring;
|
|
// cnvstr: ansistring;
|
|
error: boolean;
|
|
|
|
|
|
constructor tc.create(const s: ansistring; const w: unicodestring);
|
|
begin
|
|
orgstr:=s;
|
|
cnvstr:=w;
|
|
inherited create(true);
|
|
end;
|
|
|
|
|
|
procedure tc.execute;
|
|
var
|
|
i: longint;
|
|
w: unicodestring;
|
|
begin
|
|
for i := 1 to count do
|
|
begin
|
|
w:=orgstr;
|
|
if (w<>cnvstr) then
|
|
error:=true;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
a: array[1..4] of tc;
|
|
w1,w2,w3,w4: unicodestring;
|
|
cnvstr: ansistring;
|
|
begin
|
|
error:=false;
|
|
cnvstr:=str1;
|
|
w1:=cnvstr;
|
|
cnvstr:=str2;
|
|
w2:=cnvstr;
|
|
cnvstr:=str3;
|
|
w3:=cnvstr;
|
|
cnvstr:=str4;
|
|
w4:=cnvstr;
|
|
writeln(w1);
|
|
writeln(w2);
|
|
writeln(w3);
|
|
writeln(w4);
|
|
a[1]:=tc.create(str1,w1);
|
|
a[2]:=tc.create(str2,w2);
|
|
a[3]:=tc.create(str3,w3);
|
|
a[4]:=tc.create(str4,w4);
|
|
a[1].resume;
|
|
a[2].resume;
|
|
a[3].resume;
|
|
a[4].resume;
|
|
a[1].waitfor;
|
|
a[2].waitfor;
|
|
a[3].waitfor;
|
|
a[4].waitfor;
|
|
a[1].free;
|
|
a[2].free;
|
|
a[3].free;
|
|
a[4].free;
|
|
|
|
if error then
|
|
halt(1);
|
|
end.
|