mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:29:29 +02:00
* completed cwstring unit
* optimized LowerWideString/UpperWideString not to call UniqueString
for each string character
* fixed LowerAnsiString/UpperAnsiString in case an ascii character
has a lower/uppercase version with a different length than 1
+ generic test for ansistring comparisons using on the widestring
manager (based on glibc test)
- removed ansi2ucs4-related stuff as it's not used/needed
git-svn-id: trunk@9440 -
This commit is contained in:
Jonas Maebe
parent
32921dcafb
commit
60ccf03a0b
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7407,6 +7407,7 @@ tests/test/units/system/tvalc.pp -text
|
||||
tests/test/units/sysutils/execansi.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/execedbya.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/extractquote.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/tastrcmp.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/tfile1.pp svneol=native#text/plain
|
||||
tests/test/units/sysutils/tfloattostr.pp -text
|
||||
tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
|
||||
|
||||
@ -46,20 +46,20 @@ Const
|
||||
{$endif}
|
||||
|
||||
{ helper functions from libc }
|
||||
function tolower(__wc:cint):cint;cdecl;external libiconvname name 'tolower';
|
||||
function toupper(__wc:cint):cint;cdecl;external libiconvname name 'toupper';
|
||||
function towlower(__wc:wint_t):wint_t;cdecl;external libiconvname name 'towlower';
|
||||
function towupper(__wc:wint_t):wint_t;cdecl;external libiconvname name 'towupper';
|
||||
function towlower(__wc:wint_t):wint_t;cdecl;external clib name 'towlower';
|
||||
function towupper(__wc:wint_t):wint_t;cdecl;external clib name 'towupper';
|
||||
|
||||
function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external libiconvname name 'wcscoll';
|
||||
function strcoll (__s1:pchar; __s2:pchar):cint;cdecl;external libiconvname name 'strcoll';
|
||||
function wcscoll (__s1:pwchar_t; __s2:pwchar_t):cint;cdecl;external clib name 'wcscoll';
|
||||
function strcoll (__s1:pchar; __s2:pchar):cint;cdecl;external clib name 'strcoll';
|
||||
function setlocale(category: cint; locale: pchar): pchar; cdecl; external clib name 'setlocale';
|
||||
{$ifndef beos}
|
||||
function mbrtowc(pwc: pwchar_t; const s: pchar; n: size_t; ps: pmbstate_t): size_t; cdecl; external clib name 'mbrtowc';
|
||||
function wcrtomb(s: pchar; wc: wchar_t; ps: pmbstate_t): size_t; cdecl; external clib name 'wcrtomb';
|
||||
function mbrlen(const s: pchar; n: size_t; ps: pmbstate_t): size_t; cdecl; external clib name 'mbrlen';
|
||||
{$else beos}
|
||||
function mbtowc(pwc: pwchar_t; const s: pchar; n: size_t): size_t; cdecl; external clib name 'mbtowc';
|
||||
function wctomb(s: pchar; wc: wchar_t): size_t; cdecl; external clib name 'wctomb';
|
||||
function mblen(const s: pchar; n: size_t): size_t; cdecl; external clib name 'mblen';
|
||||
{$endif beos}
|
||||
|
||||
|
||||
@ -109,6 +109,13 @@ const
|
||||
unicode_encoding4 = 'UCS-4BE';
|
||||
{$endif FPC_LITTLE_ENDIAN}
|
||||
|
||||
{ en_US.UTF-8 needs maximally 6 chars, UCS-4/UTF-32 needs 4 }
|
||||
{ -> 10 should be enough? Should actually use MB_CUR_MAX, but }
|
||||
{ that's a libc macro mapped to internal functions/variables }
|
||||
{ and thus not a stable external API on systems where libc }
|
||||
{ breaks backwards compatibility every now and then }
|
||||
MB_CUR_MAX = 10;
|
||||
|
||||
type
|
||||
piconv_t = ^iconv_t;
|
||||
iconv_t = pointer;
|
||||
@ -127,9 +134,10 @@ function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppc
|
||||
function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'libiconv_close';
|
||||
{$endif}
|
||||
|
||||
procedure fpc_rangeerror; [external name 'FPC_RANGEERROR'];
|
||||
|
||||
|
||||
threadvar
|
||||
iconv_ansi2ucs4,
|
||||
iconv_ucs42ansi,
|
||||
iconv_ansi2wide,
|
||||
iconv_wide2ansi : iconv_t;
|
||||
|
||||
@ -270,8 +278,8 @@ function LowerWideString(const s : WideString) : WideString;
|
||||
i : SizeInt;
|
||||
begin
|
||||
SetLength(result,length(s));
|
||||
for i:=1 to length(s) do
|
||||
result[i]:=WideChar(towlower(wint_t(s[i])));
|
||||
for i:=0 to length(s)-1 do
|
||||
pwidechar(result)[i]:=WideChar(towlower(wint_t(s[i+1])));
|
||||
end;
|
||||
|
||||
|
||||
@ -280,8 +288,8 @@ function UpperWideString(const s : WideString) : WideString;
|
||||
i : SizeInt;
|
||||
begin
|
||||
SetLength(result,length(s));
|
||||
for i:=1 to length(s) do
|
||||
result[i]:=WideChar(towupper(wint_t(s[i])));
|
||||
for i:=0 to length(s)-1 do
|
||||
pwidechar(result)[i]:=WideChar(towupper(wint_t(s[i+1])));
|
||||
end;
|
||||
|
||||
|
||||
@ -319,12 +327,7 @@ begin
|
||||
ConcatCharToAnsiStr(char(nc),s,index)
|
||||
else
|
||||
begin
|
||||
{ en_US.UTF-8 needs maximally 6 chars, UCS-4/UTF-32 needs 4 }
|
||||
{ -> 10 should be enough? Should actually use MB_CUR_MAX, but }
|
||||
{ that's a libc macro mapped to internal functions/variables }
|
||||
{ and thus not a stable external API on systems where libc }
|
||||
{ breaks backwards compatibility every now and then }
|
||||
EnsureAnsiLen(s,index+10);
|
||||
EnsureAnsiLen(s,index+MB_CUR_MAX);
|
||||
{$ifndef beos}
|
||||
mblen:=wcrtomb(p,wchar_t(nc),@mbstate);
|
||||
{$else not beos}
|
||||
@ -365,46 +368,44 @@ function LowerAnsiString(const s : AnsiString) : AnsiString;
|
||||
begin
|
||||
if (s[i]<=#127) then
|
||||
begin
|
||||
ConcatCharToAnsiStr(char(tolower(cint(s[i]))),result,resindex);
|
||||
inc(i)
|
||||
wc:=wchar_t(s[i]);
|
||||
mblen:= 1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$ifndef beos}
|
||||
mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
|
||||
mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
|
||||
{$else not beos}
|
||||
mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
|
||||
mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
|
||||
{$endif not beos}
|
||||
case mblen of
|
||||
size_t(-2):
|
||||
begin
|
||||
{ partial invalid character, copy literally }
|
||||
while (i<=slen) do
|
||||
begin
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
size_t(-1), 0:
|
||||
begin
|
||||
{ invalid or null character }
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
else
|
||||
begin
|
||||
{ a valid sequence }
|
||||
{ even if mblen = 1, the lowercase version may have a }
|
||||
{ different length }
|
||||
{ We can't do anything special if wchar_t is 16 bit... }
|
||||
case mblen of
|
||||
size_t(-2):
|
||||
begin
|
||||
{ partial invalid character, copy literally }
|
||||
while (i<=slen) do
|
||||
begin
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
size_t(-1), 0:
|
||||
begin
|
||||
{ invalid or null character }
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
else
|
||||
begin
|
||||
{ a valid sequence }
|
||||
{ even if mblen = 1, the lowercase version may have a }
|
||||
{ different length }
|
||||
{ We can't do anything special if wchar_t is 16 bit... }
|
||||
{$ifndef beos}
|
||||
ConcatUTF32ToAnsiStr(towlower(wint_t(wc)),result,resindex,nmbstate);
|
||||
ConcatUTF32ToAnsiStr(towlower(wint_t(wc)),result,resindex,nmbstate);
|
||||
{$else not beos}
|
||||
ConcatUTF32ToAnsiStr(towlower(wint_t(wc)),result,resindex);
|
||||
ConcatUTF32ToAnsiStr(towlower(wint_t(wc)),result,resindex);
|
||||
{$endif not beos}
|
||||
inc(i,mblen);
|
||||
end;
|
||||
end;
|
||||
inc(i,mblen);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SetLength(result,resindex-1);
|
||||
@ -434,109 +435,50 @@ function UpperAnsiString(const s : AnsiString) : AnsiString;
|
||||
begin
|
||||
if (s[i]<=#127) then
|
||||
begin
|
||||
ConcatCharToAnsiStr(char(toupper(cint(s[i]))),result,resindex);
|
||||
inc(i)
|
||||
wc:=wchar_t(s[i]);
|
||||
mblen:= 1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$ifndef beos}
|
||||
mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
|
||||
mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
|
||||
{$else not beos}
|
||||
mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
|
||||
mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
|
||||
{$endif beos}
|
||||
case mblen of
|
||||
size_t(-2):
|
||||
begin
|
||||
{ partial invalid character, copy literally }
|
||||
while (i<=slen) do
|
||||
begin
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
size_t(-1), 0:
|
||||
begin
|
||||
{ invalid or null character }
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
else
|
||||
begin
|
||||
{ a valid sequence }
|
||||
{ even if mblen = 1, the uppercase version may have a }
|
||||
{ different length }
|
||||
{ We can't do anything special if wchar_t is 16 bit... }
|
||||
case mblen of
|
||||
size_t(-2):
|
||||
begin
|
||||
{ partial invalid character, copy literally }
|
||||
while (i<=slen) do
|
||||
begin
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
size_t(-1), 0:
|
||||
begin
|
||||
{ invalid or null character }
|
||||
ConcatCharToAnsiStr(s[i],result,resindex);
|
||||
inc(i);
|
||||
end;
|
||||
else
|
||||
begin
|
||||
{ a valid sequence }
|
||||
{ even if mblen = 1, the uppercase version may have a }
|
||||
{ different length }
|
||||
{ We can't do anything special if wchar_t is 16 bit... }
|
||||
{$ifndef beos}
|
||||
ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex,nmbstate);
|
||||
ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex,nmbstate);
|
||||
{$else not beos}
|
||||
ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex);
|
||||
ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex);
|
||||
{$endif not beos}
|
||||
inc(i,mblen);
|
||||
end;
|
||||
end;
|
||||
inc(i,mblen);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SetLength(result,resindex-1);
|
||||
end;
|
||||
|
||||
|
||||
procedure Ansi2UCS4Move(source:pchar;var dest:UCS4String;len:SizeInt);
|
||||
var
|
||||
outlength,
|
||||
outoffset,
|
||||
outleft : size_t;
|
||||
err: cint;
|
||||
srcpos,
|
||||
destpos: pchar;
|
||||
mynil : pchar;
|
||||
my0 : size_t;
|
||||
begin
|
||||
mynil:=nil;
|
||||
my0:=0;
|
||||
// extra space
|
||||
outlength:=len+1;
|
||||
setlength(dest,outlength);
|
||||
outlength:=len+1;
|
||||
srcpos:=source;
|
||||
destpos:=pchar(dest);
|
||||
outleft:=outlength*4;
|
||||
while iconv(iconv_ansi2ucs4,@srcpos,psize(@len),@destpos,@outleft)=size_t(-1) do
|
||||
begin
|
||||
err:=fpgetCerrno;
|
||||
case err of
|
||||
ESysEINVAL,
|
||||
ESysEILSEQ:
|
||||
begin
|
||||
{ skip and set to '?' }
|
||||
inc(srcpos);
|
||||
dec(len);
|
||||
plongint(destpos)^:=longint('?');
|
||||
inc(destpos,4);
|
||||
dec(outleft,4);
|
||||
{ reset }
|
||||
iconv(iconv_ansi2ucs4,@mynil,@my0,@mynil,@my0);
|
||||
if err=ESysEINVAL then
|
||||
break;
|
||||
end;
|
||||
ESysE2BIG:
|
||||
begin
|
||||
outoffset:=destpos-pchar(dest);
|
||||
{ extend }
|
||||
setlength(dest,outlength+len);
|
||||
inc(outleft,len*4);
|
||||
inc(outlength,len);
|
||||
{ string could have been moved }
|
||||
destpos:=pchar(dest)+outoffset;
|
||||
end;
|
||||
else
|
||||
runerror(231);
|
||||
end;
|
||||
end;
|
||||
// truncate string
|
||||
setlength(dest,length(dest)-outleft div 4);
|
||||
end;
|
||||
|
||||
|
||||
function utf16toutf32(const S: WideString; const index: SizeInt; out len: longint): UCS4Char; external name 'FPC_UTF16TOUTF32';
|
||||
|
||||
function WideStringToUCS4StringNoNulls(const s : WideString) : UCS4String;
|
||||
@ -582,18 +524,169 @@ function CompareTextWideString(const s1, s2 : WideString): PtrInt;
|
||||
end;
|
||||
|
||||
|
||||
function CharLengthPChar(const Str: PChar): PtrInt;
|
||||
var
|
||||
nextlen: ptrint;
|
||||
s: pchar;
|
||||
{$ifndef beos}
|
||||
mbstate: mbstate_t;
|
||||
{$endif not beos}
|
||||
begin
|
||||
result:=0;
|
||||
s:=str;
|
||||
repeat
|
||||
{$ifdef beos}
|
||||
nextlen:=ptrint(mblen(str,MB_CUR_MAX));
|
||||
{$else beos}
|
||||
nextlen:=ptrint(mbrlen(str,MB_CUR_MAX,@mbstate));
|
||||
{$endif beos}
|
||||
{ skip invalid/incomplete sequences }
|
||||
if (nextlen<0) then
|
||||
nextlen:=1;
|
||||
inc(result,nextlen);
|
||||
inc(s,nextlen);
|
||||
until (nextlen=0);
|
||||
end;
|
||||
|
||||
|
||||
function StrCompAnsiIntern(const s1,s2 : PChar; len1, len2: PtrInt): PtrInt;
|
||||
var
|
||||
a,b: pchar;
|
||||
i: PtrInt;
|
||||
begin
|
||||
getmem(a,len1+1);
|
||||
getmem(b,len2+1);
|
||||
for i:=0 to len1-1 do
|
||||
if s1[i]<>#0 then
|
||||
a[i]:=s1[i]
|
||||
else
|
||||
a[i]:=#32;
|
||||
a[len1]:=#0;
|
||||
for i:=0 to len2-1 do
|
||||
if s2[i]<>#0 then
|
||||
b[i]:=s2[i]
|
||||
else
|
||||
b[i]:=#32;
|
||||
b[len2]:=#0;
|
||||
result:=strcoll(a,b);
|
||||
freemem(a);
|
||||
freemem(b);
|
||||
end;
|
||||
|
||||
|
||||
function CompareStrAnsiString(const s1, s2: ansistring): PtrInt;
|
||||
begin
|
||||
result:=StrCompAnsiIntern(pchar(s1),pchar(s2),length(s1),length(s2));
|
||||
end;
|
||||
|
||||
|
||||
function StrCompAnsi(s1,s2 : PChar): PtrInt;
|
||||
begin
|
||||
result:=strcoll(s1,s2);
|
||||
end;
|
||||
|
||||
|
||||
function AnsiCompareText(const S1, S2: ansistring): PtrInt;
|
||||
var
|
||||
a, b: AnsiString;
|
||||
begin
|
||||
a:=UpperAnsistring(s1);
|
||||
b:=UpperAnsistring(s2);
|
||||
result:=StrCompAnsiIntern(pchar(a),pchar(b),length(a),length(b));
|
||||
end;
|
||||
|
||||
|
||||
function AnsiStrIComp(S1, S2: PChar): PtrInt;
|
||||
begin
|
||||
result:=AnsiCompareText(ansistring(s1),ansistring(s2));
|
||||
end;
|
||||
|
||||
|
||||
function AnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
|
||||
var
|
||||
a, b: pchar;
|
||||
begin
|
||||
if (IndexChar(s1^,maxlen,#0)<0) then
|
||||
begin
|
||||
getmem(a,maxlen+1);
|
||||
move(s1^,a^,maxlen);
|
||||
a[maxlen]:=#0;
|
||||
end
|
||||
else
|
||||
a:=s1;
|
||||
if (IndexChar(s2^,maxlen,#0)<0) then
|
||||
begin
|
||||
getmem(b,maxlen+1);
|
||||
move(s2^,b^,maxlen);
|
||||
b[maxlen]:=#0;
|
||||
end
|
||||
else
|
||||
b:=s2;
|
||||
result:=strcoll(a,b);
|
||||
if (a<>s1) then
|
||||
freemem(a);
|
||||
if (b<>s2) then
|
||||
freemem(b);
|
||||
end;
|
||||
|
||||
|
||||
function AnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
|
||||
var
|
||||
a, b: ansistring;
|
||||
len1,len2: SizeInt;
|
||||
begin
|
||||
len1:=IndexChar(s1^,maxlen,#0);
|
||||
if (len1<0) then
|
||||
len1:=maxlen;
|
||||
setlength(a,len1);
|
||||
if (len1<>0) then
|
||||
move(s1^,a[1],len1);
|
||||
len2:=IndexChar(s2^,maxlen,#0);
|
||||
if (len2<0) then
|
||||
len2:=maxlen;
|
||||
setlength(b,len2);
|
||||
if (len2<>0) then
|
||||
move(s2^,b[1],len2);
|
||||
result:=AnsiCompareText(a,b);
|
||||
end;
|
||||
|
||||
|
||||
procedure ansi2pchar(const s: ansistring; const orgp: pchar; out p: pchar);
|
||||
var
|
||||
newlen: sizeint;
|
||||
begin
|
||||
newlen:=length(s);
|
||||
if newlen>strlen(orgp) then
|
||||
fpc_rangeerror;
|
||||
p:=orgp;
|
||||
if (newlen>0) then
|
||||
move(s[1],p[0],newlen);
|
||||
p[newlen]:=#0;
|
||||
end;
|
||||
|
||||
|
||||
function AnsiStrLower(Str: PChar): PChar;
|
||||
var
|
||||
temp: ansistring;
|
||||
begin
|
||||
temp:=upperansistring(str);
|
||||
ansi2pchar(temp,str,result);
|
||||
end;
|
||||
|
||||
|
||||
function AnsiStrUpper(Str: PChar): PChar;
|
||||
var
|
||||
temp: ansistring;
|
||||
begin
|
||||
temp:=loweransistring(str);
|
||||
ansi2pchar(temp,str,result);
|
||||
end;
|
||||
|
||||
|
||||
procedure InitThread;
|
||||
begin
|
||||
iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding2);
|
||||
iconv_ansi2wide:=iconv_open(unicode_encoding2,nl_langinfo(CODESET));
|
||||
iconv_ucs42ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding4);
|
||||
iconv_ansi2ucs4:=iconv_open(unicode_encoding4,nl_langinfo(CODESET));
|
||||
end;
|
||||
|
||||
|
||||
@ -603,10 +696,6 @@ begin
|
||||
iconv_close(iconv_wide2ansi);
|
||||
if (iconv_ansi2wide <> iconv_t(-1)) then
|
||||
iconv_close(iconv_ansi2wide);
|
||||
if (iconv_ucs42ansi <> iconv_t(-1)) then
|
||||
iconv_close(iconv_ucs42ansi);
|
||||
if (iconv_ansi2ucs4 <> iconv_t(-1)) then
|
||||
iconv_close(iconv_ansi2ucs4);
|
||||
end;
|
||||
|
||||
|
||||
@ -625,23 +714,19 @@ begin
|
||||
|
||||
CompareWideStringProc:=@CompareWideString;
|
||||
CompareTextWideStringProc:=@CompareTextWideString;
|
||||
{
|
||||
CharLengthPCharProc
|
||||
}
|
||||
|
||||
CharLengthPCharProc:=@CharLengthPChar;
|
||||
|
||||
UpperAnsiStringProc:=@UpperAnsiString;
|
||||
LowerAnsiStringProc:=@LowerAnsiString;
|
||||
{
|
||||
CompareStrAnsiStringProc
|
||||
CompareTextAnsiStringProc
|
||||
}
|
||||
CompareStrAnsiStringProc:=@CompareStrAnsiString;
|
||||
CompareTextAnsiStringProc:=@AnsiCompareText;
|
||||
StrCompAnsiStringProc:=@StrCompAnsi;
|
||||
{
|
||||
StrICompAnsiStringProc
|
||||
StrLCompAnsiStringProc
|
||||
StrLICompAnsiStringProc
|
||||
StrLowerAnsiStringProc
|
||||
StrUpperAnsiStringProc
|
||||
}
|
||||
StrICompAnsiStringProc:=@AnsiStrIComp;
|
||||
StrLCompAnsiStringProc:=@AnsiStrLComp;
|
||||
StrLICompAnsiStringProc:=@AnsiStrLIComp;
|
||||
StrLowerAnsiStringProc:=@AnsiStrLower;
|
||||
StrUpperAnsiStringProc:=@AnsiStrUpper;
|
||||
ThreadInitProc:=@InitThread;
|
||||
ThreadFiniProc:=@FiniThread;
|
||||
end;
|
||||
|
||||
167
tests/test/units/sysutils/tastrcmp.pp
Normal file
167
tests/test/units/sysutils/tastrcmp.pp
Normal file
@ -0,0 +1,167 @@
|
||||
{ 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 testAnsiCompareText;
|
||||
begin
|
||||
teststr:='AnsiCompareText';
|
||||
check(ansicomparetext('a', 'a') = 0, 1);
|
||||
check(ansicomparetext('a', 'A') = 0, 2);
|
||||
check(ansicomparetext('A', 'a') = 0, 3);
|
||||
check(ansicomparetext('a', 'b') < 0, 4);
|
||||
check(ansicomparetext('c', 'b') > 0, 5);
|
||||
check(ansicomparetext('abc', 'AbC') = 0, 6);
|
||||
check(ansicomparetext('0123456789', '0123456789') = 0, 7);
|
||||
check(ansicomparetext('', '0123456789') < 0, 8);
|
||||
check(ansicomparetext('AbC', '') > 0, 9);
|
||||
check(ansicomparetext('AbC', 'A') > 0, 10);
|
||||
check(ansicomparetext('AbC', 'Ab') > 0, 11);
|
||||
check(ansicomparetext('AbC', 'ab') > 0, 12);
|
||||
check(ansicomparetext('Ab'#0'C', 'ab'#0) > 0, 13);
|
||||
end;
|
||||
|
||||
|
||||
procedure testAnsiStrIComp;
|
||||
begin
|
||||
teststr:='AnsiStrIComp';
|
||||
check(ansistricomp('a', 'a') = 0, 1);
|
||||
check(ansistricomp('a', 'A') = 0, 2);
|
||||
check(ansistricomp('A', 'a') = 0, 3);
|
||||
check(ansistricomp('a', 'b') < 0, 4);
|
||||
check(ansistricomp('c', 'b') > 0, 5);
|
||||
check(ansistricomp('abc', 'AbC') = 0, 6);
|
||||
check(ansistricomp('0123456789', '0123456789') = 0, 7);
|
||||
check(ansistricomp('', '0123456789') < 0, 8);
|
||||
check(ansistricomp('AbC', '') > 0, 9);
|
||||
check(ansistricomp('AbC', 'A') > 0, 10);
|
||||
check(ansistricomp('AbC', 'Ab') > 0, 11);
|
||||
check(ansistricomp('AbC', 'ab') > 0, 12);
|
||||
check(ansistricomp('Ab'#0'C', 'ab'#0) = 0, 13);
|
||||
end;
|
||||
|
||||
|
||||
procedure testAnsiStrLComp;
|
||||
begin
|
||||
teststr:='AnsiStrIComp';
|
||||
check (ansistrlcomp ('', '', 99) = 0, 1); { Trivial case. }
|
||||
check (ansistrlcomp ('a', 'a', 99) = 0, 2); { Identity. }
|
||||
check (ansistrlcomp ('abc', 'abc', 99) = 0, 3); { Multicharacter. }
|
||||
check (ansistrlcomp ('abc', 'abcd', 99) < 0, 4); { Length unequal. }
|
||||
check (ansistrlcomp ('abcd', 'abc', 99) > 0, 5);
|
||||
check (ansistrlcomp ('abcd', 'abce', 99) < 0, 6); { Honestly unequal. }
|
||||
check (ansistrlcomp ('abce', 'abcd', 99) > 0, 7);
|
||||
check (ansistrlcomp ('abce', 'abcd', 3) = 0, 10); { Count limited. }
|
||||
check (ansistrlcomp ('abce', 'abc', 3) = 0, 11); { Count = length. }
|
||||
check (ansistrlcomp ('abcd', 'abce', 4) < 0, 12); { Nudging limit. }
|
||||
check (ansistrlcomp ('abc', 'def', 0) = 0, 13); { Zero count. }
|
||||
check (ansistrlcomp ('abc'#0'e', 'abc'#0'd', 99) = 0, 14);
|
||||
end;
|
||||
|
||||
|
||||
procedure testAnsiCompareStr;
|
||||
begin
|
||||
teststr:='AnsiCompareStr';
|
||||
check (ansicomparestr ('', '') = 0, 1); { Trivial case. }
|
||||
check (ansicomparestr ('a', 'a') = 0, 2); { Identity. }
|
||||
check (ansicomparestr ('abc', 'abc') = 0, 3); { Multicharacter. }
|
||||
check (ansicomparestr ('abc', 'abcd') < 0, 4); { Length mismatches. }
|
||||
check (ansicomparestr ('abcd', 'abc') > 0, 5);
|
||||
check (ansicomparestr ('abcd', 'abce') < 0, 6); { Honest miscompares. }
|
||||
check (ansicomparestr ('abce', 'abcd') > 0, 7);
|
||||
check (ansicomparestr ('abc'#0'e', 'abc'#0'd') > 0, 8);
|
||||
end;
|
||||
|
||||
|
||||
procedure testAnsiStrComp;
|
||||
begin
|
||||
teststr:='AnsiStrComp';
|
||||
check (ansistrcomp ('', '') = 0, 1); { Trivial case. }
|
||||
check (ansistrcomp ('a', 'a') = 0, 2); { Identity. }
|
||||
check (ansistrcomp ('abc', 'abc') = 0, 3); { Multicharacter. }
|
||||
check (ansistrcomp ('abc', 'abcd') < 0, 4); { Length mismatches. }
|
||||
check (ansistrcomp ('abcd', 'abc') > 0, 5);
|
||||
check (ansistrcomp ('abcd', 'abce') < 0, 6); { Honest miscompares. }
|
||||
check (ansistrcomp ('abce', 'abcd') > 0, 7);
|
||||
check (ansistrcomp ('abc'#0'e', 'abc'#0'd') = 0, 8);
|
||||
end;
|
||||
|
||||
|
||||
procedure testAnsiStrLIComp;
|
||||
begin
|
||||
teststr:='AnsiStrLIComp';
|
||||
check(ansistrlicomp('a', 'a', 5) = 0, 1);
|
||||
check(ansistrlicomp('a', 'A', 5) = 0, 2);
|
||||
check(ansistrlicomp('A', 'a', 5) = 0, 3);
|
||||
check(ansistrlicomp('a', 'b', 5) < 0, 4);
|
||||
check(ansistrlicomp('c', 'b', 5) > 0, 5);
|
||||
check(ansistrlicomp('abc', 'AbC', 5) = 0, 6);
|
||||
check(ansistrlicomp('0123456789', '0123456789', 10) = 0, 7);
|
||||
check(ansistrlicomp('', '0123456789', 10) < 0, 8);
|
||||
check(ansistrlicomp('AbC', '', 5) > 0, 9);
|
||||
check(ansistrlicomp('AbC', 'A', 5) > 0, 10);
|
||||
check(ansistrlicomp('AbC', 'Ab', 5) > 0, 11);
|
||||
check(ansistrlicomp('AbC', 'ab', 5) > 0, 12);
|
||||
check(ansistrlicomp('0123456789', 'AbC', 0) = 0, 13);
|
||||
check(ansistrlicomp('AbC', 'abc', 1) = 0, 14);
|
||||
check(ansistrlicomp('AbC', 'abc', 2) = 0, 15);
|
||||
check(ansistrlicomp('AbC', 'abc', 3) = 0, 16);
|
||||
check(ansistrlicomp('AbC', 'abcd', 3) = 0, 17);
|
||||
check(ansistrlicomp('AbC', 'abcd', 4) < 0, 18);
|
||||
check(ansistrlicomp('ADC', 'abcd', 1) = 0, 19);
|
||||
check(ansistrlicomp('ADC', 'abcd', 2) > 0, 20);
|
||||
check(ansistrlicomp('abc'#0'e', 'abc'#0'd', 99) = 0, 21);
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
goterror:=false;
|
||||
testAnsiCompareText;
|
||||
testAnsiStrIComp;
|
||||
testAnsiStrLComp;
|
||||
testAnsiCompareStr;
|
||||
testAnsiStrComp;
|
||||
testAnsiStrLIComp;
|
||||
if goterror then
|
||||
halt(1);
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user