paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-19 04:02:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

tests:

Browse Source 
+ added UTF8 to UTF16 conversion test from Tomas
+ added a new directory for lcl tests

git-svn-id: trunk@16234 -
This commit is contained in:
vincents 2008-08-25 21:45:08 +00:00
parent a6461c8562
commit 7413699b4d
6 changed files with 159 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -3749,6 +3749,7 @@ test/bugs/testfileproc.pas svneol=native#text/plain
test/bugs/testfileutil.pas svneol=native#text/plain
test/bugtestcase.pas svneol=native#text/plain
test/hello.ahk svneol=native#text/plain
test/lcltests/testunicode.pas svneol=native#text/plain
test/readme.txt svneol=native#text/plain
test/runtests.lpi svneol=native#text/plain
test/runtests.lpr svneol=native#text/plain

128
test/lcltests/testunicode.pas Normal file
View File

@ -0,0 +1,128 @@
unit TestUnicode;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, LCLProc, testglobals;
type
{ TTestUnicode }
TTestUnicode= class(TTestCase)
published
procedure TestUTF8ToUTF16;
procedure TestUTF16ToUTF8;
procedure TestUTF16ToUnicode;
procedure TestUnicodeToUTF16;
end;
const
Limits: Array [0..8] of Cardinal =
(0, $7F, $80, $7FF, $800, $10000, $10FFFF, $1FFFFF, $D7FF);
implementation
{ TTestUnicode }
procedure TTestUnicode.TestUTF8ToUTF16;
var
U: Cardinal;
I1, I2: Integer;
SUTF8, S1UTF8: UTF8String;
SUTF16, S1UTF16, R: WideString;
begin
for U := 0 to $1FFFFF do // test each unicode char
begin
if (U >= $D800) and (U <= $FFFF) 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 $1FFFFF do
begin
if (U >= $D800) and (U <= $FFFF) 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($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(#$D800#$DC00, UnicodeToUTF16($10000));
AssertEquals(#$D800#$DC01, UnicodeToUTF16($10001));
AssertEquals(#$DBFF#$DFFD, UnicodeToUTF16($10FFFD));
end;
initialization
AddToLCLTestSuite(TTestUnicode);
end.

14
test/runtests.lpi
View File

@ -35,7 +35,7 @@
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="4">
<Units Count="5">
<Unit0>
<Filename Value="runtests.lpr"/>
<IsPartOfProject Value="True"/>
@ -56,14 +56,24 @@
<IsPartOfProject Value="True"/>
<UnitName Value="testglobals"/>
</Unit3>
<Unit4>
<Filename Value="lcltests\testunicode.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestUnicode"/>
</Unit4>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="bugs\"/>
<OtherUnitFiles Value="bugs\;lcltests\"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>

7
test/runtestsgui.lpi
View File

@ -82,8 +82,13 @@
<Version Value="8"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="bugs\"/>
<OtherUnitFiles Value="bugs\;lcltests\"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>

9
test/testglobals.pas
View File

@ -29,10 +29,12 @@ uses
var
Compiler: string;
BugsTestSuite: TTestSuite;
LCLTestSuite: TTestSuite;
// reads the output from a process and puts it in a memory stream
function ReadOutput(AProcess:TProcess): TStringList;
procedure AddToBugsTestSuite(ATest: TTest);
procedure AddToLCLTestSuite(ATestClass: TClass);
implementation
@ -90,10 +92,17 @@ begin
BugsTestSuite.AddTest(ATest);
end;
procedure AddToLCLTestSuite(ATestClass: TClass);
begin
LCLTestSuite.AddTestSuiteFromClass(ATestClass);
end;
initialization
GetTestRegistry.TestName := 'All tests';
BugsTestSuite := TTestSuite.Create('Bugs');
GetTestRegistry.AddTest(BugsTestSuite);
LCLTestSuite := TTestSuite.Create('LCL tests');
GetTestRegistry.AddTest(LCLTestSuite);
end.

4
test/testunits.pas
View File

@ -28,7 +28,9 @@ interface
uses
TestLpi, BugTestCase,
bug8432, testfileutil, testfileproc;
bug8432, testfileutil, testfileproc,
// lcltests
testunicode;
implementation