paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 17:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl: fix error message

Browse Source 
tests: add test to check utf32<->utf16 conversions

git-svn-id: trunk@19188 -
This commit is contained in:
paul 2011-09-23 02:24:30 +00:00
parent b47b4c3cba
commit 8af1fa3e57
3 changed files with 61 additions and 1 deletions
.gitattributes
rtl/objpas
character.pas
tests/test/units/character
tutf32convert.pp

1
.gitattributes vendored
View File

@ -10638,6 +10638,7 @@ tests/test/units/character/ttolower.pp svneol=native#text/pascal
tests/test/units/character/ttolower2.pp svneol=native#text/pascal
tests/test/units/character/ttoupper.pp svneol=native#text/pascal
tests/test/units/character/ttoupper2.pp svneol=native#text/pascal
tests/test/units/character/tutf32convert.pp svneol=native#text/pascal
tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
tests/test/units/classes/tsetstream.pp svneol=native#text/plain
tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain

2
rtl/objpas/character.pas
View File

@ -237,7 +237,7 @@ begin
if not IsHighSurrogate(AHighSurrogate) then
raise EArgumentOutOfRangeException.CreateFmt(SHighSurrogateOutOfRange, [Word(AHighSurrogate)]);
if not IsLowSurrogate(ALowSurrogate) then
raise EArgumentOutOfRangeException.CreateFmt(SLowSurrogateOutOfRange, [Word(AHighSurrogate)]);
raise EArgumentOutOfRangeException.CreateFmt(SLowSurrogateOutOfRange, [Word(ALowSurrogate)]);
Result := (UCS4Char(AHighSurrogate) - HIGH_SURROGATE_BEGIN) shl 10 + (UCS4Char(ALowSurrogate) - LOW_SURROGATE_BEGIN) + UCS4_HALF_BASE;
end;

59
tests/test/units/character/tutf32convert.pp Normal file
View File

@ -0,0 +1,59 @@
program tutf32convert;
{$apptype console}
uses
SysUtils, Character;
var
U4: UCS4Char;
U2: UnicodeString;
begin
U4 := $1D52D;
U2 := TCharacter.ConvertFromUtf32(U4);
if not TCharacter.IsHighSurrogate(U2[1]) then
halt(1);
if not TCharacter.IsLowSurrogate(U2[2]) then
halt(2);
if TCharacter.ConvertToUtf32(U2, 1) <> U4 then
halt(3);
SetLength(U2, 1);
try
TCharacter.ConvertToUtf32(U2, 1);
halt(4);
except
on E: EArgumentException do
WriteLn(E.Message);
on Exception do
halt(5);
end;
SetLength(U2, 0);
try
TCharacter.ConvertToUtf32(U2, 1);
halt(6);
except
on E: EArgumentOutOfRangeException do
WriteLn(E.Message);
on Exception do
halt(7);
end;
try
TCharacter.ConvertToUtf32(#1, #2);
halt(8);
except
on E: EArgumentOutOfRangeException do
WriteLn(E.Message);
on Exception do
halt(9);
end;
try
TCharacter.ConvertToUtf32(#$D800, #2);
halt(10);
except
on E: EArgumentOutOfRangeException do
WriteLn(E.Message);
on Exception do
halt(11);
end;
WriteLn('ok');
end.