Procházet zdrojové kódy

rtl: fix error message
tests: add test to check utf32<->utf16 conversions

git-svn-id: trunk@19188 -

paul před 14 roky
rodič
revize
8af1fa3e57

+ 1 - 0
.gitattributes

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

+ 1 - 1
rtl/objpas/character.pas

@@ -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 - 0
tests/test/units/character/tutf32convert.pp

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