1program tlowercase2;
2
3{$ifdef FPC}
4  {$mode objfpc}
5  {$H+}
6  {$PACKENUM 1}
7{$endif fpc}
8
9{$ifndef FPC}
10  {$APPTYPE CONSOLE}
11{$endif}
12
13uses
14  SysUtils,
15  character;
16
17{$ifndef FPC}
18  type UnicodeChar = WideChar;
19{$endif}
20
21procedure DoError(ACode : Integer); overload;
22begin
23  WriteLn('Error #',ACode);
24  Halt(Acode);
25end;
26
27procedure DoError(ACode : Integer; ACodePoint : Integer); overload;
28begin
29  WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(ACodePoint,4));
30  Halt(Acode);
31end;
32
33procedure DoError(ACode : Integer; ACodePoint : UnicodeChar); overload;
34begin
35  WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(ACodePoint),4));
36  Halt(Acode);
37end;
38
39procedure DoError(ACode : Integer; AStr : UnicodeString; AIndex : Integer); overload;
40begin
41  WriteLn('Error #',ACode,' ; CodePoint = ',IntToHex(Ord(AStr[AIndex]),4));
42  Halt(Acode);
43end;
44
45var
46  e, i : Integer;
47  strPrefix, uc : UnicodeString;
48  locCharPos : Integer;
49begin
50  strPrefix := '012345AZERT ';
51  locCharPos := Length(strPrefix) + 1;
52  e := 1;
53  for i := Ord('a') to Ord('z') do begin
54    uc := strPrefix + UnicodeChar(i) + strPrefix;
55    if not TCharacter.IsLower(uc,locCharPos) then
56      DoError(e,i);
57  end;
58
59  Inc(e);
60  for i := Ord('A') to Ord('Z') do begin
61    uc := strPrefix + UnicodeChar(i) + strPrefix;
62    if TCharacter.IsLower(uc,locCharPos) then
63      DoError(e,i);
64  end;
65
66  Inc(e);
67  for i := Low(Word) to High(Word) do begin
68    uc := strPrefix + UnicodeChar(i) + strPrefix;
69    if (TCharacter.GetUnicodeCategory(uc,locCharPos) = TUnicodeCategory.ucLowercaseLetter) then begin
70      if not TCharacter.IsLower(uc,locCharPos) then
71        DoError(e,uc,locCharPos);
72    end;
73  end;
74
75  Inc(e);
76  for i := Low(Word) to High(Word) do begin
77    uc := strPrefix + UnicodeChar(i) + strPrefix;
78    if (TCharacter.GetUnicodeCategory(uc,locCharPos) <> TUnicodeCategory.ucLowercaseLetter) then begin
79      if TCharacter.IsLower(uc,locCharPos) then
80        DoError(e,uc,locCharPos);
81    end;
82  end;
83
84  WriteLn('ok');
85end.
86
87