mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 05:39:27 +02:00
1f96763b9d
jsstringh.inc -> use generic inc/sstrings.inc
* added a bunch of extra {$ifdef FPC_HAS_XXX} protections around
routines in inc/sstrings.inc and implemented those routines for
the JVM target in java/jsstrings.inc
* use the majority of the generic routine in sstrings.inc now also
for the JVM target! Only a few changes were needed:
o in a few places, calls to move() for copying shortstring->shortstring
or shortstring->chararray were replaced with calls to a new inline
helper that calls move() in the version in inc/sstrings.inc, and
JLSystem.arraycopt() in in the version in java/jsstrings.inc
o changed the currency argument to str() for the JVM target to constref
so its address can be taken (has to be typecasted to int64 without
changing the value), and similarly changed the temporary result
inside that routine to an array of 1 elements so the address can be
taken
o don't typecast the real value to a record type in str_real for the
JVM target, but work via an int64 instead to extract sign/mantissa/exp
o everything else compiled and worked as is!!
-> val, str, hexstr/octstr/binstr, delete, pos, insert, setstring and
comparetext now all work for shortstrings on the JVM target
git-svn-id: branches/jvmbackend@18836 -
281 lines
12 KiB
PHP
281 lines
12 KiB
PHP
|
|
{ Included by several source with different
|
|
definitions of the type
|
|
IntegerType
|
|
to check that the test is working for
|
|
all basic integer types }
|
|
|
|
|
|
procedure TestVal(comment,s : string; ExpectedRes : ValTestType; expected : IntegerType);
|
|
var
|
|
i : IntegerType;
|
|
err,err1 : word;
|
|
OK : boolean;
|
|
begin
|
|
OK:=false;
|
|
if not silent and (Comment<>'') then
|
|
Writeln(Comment);
|
|
Val(s,i,err);
|
|
if ExpectedRes=ValShouldFail then
|
|
begin
|
|
if err=0 then
|
|
begin
|
|
if not silent or not HasErrors then
|
|
begin
|
|
Write('Error: string ');write(Display(s));
|
|
writeln(' is a valid input for val function');
|
|
end;
|
|
HasErrors:=true;
|
|
end
|
|
else
|
|
begin
|
|
OK:=true;
|
|
if not silent then
|
|
begin
|
|
Write('Correct: string ');write(Display(s));
|
|
writeln(' is a not valid input for val function');
|
|
end;
|
|
end;
|
|
end
|
|
else if ExpectedRes=ValShouldSucceed then
|
|
begin
|
|
if err=0 then
|
|
begin
|
|
OK:=true;
|
|
if not silent then
|
|
begin
|
|
Write('Correct: string ');write(Display(s));
|
|
writeln(' is a valid input for val function');
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if not silent or not HasErrors then
|
|
begin
|
|
Write('Error: string ');write(Display(s));
|
|
write(' is a not valid input for val function');
|
|
write(' error pos=');writeln(err);
|
|
end;
|
|
HasErrors:=true;
|
|
end;
|
|
end
|
|
else if ExpectedRes=ValShouldSucceedAfterRemovingTrail then
|
|
begin
|
|
if err=0 then
|
|
begin
|
|
if not silent or not HasErrors then
|
|
begin
|
|
Write('Error: string ');write(Display(s));
|
|
writeln(' is a valid input for val function');
|
|
end;
|
|
HasErrors:=true;
|
|
end
|
|
else
|
|
begin
|
|
err1:=err;
|
|
Val(Copy(s,1,err1-1),i,err);
|
|
if err=0 then
|
|
begin
|
|
OK:=true;
|
|
if not silent then
|
|
begin
|
|
Write('Correct: string ');write(Display(s));
|
|
write(' is a valid input for val function up to position ');writeln(err1);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if not silent or not HasErrors then
|
|
begin
|
|
Write('Error: string ');write(Display(Copy(s,1,err1-1)));
|
|
write(' is a not valid input for val function');
|
|
write(' error pos=');writeln(err);
|
|
end;
|
|
HasErrors:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
if (err=0) and CheckVal and (i<>expected) then
|
|
begin
|
|
OK:=false;
|
|
if not silent or not HasErrors then
|
|
begin
|
|
Write('Error: string ');write(Display(s));
|
|
write(' value is ');write(jlong(i));write(' <> ');writeln(jlong(expected));
|
|
end;
|
|
HasErrors:=true;
|
|
end;
|
|
if OK then
|
|
inc(SuccessCount)
|
|
else
|
|
inc(FailCount);
|
|
end;
|
|
|
|
Procedure TestBase(Const Prefix : string;ValidChars : TCharSet);
|
|
var
|
|
i,j : longint;
|
|
st : string;
|
|
begin
|
|
CheckVal:=false;
|
|
Silent:=true;
|
|
for i:=0 to 255 do
|
|
begin
|
|
st:=prefix+chr(i);
|
|
if chr(i) in ValidChars then
|
|
TestVal('',st,ValShouldSucceed,0)
|
|
else
|
|
TestVal('',st,ValShouldFail,0);
|
|
end;
|
|
for i:=0 to 255 do
|
|
for j:=0 to 255 do
|
|
begin
|
|
st:=prefix+chr(i)+chr(j);
|
|
if (chr(i) in ValidChars) and
|
|
(chr(j) in ValidChars) then
|
|
TestVal('',st,ValShouldSucceed,0)
|
|
else
|
|
begin
|
|
if ((prefix<>'') or
|
|
(not (chr(i) in SpecialCharsFirst))) and
|
|
not (chr(j) in SpecialCharsSecond) then
|
|
TestVal('',st,ValShouldFail,0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function TestAll : boolean;
|
|
|
|
var
|
|
S : string;
|
|
begin
|
|
TestVal('Testing empty string','',ValShouldFail,0);
|
|
TestVal('Testing string with #0',#0,ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and no value','0x',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and no value','x',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and no value','X',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and no value','$',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and no value','%',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and no value','&',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and #0','0x'#0,ValShouldFail,0);
|
|
TestVal('Testing normal ''''0'''' string','0',ValShouldSucceed,0);
|
|
TestVal('Testing leading space',' 0',ValShouldSucceed,0);
|
|
TestVal('Testing leading 2 spaces',' 0',ValShouldSucceed,0);
|
|
TestVal('Testing leading 2 tabs',#9#9'0',ValShouldSucceed,0);
|
|
TestVal('Testing leading 3 spaces',' 0',ValShouldSucceed,0);
|
|
TestVal('Testing leading 3 tabs',#9#9#9'0',ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination',#9' 0',ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination',' '#9'0',ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination',' '#9' 0',ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination',#9' '#9' 0',ValShouldSucceed,0);
|
|
TestVal('Testing #0 following normal ''''0''','0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading space with trailing #0',' 0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading 2 spaces with trailing #0',' 0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading 2 tabs with trailing #0',#9#9'0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading 3 spaces with trailing #0',' 0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading 3 tabs with trailing #0',#9#9#9'0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination with trailing #0',#9' 0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination with trailing #0',' '#9'0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination with trailing #0',' '#9' 0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing leading space/tab combination with trailing #0',#9' '#9' 0'#0,ValShouldSucceed,0);
|
|
TestVal('Testing trailing space','0 ',ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing 2 spaces','0 ',ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing 2 tabs','0'#9#9,ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing 3 spaces','0 ',ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing 3 tabs','0'#9#9#9,ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing space/tab combination','0'#9' ',ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing space/tab combination','0 '#9,ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing space/tab combination','0 '#9' ',ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing trailing space/tab combination','0'#9' '#9' ',ValShouldSucceedAfterRemovingTrail,0);
|
|
TestVal('Testing several zeroes',' 00'#0,ValShouldSucceed,0);
|
|
TestVal('Testing normal zero','0',ValShouldSucceed,0);
|
|
TestVal('Testing several zeroes','00',ValShouldSucceed,0);
|
|
TestVal('Testing normal zero with leading space',' 0',ValShouldSucceed,0);
|
|
TestVal('Testing several zeroes with leading space',' 00',ValShouldSucceed,0);
|
|
TestVal('Testing string with base prefix and zero','0x0',ValShouldSucceed,0);
|
|
TestVal('Testing string with base prefix and zero','x0',ValShouldSucceed,0);
|
|
TestVal('Testing string with base prefix and zero','X0',ValShouldSucceed,0);
|
|
TestVal('Testing string with base prefix and zero','$0',ValShouldSucceed,0);
|
|
TestVal('Testing string with base prefix and zero','%0',ValShouldSucceed,0);
|
|
TestVal('Testing string with base prefix and zero','&0',ValShouldSucceed,0);
|
|
TestVal('Testing string with base prefix and one','0x1',ValShouldSucceed,1);
|
|
TestVal('Testing string with base prefix and one','x1',ValShouldSucceed,1);
|
|
TestVal('Testing string with base prefix and one','X1',ValShouldSucceed,1);
|
|
TestVal('Testing string with base prefix and one','$1',ValShouldSucceed,1);
|
|
TestVal('Testing string with base prefix and one','%1',ValShouldSucceed,1);
|
|
TestVal('Testing string with base prefix and one','&1',ValShouldSucceed,1);
|
|
TestVal('Testing string with base prefix and two','0x2',ValShouldSucceed,2);
|
|
TestVal('Testing string with base prefix and two','x2',ValShouldSucceed,2);
|
|
TestVal('Testing string with base prefix and two','X2',ValShouldSucceed,2);
|
|
TestVal('Testing string with base prefix and two','$2',ValShouldSucceed,2);
|
|
TestVal('Testing string with base prefix and two','%2',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and two','&2',ValShouldSucceed,2);
|
|
TestVal('Testing string with base prefix and seven','0x7',ValShouldSucceed,7);
|
|
TestVal('Testing string with base prefix and seven','x7',ValShouldSucceed,7);
|
|
TestVal('Testing string with base prefix and seven','X7',ValShouldSucceed,7);
|
|
TestVal('Testing string with base prefix and seven','$7',ValShouldSucceed,7);
|
|
TestVal('Testing string with base prefix and seven','%7',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and seven','&7',ValShouldSucceed,7);
|
|
TestVal('Testing string with base prefix and eight','0x8',ValShouldSucceed,8);
|
|
TestVal('Testing string with base prefix and eight','x8',ValShouldSucceed,8);
|
|
TestVal('Testing string with base prefix and eight','X8',ValShouldSucceed,8);
|
|
TestVal('Testing string with base prefix and eight','$8',ValShouldSucceed,8);
|
|
TestVal('Testing string with base prefix and eight','%8',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and eight','&8',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and nine','0x9',ValShouldSucceed,9);
|
|
TestVal('Testing string with base prefix and nine','x9',ValShouldSucceed,9);
|
|
TestVal('Testing string with base prefix and nine','X9',ValShouldSucceed,9);
|
|
TestVal('Testing string with base prefix and nine','$9',ValShouldSucceed,9);
|
|
TestVal('Testing string with base prefix and nine','%9',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and nine','&9',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "a"','0xa',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "a"','xa',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "a"','Xa',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "a"','$a',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "a"','%a',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "a"','&a',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "A"','0xA',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "A"','xA',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "A"','XA',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "A"','$A',ValShouldSucceed,10);
|
|
TestVal('Testing string with base prefix and "A"','%A',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "A"','&A',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "f"','0xf',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "f"','xf',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "f"','Xf',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "f"','$f',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "f"','%f',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "f"','&f',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "F"','0xF',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "F"','xF',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "F"','XF',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "F"','$F',ValShouldSucceed,15);
|
|
TestVal('Testing string with base prefix and "F"','%F',ValShouldFail,0);
|
|
TestVal('Testing string with base prefix and "F"','&F',ValShouldFail,0);
|
|
|
|
// TestVal('Testing -zero','-0',ValShouldSucceed,0);
|
|
TestVal('Testing +zero','+0',ValShouldSucceed,0);
|
|
TestVal('Testing - zero','- 0',ValShouldFail,0);
|
|
TestVal('Testing + zero','+ 0',ValShouldFail,0);
|
|
TestVal('Testing --zero','--0',ValShouldFail,0);
|
|
TestVal('Testing ++zero','++0',ValShouldFail,0);
|
|
TestVal('Testing -+zero','-+0',ValShouldFail,0);
|
|
|
|
TestBase('%', ValidNumeralsBase2);
|
|
TestBase('&', ValidNumeralsBase8);
|
|
TestBase('', ValidNumeralsBase10);
|
|
TestBase('0x', ValidNumeralsBase16);
|
|
|
|
if HasErrors then
|
|
begin
|
|
Write(FailCount);write(' tests failed over ');writeln(SuccessCount+FailCount);
|
|
end
|
|
else
|
|
begin
|
|
Write('All tests succeeded count=');writeln(SuccessCount);
|
|
end;
|
|
TestAll:=HasErrors;
|
|
|
|
end;
|
|
|