Bladeren bron

+ remaining missing pwidechar overloads/equivalents of pchar functions
(strecopy, strend, strcat, strcomp, strlcomp, stricomp, strlcat, strrscan,
strlower, strupper, strlicomp, strpos, WideStrAlloc, StrBufSize,
StrDispose)
* adjusted pwidechar version of strnew to call WideStrAlloc instead of
StrAlloc
+ tests for several newly added sysutils pwidechar routines based on
existing tests for equivalent pchar routines
* converted several sysutils ansistr*() function tests to tests for str*
functions

git-svn-id: branches/cpstrrtl@24998 -

Jonas Maebe 12 jaren geleden
bovenliggende
commit
746546ed09

+ 4 - 0
.gitattributes

@@ -12102,8 +12102,10 @@ tests/test/units/sysutils/tformat.pp svneol=native#text/plain
 tests/test/units/sysutils/tlocale.pp svneol=native#text/plain
 tests/test/units/sysutils/trwsync.pp svneol=native#text/plain
 tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
+tests/test/units/sysutils/tstrcmp.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
 tests/test/units/sysutils/tunifile.pp svneol=native#text/plain
+tests/test/units/sysutils/twstrcmp.pp svneol=native#text/plain
 tests/test/units/ucomplex/tcsqr1.pp svneol=native#text/pascal
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
 tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
@@ -13341,6 +13343,7 @@ tests/webtbs/tw21329.pp svneol=native#text/pascal
 tests/webtbs/tw21350a.pp svneol=native#text/pascal
 tests/webtbs/tw21350b.pp svneol=native#text/pascal
 tests/webtbs/tw21443.pp svneol=native#text/plain
+tests/webtbs/tw21443a.pp svneol=native#text/plain
 tests/webtbs/tw2145.pp svneol=native#text/plain
 tests/webtbs/tw21457.pp svneol=native#text/pascal
 tests/webtbs/tw21472.pp svneol=native#text/pascal
@@ -13669,6 +13672,7 @@ tests/webtbs/tw3226.pp svneol=native#text/plain
 tests/webtbs/tw3227.pp svneol=native#text/plain
 tests/webtbs/tw3227a.pp svneol=native#text/plain
 tests/webtbs/tw3235.pp svneol=native#text/plain
+tests/webtbs/tw3235a.pp svneol=native#text/plain
 tests/webtbs/tw3241a.pp svneol=native#text/plain
 tests/webtbs/tw3252.pp svneol=native#text/plain
 tests/webtbs/tw3255.pp svneol=native#text/plain

+ 246 - 12
rtl/objpas/sysutils/sysuni.inc

@@ -195,24 +195,258 @@ Begin
 end;
 
 
-function strnew(p : PWideChar) : PWideChar; overload;
-var
-  len : SizeInt;
+function StrPas(Str: PWideChar): UnicodeString;overload;
 begin
-  Result:=nil;
-  if (p=nil) or (p^=#0) then
-   exit;
-  len:=strlen(p)+1;
-  Result:=PWideChar(StrAlloc(Len*2));
-  if Result<>nil then
-   strmove(Result,p,len);
+  Result:=Str;
 end;
 
-function StrPas(Str: PWideChar): UnicodeString;overload;
+
+function strecopy(dest,source : pwidechar) : pwidechar;
+  var
+    counter: sizeint;
+  begin
+    counter := indexword(source^,-1,0);
+    { counter+1 will move zero terminator }
+    move(source^,dest^,(counter+1)*2);
+    result:=dest+counter;
+  end;
+
+
+function strend(p : pwidechar) : pwidechar;
+  begin
+    result:=p+indexword(p^,-1,0);
+  end;
+
+
+function strcat(dest,source : pwidechar) : pwidechar;
+  begin
+    strcopy(strend(dest),source);
+    strcat:=dest;
+  end;
+
+
+function strcomp(str1,str2 : pwidechar) : SizeInt;
+  var
+    counter: sizeint;
+    c1, c2: widechar;
+  begin
+    counter:=0;
+    repeat
+      c1:=str1[counter];
+      c2:=str2[counter];
+      inc(counter);
+    until (c1<>c2) or
+          (c1=#0) or
+          (c2=#0);
+    strcomp:=ord(c1)-ord(c2);
+  end;
+
+
+function strlcomp(str1,str2 : pwidechar;l : SizeInt) : SizeInt;
+  var
+    counter: sizeint;
+    c1, c2: widechar;
+  begin
+    if l = 0 then
+      begin
+        strlcomp := 0;
+        exit;
+      end;
+    counter:=0;
+    repeat
+      c1:=str1[counter];
+      c2:=str2[counter];
+      inc(counter);
+   until (c1<>c2) or (counter>=l) or
+         (c1=#0) or (c2=#0);
+    strlcomp:=ord(c1)-ord(c2);
+  end;
+
+
+{ the str* functions are not supposed to support internationalisation;
+  system.upcase(widechar) does support it (although this is
+  Delphi-incompatible) }
+function simplewideupcase(w: widechar): widechar;
+  begin
+    if w in ['a'..'z'] then
+      result:=widechar(ord(w)-32)
+    else
+      result:=w;
+  end;
+
+
+function stricomp(str1,str2 : pwidechar) : SizeInt;
+  var
+   counter: sizeint;
+   c1, c2: widechar;
+  begin
+    counter := 0;
+    c1:=simplewideupcase(str1[counter]);
+    c2:=simplewideupcase(str2[counter]);
+    while c1=c2 do
+      begin
+        if (c1=#0) or (c2=#0) then break;
+        inc(counter);
+        c1:=simplewideupcase(str1[counter]);
+        c2:=simplewideupcase(str2[counter]);
+      end;
+    stricomp:=ord(c1)-ord(c2);
+  end;
+
+
+function strlcat(dest,source : pwidechar;l : SizeInt) : pwidechar;
+  var
+    destend : pwidechar;
+  begin
+    destend:=strend(dest);
+    dec(l,destend-dest);
+    if l>0 then
+      strlcopy(destend,source,l);
+    strlcat:=dest;
+  end;
+
+
+function strrscan(p : pwidechar;c : widechar) : pwidechar;
+  var
+   count: sizeint;
+   index: sizeint;
+  begin
+    count:=strlen(p);
+    { As in Borland Pascal , if looking for NULL return null }
+    if c=#0 then
+      begin
+        strrscan:=@(p[count]);
+        exit;
+      end;
+    dec(count);
+    for index:=count downto 0 do
+      begin
+        if c=p[index] then
+          begin
+            strrscan:=@(p[index]);
+            exit;
+          end;
+      end;
+    { nothing found. }
+    strrscan:=nil;
+  end;
+
+
+function strlower(p : pwidechar) : pwidechar;
+  var
+   counter: SizeInt;
+   c: widechar;
+  begin
+    counter:=0;
+    repeat
+      c:=p[counter];
+      if c in [#65..#90] then
+        p[counter]:=widechar(ord(c)+32);
+      inc(counter);
+    until c=#0;
+    strlower:=p;
+  end;
+
+
+function strupper(p : pwidechar) : pwidechar;
+  var
+   counter: SizeInt;
+   c: widechar;
+  begin
+    counter:=0;
+    repeat
+      c:=p[counter];
+      if c in [#97..#122] then
+        p[counter]:=widechar(ord(c)-32);
+      inc(counter);
+    until c=#0;
+    strupper:=p;
+  end;
+
+
+function strlicomp(str1,str2 : pwidechar;l : SizeInt) : SizeInt;
+  var
+   counter: sizeint;
+   c1, c2: char;
+  begin
+    counter := 0;
+    if l=0 then
+      begin
+        strlicomp := 0;
+        exit;
+      end;
+    repeat
+      c1:=simplewideupcase(str1[counter]);
+      c2:=simplewideupcase(str2[counter]);
+      if (c1=#0) or (c2=#0) then break;
+      inc(counter);
+    until (c1<>c2) or (counter>=l);
+    strlicomp:=ord(c1)-ord(c2);
+  end;
+
+
+function strpos(str1,str2 : pwidechar) : pwidechar;
+  var
+    p : pwidechar;
+    lstr2 : SizeInt;
+  begin
+    strpos:=nil;
+    if (str1=nil) or (str2=nil) then
+      exit;
+    p:=strscan(str1,str2^);
+    if p=nil then
+       exit;
+    lstr2:=strlen(str2);
+    while p<>nil do
+      begin
+        if strlcomp(p,str2,lstr2)=0 then
+          begin
+             strpos:=p;
+             exit;
+          end;
+        inc(p);
+        p:=strscan(p,str2^);
+      end;
+  end;
+
+
+function strnew(p : pwidechar) : pwidechar; overload;
+  var
+    len: sizeint;
+  begin
+    len:=strlen(p)+1;
+    result:=WideStrAlloc(Len);
+    if result<>nil then
+      strmove(result,p,len);
+  end;
+
+
+function WideStrAlloc(Size: cardinal): PWideChar;
+  begin
+    getmem(result,size*2+sizeof(cardinal));
+    cardinal(pointer(result)^):=size*2+sizeof(cardinal);
+    inc(result,sizeof(cardinal));
+  end;
+
+function StrBufSize(str: pwidechar): SizeUInt;
+  begin
+    if assigned(str) then
+      result:=cardinal(pointer(str-sizeof(cardinal))^)-sizeof(cardinal)
+    else
+      result := 0;
+  end;
+
+procedure StrDispose(str: pwidechar);
 begin
-  Result:=Str;
+  if assigned(str) then
+   begin
+     dec(str,sizeof(cardinal));
+     freemem(str,cardinal(pointer(str)^));
+   end;
 end;
 
+
+
 function BytesOf(const Val: UnicodeString): TBytes;
 begin
   Result:=TEncoding.Default.GetBytes(Val);

+ 18 - 0
rtl/objpas/sysutils/sysunih.inc

@@ -40,6 +40,24 @@ function strnew(p : PWideChar) : PWideChar; overload;
 
 function StrPas(Str: PWideChar): UnicodeString;overload;
 
+function strecopy(dest,source : pwidechar) : pwidechar;
+function strend(p : pwidechar) : pwidechar;
+function strcat(dest,source : pwidechar) : pwidechar;
+function strcomp(str1,str2 : pwidechar) : SizeInt;
+function strlcomp(str1,str2 : pwidechar;l : SizeInt) : SizeInt;
+function stricomp(str1,str2 : pwidechar) : SizeInt;
+function strlcat(dest,source : pwidechar;l : SizeInt) : pwidechar;
+function strrscan(p : pwidechar;c : widechar) : pwidechar;
+function strlower(p : pwidechar) : pwidechar;
+function strupper(p : pwidechar) : pwidechar;
+function strlicomp(str1,str2 : pwidechar;l : SizeInt) : SizeInt;
+function strpos(str1,str2 : pwidechar) : pwidechar;
+
+function WideStrAlloc(size: cardinal): pwidechar;
+function StrBufSize(str: pwidechar): Cardinal;
+procedure StrDispose(str: pwidechar);
+
+
 function BytesOf(const Val: UnicodeString): TBytes; overload;
 function BytesOf(const Val: WideChar): TBytes; overload;
 function StringOf(const Bytes: TBytes): UnicodeString;

+ 132 - 0
tests/test/units/sysutils/tstrcmp.pp

@@ -0,0 +1,132 @@
+{ based on string/tester.c of glibc 2.3.6
+
+* Tester for string functions.
+   Copyright (C) 1995-2000, 2001, 2003 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+}
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif fpc}
+
+uses
+{$ifdef unix}
+  cwstring,
+{$endif unix}
+  SysUtils;
+
+var
+  teststr: string;
+  goterror: boolean;
+
+procedure check(b: boolean; testnr: longint);
+begin
+  if not (b) then
+    begin
+      writeln(teststr,' error nr ',testnr);
+      goterror:=true;
+    end;
+end;
+
+procedure teststricomp;
+begin
+  teststr:='stricomp';
+  check(stricomp('a', 'a') = 0, 1);
+  check(stricomp('a', 'A') = 0, 2);
+  check(stricomp('A', 'a') = 0, 3);
+  check(stricomp('a', 'b') < 0, 4);
+  check(stricomp('c', 'b') > 0, 5);
+  check(stricomp('abc', 'AbC') = 0, 6);
+  check(stricomp('0123456789', '0123456789') = 0, 7);
+  check(stricomp('', '0123456789') < 0, 8);
+  check(stricomp('AbC', '') > 0, 9);
+  check(stricomp('AbC', 'A') > 0, 10);
+  check(stricomp('AbC', 'Ab') > 0, 11);
+  check(stricomp('AbC', 'ab') > 0, 12);
+  check(stricomp('Ab'#0'C', 'ab'#0) = 0, 13);
+end;
+
+
+procedure teststrlcomp;
+begin
+  teststr:='strlcomp';
+  check (strlcomp ('', '', 0) = 0, 1); { Trivial case. }
+  check (strlcomp ('a', 'a', 1) = 0, 2);       { Identity. }
+  check (strlcomp ('abc', 'abc', 3) = 0, 3);   { Multicharacter. }
+  check (strlcomp ('abc'#0, 'abcd', 4) < 0, 4);   { Length unequal. }
+  check (strlcomp ('abcd', 'abc'#0, 4) > 0, 5);
+  check (strlcomp ('abcd', 'abce', 4) < 0, 6);  { Honestly unequal. }
+  check (strlcomp ('abce', 'abcd', 4) > 0, 7);
+  check (strlcomp ('abce', 'abcd', 3) = 0, 10); { Count limited. }
+  check (strlcomp ('abce', 'abc', 3) = 0, 11);  { Count = length. }
+  check (strlcomp ('abcd', 'abce', 4) < 0, 12);  { Nudging limit. }
+  check (strlcomp ('abc', 'def', 0) = 0, 13);   { Zero count. }
+  check (strlcomp ('abc'#0'e', 'abc'#0'd', 5) = 0, 14);
+end;
+
+
+procedure teststrcomp;
+begin
+  teststr:='strcomp';
+  check (strcomp ('', '') = 0, 1);              { Trivial case. }
+  check (strcomp ('a', 'a') = 0, 2);            { Identity. }
+  check (strcomp ('abc', 'abc') = 0, 3);        { Multicharacter. }
+  check (strcomp ('abc', 'abcd') < 0, 4);        { Length mismatches. }
+  check (strcomp ('abcd', 'abc') > 0, 5);
+  check (strcomp ('abcd', 'abce') < 0, 6);       { Honest miscompares. }
+  check (strcomp ('abce', 'abcd') > 0, 7);
+  check (strcomp ('abc'#0'e', 'abc'#0'd') = 0, 8);
+end;
+
+
+procedure teststrlicomp;
+begin
+  teststr:='strlicomp';
+  check(strlicomp('a', 'a', 1) = 0, 1);
+  check(strlicomp('a', 'A', 1) = 0, 2);
+  check(strlicomp('A', 'a', 1) = 0, 3);
+  check(strlicomp('a', 'b', 1) < 0, 4);
+  check(strlicomp('c', 'b', 1) > 0, 5);
+  check(strlicomp('abc', 'AbC', 3) = 0, 6);
+  check(strlicomp('0123456789', '0123456789', 10) = 0, 7);
+  check(strlicomp(#0'123456789', #0'123456799', 10) = 0, 8);
+  check(strlicomp(#0'bD', #0'bC', 3) = 0, 9);
+  check(strlicomp('AbC', 'A'#0#0,3) > 0, 10);
+  check(strlicomp('AbC', 'Ab'#0, 3) > 0, 11);
+  check(strlicomp('AbC', 'ab'#0, 3) > 0, 12);
+  check(strlicomp('0123456789', 'AbC', 0) = 0, 13);
+  check(strlicomp('AbC', 'abc', 1) = 0, 14);
+  check(strlicomp('AbC', 'abc', 2) = 0, 15);
+  check(strlicomp('AbC', 'abc', 3) = 0, 16);
+  check(strlicomp('AbC', 'abcd', 3) = 0, 17);
+  check(strlicomp('AbCc', 'abcd', 4) < 0, 18);
+  check(strlicomp('ADC', 'abcd', 1) = 0, 19);
+  check(strlicomp('ADC', 'abcd', 2) > 0, 20);
+  check(strlicomp('abc'#0'e', 'abc'#0'd', 5) = 0, 21);
+end;
+
+
+begin
+  goterror:=false;
+  teststricomp;
+  teststrlcomp;
+  teststrcomp;
+  teststrlicomp;
+  if goterror then
+    halt(1);
+end.

+ 133 - 0
tests/test/units/sysutils/twstrcmp.pp

@@ -0,0 +1,133 @@
+{ based on string/tester.c of glibc 2.3.6
+
+* Tester for string functions.
+   Copyright (C) 1995-2000, 2001, 2003 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+}
+
+{$ifdef fpc}
+{$mode delphi}
+{$modeswitch unicodestrings}
+{$endif fpc}
+
+uses
+{$ifdef unix}
+  cwstring,
+{$endif unix}
+  SysUtils;
+
+var
+  teststr: string;
+  goterror: boolean;
+
+procedure check(b: boolean; testnr: longint);
+begin
+  if not (b) then
+    begin
+      writeln(teststr,' error nr ',testnr);
+      goterror:=true;
+    end;
+end;
+
+procedure teststricomp;
+begin
+  teststr:='stricomp';
+  check(stricomp(pwidechar('a'), pwidechar('a')) = 0, 1);
+  check(stricomp(pwidechar('a'), pwidechar('A')) = 0, 2);
+  check(stricomp(pwidechar('A'), pwidechar('a')) = 0, 3);
+  check(stricomp(pwidechar('a'), pwidechar('b')) < 0, 4);
+  check(stricomp(pwidechar('c'), pwidechar('b')) > 0, 5);
+  check(stricomp('abc', 'AbC') = 0, 6);
+  check(stricomp('0123456789', '0123456789') = 0, 7);
+  check(stricomp(pwidechar(''), '0123456789') < 0, 8);
+  check(stricomp('AbC', pwidechar('')) > 0, 9);
+  check(stricomp('AbC', pwidechar('A')) > 0, 10);
+  check(stricomp('AbC', 'Ab') > 0, 11);
+  check(stricomp('AbC', 'ab') > 0, 12);
+  check(stricomp('Ab'#0'C', 'ab'#0) = 0, 13);
+end;
+
+
+procedure teststrlcomp;
+begin
+  teststr:='strlcomp';
+  check (strlcomp ('', '', 0) = 0, 1); { Trivial case. }
+  check (strlcomp (pwidechar('a'), pwidechar('a'), 1) = 0, 2);       { Identity. }
+  check (strlcomp ('abc', 'abc', 3) = 0, 3);   { Multicharacter. }
+  check (strlcomp ('abc'#0, 'abcd', 4) < 0, 4);   { Length unequal. }
+  check (strlcomp ('abcd', 'abc'#0, 4) > 0, 5);
+  check (strlcomp ('abcd', 'abce', 4) < 0, 6);  { Honestly unequal. }
+  check (strlcomp ('abce', 'abcd', 4) > 0, 7);
+  check (strlcomp ('abce', 'abcd', 3) = 0, 10); { Count limited. }
+  check (strlcomp ('abce', 'abc', 3) = 0, 11);  { Count = length. }
+  check (strlcomp ('abcd', 'abce', 4) < 0, 12);  { Nudging limit. }
+  check (strlcomp ('abc', 'def', 0) = 0, 13);   { Zero count. }
+  check (strlcomp ('abc'#0'e', 'abc'#0'd', 5) = 0, 14);
+end;
+
+
+procedure teststrcomp;
+begin
+  teststr:='strcomp';
+  check (strcomp (pwidechar(''), pwidechar('')) = 0, 1);              { Trivial case. }
+  check (strcomp (pwidechar('a'), pwidechar('a')) = 0, 2);            { Identity. }
+  check (strcomp ('abc', 'abc') = 0, 3);        { Multicharacter. }
+  check (strcomp ('abc', 'abcd') < 0, 4);        { Length mismatches. }
+  check (strcomp ('abcd', 'abc') > 0, 5);
+  check (strcomp ('abcd', 'abce') < 0, 6);       { Honest miscompares. }
+  check (strcomp ('abce', 'abcd') > 0, 7);
+  check (strcomp ('abc'#0'e', 'abc'#0'd') = 0, 8);
+end;
+
+
+procedure teststrlicomp;
+begin
+  teststr:='strlicomp';
+  check(strlicomp(pwidechar('a'), pwidechar('a'), 1) = 0, 1);
+  check(strlicomp(pwidechar('a'), pwidechar('A'), 1) = 0, 2);
+  check(strlicomp(pwidechar('A'), pwidechar('a'), 1) = 0, 3);
+  check(strlicomp(pwidechar('a'), pwidechar('b'), 1) < 0, 4);
+  check(strlicomp(pwidechar('c'), pwidechar('b'), 1) > 0, 5);
+  check(strlicomp('abc', 'AbC', 3) = 0, 6);
+  check(strlicomp('0123456789', '0123456789', 10) = 0, 7);
+  check(strlicomp(#0'123456789', #0'123456799', 10) = 0, 8);
+  check(strlicomp(#0'bD', #0'bC', 3) = 0, 9);
+  check(strlicomp('AbC', 'A'#0#0,3) > 0, 10);
+  check(strlicomp('AbC', 'Ab'#0, 3) > 0, 11);
+  check(strlicomp('AbC', 'ab'#0, 3) > 0, 12);
+  check(strlicomp('0123456789', 'AbC', 0) = 0, 13);
+  check(strlicomp('AbC', 'abc', 1) = 0, 14);
+  check(strlicomp('AbC', 'abc', 2) = 0, 15);
+  check(strlicomp('AbC', 'abc', 3) = 0, 16);
+  check(strlicomp('AbC', 'abcd', 3) = 0, 17);
+  check(strlicomp('AbCc', 'abcd', 4) < 0, 18);
+  check(strlicomp('ADC', 'abcd', 1) = 0, 19);
+  check(strlicomp('ADC', 'abcd', 2) > 0, 20);
+  check(strlicomp('abc'#0'e', 'abc'#0'd', 5) = 0, 21);
+end;
+
+
+begin
+  goterror:=false;
+  teststricomp;
+  teststrlcomp;
+  teststrcomp;
+  teststrlicomp;
+  if goterror then
+    halt(1);
+end.

+ 20 - 0
tests/webtbs/tw21443a.pp

@@ -0,0 +1,20 @@
+uses
+  sysutils;
+
+var
+  p1, p2, p3, p4: pwidechar;
+begin
+
+ { StrECopy(Dest,Source) is equivalent to the following:
+    strcopy(Dest,Source);
+    StrECopy := StrEnd(Dest);
+  }
+  p1:='abcdefg';
+  getmem(p2,100);
+  p3:=strecopy(p2,p1);
+  fillchar(p2^,100,0);
+  strcopy(p2,p1);
+  p4:=strend(p2);
+  if p3<>p4 then
+    halt(1);
+end.

+ 20 - 0
tests/webtbs/tw3235a.pp

@@ -0,0 +1,20 @@
+program TestStrIComp;
+  uses
+    {$ifdef unix}cwstring,{$endif}
+    SysUtils;
+
+var l: longint;
+begin
+  l := StrIComp(pwidechar('abcdefghijklmnopqrstuvwxyz'), pwidechar('ABCDEFGHIJKLMNOPQRSTUVWXYZ'));
+  if (l <> 0) then
+    begin
+      writeln('error: expected 0, got ',l);
+      halt(1);
+    end;
+  l := StrIComp(pwidechar('ABCDEFGHIJKLMNOPQRSTUVWXYZ'),pwidechar('abcdefghijklmnopqrstuvwxyz'));
+  if (l <> 0) then
+    begin
+      writeln('error: expected 0, got ',l);
+      halt(1);
+    end;
+end.