test: add more fpwidestring tests by Inoussa

git-svn-id: trunk@25311 -

.gitattributes

@@ -11984,9 +11984,25 @@ tests/test/units/fpcunit/tstrutils.lpi svneol=native#text/plain
 tests/test/units/fpcunit/tstrutils.lpr svneol=native#text/plain
 tests/test/units/fpwidestring/CollationTest_NON_IGNORABLE_SHORT.txt svneol=native#text/plain
 tests/test/units/fpwidestring/CollationTest_SHIFTED_SHORT.txt svneol=native#text/plain
+tests/test/units/fpwidestring/tcpstr13fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tcpstr17fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tcpstr18fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tcpstr9fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tcpstransistr2shortstringfpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tcpstransistr2widechararrayfpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tcpstrpchar2ansistrfpws.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tcpstrshortstr2ansistrfpws.pp svneol=native#text/pascal
 tests/test/units/fpwidestring/tuca1.pp svneol=native#text/pascal
 tests/test/units/fpwidestring/tuca2.pp svneol=native#text/pascal
 tests/test/units/fpwidestring/tucawsm.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tunistr1fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tunistr2fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tunistr6fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/tunistr7fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/twide1fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/twide2fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/twide6fpwidestring.pp svneol=native#text/pascal
+tests/test/units/fpwidestring/twide7fpwidestring.pp svneol=native#text/pascal
 tests/test/units/lineinfo/tlininfo.pp svneol=native#text/plain
 tests/test/units/math/tdivmod.pp svneol=native#text/plain
 tests/test/units/math/tmask.inc svneol=native#text/plain

tests/test/units/fpwidestring/tcpstr13fpwidestring.pp

@@ -0,0 +1,24 @@
+program tcpstr13;
+
+// check that copy operation converts from 866 to DefaultSystemCodePage encoding
+
+{$mode delphi}
+
+uses 
+  unicodeducet, fpwidestring, cp866;
+
+type
+  ts866 = type ansistring(866);
+
+var
+  s: ts866;
+  a: ansistring;
+begin
+  s:='abc'#$00A9#$00AE'123';
+//  if s[4] <> 'c' then
+//    halt(1);
+  a:=copy(s,1,4);
+  if stringcodepage(a)<>DefaultSystemCodePage then
+    halt(2);
+  writeln('ok');
+end.

tests/test/units/fpwidestring/tcpstr17fpwidestring.pp

@@ -0,0 +1,84 @@
+// to have correct test result with delphi set codepage option to 65001
+program tcpstr17;
+{$ifdef FPC}
+  {$mode delphi}
+  {$codepage utf8}
+{$endif}
+{$apptype console}
+
+uses
+  fpwidestring, 
+{$ifdef android}
+  cp1251,
+{$else}
+  cp866,
+{$endif}
+  unicodeducet;
+
+const
+{$ifdef android}
+  OemCP = 1251;
+{$else}
+  OemCP = 866;
+{$endif}
+
+type
+  TOEMStr = type AnsiString(OemCP);
+{$ifndef FPC}
+  TSystemCodePage = Word;
+const
+  CP_UTF8 = 65001;
+{$endif}
+
+procedure TestCodeConvRaw(const s: rawbytestring; const CodePage: TSystemCodePage);
+begin
+  WriteLn(StringCodePage(s), ' ',s);
+  if CodePage <> StringCodePage(s) then
+    halt(1);
+end;
+
+procedure TestCodeConvAnsi(const s: ansistring; const CodePage: TSystemCodePage);
+begin
+  WriteLn(StringCodePage(s), ' ',s);
+  if CodePage <> StringCodePage(s) then
+    halt(2);
+end;
+
+procedure TestCodeConvUTF(const s: utf8string; const CodePage: TSystemCodePage);
+begin
+  WriteLn(StringCodePage(s), ' ',s);
+  if CodePage <> StringCodePage(s) then
+    halt(3);
+end;
+
+var
+  u: unicodestring;
+  u8: utf8string;
+  s: ansistring;
+  oemstr: TOEMStr;
+begin
+  u := #$0141#$00F3#$0064#$017A;
+  u8 := u;
+  TestCodeConvRaw(u8, CP_UTF8);
+  // if UTF8 codepage is set in options S will have UTF8 codepage
+  s := u8;
+  TestCodeConvRaw(s, CP_UTF8);
+  TestCodeConvAnsi(u8, CP_UTF8);
+  TestCodeConvAnsi(s, CP_UTF8);
+  // converts to OemCP
+  oemstr := u8;
+  TestCodeConvRaw(oemstr, OemCP);
+  TestCodeConvAnsi(oemstr, DefaultSystemCodePage);
+  s := 'test';
+  TestCodeConvRaw(s, CP_UTF8);
+  // converts to System codepage
+  s := oemstr;
+  TestCodeConvRaw(s, DefaultSystemCodePage);
+  TestCodeConvUTF(s, DefaultSystemCodePage);
+  // outputs in source codepage instead of OEM
+  TestCodeConvRaw('привет', CP_UTF8);
+  // outputs in OEM codepage
+  TestCodeConvRaw(TOEMStr('привет'), OemCP);
+  
+  writeln('ok');
+end.

tests/test/units/fpwidestring/tcpstr18fpwidestring.pp

@@ -0,0 +1,41 @@
+// to have correct test result with delphi set codepage option to 866
+program tcpstr17;
+{$apptype console}
+{$ifdef fpc}
+  {$mode delphi}
+  {$codepage cp866}
+{$endif}
+
+uses
+  unicodeducet, fpwidestring, cp866;
+
+procedure TestRawByte(const Source: RawByteString; cp: word; const reason: integer);
+begin
+  Writeln(StringCodePage(Source), ' ', Source);
+  if StringCodePage(Source) <> cp then
+    halt(reason);
+end;
+
+const
+  test: array[0..4] of ansichar = 'test'#0;
+var
+  s: rawbytestring;
+  ss: shortstring;
+  c: ansichar;
+  w: widechar;
+begin
+  s := 'test';
+  ss := 'test';
+  TestRawByte(s, 866, 1);
+  TestRawByte(ss, DefaultSystemCodePage, 2);
+  TestRawByte(AnsiChar('t'), 866, 3);
+  c := 't';
+  TestRawByte(c, DefaultSystemCodePage, 4);
+  TestRawByte(WideChar('t'), 866, 5);
+  w := 't';
+  TestRawByte(w, DefaultSystemCodePage, 6);
+  TestRawByte(test, DefaultSystemCodePage, 7);
+  TestRawByte(PAnsiChar(@test[0]), DefaultSystemCodePage, 8);
+  
+  writeln('ok');
+end.

tests/test/units/fpwidestring/tcpstr9fpwidestring.pp

@@ -0,0 +1,18 @@
+{ %skiptarget=android }
+program tcpstr9;
+{$mode delphiunicode}
+{$apptype console}
+uses 
+  unicodeducet, fpwidestring;
+  
+begin
+  // this test can be only run with the compiler built right now on the
+  // same system
+  if StringCodePage(AnsiString('test')) <> DefaultSystemCodePage then
+  begin
+    WriteLn(StringCodePage(AnsiString('test')), ' <> ', DefaultSystemCodePage);
+    halt(1);
+  end;
+  Writeln('ok');
+end.
+

tests/test/units/fpwidestring/tcpstransistr2shortstringfpwidestring.pp

@@ -0,0 +1,31 @@
+{$apptype console}
+uses
+  unicodeducet, fpwidestring, cp866,
+  sysutils;
+  
+type  
+  ts866 = type AnsiString(866);
+
+  procedure doerror(ANumber : Integer);
+  begin
+    WriteLn('error ',ANumber);
+    Halt(ANumber);
+  end;
+
+var
+  s : ts866;
+  i : Integer;
+  ss : ShortString;
+begin
+  s := '123'#196#200#250;
+  ss := s;
+  if (Length(s) <> Length(ss)) then
+    doerror(1);
+  for i := 1 to Length(s) do
+    begin
+      if (Byte(ss[i]) <> Byte(s[i])) then
+        doerror(2)
+    end;
+
+  WriteLn('Ok');
+end.

tests/test/units/fpwidestring/tcpstransistr2widechararrayfpwidestring.pp

@@ -0,0 +1,36 @@
+uses
+{$ifdef unix}
+  cwstring,
+{$endif unix}
+  sysutils;
+  
+type  
+  ts850 = type AnsiString(850);
+
+  procedure doerror(ANumber : Integer);
+  begin
+    WriteLn('error ',ANumber);
+    Halt(ANumber);
+  end;
+
+var
+  x : ts850;
+  i : Integer;
+  ua : array[0..7] of UnicodeChar;
+  uc : UnicodeChar;
+  us : UnicodeString;
+begin
+  x := 'abc'#$00A9#$00AE'123';
+  ua := x;
+  us := x;
+  for i := 1 to Length(us) do
+    begin
+      uc := us[i];
+      if (uc <> ua[i-1]) then begin
+        writeln(i);
+        doerror(2);
+      end;
+    end;
+
+  WriteLn('Ok');
+end.

tests/test/units/fpwidestring/tcpstrpchar2ansistrfpws.pp

@@ -0,0 +1,50 @@
+uses
+  unicodeducet, fpwidestring, cp1252, cp866,
+  sysutils;
+  
+type  
+  ts866 = type AnsiString(866);
+  ts1252 = type AnsiString(1252);
+
+  procedure doerror(ANumber : Integer);
+  begin
+    WriteLn('error ',ANumber);
+    Halt(ANumber);
+  end;
+
+var
+  x : ts866;
+  i : Integer;
+  c : Integer;
+  p, pp : pansichar;
+  sa : ansistring;
+begin
+  p := 'abc'#190#250;
+  c := 5;
+  sa := p;
+  if (StringCodePage(sa) <> DefaultSystemCodePage) then
+    doerror(1);
+  if (Length(sa) <> c) then
+    doerror(2);
+  pp := p;
+  for i := 1 to Length(sa) do
+    begin
+      if (Byte(sa[i]) <> Byte(pp^)) then
+        doerror(3);
+      Inc(pp);
+    end;
+  x := p;
+  if (StringCodePage(x) <> 866) then
+    doerror(10);
+  if (Length(x) <> c) then
+    doerror(20);
+  pp := p;
+  for i := 1 to Length(x) do
+    begin
+      if (Byte(x[i]) <> Byte(pp^)) then
+        doerror(30);
+      Inc(pp);
+    end;
+
+  WriteLn('Ok');
+end.

tests/test/units/fpwidestring/tcpstrshortstr2ansistrfpws.pp

@@ -0,0 +1,47 @@
+{$mode objfpc} {$H+}
+uses
+  unicodeducet, fpwidestring, cp1252, cp866,
+  sysutils;
+  
+type  
+  ts866 = type AnsiString(866);
+  ts1252 = type AnsiString(1252);
+
+  procedure doerror(ANumber : Integer);
+  begin
+    WriteLn('error ',ANumber);
+    Halt(ANumber);
+  end;
+
+var
+  s : ts866;
+  x : ts1252;
+  ss : shortstring;
+  i : Integer;
+begin
+  ss := #128#156#196;
+
+  s := ss;
+  if (StringCodePage(s) <> 866) then
+    doerror(1);
+  if (Length(s) <> Length(ss)) then
+    doerror(2);
+  for i := 1 to Length(s) do
+    begin
+      if (Byte(s[i]) <> Byte(ss[i])) then
+        doerror(3)
+    end;
+
+  x := ss;
+  if (StringCodePage(x) <> 1252) then
+    doerror(4);
+  if (Length(x) <> Length(ss)) then
+    doerror(5);
+  for i := 1 to Length(x) do
+    begin
+      if (Byte(x[i]) <> Byte(ss[i])) then
+        doerror(6)
+    end;
+
+  WriteLn('Ok');
+end.

tests/test/units/fpwidestring/tunistr1fpwidestring.pp

@@ -0,0 +1,17 @@
+uses
+  unicodeducet, fpwidestring;
+
+var
+  w : unicodestring;
+  a : ansistring;
+
+begin
+  a:='A';
+  w:=a;
+  if w[1]<>#65 then
+    halt(1);
+  a:=w;
+  if a[1]<>'A' then
+    halt(1);
+  writeln('ok');
+end.

tests/test/units/fpwidestring/tunistr2fpwidestring.pp

@@ -0,0 +1,19 @@
+uses
+  unicodeducet, fpwidestring;
+
+var
+  i : longint;
+  w,w2 : unicodestring;
+  a : ansistring;
+
+begin
+  setlength(w,1000);
+  for i:=1 to 1000 do
+    w[i]:=widechar(i);
+  for i:=1 to 10 do
+    begin
+      a:=w;
+      w2:=a;
+    end;
+  writeln('ok');
+end.

tests/test/units/fpwidestring/tunistr6fpwidestring.pp

@@ -0,0 +1,229 @@
+{%skiptarget=wince}
+{$codepage utf-8}
+uses
+  unicodeducet, fpwidestring,
+  sysutils;
+
+procedure doerror(i : integer);
+  begin
+    writeln('Error: ',i);
+    halt(i);
+  end;
+
+
+{ normal upper case testing }
+procedure testupper;
+var
+  w1,w2: unicodestring;
+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}
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(1);
+
+  w1:='aéèàł'#$d87e#$dc04;
+  w2:='AÉÈÀŁ'#$d87e#$dc04;
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(21);
+end;
+
+
+{ normal lower case testing }
+procedure testlower;
+var
+  w1,w2: unicodestring;
+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}
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(3);
+
+
+  w1:='AÉÈÀŁ'#$d87e#$dc04;
+  w2:='aéèàł'#$d87e#$dc04;
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(3);
+end;
+
+
+
+{ upper case testing with a missing utf-16 pair at the end }
+procedure testupperinvalid;
+var
+  w1,w2: unicodestring;
+begin
+  { missing utf-16 pair at end }
+  w1:='aé'#0'èàł'#$d87e;
+  w2:='AÉ'#0'ÈÀŁ'#$d87e;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(5);
+end;
+
+
+{ lower case testing with a missing utf-16 pair at the end }
+procedure testlowerinvalid;
+var
+  w1,w2: unicodestring;
+begin
+  { missing utf-16 pair at end}
+  w1:='AÉ'#0'ÈÀŁ'#$d87e;
+  w2:='aé'#0'èàł'#$d87e;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(7);
+end;
+
+
+
+{ upper case testing with a missing utf-16 pair at the end, followed by a normal char }
+procedure testupperinvalid1;
+var
+  w1,w2: unicodestring;
+begin
+  { missing utf-16 pair at end with char after it}
+  w1:='aé'#0'èàł'#$d87e'j';
+  w2:='AÉ'#0'ÈÀŁ'#$d87e'J';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(9);
+end;
+
+
+{ lower case testing with a missing utf-16 pair at the end, followed by a normal char }
+procedure testlowerinvalid1;
+var
+  w1,w2: unicodestring;
+begin
+  { missing utf-16 pair at end with char after it}
+  w1:='AÉ'#0'ÈÀŁ'#$d87e'J';
+  w2:='aé'#0'èàł'#$d87e'j';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(11);
+end;
+
+
+{ upper case testing with corrupting the utf-8 string after conversion }
+procedure testupperinvalid2;
+var
+  w1,w2: unicodestring;
+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}
+  w1:=UnicodeUpperCase(w1);
+{$ifdef print}
+  writeln('unicodeupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(13);
+end;
+
+
+{ lower case testing with corrupting the utf-8 string after conversion }
+procedure testlowerinvalid2;
+var
+  w1,w2: unicodestring;
+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}
+  w1:=UnicodeLowerCase(w1);
+{$ifdef print}
+  writeln('unicodelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(15);
+end;
+
+
+
+begin
+  testupper;
+  writeln;
+  testlower;
+  writeln;
+  writeln;
+  testupperinvalid;
+  writeln;
+  testlowerinvalid;
+  writeln;
+  writeln;
+  testupperinvalid1;
+  writeln;
+  testlowerinvalid1;
+  writeln;
+  writeln;
+  testupperinvalid2;
+  writeln;
+  testlowerinvalid2;
+  writeln('ok');
+end.

tests/test/units/fpwidestring/tunistr7fpwidestring.pp

@@ -0,0 +1,46 @@
+{$codepage utf-8}
+
+uses
+  unicodeducet, fpwidestring,
+  sysutils;
+
+procedure testwcmp;
+var
+  w1,w2: unicodestring;
+  s: ansistring;
+begin
+  w1:='aécde';
+  { filter unsupported characters }
+  s:=w1;
+  w1:=s;
+  w2:=w1;
+
+  if (w1<>w2) then
+    halt(1);
+  w1[2]:='f';
+  if (w1=w2) or
+     WideSameStr(w1,w2) or
+     (WideCompareText(w1,w2)=0) or
+     (WideCompareStr(w1,w2)<0) or
+     (WideCompareStr(w2,w1)>0) then
+    halt(2);
+  w1[2]:=#0;
+  w2[2]:=#0;
+  if (w1<>w2) or
+     not WideSameStr(w1,w2) or
+     (WideCompareStr(w1,w2)<>0) or
+     (WideCompareText(w1,w2)<>0) then
+    halt(3);
+  w1[3]:='m';
+  if WideSameStr(w1,w2) or
+     (WideCompareText(w1,w2)=0) or
+     (WideCompareStr(w1,w2)<0) or
+     (WideCompareStr(w2,w1)>0) then
+    halt(4);
+end;
+
+
+begin
+  testwcmp;
+  writeln('ok');
+end.

tests/test/units/fpwidestring/twide1fpwidestring.pp

@@ -0,0 +1,27 @@
+uses
+  unicodeducet, fpwidestring;
+  
+var
+  w : widestring;
+  u : unicodestring;
+  a : ansistring;
+  
+begin
+  a:='A';
+  w:=a;
+  if w[1]<>#65 then
+    halt(1);
+  a:=w;
+  if a[1]<>'A' then
+    halt(2);
+  writeln('ok');
+
+  a:='A';
+  u:=a;
+  if u[1]<>#65 then
+    halt(3);
+  a:=u;
+  if a[1]<>'A' then
+    halt(4);
+  writeln('ok');
+end.

tests/test/units/fpwidestring/twide2fpwidestring.pp

@@ -0,0 +1,27 @@
+uses
+  unicodeducet, fpwidestring;
+
+var
+  i : longint;
+  w,w2 : widestring;
+  u,u2 : unicodestring;
+  a : ansistring;
+  
+begin
+  setlength(w,1000);
+  for i:=1 to 1000 do
+    w[i]:=widechar(i);
+  for i:=1 to 10 do
+    begin
+      a:=w;
+      w2:=a;
+    end;
+  setlength(u,1000);
+  for i:=1 to 1000 do
+    u[i]:=widechar(i);
+  for i:=1 to 10 do
+    begin
+      a:=u;
+      u2:=a;
+    end;
+end.

tests/test/units/fpwidestring/twide6fpwidestring.pp

@@ -0,0 +1,226 @@
+{%skiptarget=wince}
+{$codepage utf-8}
+uses
+  unicodeducet, fpwidestring,
+  sysutils;
+
+// {$define print}
+
+procedure doerror(i : integer);
+  begin
+    writeln('Error: ',i);
+    halt(i);
+  end;
+
+
+{ normal upper case testing (widestring) }
+procedure testupper;
+var
+  w1,w2: widestring;
+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}
+  w1:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(1);
+
+  w1:='aéèàł'#$d87e#$dc04;
+  w2:='AÉÈÀŁ'#$d87e#$dc04;
+  w1:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(21);
+end;
+
+
+{ normal lower case testing (widestring) }
+procedure testlower;
+var
+  w1,w2: widestring;
+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}
+  w1:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(3);
+
+
+  w1:='AÉÈÀŁ'#$d87e#$dc04;
+  w2:='aéèàł'#$d87e#$dc04;
+  w1:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(3);
+end;
+
+
+{ upper case testing with a missing utf-16 pair at the end }
+procedure testupperinvalid;
+var
+  w1,w2: widestring;
+begin
+  { missing utf-16 pair at end }
+  w1:='aé'#0'èàł'#$d87e;
+  w2:='AÉ'#0'ÈÀŁ'#$d87e;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  w1:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(5);
+end;
+
+
+{ lower case testing with a missing utf-16 pair at the end }
+procedure testlowerinvalid;
+var
+  w1,w2: widestring;
+begin
+  { missing utf-16 pair at end}
+  w1:='AÉ'#0'ÈÀŁ'#$d87e;
+  w2:='aé'#0'èàł'#$d87e;
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  w1:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(7);
+end;
+
+
+{ upper case testing with a missing utf-16 pair at the end, followed by a normal char }
+procedure testupperinvalid1;
+var
+  w1,w2: widestring;
+begin
+  { missing utf-16 pair at end with char after it}
+  w1:='aé'#0'èàł'#$d87e'j';
+  w2:='AÉ'#0'ÈÀŁ'#$d87e'J';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original upper: ',w2);
+{$endif print}
+  w1:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(9);
+end;
+
+
+{ lower case testing with a missing utf-16 pair at the end, followed by a normal char }
+procedure testlowerinvalid1;
+var
+  w1,w2: widestring;
+begin
+  { missing utf-16 pair at end with char after it}
+  w1:='AÉ'#0'ÈÀŁ'#$d87e'J';
+  w2:='aé'#0'èàł'#$d87e'j';
+{$ifdef print}
+// the utf-8 output can confuse the testsuite parser
+  writeln('original: ',w1);
+  writeln('original lower: ',w2);
+{$endif print}
+  w1:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(11);
+end;
+
+
+{ upper case testing with corrupting the utf-8 string after conversion }
+procedure testupperinvalid2;
+var
+  w1,w2: widestring;
+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}
+  w1:=wideuppercase(w1);
+{$ifdef print}
+  writeln('wideupper: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(13);
+end;
+
+
+{ lower case testing with corrupting the utf-8 string after conversion }
+procedure testlowerinvalid2;
+var
+  w1,w2: widestring;
+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}
+  w1:=widelowercase(w1);
+{$ifdef print}
+  writeln('widelower: ',w1);
+{$endif print}
+  if (w1 <> w2) then
+    doerror(15);
+end;
+
+
+begin
+  testupper;
+  writeln;
+  testlower;
+  writeln;
+  writeln;
+  testupperinvalid;
+  writeln;
+  testlowerinvalid;
+  writeln;
+  writeln;
+  testupperinvalid1;
+  writeln;
+  testlowerinvalid1;
+  writeln;
+  writeln;
+  testupperinvalid2;
+  writeln;
+  testlowerinvalid2;
+end.

tests/test/units/fpwidestring/twide7fpwidestring.pp

@@ -0,0 +1,46 @@
+{$codepage utf-8}
+
+uses
+  unicodeducet, fpwidestring,
+  sysutils;
+
+procedure testwcmp;
+var
+  w1,w2: widestring;
+  s: ansistring;
+begin
+  w1:='aécde';
+  { filter unsupported characters }
+  s:=w1;
+  w1:=s;
+  w2:=w1;
+  
+  if (w1<>w2) then
+    halt(1);
+  w1[2]:='f';
+  if (w1=w2) or
+     WideSameStr(w1,w2) or
+     (WideCompareText(w1,w2)=0) or
+     (WideCompareStr(w1,w2)<0) or
+     (WideCompareStr(w2,w1)>0) then
+    halt(2);
+  w1[2]:=#0;
+  w2[2]:=#0;
+  if (w1<>w2) or
+     not WideSameStr(w1,w2) or
+     (WideCompareStr(w1,w2)<>0) or
+     (WideCompareText(w1,w2)<>0) then
+    halt(3);
+  w1[3]:='m';
+  if WideSameStr(w1,w2) or
+     (WideCompareText(w1,w2)=0) or
+     (WideCompareStr(w1,w2)<0) or
+     (WideCompareStr(w2,w1)>0) then
+    halt(4);
+end;
+
+
+begin
+  testwcmp;
+  writeln('ok');
+end.