paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-25 18:12:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

* added test counting

Browse Source 
git-svn-id: trunk@7131 -
This commit is contained in:
pierre 2007-04-18 09:04:52 +00:00
parent 2cf09d68f7
commit 761a086728
1 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
tests/test/units/system/tval.pp
View File

@ -3,6 +3,8 @@ const
HasErrors : boolean = false; HasErrors : boolean = false;
Silent : boolean = false; Silent : boolean = false;
CheckVal : boolean = true; CheckVal : boolean = true;
SuccessCount : longint = 0;
FailCount : longint = 0;
type type
TCharSet = set of char; TCharSet = set of char;
@ -56,7 +58,9 @@ procedure TestVal(comment,s : string; ExpectedRes : ValTestType; expected : long
var var
i : longint; i : longint;
err,err1 : word; err,err1 : word;
OK : boolean;
begin begin
OK:=false;
if not silent and (Comment<>'') then if not silent and (Comment<>'') then
Writeln(Comment); Writeln(Comment);
Val(s,i,err); Val(s,i,err);
@ -70,6 +74,7 @@ begin
end end
else else
begin begin
OK:=true;
if not silent then if not silent then
Writeln('Correct: string ',Display(s), Writeln('Correct: string ',Display(s),
' is a not valid input for val function'); ' is a not valid input for val function');
@ -79,6 +84,7 @@ begin
begin begin
if err=0 then if err=0 then
begin begin
OK:=true;
if not silent then if not silent then
Writeln('Correct: string ',Display(s), Writeln('Correct: string ',Display(s),
' is a valid input for val function'); ' is a valid input for val function');
@ -105,6 +111,7 @@ begin
Val(Copy(s,1,err1-1),i,err); Val(Copy(s,1,err1-1),i,err);
if err=0 then if err=0 then
begin begin
OK:=true;
if not silent then if not silent then
Writeln('Correct: string ',Display(s), Writeln('Correct: string ',Display(s),
' is a valid input for val function up to position ',err1); ' is a valid input for val function up to position ',err1);
@ -120,10 +127,15 @@ begin
end; end;
if (err=0) and CheckVal and (i<>expected) then if (err=0) and CheckVal and (i<>expected) then
begin begin
OK:=false;
Writeln('Error: string ',Display(s), Writeln('Error: string ',Display(s),
' value is ',i,' <> ',expected); ' value is ',i,' <> ',expected);
HasErrors:=true; HasErrors:=true;
end; end;
if OK then
inc(SuccessCount)
else
inc(FailCount);
end; end;
Procedure TestBase(Const Prefix : string;ValidChars : TCharSet); Procedure TestBase(Const Prefix : string;ValidChars : TCharSet);
@ -283,9 +295,9 @@ begin
if HasErrors then if HasErrors then
begin begin
Writeln('At least one test failed'); Writeln(FailCount,' tests failed over ',SuccessCount+FailCount);
Halt(1); Halt(1);
end end
else else
Writeln('All tests succeeded'); Writeln('All tests succeeded count=',SuccessCount);
end. end.