unit TestUnicode; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpcunit, LCLProc, testglobals; type { TTestUnicode } TTestUnicode= class(TTestCase) published procedure TestUTF8ToUTF16; procedure TestUTF16ToUTF8; procedure TestUTF16ToUnicode; procedure TestUnicodeToUTF16; procedure TestUTF8CharacterToUnicode; end; const Limits: Array [0..9] of Cardinal = (0, $7F, $80, $7FF, $800, $D7FF, $E000, $FFFF, $10000, $10FFFF); implementation { TTestUnicode } procedure TTestUnicode.TestUTF8ToUTF16; var U: Cardinal; I1, I2: Integer; SUTF8, S1UTF8: UTF8String; SUTF16, S1UTF16, R: WideString; begin for U := 0 to $10FFFF do // test each unicode char begin if (U >= $D800) and (U <= $DFFF) then Continue; SUTF8 := UnicodeToUTF8(U); SUTF16 := UnicodeToUTF16(U); R := UTF8ToUTF16(SUTF8); AssertEquals('UTF8ToUTF16 of unicode char: ' + IntToHex(U, 6) + ' error! ' + DbgWideStr(SUTF16) + ' ' + DbgWideStr(R), SUTF16, R); end; for I1 := 0 to High(Limits) do // test two char string with limit char values begin S1UTF8 := UnicodeToUTF8(Limits[I1]); S1UTF16 := UnicodeToUTF16(Limits[I1]); for I2 := 0 to High(Limits) do begin SUTF8 := S1UTF8 + UnicodeToUTF8(Limits[I2]); SUTF16 := S1UTF16 + UnicodeToUTF16(Limits[I2]); R := UTF8ToUTF16(SUTF8); AssertEquals('UTF8ToUTF16 of two unicode chars: ' + IntToHex(Limits[I1], 6) + IntToHex(Limits[I2], 6) + ' error!', SUTF16, R); end; end; end; procedure TTestUnicode.TestUTF16ToUTF8; var U: Cardinal; I1, I2: Integer; SUTF8, S1UTF8, R: UTF8String; SUTF16, S1UTF16: WideString; begin for U := 0 to $10FFFF do begin if (U >= $D800) and (U <= $DFFF) then Continue; SUTF8 := UnicodeToUTF8(U); SUTF16 := UnicodeToUTF16(U); R := UTF16ToUTF8(SUTF16); AssertEquals('UTF16ToUTF8 of unicode char: ' + IntToHex(U, 6) + ' error! ' + DbgStr(SUTF16) + ' ' + DbgStr(R), SUTF8, R); end; for I1 := 0 to High(Limits) do begin S1UTF8 := UnicodeToUTF8(Limits[I1]); S1UTF16 := UnicodeToUTF16(Limits[I1]); for I2 := 0 to High(Limits) do begin SUTF8 := S1UTF8 + UnicodeToUTF8(Limits[I2]); SUTF16 := S1UTF16 + UnicodeToUTF16(Limits[I2]); R := UTF16ToUTF8(SUTF16); AssertEquals('UTF16ToUTF8 of two unicode chars: ' + IntToHex(Limits[I1], 6) + IntToHex(Limits[I2], 6) + ' error!', SUTF8, R); end; end; end; procedure TTestUnicode.TestUTF16ToUnicode; var L: Integer; begin AssertEquals(0, UTF16CharacterToUnicode(#0, L)); AssertEquals($D7FF, UTF16CharacterToUnicode(#$D7FF, L)); AssertEquals($E000, UTF16CharacterToUnicode(#$E000, L)); AssertEquals($FFFF, UTF16CharacterToUnicode(#$FFFF, L)); AssertEquals($10000, UTF16CharacterToUnicode(#$D800#$DC00, L)); AssertEquals($10001, UTF16CharacterToUnicode(#$D800#$DC01, L)); AssertEquals($10FFFD, UTF16CharacterToUnicode(#$DBFF#$DFFD, L)); end; procedure TTestUnicode.TestUnicodeToUTF16; begin AssertEquals(#0, UnicodeToUTF16(0)); AssertEquals(#$D7FF, UnicodeToUTF16($D7FF)); AssertEquals(#$E000, UnicodeToUTF16($E000)); AssertEquals(#$FFFF, UnicodeToUTF16($FFFF)); AssertEquals(#$D800#$DC00, UnicodeToUTF16($10000)); AssertEquals(#$D800#$DC01, UnicodeToUTF16($10001)); AssertEquals(#$DBFF#$DFFD, UnicodeToUTF16($10FFFD)); end; procedure TTestUnicode.TestUTF8CharacterToUnicode; var i,u: cardinal; s: String; dum: integer; begin for i:=0 to $10FFFF do begin s:=UnicodeToUTF8(i); u:=UTF8CharacterToUnicode(PChar(s), dum); AssertEquals('got (hexidecimal): ' + InttoHex(u,6), i, u); end; end; initialization AddToLCLTestSuite(TTestUnicode); end.