paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 11:08:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

Improved unicode test

Browse Source 
git-svn-id: trunk@32734 -
This commit is contained in:
sekelsenmat 2011-10-07 09:15:33 +00:00
parent 72be8c7edb
commit c32a82b77b
2 changed files with 42 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
test/lazutils/testunicode.lpi
View File

@ -6,7 +6,6 @@
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<UseDefaultCompilerOptions Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
@ -57,6 +56,7 @@
</SearchPaths>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<DebugInfoType Value="dsAuto"/>
</Debugging>
</Linking>

46
test/lazutils/testunicode.pas
View File

@ -3,18 +3,54 @@ program TestUnicode;
{$mode objfpc}{$H+}
uses
lazutf8;
sysutils, lazutf8;
procedure WriteStringHex(Str: utf8string);
var
StrOut: utf8string;
i: Integer;
begin
StrOut := '';
for i := 1 to Length(Str) do
begin
StrOut := StrOut + IntToHex(Byte(Str[i]), 2) + ' ';
end;
Write(StrOut);
end;
procedure AssertStringOperation(AMsg, AStr1, AStr2, AStrExpected2: utf8string);
begin
Write(AMsg, ' ', AStr1, ' => ', AStr2, ' Expected ', AStrExpected2);
if UTF8CompareStr(AStr1, AStr2) <> 0 then Write(' !Error!');
Write(AMsg, ' ', AStr1, ' => ', AStr2);
if UTF8CompareStr(AStr1, AStr2) <> 0 then
begin
Write(' Expected ', AStrExpected2, ' !Error!');
WriteLn();
WriteStringHex(AStr2);
WriteLn('');
WriteLn('Expected');
WriteStringHex(AStr2);
end;
WriteLn();
end;
procedure AssertStringOperationUTF8UpperCase(AMsg, ALocale, AStr1, AStrExpected2: utf8string);
begin
AssertStringOperation(AMsg, AStr1, UTF8UpperCase(AStr1, ALocale), AStrExpected2);
end;
procedure TestUTF8UpperCase;
begin
// ASCII
AssertStringOperationUTF8UpperCase('ASCII UTF8UpperCase', '', 'abcdefghijklmnopqrstuwvxyz', 'ABCDEFGHIJKLMNOPQRSTUWVXYZ');
// Latin
AssertStringOperationUTF8UpperCase('Polish UTF8UpperCase 1', '', 'aąbcćdeęfghijklłmnńoóprsśtuwyzźż', 'AĄBCĆDEĘFGHIJKLŁMNŃOÓPRSŚTUWYZŹŻ');
AssertStringOperationUTF8UpperCase('Polish UTF8UpperCase 2', '', 'AĄBCĆDEĘFGHIJKLŁMNŃOÓPRSŚTUWYZŹŻ', 'AĄBCĆDEĘFGHIJKLŁMNŃOÓPRSŚTUWYZŹŻ');
// Turkish
AssertStringOperation('Turkish UTF8UpperCase 1', 'abcçdefgğhıijklmnoöprsştuüvyz', UTF8UpperCase('abcçdefgğhıijklmnoöprsştuüvyz'), 'ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZ');
AssertStringOperation('Turkish UTF8UpperCase 2', 'ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZ', UTF8UpperCase('ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZ'), 'ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZ');
AssertStringOperationUTF8UpperCase('Turkish UTF8UpperCase 1', 'tu', 'abcçdefgğhıijklmnoöprsştuüvyz', 'ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZ');
AssertStringOperationUTF8UpperCase('Turkish UTF8UpperCase 2', 'tu', 'ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZ', 'ABCÇDEFGĞHIİJKLMNOÖPRSŞTUÜVYZ');
end;
begin
TestUTF8UpperCase();
end.