paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 06:36:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

tests:

Browse Source 
- fix twide6.pp: 
    1. remote unicodestring part because tunistr6.pp already test it
    2. remove ansistring function tests because it depended on the fact that WideString->AnsiString conversions replaced all unsupported characters with "?" which is not true now - those unsupported characters are transliterated currently.
  - apply similar fix to tunistr6.pp

git-svn-id: trunk@19568 -
This commit is contained in:
paul 2011-11-01 02:37:54 +00:00
parent 60de075ebe
commit 82dd2e28d5
2 changed files with 18 additions and 477 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

182
tests/test/tunistr6.pp
View File

@ -16,9 +16,7 @@ procedure doerror(i : integer);
{ normal upper case testing }
procedure testupper;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
w1:='aé'#0'èàł'#$d87e#$dc04;
w2:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
@ -27,61 +25,29 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
{$ifdef print}
writeln('ansi: ',s);
{$endif print}
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeUpperCase(w1);
{$ifdef print}
writeln('unicodeupper: ',w1);
writeln('original upper: ',w2);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(1);
if (w4 <> w2) then
doerror(2);
w1:='aéèàł'#$d87e#$dc04;
w2:='AÉÈÀŁ'#$d87e#$dc04;
s:=w1;
w3:=s;
w4:=AnsiStrUpper(pchar(s));
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeUpperCase(w1);
{$ifdef print}
writeln('unicodeupper: ',w1);
writeln('ansistrupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(21);
if (w4 <> w2) then
doerror(22);
end;
{ normal lower case testing }
procedure testlower;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
w1:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
w2:='aé'#0'èàł'#$d87e#$dc04;
@ -90,48 +56,22 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeLowerCase(w1);
{$ifdef print}
writeln('unicodelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(3);
if (w4 <> w2) then
doerror(4);
w1:='AÉÈÀŁ'#$d87e#$dc04;
w2:='aéèàł'#$d87e#$dc04;
s:=w1;
w3:=s;
w4:=AnsiStrLower(pchar(s));
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeLowerCase(w1);
{$ifdef print}
writeln('unicodelower: ',w1);
writeln('ansistrlower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(3);
if (w4 <> w2) then
doerror(4);
end;
@ -139,9 +79,7 @@ end;
{ upper case testing with a missing utf-16 pair at the end }
procedure testupperinvalid;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
{ missing utf-16 pair at end }
w1:='aé'#0'èàł'#$d87e;
@ -151,34 +89,19 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeUpperCase(w1);
{$ifdef print}
writeln('unicodeupper: ',w1);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(5);
if (w4 <> w2) then
doerror(6);
end;
{ lower case testing with a missing utf-16 pair at the end }
procedure testlowerinvalid;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
{ missing utf-16 pair at end}
w1:='AÉ'#0'ÈÀŁ'#$d87e;
@ -188,25 +111,12 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeLowerCase(w1);
{$ifdef print}
writeln('unicodelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(7);
if (w4 <> w2) then
doerror(8);
end;
@ -214,9 +124,7 @@ end;
{ upper case testing with a missing utf-16 pair at the end, followed by a normal char }
procedure testupperinvalid1;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
{ missing utf-16 pair at end with char after it}
w1:='aé'#0'èàł'#$d87e'j';
@ -226,34 +134,19 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeUpperCase(w1);
{$ifdef print}
writeln('unicodeupper: ',w1);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(9);
if (w4 <> w2) then
doerror(10);
end;
{ lower case testing with a missing utf-16 pair at the end, followed by a normal char }
procedure testlowerinvalid1;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
{ missing utf-16 pair at end with char after it}
w1:='AÉ'#0'ÈÀŁ'#$d87e'J';
@ -263,34 +156,19 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeLowerCase(w1);
{$ifdef print}
writeln('unicodelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(11);
if (w4 <> w2) then
doerror(12);
end;
{ upper case testing with corrupting the utf-8 string after conversion }
procedure testupperinvalid2;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
w1:='aé'#0'èàł'#$d87e#$dc04'ö';
w2:='AÉ'#0'ÈÀŁ'#$d87e#$dc04'Ö';
@ -299,42 +177,19 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
{ truncate the last utf-8 character }
setlength(s,length(s)-1);
w3:=s;
{ adjust checking values for new length due to corruption }
if length(w3)<>length(w2) then
begin
setlength(w2,length(w3));
setlength(w1,length(w3));
end;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeUpperCase(w1);
{$ifdef print}
writeln('unicodeupper: ',w1);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(13);
if (w4 <> w2) then
doerror(14);
end;
{ lower case testing with corrupting the utf-8 string after conversion }
procedure testlowerinvalid2;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
w1,w2: unicodestring;
begin
w1:='AÉ'#0'ÈÀŁ'#$d87e#$dc04'Ö';
w2:='aé'#0'èàł'#$d87e#$dc04'ö';
@ -343,33 +198,12 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
{ truncate the last utf-8 character }
setlength(s,length(s)-1);
w3:=s;
{ adjust checking values for new length due to corruption }
if length(w3)<>length(w2) then
begin
setlength(w2,length(w3));
setlength(w1,length(w3));
end;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=UnicodeLowerCase(w1);
{$ifdef print}
writeln('unicodelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(15);
if (w4 <> w2) then
doerror(16);
end;

313
tests/test/twide6.pp
View File

@ -6,6 +6,8 @@ uses
{$endif}
sysutils;
// {$define print}
procedure doerror(i : integer);
begin
writeln('Error: ',i);
@ -16,10 +18,7 @@ procedure doerror(i : integer);
{ normal upper case testing (widestring) }
procedure testupper;
var
s: ansistring;
w1,w2,w3,w4: widestring;
u1,u2,u3,u4: unicodestring;
i: longint;
w1,w2: widestring;
begin
w1:='aé'#0'èàł'#$d87e#$dc04;
w2:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
@ -28,124 +27,28 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
{$ifdef print}
writeln('ansi: ',s);
{$endif print}
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=wideuppercase(w1);
{$ifdef print}
writeln('wideupper: ',w1);
writeln('original upper: ',w2);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(1);
if (w4 <> w2) then
doerror(2);
w1:='aéèàł'#$d87e#$dc04;
w2:='AÉÈÀŁ'#$d87e#$dc04;
s:=w1;
w3:=s;
w4:=AnsiStrUpper(pchar(s));
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=wideuppercase(w1);
{$ifdef print}
writeln('wideupper: ',w1);
writeln('ansistrupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(21);
if (w4 <> w2) then
doerror(22);
end;
{ normal upper case testing (unicodestring) }
procedure testupperu;
var
s: ansistring;
w1,w2,w3,w4: widestring;
u1,u2,u3,u4: unicodestring;
i: longint;
begin
w1:='aé'#0'èàł'#$d87e#$dc04;
w2:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
{$ifdef print}
// the utf-8 output can confuse the testsuite parser
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
{$ifdef print}
writeln('ansi: ',s);
{$endif print}
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=unicodeuppercase(w1);
{$ifdef print}
writeln('wideupper: ',w1);
writeln('original upper: ',w2);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(1);
if (w4 <> w2) then
doerror(2);
w1:='aéèàł'#$d87e#$dc04;
w2:='AÉÈÀŁ'#$d87e#$dc04;
s:=w1;
w3:=s;
w4:=AnsiStrUpper(pchar(s));
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=unicodeuppercase(w1);
{$ifdef print}
writeln('unicodeupper: ',w1);
writeln('ansistrupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(21);
if (w4 <> w2) then
doerror(22);
end;
{ normal lower case testing (widestring) }
procedure testlower;
var
s: ansistring;
w1,w2,w3,w4: widestring;
i: longint;
w1,w2: widestring;
begin
w1:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
w2:='aé'#0'èàł'#$d87e#$dc04;
@ -154,115 +57,29 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=widelowercase(w1);
{$ifdef print}
writeln('widelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(3);
if (w4 <> w2) then
doerror(4);
w1:='AÉÈÀŁ'#$d87e#$dc04;
w2:='aéèàł'#$d87e#$dc04;
s:=w1;
w3:=s;
w4:=AnsiStrLower(pchar(s));
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=widelowercase(w1);
{$ifdef print}
writeln('widelower: ',w1);
writeln('ansistrlower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(3);
if (w4 <> w2) then
doerror(4);
end;
{ normal lower case testing (unicodestring) }
procedure testloweru;
var
s: ansistring;
w1,w2,w3,w4: unicodestring;
i: longint;
begin
w1:='AÉ'#0'ÈÀŁ'#$d87e#$dc04;
w2:='aé'#0'èàł'#$d87e#$dc04;
{$ifdef print}
// the utf-8 output can confuse the testsuite parser
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=unicodelowercase(w1);
{$ifdef print}
writeln('unicodelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(3);
if (w4 <> w2) then
doerror(4);
w1:='AÉÈÀŁ'#$d87e#$dc04;
w2:='aéèàł'#$d87e#$dc04;
s:=w1;
w3:=s;
w4:=AnsiStrLower(pchar(s));
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=unicodelowercase(w1);
{$ifdef print}
writeln('unicodelower: ',w1);
writeln('ansistrlower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(3);
if (w4 <> w2) then
doerror(4);
end;
{ upper case testing with a missing utf-16 pair at the end }
procedure testupperinvalid;
var
s: ansistring;
w1,w2,w3,w4: widestring;
i: longint;
w1,w2: widestring;
begin
{ missing utf-16 pair at end }
w1:='aé'#0'èàł'#$d87e;
@ -272,34 +89,19 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=wideuppercase(w1);
{$ifdef print}
writeln('wideupper: ',w1);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(5);
if (w4 <> w2) then
doerror(6);
end;
{ lower case testing with a missing utf-16 pair at the end }
procedure testlowerinvalid;
var
s: ansistring;
w1,w2,w3,w4: widestring;
i: longint;
w1,w2: widestring;
begin
{ missing utf-16 pair at end}
w1:='AÉ'#0'ÈÀŁ'#$d87e;
@ -309,35 +111,19 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=widelowercase(w1);
{$ifdef print}
writeln('widelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(7);
if (w4 <> w2) then
doerror(8);
end;
{ upper case testing with a missing utf-16 pair at the end, followed by a normal char }
procedure testupperinvalid1;
var
s: ansistring;
w1,w2,w3,w4: widestring;
i: longint;
w1,w2: widestring;
begin
{ missing utf-16 pair at end with char after it}
w1:='aé'#0'èàł'#$d87e'j';
@ -347,34 +133,19 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=wideuppercase(w1);
{$ifdef print}
writeln('wideupper: ',w1);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(9);
if (w4 <> w2) then
doerror(10);
end;
{ lower case testing with a missing utf-16 pair at the end, followed by a normal char }
procedure testlowerinvalid1;
var
s: ansistring;
w1,w2,w3,w4: widestring;
i: longint;
w1,w2: widestring;
begin
{ missing utf-16 pair at end with char after it}
w1:='AÉ'#0'ÈÀŁ'#$d87e'J';
@ -384,34 +155,19 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
w3:=s;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=widelowercase(w1);
{$ifdef print}
writeln('widelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(11);
if (w4 <> w2) then
doerror(12);
end;
{ upper case testing with corrupting the utf-8 string after conversion }
procedure testupperinvalid2;
var
s: ansistring;
w1,w2,w3,w4: widestring;
i: longint;
w1,w2: widestring;
begin
w1:='aé'#0'èàł'#$d87e#$dc04'ö';
w2:='AÉ'#0'ÈÀŁ'#$d87e#$dc04'Ö';
@ -420,42 +176,19 @@ begin
writeln('original: ',w1);
writeln('original upper: ',w2);
{$endif print}
s:=w1;
{ truncate the last utf-8 character }
setlength(s,length(s)-1);
w3:=s;
{ adjust checking values for new length due to corruption }
if length(w3)<>length(w2) then
begin
setlength(w2,length(w3));
setlength(w1,length(w3));
end;
w4:=AnsiUpperCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=wideuppercase(w1);
{$ifdef print}
writeln('wideupper: ',w1);
writeln('ansiupper: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(13);
if (w4 <> w2) then
doerror(14);
end;
{ lower case testing with corrupting the utf-8 string after conversion }
procedure testlowerinvalid2;
var
s: ansistring;
w1,w2,w3,w4: widestring;
i: longint;
w1,w2: widestring;
begin
w1:='AÉ'#0'ÈÀŁ'#$d87e#$dc04'Ö';
w2:='aé'#0'èàł'#$d87e#$dc04'ö';
@ -464,46 +197,20 @@ begin
writeln('original: ',w1);
writeln('original lower: ',w2);
{$endif print}
s:=w1;
{ truncate the last utf-8 character }
setlength(s,length(s)-1);
w3:=s;
{ adjust checking values for new length due to corruption }
if length(w3)<>length(w2) then
begin
setlength(w2,length(w3));
setlength(w1,length(w3));
end;
w4:=AnsiLowerCase(s);
{ filter out unsupported characters }
for i:=1 to length(w3) do
if w3[i]='?' then
begin
w2[i]:='?';
w1[i]:='?';
end;
w1:=widelowercase(w1);
{$ifdef print}
writeln('widelower: ',w1);
writeln('ansilower: ',w4);
{$endif print}
if (w1 <> w2) then
doerror(15);
if (w4 <> w2) then
doerror(16);
end;
begin
testupper;
writeln;
testupperu;
writeln;
testlower;
writeln;
testloweru;
writeln;
writeln;
testupperinvalid;
writeln;