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

rtl: add TCharacter class implementation by Inoussa. At this moment only BMP(0-$FFFF) UnicodeChar are handled.

Browse Source 
tests: add character unit tests
(mantis #0020302)

git-svn-id: trunk@19170 -
This commit is contained in:
paul 2011-09-22 00:52:51 +00:00
parent f14e0a25c6
commit 59a69eaeba
30 changed files with 5932 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
.gitattributes vendored
View File

@ -7745,6 +7745,7 @@ rtl/netwlibc/winsock.pp svneol=native#text/plain
rtl/netwlibc/ws2_32.imp -text
rtl/netwlibc/ws2nlm.imp -text
rtl/objpas/README.txt svneol=native#text/plain
rtl/objpas/character.pas svneol=native#text/pascal
rtl/objpas/classes/action.inc svneol=native#text/plain
rtl/objpas/classes/bits.inc svneol=native#text/plain
rtl/objpas/classes/classes.inc svneol=native#text/plain
@ -7817,6 +7818,7 @@ rtl/objpas/sysutils/syswide.inc svneol=native#text/plain
rtl/objpas/sysutils/syswideh.inc svneol=native#text/plain
rtl/objpas/types.pp svneol=native#text/plain
rtl/objpas/typinfo.pp svneol=native#text/plain
rtl/objpas/unicodedata.inc svneol=native#text/pascal
rtl/objpas/utf8bidi.pp svneol=native#text/plain
rtl/objpas/varutilh.inc svneol=native#text/plain
rtl/objpas/varutils.inc svneol=native#text/plain
@ -10609,6 +10611,33 @@ tests/test/ulib2a.pp svneol=native#text/plain
tests/test/umaclocalprocparam3f.pp svneol=native#text/plain
tests/test/umacpas1.pp svneol=native#text/plain
tests/test/umainnam.pp svneol=native#text/plain
tests/test/units/character/tfpwidestring.pp svneol=native#text/pascal
tests/test/units/character/tgetnumericvalue.pp svneol=native#text/pascal
tests/test/units/character/tgetnumericvalue2.pp svneol=native#text/pascal
tests/test/units/character/tiscontrol.pp svneol=native#text/pascal
tests/test/units/character/tiscontrol2.pp svneol=native#text/pascal
tests/test/units/character/tisdigit.pp svneol=native#text/pascal
tests/test/units/character/tisdigit2.pp svneol=native#text/pascal
tests/test/units/character/tishighsurrogate.pp svneol=native#text/pascal
tests/test/units/character/tisletter.pp svneol=native#text/pascal
tests/test/units/character/tisletterordigit.pp svneol=native#text/pascal
tests/test/units/character/tislowsurrogate.pp svneol=native#text/pascal
tests/test/units/character/tisnumber.pp svneol=native#text/pascal
tests/test/units/character/tisnumber2.pp svneol=native#text/pascal
tests/test/units/character/tispunctuation.pp svneol=native#text/pascal
tests/test/units/character/tisseparator.pp svneol=native#text/pascal
tests/test/units/character/tissurrogate.pp svneol=native#text/pascal
tests/test/units/character/tissurrogatepair.pp svneol=native#text/pascal
tests/test/units/character/tissurrogatepair2.pp svneol=native#text/pascal
tests/test/units/character/tissymbol.pp svneol=native#text/pascal
tests/test/units/character/tisupper.pp svneol=native#text/pascal
tests/test/units/character/tiswhitespace.pp svneol=native#text/pascal
tests/test/units/character/tlowercase.pp svneol=native#text/pascal
tests/test/units/character/tlowercase2.pp svneol=native#text/pascal
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/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

463
rtl/objpas/character.pas Normal file
View File

@ -0,0 +1,463 @@
unit character;
interface
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$SCOPEDENUMS ON}
type
// Unicode General Category
TUnicodeCategory = (
ucUppercaseLetter, // Lu = Letter, uppercase
ucLowercaseLetter, // Ll = Letter, lowercase
ucTitlecaseLetter, // Lt = Letter, titlecase
ucModifierLetter, // Lm = Letter, modifier
ucOtherLetter, // Lo = Letter, other
ucNonSpacingMark, // Mn = Mark, nonspacing
ucCombiningMark, // Mc = Mark, spacing combining
ucEnclosingMark, // Me = Mark, enclosing
ucDecimalNumber, // Nd = Number, decimal digit
ucLetterNumber, // Nl = Number, letter
ucOtherNumber, // No = Number, other
ucConnectPunctuation, // Pc = Punctuation, connector
ucDashPunctuation, // Pd = Punctuation, dash
ucOpenPunctuation, // Ps = Punctuation, open
ucClosePunctuation, // Pe = Punctuation, close
ucInitialPunctuation, // Pi = Punctuation, initial quote (may behave like Ps or Pe depending on usage)
ucFinalPunctuation, // Pf = Punctuation, final quote (may behave like Ps or Pe depending on usage)
ucOtherPunctuation, // Po = Punctuation, other
ucMathSymbol, // Sm = Symbol, math
ucCurrencySymbol, // Sc = Symbol, currency
ucModifierSymbol, // Sk = Symbol, modifier
ucOtherSymbol, // So = Symbol, other
ucSpaceSeparator, // Zs = Separator, space
ucLineSeparator, // Zl = Separator, line
ucParagraphSeparator, // Zp = Separator, paragraph
ucControl, // Cc = Other, control
ucFormat, // Cf = Other, format
ucSurrogate, // Cs = Other, surrogate
ucPrivateUse, // Co = Other, private use
ucUnassigned // Cn = Other, not assigned (including noncharacters)
);
{ TCharacter }
TCharacter = class sealed
public
{class function ConvertFromUtf32(AChar : UCS4Char) : UnicodeString; static;
class function ConvertToUtf32(const AString : UnicodeString; AIndex : Integer) : UCS4Char; overload; static;
class function ConvertToUtf32(const AString : UnicodeString; AIndex : Integer; out ACharLength : Integer) : UCS4Char; overload; static;
class function ConvertToUtf32(AHighSurrogate, ALowSurrogate : UnicodeChar; AIndex : Integer) : UCS4Char; overload; static;}
class function GetNumericValue(AChar : UnicodeChar) : Double; static; overload;
class function GetNumericValue(const AString : UnicodeString; AIndex : Integer) : Double; overload; static;
class function GetUnicodeCategory(AChar : UnicodeChar) : TUnicodeCategory; overload; static;
class function GetUnicodeCategory(const AString : UnicodeString; AIndex : Integer) : TUnicodeCategory; overload; static;
class function IsControl(AChar : UnicodeChar) : Boolean; overload; static;
class function IsControl(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsDigit(AChar : UnicodeChar) : Boolean; overload; static;
class function IsDigit(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsSurrogate(AChar : UnicodeChar) : Boolean; overload; static;
class function IsSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsHighSurrogate(AChar : UnicodeChar) : Boolean; overload; static;
class function IsHighSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsLowSurrogate(AChar : UnicodeChar) : Boolean; overload; static;
class function IsLowSurrogate(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsSurrogatePair(const AHighSurrogate, ALowSurrogate : UnicodeChar) : Boolean; overload; static; inline;
class function IsSurrogatePair(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsLetter(AChar : UnicodeChar) : Boolean; overload; static;
class function IsLetter(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsLetterOrDigit(AChar : UnicodeChar) : Boolean; overload; static;
class function IsLetterOrDigit(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsLower(AChar : UnicodeChar) : Boolean; overload; static;
class function IsLower(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsNumber(AChar : UnicodeChar) : Boolean; overload; static;
class function IsNumber(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsPunctuation(AChar : UnicodeChar) : Boolean; overload; static;
class function IsPunctuation(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsSeparator(AChar : UnicodeChar) : Boolean; overload; static;
class function IsSeparator(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsSymbol(AChar : UnicodeChar) : Boolean; overload; static;
class function IsSymbol(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsUpper(AChar : UnicodeChar) : Boolean; overload; static;
class function IsUpper(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function IsWhiteSpace(AChar : UnicodeChar) : Boolean; overload; static;
class function IsWhiteSpace(const AString : UnicodeString; AIndex : Integer) : Boolean; overload; static;
class function ToLower(AChar : UnicodeChar) : UnicodeChar; overload; static;
class function ToLower(const AString : UnicodeString) : UnicodeString; overload; static;
class function ToUpper(AChar : UnicodeChar) : UnicodeChar; overload; static;
class function ToUpper(const AString : UnicodeString) : UnicodeString; overload; static;
end;
implementation
uses
SysUtils;
type
PUC_Prop = ^TUC_Prop;
TUC_Prop = packed record
Category : TUnicodeCategory;
NumericValue : Double;
SimpleUpperCase : DWord;
SimpleLowerCase : DWord;
WhiteSpace : Boolean;
end;
{$INCLUDE unicodedata.inc}
const
LOW_SURROGATE_BEGIN = Word($DC00);
LOW_SURROGATE_END = Word($DFFF);
HIGH_SURROGATE_BEGIN = Word($D800);
HIGH_SURROGATE_END = Word($DBFF);
const
LETTER_CATEGORIES = [
TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucModifierLetter,
TUnicodeCategory.ucOtherLetter
];
LETTER_OR_DIGIT_CATEGORIES =
LETTER_CATEGORIES +
[TUnicodeCategory.ucDecimalNumber,TUnicodeCategory.ucLetterNumber];
NUMBER_CATEGORIES =
[ TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber,
TUnicodeCategory.ucOtherNumber
];
PUNCTUATION_CATEGORIES = [
TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
TUnicodeCategory.ucOpenPunctuation, TUnicodeCategory.ucClosePunctuation,
TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucFinalPunctuation,
TUnicodeCategory.ucOtherPunctuation
];
SEPARATOR_CATEGORIES =
[ TUnicodeCategory.ucSpaceSeparator, TUnicodeCategory.ucLineSeparator,
TUnicodeCategory.ucParagraphSeparator
];
SYMBOL_CATEGORIES =
[ TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucCurrencySymbol,
TUnicodeCategory.ucModifierSymbol, TUnicodeCategory.ucOtherSymbol
];
function GetProps(const ACodePoint : Word) : PUC_Prop; //inline;
begin
Result:=
@UC_PROP_ARRAY[
UC_TABLE_2[
(UC_TABLE_1[WordRec(ACodePoint).Hi] * 256) +
WordRec(ACodePoint).Lo
]
];
end;
{ TCharacter }
class function TCharacter.GetNumericValue(AChar : UnicodeChar) : Double; static;
begin
Result := GetProps(Word(AChar))^.NumericValue;
end;
class function TCharacter.GetNumericValue(
const AString : UnicodeString;
AIndex : Integer
) : Double; static;
begin
Result := GetNumericValue(AString[AIndex]);
end;
class function TCharacter.GetUnicodeCategory(AChar : UnicodeChar) : TUnicodeCategory; static;
begin
Result := GetProps(Word(AChar))^.Category;
end;
class function TCharacter.GetUnicodeCategory(
const AString : UnicodeString;
AIndex : Integer
) : TUnicodeCategory; static;
begin
Result := GetUnicodeCategory(AString[AIndex]);
end;
class function TCharacter.IsControl(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucControl);
end;
class function TCharacter.IsControl(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsControl(AString[AIndex]);
end;
class function TCharacter.IsDigit(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucDecimalNumber);
end;
class function TCharacter.IsDigit(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsDigit(AString[AIndex]);
end;
class function TCharacter.IsSurrogate(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucSurrogate);
end;
class function TCharacter.IsSurrogate(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsSurrogate(AString[AIndex]);
end;
class function TCharacter.IsHighSurrogate(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucSurrogate) and
(Word(AChar) >= HIGH_SURROGATE_BEGIN) and
(Word(AChar) <= HIGH_SURROGATE_END);
end;
class function TCharacter.IsHighSurrogate(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsHighSurrogate(AString[AIndex]);
end;
class function TCharacter.IsLowSurrogate(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucSurrogate) and
(Word(AChar) >= LOW_SURROGATE_BEGIN) and
(Word(AChar) <= LOW_SURROGATE_END);
end;
class function TCharacter.IsLowSurrogate(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsLowSurrogate(AString[AIndex]);
end;
class function TCharacter.IsSurrogatePair(
const AHighSurrogate,
ALowSurrogate : UnicodeChar
) : Boolean;static;
begin
Result :=
( (Word(AHighSurrogate) >= HIGH_SURROGATE_BEGIN) and
(Word(AHighSurrogate) <= HIGH_SURROGATE_END)
) and
( (Word(ALowSurrogate) >= LOW_SURROGATE_BEGIN) and
(Word(ALowSurrogate) <= LOW_SURROGATE_END)
)
end;
class function TCharacter.IsSurrogatePair(
const AString : UnicodeString;
AIndex : Integer
) : Boolean;static;
begin
Result := IsSurrogatePair(AString[AIndex],AString[AIndex+1]);
end;
class function TCharacter.IsLetter(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category in LETTER_CATEGORIES);
end;
class function TCharacter.IsLetter(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsLetter(AString[AIndex]);
end;
class function TCharacter.IsLetterOrDigit(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category in LETTER_OR_DIGIT_CATEGORIES);
end;
class function TCharacter.IsLetterOrDigit(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsLetterOrDigit(AString[AIndex]);
end;
class function TCharacter.IsLower(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucLowercaseLetter);
end;
class function TCharacter.IsLower(
const AString : UnicodeString;
AIndex : Integer
) : Boolean; static;
begin
Result := IsLower(AString[AIndex]);
end;
class function TCharacter.IsNumber(AChar : UnicodeChar) : Boolean; static;
begin
Result := (GetProps(Word(AChar))^.Category in NUMBER_CATEGORIES);
end;
class function TCharacter.IsNumber(
const AString : UnicodeString;
AIndex : Integer
) : Boolean;static;
begin
Result := IsNumber(AString[AIndex]);
end;
class function TCharacter.IsPunctuation(AChar : UnicodeChar) : Boolean;static;
begin
Result := (GetProps(Word(AChar))^.Category in PUNCTUATION_CATEGORIES);
end;
class function TCharacter.IsPunctuation(
const AString : UnicodeString;
AIndex : Integer
) : Boolean;static;
begin
Result := IsPunctuation(AString[AIndex]);
end;
class function TCharacter.IsSeparator(AChar: UnicodeChar): Boolean;static;
begin
Result := (GetProps(Word(AChar))^.Category in SEPARATOR_CATEGORIES);
end;
class function TCharacter.IsSeparator(
const AString : UnicodeString;
AIndex : Integer
) : Boolean;static;
begin
Result := IsSeparator(AString[AIndex]);
end;
class function TCharacter.IsSymbol(AChar: UnicodeChar): Boolean;static;
begin
Result := (GetProps(Word(AChar))^.Category in SYMBOL_CATEGORIES);
end;
class function TCharacter.IsSymbol(
const AString : UnicodeString;
AIndex : Integer
) : Boolean;static;
begin
Result := IsSymbol(AString[AIndex]);
end;
class function TCharacter.IsUpper(AChar : UnicodeChar) : Boolean;static;
begin
Result := (GetProps(Word(AChar))^.Category = TUnicodeCategory.ucUppercaseLetter);
end;
class function TCharacter.IsUpper(
const AString : UnicodeString;
AIndex : Integer
) : Boolean;static;
begin
Result := IsUpper(AString[AIndex]);
end;
class function TCharacter.IsWhiteSpace(AChar : UnicodeChar) : Boolean;static;
begin
Result := GetProps(Word(AChar))^.WhiteSpace;
end;
class function TCharacter.IsWhiteSpace(
const AString : UnicodeString;
AIndex : Integer
) : Boolean;static;
begin
Result := IsWhiteSpace(AString[AIndex]);
end;
class function TCharacter.ToLower(AChar : UnicodeChar) : UnicodeChar;static;
begin
Result := UnicodeChar(GetProps(Word(AChar))^.SimpleLowerCase);
if (Result = UnicodeChar(0)) then
Result := AChar;
end;
class function TCharacter.ToLower(const AString : UnicodeString) : UnicodeString;static;
var
i, c : SizeInt;
pp, pr : PUnicodeChar;
begin
c := Length(AString);
SetLength(Result,c);
if (c > 0) then begin
pp := @AString[1];
pr := @Result[1];
for i := 1 to c do begin
pr^ := ToLower(pp^);
Inc(pp);
Inc(pr);
end;
end;
end;
class function TCharacter.ToUpper(AChar : UnicodeChar) : UnicodeChar;static;
begin
Result := UnicodeChar(GetProps(Word(AChar))^.SimpleUpperCase);
if (Result = UnicodeChar(0)) then
Result := AChar;
end;
class function TCharacter.ToUpper(const AString : UnicodeString) : UnicodeString;static;
var
i, c : SizeInt;
pp, pr : PUnicodeChar;
begin
c := Length(AString);
SetLength(Result,c);
if (c > 0) then begin
pp := @AString[1];
pr := @Result[1];
for i := 1 to c do begin
pr^ := ToUpper(pp^);
Inc(pp);
Inc(pr);
end;
end;
end;
end.

3347
rtl/objpas/unicodedata.inc Normal file
View File

File diff suppressed because it is too large Load Diff

27
tests/test/units/character/tfpwidestring.pp Normal file
View File

@ -0,0 +1,27 @@
program tfpwidestring;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character, fpwidestring;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
var
e, i, j : Integer;
uc : UnicodeChar;
begin
e := 1;
WriteLn('ok');
end.

70
tests/test/units/character/tgetnumericvalue.pp Normal file
View File

@ -0,0 +1,70 @@
program tgetnumericvalue;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
uc : UnicodeChar;
d : Double;
begin
e := 1;
k := 0;
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucDecimalNumber,
TUnicodeCategory.ucLetterNumber,
TUnicodeCategory.ucOtherNumber
] //TCharacter.IsNumber(uc)
)
then begin
WriteLn('CodePoint = ',IntToHex(Ord(uc),4), ' ; Value = ',TCharacter.GetNumericValue(uc));
Inc(k);
end;
end;
WriteLn(k, ' numbers',sLineBreak);
Inc(e);
for i := 0 to 9 do begin
uc := IntToStr(i)[1];
d := i;
if (TCharacter.GetNumericValue(uc) <> d) then
DoError(e,uc);
end;
WriteLn('ok');
end.

80
tests/test/units/character/tgetnumericvalue2.pp Normal file
View File

@ -0,0 +1,80 @@
program tgetnumericvalue2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; AStr : UnicodeString; AIndex : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(AStr[AIndex]),4));
Halt(Acode);
end;
var
e, i , k: Integer;
strPrefix, uc : UnicodeString;
locCharPos : Integer;
d : Double;
begin
strPrefix := '012345AZERT ';
locCharPos := Length(strPrefix) + 1;
e := 1;
k := 0;
for i := Low(Word) to High(Word) do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if (TCharacter.GetUnicodeCategory(uc,locCharPos) in
[ TUnicodeCategory.ucDecimalNumber,
TUnicodeCategory.ucLetterNumber,
TUnicodeCategory.ucOtherNumber
] //TCharacter.IsNumber(uc)
)
then begin
WriteLn('CodePoint = ',IntToHex(Ord(uc[locCharPos]),4), ' ; Value = ',TCharacter.GetNumericValue(uc,locCharPos));
Inc(k);
end;
end;
WriteLn(k, ' numbers',sLineBreak);
Inc(e);
for i := 0 to 9 do begin
uc := strPrefix + IntToStr(i) + strPrefix;
d := i;
if (TCharacter.GetNumericValue(uc,locCharPos) <> d) then
DoError(e,uc,locCharPos);
end;
WriteLn('ok');
end.

74
tests/test/units/character/tiscontrol.pp Normal file
View File

@ -0,0 +1,74 @@
program tiscontrol;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
for i := $0000 to $001F do begin
uc := UnicodeChar(i);
if not TCharacter.IsControl(uc) then
DoError(e,uc);
end;
Inc(e);
for i := $0080 to $009F do begin
uc := UnicodeChar(i);
if not TCharacter.IsControl(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucControl) then begin
if not TCharacter.IsControl(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if TCharacter.IsControl(uc) then
DoError(e,uc);
end;
WriteLn('ok');
end.

77
tests/test/units/character/tiscontrol2.pp Normal file
View File

@ -0,0 +1,77 @@
program tiscontrol2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
strPrefix, uc : UnicodeString;
locCharPos : Integer;
begin
strPrefix := '012345AZERT ';
locCharPos := Length(strPrefix) + 1;
e := 1;
for i := $0000 to $001F do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if not TCharacter.IsControl(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
Inc(e);
for i := $0080 to $009F do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if not TCharacter.IsControl(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucControl) then begin
if not TCharacter.IsControl(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
end;
Inc(e);
for i := Ord('a') to Ord('z') do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if TCharacter.IsControl(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
WriteLn('ok');
end.

67
tests/test/units/character/tisdigit.pp Normal file
View File

@ -0,0 +1,67 @@
program tisdigit;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
for i := Ord('0') to Ord('9') do begin
uc := UnicodeChar(i);
if not TCharacter.IsDigit(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucDecimalNumber) then begin
if not TCharacter.IsDigit(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if TCharacter.IsDigit(uc) then
DoError(e,uc);
end;
WriteLn('ok');
end.

70
tests/test/units/character/tisdigit2.pp Normal file
View File

@ -0,0 +1,70 @@
program tisdigit2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
strPrefix, uc : UnicodeString;
locCharPos : Integer;
begin
strPrefix := '012345AZERT ';
locCharPos := Length(strPrefix) + 1;
e := 1;
for i := Ord('0') to Ord('9') do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if not TCharacter.IsDigit(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucDecimalNumber) then begin
if not TCharacter.IsDigit(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
end;
Inc(e);
for i := Ord('a') to Ord('z') do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if TCharacter.IsDigit(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
WriteLn('ok');
end.

72
tests/test/units/character/tishighsurrogate.pp Normal file
View File

@ -0,0 +1,72 @@
program tishighsurrogate;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
const
LOW_SURROGATE_BEGIN = Word($DC00);
LOW_SURROGATE_END = Word($DFFF);
HIGH_SURROGATE_BEGIN = Word($D800);
HIGH_SURROGATE_END = Word($DBFF);
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
for i := HIGH_SURROGATE_BEGIN to HIGH_SURROGATE_END do begin
uc := UnicodeChar(i);
if not TCharacter.IsHighSurrogate(uc) then
DoError(e,uc);
end;
Inc(e);
for i := LOW_SURROGATE_BEGIN to LOW_SURROGATE_END do begin
uc := UnicodeChar(i);
if TCharacter.IsHighSurrogate(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
if (i < $D800) or (i > $DFFF) then begin
uc := UnicodeChar(i);
if TCharacter.IsHighSurrogate(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

95
tests/test/units/character/tisletter.pp Normal file
View File

@ -0,0 +1,95 @@
program tisletter;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if not TCharacter.IsLetter(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
if not TCharacter.IsLetter(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucModifierLetter,
TUnicodeCategory.ucOtherLetter
]
)
then begin
if not TCharacter.IsLetter(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Ord('1') to Ord('9') do begin
uc := UnicodeChar(i);
if TCharacter.IsLetter(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if not (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucModifierLetter,
TUnicodeCategory.ucOtherLetter
]
)
then begin
if TCharacter.IsLetter(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

97
tests/test/units/character/tisletterordigit.pp Normal file
View File

@ -0,0 +1,97 @@
program tisletterordigit;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if not TCharacter.IsLetterOrDigit(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
if not TCharacter.IsLetterOrDigit(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Ord('0') to Ord('9') do begin
uc := UnicodeChar(i);
if not TCharacter.IsLetterOrDigit(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucModifierLetter,
TUnicodeCategory.ucOtherLetter,
TUnicodeCategory.ucDecimalNumber,TUnicodeCategory.ucLetterNumber
]
)
then begin
if not TCharacter.IsLetterOrDigit(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if not (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucUppercaseLetter, TUnicodeCategory.ucLowercaseLetter,
TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucModifierLetter,
TUnicodeCategory.ucOtherLetter,
TUnicodeCategory.ucDecimalNumber,TUnicodeCategory.ucLetterNumber
]
)
then begin
if TCharacter.IsLetterOrDigit(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

72
tests/test/units/character/tislowsurrogate.pp Normal file
View File

@ -0,0 +1,72 @@
program tislowsurrogate;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
const
LOW_SURROGATE_BEGIN = Word($DC00);
LOW_SURROGATE_END = Word($DFFF);
HIGH_SURROGATE_BEGIN = Word($D800);
HIGH_SURROGATE_END = Word($DBFF);
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
for i := LOW_SURROGATE_BEGIN to LOW_SURROGATE_END do begin
uc := UnicodeChar(i);
if not TCharacter.IsLowSurrogate(uc) then
DoError(e,uc);
end;
Inc(e);
for i := HIGH_SURROGATE_BEGIN to HIGH_SURROGATE_END do begin
uc := UnicodeChar(i);
if TCharacter.IsLowSurrogate(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
if (i < $D800) or (i > $DFFF) then begin
uc := UnicodeChar(i);
if TCharacter.IsLowSurrogate(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

63
tests/test/units/character/tisnumber.pp Normal file
View File

@ -0,0 +1,63 @@
program tisnumber;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
uc : UnicodeChar;
d : Double;
begin
e := 1;
k := 0;
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if TCharacter.IsNumber(uc) then begin
WriteLn('CodePoint = ',IntToHex(Ord(uc),4), ' ; IsNumber = ',TCharacter.IsNumber(uc));
Inc(k);
end;
end;
WriteLn(k, ' numbers',sLineBreak);
Inc(e);
for i := 0 to 9 do begin
uc := IntToStr(i)[1];
if not TCharacter.IsNumber(uc) then
DoError(e,uc);
end;
WriteLn('ok');
end.

66
tests/test/units/character/tisnumber2.pp Normal file
View File

@ -0,0 +1,66 @@
program tisnumber2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
strPrefix, uc : UnicodeString;
locCharPos : Integer;
d : Double;
begin
strPrefix := '012345AZERT ';
locCharPos := Length(strPrefix) + 1;
e := 1;
k := 0;
for i := Low(Word) to High(Word) do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if TCharacter.IsNumber(uc,locCharPos) then begin
WriteLn('CodePoint = ',IntToHex(Ord(uc[locCharPos]),4), ' ; IsNumber = ',TCharacter.IsNumber(uc,locCharPos));
Inc(k);
end;
end;
WriteLn(k, ' numbers',sLineBreak);
Inc(e);
for i := 0 to 9 do begin
uc := strPrefix + IntToStr(i) + strPrefix;
if not TCharacter.IsNumber(uc,locCharPos) then
DoError(e,uc[locCharPos]);
end;
WriteLn('ok');
end.

98
tests/test/units/character/tispunctuation.pp Normal file
View File

@ -0,0 +1,98 @@
program tispunctuation;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
procedure CheckItems(AStart, AEnd : Word; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := AStart to AEnd do begin
locItem := UnicodeChar(q);
if TCharacter.IsPunctuation(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
procedure CheckItems(AItems : array of Word; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := Low(AItems) to High(AItems) do begin
locItem := UnicodeChar(AItems[q]);
if TCharacter.IsPunctuation(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
CheckItems($0021,$0023,True,e);
CheckItems($0025,$002A,True,e);
CheckItems($002C,$002F,True,e);
CheckItems($003A,$003B,True,e);
CheckItems($003F,$0040,True,e);
CheckItems($005B,$005D,True,e);
CheckItems([$005F,$007B,$007D,$00A1,$00AB,{ $00AD,}$00B7,$00BB,$00BF,$037E],True,e);
CheckItems($055A,$055F,True,e);
CheckItems([$0589,$058A],True,e);
CheckItems($FF5F,$FF65,True,e);
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation,
TUnicodeCategory.ucOpenPunctuation, TUnicodeCategory.ucClosePunctuation,
TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucFinalPunctuation,
TUnicodeCategory.ucOtherPunctuation
]
)
then begin
if not TCharacter.IsPunctuation(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

92
tests/test/units/character/tisseparator.pp Normal file
View File

@ -0,0 +1,92 @@
program tisseparator;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
procedure CheckItems(AItems : array of Word; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := Low(AItems) to High(AItems) do begin
locItem := UnicodeChar(AItems[q]);
if TCharacter.IsSeparator(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
CheckItems([$0020,$2028,$2029],True,e);
Inc(e);
CheckItems([$000A,$000C,$000D],False,e);
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucSpaceSeparator,
TUnicodeCategory.ucLineSeparator,
TUnicodeCategory.ucParagraphSeparator
]
)
then begin
if not TCharacter.IsSeparator(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if not (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucSpaceSeparator,
TUnicodeCategory.ucLineSeparator,
TUnicodeCategory.ucParagraphSeparator
]
)
then begin
if TCharacter.IsSeparator(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

69
tests/test/units/character/tissurrogate.pp Normal file
View File

@ -0,0 +1,69 @@
program tissurrogate;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
for i := $D800 to $DFFF do begin
uc := UnicodeChar(i);
if not TCharacter.IsSurrogate(uc) then
DoError(e,uc);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucSurrogate) then begin
if not TCharacter.IsSurrogate(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
if (i < $D800) or (i > $DFFF) then begin
uc := UnicodeChar(i);
if TCharacter.IsSurrogate(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

62
tests/test/units/character/tissurrogatepair.pp Normal file
View File

@ -0,0 +1,62 @@
program tissurrogatepair;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer; ACodePoint1, ACodePoint2 : Integer); overload;
begin
WriteLn(
'Error #',ACode,
' ; CodePoint1 = ',IntToHex(ACodePoint1,4),
' ; CodePoint2 = ',IntToHex(ACodePoint2,4)
);
Halt(Acode);
end;
const
LOW_SURROGATE_BEGIN = Word($DC00);
LOW_SURROGATE_END = Word($DFFF);
HIGH_SURROGATE_BEGIN = Word($D800);
HIGH_SURROGATE_END = Word($DBFF);
var
e, i , j: Integer;
begin
e := 1;
for i := HIGH_SURROGATE_BEGIN to HIGH_SURROGATE_END do begin
for j := LOW_SURROGATE_BEGIN to LOW_SURROGATE_END do begin
if not TCharacter.IsSurrogatePair(UnicodeChar(i),UnicodeChar(j)) then
DoError(e,i,j);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
if (i < HIGH_SURROGATE_BEGIN) or (i > HIGH_SURROGATE_END) then begin
for j := Low(Word) to High(Word) do begin
if (j < LOW_SURROGATE_BEGIN) or (j > LOW_SURROGATE_END) then begin
if TCharacter.IsSurrogatePair(UnicodeChar(i),UnicodeChar(j)) then
DoError(e,i,j);
end;
end;
end;
end;
WriteLn('ok');
end.

68
tests/test/units/character/tissurrogatepair2.pp Normal file
View File

@ -0,0 +1,68 @@
program tissurrogatepair2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer; ACodePoint1, ACodePoint2 : Integer); overload;
begin
WriteLn(
'Error #',ACode,
' ; CodePoint1 = ',IntToHex(ACodePoint1,4),
' ; CodePoint2 = ',IntToHex(ACodePoint2,4)
);
Halt(Acode);
end;
const
LOW_SURROGATE_BEGIN = Word($DC00);
LOW_SURROGATE_END = Word($DFFF);
HIGH_SURROGATE_BEGIN = Word($D800);
HIGH_SURROGATE_END = Word($DBFF);
var
e, i , j: Integer;
s : UnicodeString;
begin
s := 'azerty12345';
e := 1;
for i := HIGH_SURROGATE_BEGIN to HIGH_SURROGATE_END do begin
for j := LOW_SURROGATE_BEGIN to LOW_SURROGATE_END do begin
s[3] := UnicodeChar(i);
s[4] := UnicodeChar(j);
if not TCharacter.IsSurrogatePair(s,3) then
DoError(e,i,j);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
if (i < HIGH_SURROGATE_BEGIN) or (i > HIGH_SURROGATE_END) then begin
for j := Low(Word) to High(Word) do begin
if (j < LOW_SURROGATE_BEGIN) or (j > LOW_SURROGATE_END) then begin
s[5] := UnicodeChar(i);
s[6] := UnicodeChar(j);
if TCharacter.IsSurrogatePair(s,5) then
DoError(e,i,j);
end;
end;
end;
end;
WriteLn('ok');
end.

123
tests/test/units/character/tissymbol.pp Normal file
View File

@ -0,0 +1,123 @@
program tissymbol;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
procedure CheckItems(AItems : array of Word; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := Low(AItems) to High(AItems) do begin
locItem := UnicodeChar(AItems[q]);
if TCharacter.IsSymbol(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
procedure CheckItems(AItems : array of UnicodeChar; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := Low(AItems) to High(AItems) do begin
locItem := AItems[q];
if TCharacter.IsSymbol(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
procedure CheckItems(AStart, AEnd : Word; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := AStart to AEnd do begin
locItem := UnicodeChar(q);
if TCharacter.IsSymbol(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
//Currency
CheckItems([$0024,$00A2,$00A3,$00A4,$00A5,$060B,$09F2,$09F3],True,e);
CheckItems([$09FB,$0AF1,$0BF9,$0E3F,$17DB],True,e);
CheckItems([$A838,$FDFC],True,e);
CheckItems([$20A4,$20AC],True,e);
CheckItems($FFE0,$FFE6,True,e);
//Letterlike symbol
Inc(e);
// CheckItems($2100,$214F,True,e);
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucMathSymbol,
TUnicodeCategory.ucCurrencySymbol,
TUnicodeCategory.ucModifierSymbol,
TUnicodeCategory.ucOtherSymbol
]
)
then begin
if not TCharacter.IsSymbol(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if not (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucMathSymbol,
TUnicodeCategory.ucCurrencySymbol,
TUnicodeCategory.ucModifierSymbol,
TUnicodeCategory.ucOtherSymbol
]
)
then begin
if TCharacter.IsSymbol(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

77
tests/test/units/character/tisupper.pp Normal file
View File

@ -0,0 +1,77 @@
program tisupper;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i : Integer;
uc : UnicodeChar;
begin
e := 1;
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
if not TCharacter.IsUpper(uc) then
DoError(e,i);
end;
Inc(e);
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if TCharacter.IsUpper(uc) then
DoError(e,i);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucUppercaseLetter) then begin
if not TCharacter.IsUpper(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) <> TUnicodeCategory.ucUppercaseLetter) then begin
if TCharacter.IsUpper(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

103
tests/test/units/character/tiswhitespace.pp Normal file
View File

@ -0,0 +1,103 @@
program tiswhitespace;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
procedure CheckItems(AItems : array of Word; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := Low(AItems) to High(AItems) do begin
locItem := UnicodeChar(AItems[q]);
if TCharacter.IsWhiteSpace(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
procedure CheckItems(AItems : array of UnicodeChar; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := Low(AItems) to High(AItems) do begin
locItem := AItems[q];
if TCharacter.IsWhiteSpace(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
procedure CheckItems(AStart, AEnd : Word; ADoCheck : Boolean; AError : Integer); overload;
var
q : Integer;
locItem : UnicodeChar;
begin
for q := AStart to AEnd do begin
locItem := UnicodeChar(q);
if TCharacter.IsWhiteSpace(locItem) <> ADoCheck then
DoError(AError,locItem);
end;
end;
var
e, i , k: Integer;
uc : UnicodeChar;
begin
e := 1;
CheckItems([$0020,$1680,$180E],True,e);
CheckItems($2000,$200A,True,e);
CheckItems([$202F,$205F,$3000],True,e);
CheckItems([$2028,$2029],True,e);
CheckItems($0009,$000D,True,e);
CheckItems([$0085,$00A0],True,e);
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) in
[ TUnicodeCategory.ucSpaceSeparator,
TUnicodeCategory.ucLineSeparator,
TUnicodeCategory.ucParagraphSeparator
]
)
then begin
if not TCharacter.IsWhiteSpace(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

77
tests/test/units/character/tlowercase.pp Normal file
View File

@ -0,0 +1,77 @@
program tlowercase;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i : Integer;
uc : UnicodeChar;
begin
e := 1;
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if not TCharacter.IsLower(uc) then
DoError(e,i);
end;
Inc(e);
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
if TCharacter.IsLower(uc) then
DoError(e,i);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucLowercaseLetter) then begin
if not TCharacter.IsLower(uc) then
DoError(e,uc);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) <> TUnicodeCategory.ucLowercaseLetter) then begin
if TCharacter.IsLower(uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

86
tests/test/units/character/tlowercase2.pp Normal file
View File

@ -0,0 +1,86 @@
program tlowercase2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; AStr : UnicodeString; AIndex : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(AStr[AIndex]),4));
Halt(Acode);
end;
var
e, i : Integer;
strPrefix, uc : UnicodeString;
locCharPos : Integer;
begin
strPrefix := '012345AZERT ';
locCharPos := Length(strPrefix) + 1;
e := 1;
for i := Ord('a') to Ord('z') do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if not TCharacter.IsLower(uc,locCharPos) then
DoError(e,i);
end;
Inc(e);
for i := Ord('A') to Ord('Z') do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if TCharacter.IsLower(uc,locCharPos) then
DoError(e,i);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucLowercaseLetter) then begin
if not TCharacter.IsLower(uc,locCharPos) then
DoError(e,uc,locCharPos);
end;
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := strPrefix + UnicodeChar(i) + strPrefix;
if (TCharacter.GetUnicodeCategory(uc,locCharPos) <> TUnicodeCategory.ucLowercaseLetter) then begin
if TCharacter.IsLower(uc,locCharPos) then
DoError(e,uc,locCharPos);
end;
end;
WriteLn('ok');
end.

77
tests/test/units/character/ttolower.pp Normal file
View File

@ -0,0 +1,77 @@
program ttolower;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i, j : Integer;
uc : UnicodeChar;
begin
e := 1;
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if (TCharacter.ToLower(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
for i := Ord('0') to Ord('9') do begin
uc := UnicodeChar(i);
if (TCharacter.ToLower(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
j := Ord('a');
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
if (TCharacter.ToLower(uc) <> UnicodeChar(j)) then
DoError(e,i);
Inc(j);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucLowercaseLetter) then begin
if (TCharacter.ToLower(uc) <> uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

77
tests/test/units/character/ttolower2.pp Normal file
View File

@ -0,0 +1,77 @@
program ttolower2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeString); overload;
begin
WriteLn('Error #',ACode,' ; String = ',ACodePoint);
Halt(Acode);
end;
var
e, i, j : Integer;
uc, s : UnicodeString;
begin
e := 1;
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
if (TCharacter.ToLower(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
for i := Ord('0') to Ord('9') do begin
uc := UnicodeChar(i);
if (TCharacter.ToLower(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
if (TCharacter.ToLower('azerty') <> 'azerty') then
DoError(e,'azerty');
if (TCharacter.ToLower('AZERTY') <> 'azerty') then
DoError(e,'AZERTY');
if (TCharacter.ToLower('AzERty') <> 'azerty') then
DoError(e,'AzERty');
Inc(e);
j := Ord('a');
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
s := UnicodeChar(j);
if (TCharacter.ToLower(uc) <> s) then
DoError(e,i);
Inc(j);
end;
WriteLn('ok');
end.

77
tests/test/units/character/ttoupper.pp Normal file
View File

@ -0,0 +1,77 @@
program ttoupper;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
Halt(Acode);
end;
var
e, i, j : Integer;
uc : UnicodeChar;
begin
e := 1;
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
if (TCharacter.ToUpper(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
for i := Ord('0') to Ord('9') do begin
uc := UnicodeChar(i);
if (TCharacter.ToUpper(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
j := Ord('A');
for i := Ord('a') to Ord('a') do begin
uc := UnicodeChar(i);
if (TCharacter.ToUpper(uc) <> UnicodeChar(j)) then
DoError(e,i);
Inc(j);
end;
Inc(e);
for i := Low(Word) to High(Word) do begin
uc := UnicodeChar(i);
if (TCharacter.GetUnicodeCategory(uc) = TUnicodeCategory.ucUppercaseLetter) then begin
if (TCharacter.ToUpper(uc) <> uc) then
DoError(e,uc);
end;
end;
WriteLn('ok');
end.

77
tests/test/units/character/ttoupper2.pp Normal file
View File

@ -0,0 +1,77 @@
program ttoupper2;
{$ifdef FPC}
{$mode objfpc}
{$H+}
{$PACKENUM 1}
{$endif fpc}
{$ifndef FPC}
{$APPTYPE CONSOLE}
{$endif}
uses
SysUtils,
character;
{$ifndef FPC}
type UnicodeChar = WideChar;
{$endif}
procedure DoError(ACode : Integer); overload;
begin
WriteLn('Error #',ACode);
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
begin
WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
Halt(Acode);
end;
procedure DoError(ACode : Integer; ACodePoint : UnicodeString); overload;
begin
WriteLn('Error #',ACode,' ; String = ',ACodePoint);
Halt(Acode);
end;
var
e, i, j : Integer;
uc, s : UnicodeString;
begin
e := 1;
for i := Ord('A') to Ord('Z') do begin
uc := UnicodeChar(i);
if (TCharacter.ToUpper(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
for i := Ord('0') to Ord('9') do begin
uc := UnicodeChar(i);
if (TCharacter.ToUpper(uc) <> uc) then
DoError(e,i);
end;
Inc(e);
if (TCharacter.ToUpper('azerty') <> 'AZERTY') then
DoError(e,'azerty');
if (TCharacter.ToUpper('AZERTY') <> 'AZERTY') then
DoError(e,'AZERTY');
if (TCharacter.ToUpper('AzERty') <> 'AZERTY') then
DoError(e,'AzERty');
Inc(e);
j := Ord('A');
for i := Ord('a') to Ord('z') do begin
uc := UnicodeChar(i);
s := UnicodeChar(j);
if (TCharacter.ToUpper(uc) <> s) then
DoError(e,i);
Inc(j);
end;
WriteLn('ok');
end.