{ 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ } {$ifdef fpc} {$mode delphi} {$modeswitch unicodestrings} {$endif fpc} {$ifdef go32v2} {$define USE_INTERNAL_UNICODE} {$endif} {$ifdef USE_INTERNAL_UNICODE} {$define USE_FPWIDESTRING_UNIT} {$define USE_UNICODEDUCET_UNIT} {$define USE_CPALL_UNIT} {$endif} uses {$ifndef USE_INTERNAL_UNICODE} {$ifdef unix} {$ifdef darwin}iosxwstr{$else}cwstring{$endif}, {$endif unix} {$endif not USE_INTERNAL_UNICODE} {$ifdef USE_UNICODEDUCET_UNIT} unicodeducet, {$endif} {$ifdef USE_FPWIDESTRING_UNIT} fpwidestring, {$endif} {$ifdef USE_CPALL_UNIT} cpall, {$endif} 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.