mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 02:29:36 +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 -
46 lines
1.2 KiB
ObjectPascal
46 lines
1.2 KiB
ObjectPascal
{$codepage utf-8}
|
|
|
|
var
|
|
ws: unicodestring;
|
|
us: UCS4String;
|
|
begin
|
|
// the compiler does not yet support characters which require
|
|
// a surrogate pair in utf-16
|
|
// ws:='鳣ćçŹ你';
|
|
// so write the last character directly using a utf-16 surrogate pair
|
|
ws:='鳣ćçŹ'#$d87e#$dc04;
|
|
|
|
if (length(ws)<>8) or
|
|
(ws[1]<>'é') or
|
|
(ws[2]<>'ł') or
|
|
(ws[3]<>'Ł') or
|
|
(ws[4]<>'ć') or
|
|
(ws[5]<>'ç') or
|
|
(ws[6]<>'Ź') or
|
|
(ws[7]<>#$d87e) or
|
|
(ws[8]<>#$dc04) then
|
|
halt(1);
|
|
us:=UnicodeStringToUCS4String(ws);
|
|
if (length(us)<>8) or
|
|
(us[0]<>UCS4Char(unicodechar('é'))) or
|
|
(us[1]<>UCS4Char(unicodechar('ł'))) or
|
|
(us[2]<>UCS4Char(unicodechar('Ł'))) or
|
|
(us[3]<>UCS4Char(unicodechar('ć'))) or
|
|
(us[4]<>UCS4Char(unicodechar('ç'))) or
|
|
(us[5]<>UCS4Char(unicodechar('Ź'))) or
|
|
(us[6]<>UCS4Char($2F804)) or
|
|
(us[7]<>UCS4Char(0)) then
|
|
halt(2);
|
|
ws:=UCS4StringToUnicodeString(us);
|
|
if (length(ws)<>8) or
|
|
(ws[1]<>'é') or
|
|
(ws[2]<>'ł') or
|
|
(ws[3]<>'Ł') or
|
|
(ws[4]<>'ć') or
|
|
(ws[5]<>'ç') or
|
|
(ws[6]<>'Ź') or
|
|
(ws[7]<>#$d87e) or
|
|
(ws[8]<>#$dc04) then
|
|
halt(3);
|
|
end.
|