mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:29:27 +02:00
+ 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 -
This commit is contained in:
Jonas Maebe
parent
eb93429cf0
commit
746546ed09
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -195,24 +195,258 @@ Begin
|
||||
end;
|
||||
|
||||
|
||||
function strnew(p : PWideChar) : PWideChar; overload;
|
||||
var
|
||||
len : SizeInt;
|
||||
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);
|
||||
end;
|
||||
|
||||
function StrPas(Str: PWideChar): UnicodeString;overload;
|
||||
begin
|
||||
Result:=Str;
|
||||
end;
|
||||
|
||||
|
||||
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
|
||||
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);
|
||||
|
||||
@ -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
tests/test/units/sysutils/tstrcmp.pp
Normal file
132
tests/test/units/sysutils/tstrcmp.pp
Normal file
@ -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
tests/test/units/sysutils/twstrcmp.pp
Normal file
133
tests/test/units/sysutils/twstrcmp.pp
Normal file
@ -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
tests/webtbs/tw21443a.pp
Normal file
20
tests/webtbs/tw21443a.pp
Normal file
@ -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
tests/webtbs/tw3235a.pp
Normal file
20
tests/webtbs/tw3235a.pp
Normal file
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user