home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
TPL60N19
/
TESTPRGS
/
ROUNDTST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-12
|
3KB
|
115 lines
{$N+}
USES Fun1_TP6;
VAR X,Y,Z: REAL;
I,II,LL,L,K: LONGINT;
XA:ARRAY [1..6] OF BYTE ABSOLUTE X;
BEGIN
Y := 4.5;
Z := 5.5;
WriteLn ('Testing implementation of Round/Trunc for correct range and IEEE-rounding');
WriteLn;
WriteLn;
Write ('Testing range of Round towards lower limit ... ');
X := -2147483647.0;
REPEAT
I := Round_TP60 (X);
(* WriteLn (X+2147483648.0);*)
X := X - 1.0/256.0;
UNTIL X <= -2147483648.5;
WriteLn ('passed');
WriteLn;
Write ('Testing range of Round towards upper limit ... ');
X := 2147483647.0;
REPEAT
I := Round_TP60 (X);
(* writeln (x-2147483648.0);*)
X := X + 1.0/256.0;
UNTIL X >= 2147483647.5;
WriteLn ('passed');
WriteLn;
Write ('Testing range of Trunc towards lower limit ... ');
X := -2147483647.0;
REPEAT
I := Trunc_TP60 (X);
(* writeln (x+2147483648.0);*)
X := X - 1.0/256.0;
UNTIL X <= -2147483649.0;
WriteLn ('passed');
WriteLn;
Write ('Testing range of Trunc towards upper limit ... ');
X := 2147483647.0;
REPEAT
I := Trunc_TP60 (X);
(* writeln (x-2147483648.0);*)
X := X + 1.0/256.0;
UNTIL X >= 2147483648.0;
WriteLn ('passed');
WriteLn;
Write ('Round (4.5) should be: 4, actual value is: ', Round (Y));
IF Round_Tp60 (Y) = 4 THEN
WriteLn (' passed')
ELSE
WriteLn (' failed');
Write ('Round (5.5) should be: 6, actual value is: ', Round (Z));
IF Round_TP60 (Z) = 6 THEN
WriteLn (' passed')
ELSE
WriteLn (' failed');
WriteLn;
Y := -4.5;
Z := -5.5;
Write ('Round (-4.5) should be:-4, actual value is:', Round (Y));
IF Round_Tp60 (Y) =-4 THEN
WriteLn (' passed')
ELSE
WriteLn (' failed');
Write ('Round (-5.5) should be:-6, actual value is:', Round (Z));
IF Round_TP60 (Z) =-6 THEN
WriteLn (' passed')
ELSE
WriteLn (' failed');
WriteLn;
WriteLn ('Testing full range of Trunc and Round functions');
WriteLn;
WriteLn;
X := 0.0;
WHILE X < 2147483647.0 DO BEGIN
I := Trunc_TP60 (X);
II:= Trunc (X);
L := Round_TP60 (X);
LL:= Round (X);
IF I <> II THEN BEGIN
WriteLn;
WriteLn ('Error in Trunc:', X, I:10, II:10);
END;
IF L <> LL THEN BEGIN
WriteLn;
WriteLn ('Error in Round:', X, L:10, LL:10);
FOR K := 1 to 6 do begin
Write(XA[k]:4);
end; {endfor}
writeln;
END;
I := Trunc_TP60 (-X);
II:= Trunc (-X);
L := Round_TP60 (-X);
LL:= Round (-X);
IF I <> II THEN BEGIN
WriteLn;
WriteLn ('Error in Trunc:', X, I:10, II:10);
END;
IF L <> LL THEN BEGIN
WriteLn;
WriteLn ('Error in Round:', X, L:10, LL:10);
END;
IF (I AND $FF) = 0 THEN
Write (#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8#8, 'X= ', X);
X := X + 0.5;
END;
WriteLn;
WriteLn ('Test complete!');
END.