tissurrogatepair.pp 1.3 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162
  1. program tissurrogatepair;
  2. {$ifdef FPC}
  3. {$mode objfpc}
  4. {$H+}
  5. {$PACKENUM 1}
  6. {$endif fpc}
  7. {$ifndef FPC}
  8. {$APPTYPE CONSOLE}
  9. {$endif}
  10. uses
  11. SysUtils,
  12. character;
  13. {$ifndef FPC}
  14. type UnicodeChar = WideChar;
  15. {$endif}
  16. procedure DoError(ACode : Integer; ACodePoint1, ACodePoint2 : Integer); overload;
  17. begin
  18. WriteLn(
  19. 'Error #',ACode,
  20. ' ; CodePoint1 = ',IntToHex(ACodePoint1,4),
  21. ' ; CodePoint2 = ',IntToHex(ACodePoint2,4)
  22. );
  23. Halt(Acode);
  24. end;
  25. const
  26. LOW_SURROGATE_BEGIN = Word($DC00);
  27. LOW_SURROGATE_END = Word($DFFF);
  28. HIGH_SURROGATE_BEGIN = Word($D800);
  29. HIGH_SURROGATE_END = Word($DBFF);
  30. var
  31. e, i , j: Integer;
  32. begin
  33. e := 1;
  34. for i := HIGH_SURROGATE_BEGIN to HIGH_SURROGATE_END do begin
  35. for j := LOW_SURROGATE_BEGIN to LOW_SURROGATE_END do begin
  36. if not TCharacter.IsSurrogatePair(UnicodeChar(i),UnicodeChar(j)) then
  37. DoError(e,i,j);
  38. end;
  39. end;
  40. Inc(e);
  41. for i := Low(Word) to High(Word) do begin
  42. if (i < HIGH_SURROGATE_BEGIN) or (i > HIGH_SURROGATE_END) then begin
  43. for j := Low(Word) to High(Word) do begin
  44. if (j < LOW_SURROGATE_BEGIN) or (j > LOW_SURROGATE_END) then begin
  45. if TCharacter.IsSurrogatePair(UnicodeChar(i),UnicodeChar(j)) then
  46. DoError(e,i,j);
  47. end;
  48. end;
  49. end;
  50. end;
  51. WriteLn('ok');
  52. end.