mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 13:39:36 +02:00
+ test for large case statements
git-svn-id: trunk@35646 -
This commit is contained in:
florian
parent
d5754cf47c
commit
e8f7c9dfdd
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -11524,6 +11524,7 @@ tests/test/cg/tcalvar7.pp svneol=native#text/plain
|
||||
tests/test/cg/tcalvar8.pp svneol=native#text/plain
|
||||
tests/test/cg/tcase.pp svneol=native#text/plain
|
||||
tests/test/cg/tcase2.pp svneol=native#text/plain
|
||||
tests/test/cg/tcase3.pp svneol=native#text/pascal
|
||||
tests/test/cg/tclacla1.pp svneol=native#text/plain
|
||||
tests/test/cg/tclasize.pp svneol=native#text/plain
|
||||
tests/test/cg/tclatype.pp svneol=native#text/plain
|
||||
|
||||
233
tests/test/cg/tcase3.pp
Normal file
233
tests/test/cg/tcase3.pp
Normal file
@ -0,0 +1,233 @@
|
||||
{$codepage utf8}
|
||||
{$mode objfpc} {$h+} {$coperators on}
|
||||
uses
|
||||
SysUtils, DateUtils;
|
||||
|
||||
const
|
||||
Sample = widestring('Examples' + LineEnding +
|
||||
'Appointments: Аппойнтменты (Appojntmenty)[2]' + LineEnding +
|
||||
'Iced Coffee: Аисд кофе (Aisd kofe)[2]' + LineEnding +
|
||||
'Would you like that sliced or in one piece?: Вам наслайсовать или писом? (Vam naslajsovatj ili pisom?)[4]' + LineEnding +
|
||||
'Driving upstate on the highways: Драйвуем в апстейт по хайвеям (Drajvujem v apstejt po hajwejam)[5]' + LineEnding +
|
||||
'Sliced Cheese: Слайсающий чиз (Slajsajuçij čiz)[5]' + LineEnding +
|
||||
'To merge branches: Смержить бранчи (Smeržitj branči)[2]' + LineEnding +
|
||||
'To manage: Сменеджить (Smenedžitj)' + LineEnding +
|
||||
'I sent you message with attached request: Я засендил тебе месседж с приаттаченым реквестом (Ya zasendil tebe messedž s priattachenim rekvestom)');
|
||||
Iterations = 880000;
|
||||
|
||||
type
|
||||
CodepointFlag = (Letter, Vowel, Consonant, Digit, Whitespace, Newline, Punctuation, Cyrillic, Latin, Diacritic);
|
||||
CodepointClassification = set of CodepointFlag;
|
||||
|
||||
function Classify_Case(const cp: widechar): CodepointClassification;
|
||||
begin
|
||||
case cp of
|
||||
' ', #$9 {tab}, #$a0 {nbsp}, ' ' {ideographic space}: result := [Whitespace];
|
||||
#$a {lf}, #$d {cr}: result := [Whitespace, Newline];
|
||||
'0' .. '9': result := [Digit];
|
||||
'a', 'e', 'i', 'o', 'u', 'y', 'A', 'E', 'I', 'O', 'U', 'Y': result := [Letter, Latin, Vowel];
|
||||
'b', 'c', 'd', 'f', 'g', 'h', 'j', 'k', 'l', 'm', 'n', 'p', 'q', 'r', 's', 't', 'v', 'w', 'x', 'z',
|
||||
'B', 'C', 'D', 'F', 'G', 'H', 'J', 'K', 'L', 'M', 'N', 'P', 'Q', 'R', 'S', 'T', 'V', 'W', 'X', 'Z': result := [Letter, Latin, Consonant];
|
||||
'.', '!', ',', '?', ':', ';', '-', '—': result := [Punctuation];
|
||||
'А', 'Е', 'И', 'О', 'У', 'Ы', 'Э', 'Ю', 'Я', 'а', 'е', 'и', 'о', 'у', 'ы', 'э', 'ю', 'я', 'Ё', 'ё': result := [Letter, Cyrillic, Vowel];
|
||||
'б', 'в', 'г', 'д', 'ж', 'з', 'й', 'к', 'л', 'м', 'н', 'п', 'р', 'с', 'т', 'ф', 'х', 'ц', 'ч', 'ш', 'щ',
|
||||
'Б', 'В', 'Г', 'Д', 'Ж', 'З', 'Й', 'К', 'Л', 'М', 'Н', 'П', 'Р', 'С', 'Т', 'Ф', 'Х', 'Ц', 'Ч', 'Ш', 'Щ': result := [Letter, Cyrillic, Consonant];
|
||||
'ъ', 'ь', 'Ъ', 'Ь': result := [Letter, Cyrillic];
|
||||
#$300 {first diacritic} .. #$36f {last diacritic}: result := [Diacritic];
|
||||
else result := [];
|
||||
end;
|
||||
end;
|
||||
|
||||
// I have built this tree from sorted starts of subsequences:
|
||||
// (1) 9 tab
|
||||
// (2) A lf
|
||||
// (3) D cr
|
||||
// (4) 20 space
|
||||
// (5) 21 !
|
||||
// (6) 2C ,
|
||||
// (7) 2D -
|
||||
// (8) 2E .
|
||||
// (9) 30–39 0-9
|
||||
// (10) 3A :
|
||||
// (11) 3B ;
|
||||
// (12) 3F ?
|
||||
// (13) 41-5a A-Z
|
||||
// (14) 61-7a a-z
|
||||
// (15) A0 nbsp
|
||||
// (16) 300–36f diacritics
|
||||
// (17) 401 Ё
|
||||
// (18) 410–44f А-я
|
||||
// (19) 451 ё
|
||||
// (20) 2014 — (em dash)
|
||||
// (21) 3000 ideographic space
|
||||
function Classify_Tree(const cp: widechar): CodepointClassification;
|
||||
begin
|
||||
if cp < #$3F then // (1) ~ (11)
|
||||
if cp < #$2D then // (1) ~ (6) — small set without subsequences, resort to predictor-friendly :) case..of
|
||||
case cp of
|
||||
' ', #$9 {tab}: exit([Whitespace]);
|
||||
#$a {lf}, #$d {cr}: exit([Whitespace, Newline]);
|
||||
'!', ',': exit([Punctuation]);
|
||||
end
|
||||
else // (7) ~ (11)
|
||||
if cp < #$3A then // (7) ~ (9)
|
||||
if cp < #$30 then // (7) ~ (8)
|
||||
case cp of
|
||||
'-', '.': exit([Punctuation]);
|
||||
end
|
||||
else // (9)
|
||||
case cp of
|
||||
'0' .. '9': exit([Digit]);
|
||||
end
|
||||
else // (10) ~ (11)
|
||||
case cp of
|
||||
':', ';': exit([Punctuation]);
|
||||
end
|
||||
else // (12) ~ (21)
|
||||
if cp < #$401 then // (12) ~ (16)
|
||||
if cp < #$A0 then // (12) ~ (14)
|
||||
if cp < #$61 then // (12) ~ (13)
|
||||
if cp < #$41 then // (12)
|
||||
case cp of
|
||||
'?': exit([Punctuation]);
|
||||
end
|
||||
else // (13)
|
||||
case cp of
|
||||
'A', 'E', 'I', 'O', 'U', 'Y': exit([Letter, Latin, Vowel]);
|
||||
'B', 'C', 'D', 'F', 'G', 'H', 'J', 'K', 'L', 'M', 'N', 'P', 'Q', 'R', 'S', 'T', 'V', 'W', 'X', 'Z': exit([Letter, Latin, Consonant]);
|
||||
end
|
||||
else //(14)
|
||||
case cp of
|
||||
'a', 'e', 'i', 'o', 'u', 'y': exit([Letter, Latin, Vowel]);
|
||||
'b', 'c', 'd', 'f', 'g', 'h', 'j', 'k', 'l', 'm', 'n', 'p', 'q', 'r', 's', 't', 'v', 'w', 'x', 'z': exit([Letter, Latin, Consonant]);
|
||||
end
|
||||
else // (15) ~ (16)
|
||||
if cp < #$300 then // (15)
|
||||
case cp of
|
||||
#$a0 {nbsp}: exit([Whitespace]);
|
||||
end
|
||||
else // (16)
|
||||
case cp of
|
||||
#$300 {first diacritic} .. #$36f {last diacritic}: exit([Diacritic]);
|
||||
end
|
||||
else // (17) ~ (21)
|
||||
if cp < #$2014 then // (17) ~ (19)
|
||||
if cp < #$451 then // (17) ~ (18)
|
||||
if cp < #$410 then // (17)
|
||||
case cp of
|
||||
'Ё': exit([Letter, Cyrillic, Vowel]);
|
||||
end
|
||||
else // (18)
|
||||
case cp of
|
||||
'А', 'Е', 'И', 'О', 'У', 'Ы', 'Э', 'Ю', 'Я', 'а', 'е', 'и', 'о', 'у', 'ы', 'э', 'ю', 'я': exit([Letter, Cyrillic, Vowel]);
|
||||
'б', 'в', 'г', 'д', 'ж', 'з', 'й', 'к', 'л', 'м', 'н', 'п', 'р', 'с', 'т', 'ф', 'х', 'ц', 'ч', 'ш', 'щ',
|
||||
'Б', 'В', 'Г', 'Д', 'Ж', 'З', 'Й', 'К', 'Л', 'М', 'Н', 'П', 'Р', 'С', 'Т', 'Ф', 'Х', 'Ц', 'Ч', 'Ш', 'Щ': exit([Letter, Cyrillic, Consonant]);
|
||||
'ъ', 'ь', 'Ъ', 'Ь': exit([Letter, Cyrillic]);
|
||||
end
|
||||
else // (19)
|
||||
case cp of
|
||||
'ё': exit([Letter, Cyrillic, Vowel]);
|
||||
end
|
||||
else // (20) ~ (21)
|
||||
case cp of
|
||||
'—': exit([Punctuation]);
|
||||
' ': exit([Whitespace]);
|
||||
end;
|
||||
|
||||
// 'else'
|
||||
result := [];
|
||||
end;
|
||||
|
||||
procedure Test;
|
||||
function ToString(const cls: CodepointClassification): string;
|
||||
var
|
||||
f: CodepointFlag;
|
||||
begin
|
||||
result := '';
|
||||
for f in CodepointFlag do
|
||||
if f in cls then
|
||||
begin
|
||||
if result <> '' then result += ', ';
|
||||
WriteStr(result, f);
|
||||
end;
|
||||
result := '[' + result + ']';
|
||||
end;
|
||||
var
|
||||
cp: widechar;
|
||||
begin
|
||||
write('Sanity check... ');
|
||||
for cp := #0 to #$3001 do
|
||||
if Classify_Case(cp) <> Classify_Tree(cp) then
|
||||
begin
|
||||
writeln(
|
||||
'Failed. Classify_Case isn''t equivalent to Classify_Tree.', LineEnding,
|
||||
'Symbol code: $', HexStr(cardinal(cp), bitsizeof(widechar) div 4), LineEnding,
|
||||
'Classify_Case: ', ToString(Classify_Case(cp)), LineEnding,
|
||||
'Classify_Tree: ', ToString(Classify_Tree(cp)), LineEnding);
|
||||
readln;
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
writeln('Passed. Classify_Case and Classify_Tree are equivalent.',
|
||||
LineEnding);
|
||||
end;
|
||||
|
||||
procedure Benchmark;
|
||||
var
|
||||
caseTime, treeTime: TDateTime;
|
||||
vow, lat: cardinal;
|
||||
iteration: cardinal;
|
||||
i: SizeInt;
|
||||
|
||||
procedure ResetWork(out vow, lat: cardinal);
|
||||
begin
|
||||
vow := 0; lat := 0;
|
||||
end;
|
||||
|
||||
procedure Note(const cls: CodepointClassification);
|
||||
begin
|
||||
if Vowel in cls then inc(vow);
|
||||
if Latin in cls then inc(lat);
|
||||
end;
|
||||
|
||||
begin
|
||||
write('Benchmarking Classify_Tree... ');
|
||||
ResetWork(vow, lat);
|
||||
treeTime := Now;
|
||||
for iteration := 1 to Iterations do
|
||||
begin
|
||||
for i := 1 to length(Sample) do
|
||||
Note(Classify_Tree(Sample[i]));
|
||||
if iteration < Iterations then ResetWork(vow, lat);
|
||||
end;
|
||||
treeTime := SecondSpan(Now, treeTime);
|
||||
writeln(treeTime:0:1, ' s (', treeTime/Iterations*1e6:0:1, ' mcs/it), vow. ', vow, ', lat. ', lat, '.');
|
||||
|
||||
write('Benchmarking Classify_Case... ');
|
||||
ResetWork(vow, lat);
|
||||
caseTime := Now;
|
||||
for iteration := 1 to Iterations do
|
||||
begin
|
||||
for i := 1 to length(Sample) do
|
||||
Note(Classify_Case(Sample[i]));
|
||||
if iteration < Iterations then ResetWork(vow, lat);
|
||||
end;
|
||||
caseTime := SecondSpan(Now, caseTime);
|
||||
writeln(caseTime:0:1, ' s (', caseTime/Iterations*1e6:0:1, ' mcs/it), vow. ', vow, ', lat. ', lat, '.');
|
||||
|
||||
if (treeTime < 0.5) or (caseTime < 0.5) then
|
||||
writeln('Could not deduce anything useful.')
|
||||
else
|
||||
if (treeTime <= 1.05*caseTime) and (caseTime <= 1.05*treeTime) then
|
||||
writeln('There was no observable difference.')
|
||||
else
|
||||
if treeTime > caseTime then
|
||||
writeln('Classify_Case was faster by ', (treeTime / caseTime - 1)*100:0:0, '% (', treeTime/caseTime:0:1, 'x).')
|
||||
else
|
||||
writeln('Classify_Tree was faster by ', (caseTime / treeTime - 1)*100:0:0, '% (', caseTime/treeTime:0:1, 'x).')
|
||||
end;
|
||||
|
||||
begin
|
||||
Test;
|
||||
// Benchmark;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user