TestDReal.mesa
Copyright Ó 1989, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) July 5, 1989 9:04:45 pm PDT
DIRECTORY FloatingPointCommon, FloatingPointPrivate, DRealSupport, DRealFns;
TestDReal: PROGRAM
IMPORTS FloatingPointCommon, FloatingPointPrivate, DRealSupport, DRealFns = BEGIN
setHardwareCheck: BOOL ¬ FALSE;
PREAL: TYPE = POINTER TO REAL;
PDREAL: TYPE = POINTER TO DREAL;
Test routines
epsPlusR: REAL ¬ 1.0;
epsPlusD: DREAL ¬ 1.0;
TestSupport: PROC = {
xd: DREAL ¬ 4.5;
yd: DREAL ¬ 6.7;
xr: REAL ¬ 4.5;
yr: REAL ¬ 6.7;
epsR: REAL ¬ 1.0;
epsD: DREAL ¬ 1.0;
DebugPutString["TestSupport\n"];
DebugPutString["Computing REAL eps ... "];
DO
next: REAL ¬ epsR*0.5;
IF next+1.0 = 1.0 THEN {epsPlusR ¬ 1.0+epsR; EXIT};
epsR ¬ next;
ENDLOOP;
DebugPutString["epsR = "];
PutDReal[epsR];
DebugPutChar['\n];
DebugPutString["Computing DREAL eps ... "];
DO
next: DREAL ¬ epsD*0.5;
IF next+1.0 = 1.0 THEN {epsPlusD ¬ 1.0+epsD; EXIT};
epsD ¬ next;
ENDLOOP;
DebugPutString["epsD = "];
PutDReal[epsD];
DebugPutChar['\n];
DebugPutString["Example[zero] = "];
{
d: DREAL = DRealSupport.Example[zero];
PutDReal[d];
IF DRealSupport.Classify[d] # zero THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["Example[subnormal, TRUE] = "];
{
d: DREAL = DRealSupport.Example[subnormal, TRUE];
PutDReal[d];
IF DRealSupport.Classify[d] # subnormal THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["Example[subnormal, FALSE] = "];
{
d: DREAL = DRealSupport.Example[subnormal, FALSE];
PutDReal[d];
IF DRealSupport.Classify[d] # subnormal THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["Example[normal, TRUE] = "];
{
d: DREAL = DRealSupport.Example[normal, TRUE];
PutDReal[d];
IF DRealSupport.Classify[d] # normal THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["Example[normal, FALSE] = "];
{
d: DREAL = DRealSupport.Example[normal, FALSE];
PutDReal[d];
IF DRealSupport.Classify[d] # normal THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["Example[infinity] = "];
{
d: DREAL = DRealSupport.Example[infinity];
PutDReal[d];
IF DRealSupport.Classify[d] # infinity THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["Example[quiet] = "];
{
d: DREAL = DRealSupport.Example[quiet];
PutDReal[d];
IF DRealSupport.Classify[d] # quiet THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["Example[signaling] = "];
{
d: DREAL = DRealSupport.Example[signaling];
PutDReal[d];
IF DRealSupport.Classify[d] # signaling THEN DebugPutString[" <<Bad classification>>"];
};
DebugPutChar['\n];
DebugPutString["xd = "];
PutDReal[xd];
DebugPutString[", yd = "];
PutDReal[yd];
DebugPutString[", xr = "];
PutDReal[xr];
DebugPutString[", yr = "];
PutDReal[yr];
DebugPutChar['\n];
TestMixed[xd+yd, xr+yr, "addition (DREAL vs. REAL)", epsPlusR];
TestMixed[xd-yd, xr-yr, "subtraction (DREAL vs. REAL)", epsPlusR];
TestMixed[xd*yd, xr*yr, "multiplication (DREAL vs. REAL)", epsPlusR];
TestMixed[xd/yd, xr/yr, "division (DREAL vs. REAL)", epsPlusR];
TestMixed[xd**yd, xr**yr, "power (DREAL vs. REAL)", epsPlusR**yr];
DebugPutString["\n"];
};
TestFns: PROC = {
OPEN DRealFns;
DebugPutString["TestFns\n"];
TestDouble[Exp[Ln[4.7]], 4.7, "Exp[Ln[4.7]] = 4.7", epsPlusD];
TestDouble[Ln[Exp[4.7]], 4.7, "Ln[Exp[4.7]] = 4.7", epsPlusD];
TestDouble[SqRt[DREAL[4.7]*4.7], 4.7, "SqRt[4.7*4.7] = 4.7", SqRt[epsPlusD*epsPlusD]];
TestDouble[SqRt[0.0], 0.0, "SqRt[0.0] = 0.0", epsPlusD];
TestDouble[Sin[0.6]**2+Cos[0.6]**2, 1.0, "Sin[0.6]**2+Cos[0.6]**2 = 1.0", epsPlusD];
TestDouble[SinDeg[30.0], 0.5, "SinDeg[30.0] = 0.5", epsPlusD];
TestDouble[ArcTan[Tan[0.6], 1.0], 0.6, "ArcTan[Tan[0.6]] = 0.6", epsPlusD];
TestDouble[Gamma[4.0], 6.0, "Gamma[4.0] = 6.0", epsPlusD];
DebugPutString["\n"];
};
TestErrors: PROC = {
OPEN DRealFns;
quietNaN: DREAL = DRealSupport.Example[quiet];
infinity: DREAL = DRealSupport.Example[infinity];
ec: FloatingPointCommon.Exception;
DebugPutString["TestErrors\n"];
IF setHardwareCheck THEN {
[] ¬ FloatingPointPrivate.SetState[hardware];
IF FloatingPointPrivate.currentState # hardware THEN
DebugPutString["(could not set hardware checking)\n"];
};
{
ENABLE FloatingPointCommon.Error => {ec ¬ code; GO TO done};
one: DREAL ¬ 1.0;
zero: DREAL ¬ 0.0;
div: DREAL ¬ one/zero;
PrintClass[DRealSupport.Classify[div], "1.0/0.0 has class of "];
DebugPutString["\n"];
TestDouble[div, infinity, "1.0/0.0 = infinity", epsPlusD];
EXITS done => PrintCode[ec, "1.0/0.0"];
};
{
ENABLE FloatingPointCommon.Error => {ec ¬ code; GO TO done};
TestDouble[SqRt[-1.0], quietNaN, "SqRt[-1.0] = quietNaN", epsPlusD];
EXITS done => PrintCode[ec, "SqRt[-1.0]"];
};
{
ENABLE FloatingPointCommon.Error => {ec ¬ code; GO TO done};
TestDouble[Ln[0.0], quietNaN, "Ln[0.0] = quietNaN", epsPlusD];
EXITS done => PrintCode[ec, "Ln[0.0]"];
};
{
ENABLE FloatingPointCommon.Error => {ec ¬ code; GO TO done};
TestDouble[Ln[-1.0], quietNaN, "Ln[-1.0] = quietNaN", epsPlusD];
EXITS done => PrintCode[ec, "Ln[-1.0]"];
};
DebugPutString["\n"];
};
Support routines
DebugPutString: PROC [s: STRING] = {
IF s # NIL THEN FOR i: NAT IN [0..s.length) DO DebugPutChar[s[i]]; ENDLOOP;
};
PutDReal: PROC [d: DREAL] = {
buffer: CharBufferRep ¬ ALL[0C];
LocalSprintDReal[@buffer, @d];
FOR i: NAT IN CharBufferIndex DO
c: CHAR = buffer[i];
IF c = 0C THEN EXIT;
DebugPutChar[c];
ENDLOOP;
};
PutReal: PROC [r: REAL] = {
buffer: CharBufferRep ¬ ALL[0C];
LocalSprintReal[@buffer, @r];
FOR i: NAT IN CharBufferIndex DO
c: CHAR = buffer[i];
IF c = 0C THEN EXIT;
DebugPutChar[c];
ENDLOOP;
};
CharBuffer: TYPE = POINTER TO CharBufferRep;
CharBufferRep: TYPE = PACKED ARRAY CharBufferIndex OF CHAR;
CharBufferIndex: TYPE = [0..20);
TestMixed: PROC [d: DREAL, r: REAL, msg: STRING, factor: REAL] = {
DebugPutString["Testing: "];
DebugPutString[msg];
DebugPutString["\n"];
IF ABS[d * factor] < ABS[r] OR ABS[r * factor] < ABS[d] THEN TRUSTED {
Too much error
DebugPutString["Excessive error: d = "];
PutDReal[d];
DebugPutString[", r = "];
PutDReal[r];
DebugPutString[", ABS[d-r] = "];
PutDReal[ABS[d-r]];
DebugPutString["\n in test: "];
DebugPutString[msg];
DebugPutChar['\n];
};
};
TestDouble: PROC [d1: DREAL, d2: DREAL, msg: STRING, factor: DREAL] = {
DebugPutString["Testing: "];
DebugPutString[msg];
DebugPutString["\n"];
IF ABS[d1 * factor] < ABS[d2] OR ABS[d2 * factor] < ABS[d1] THEN TRUSTED {
Too much error
DebugPutString["Excessive error: d1 = "];
PutDReal[d1];
DebugPutString[", d2 = "];
PutDReal[d2];
DebugPutString[", ABS[d1-d2] = "];
PutDReal[ABS[d1-d2]];
DebugPutString["\n in test: "];
DebugPutString[msg];
DebugPutChar['\n];
};
};
PrintCode: PROC [code: FloatingPointCommon.Exception, msg: STRING] = {
DebugPutString["ERROR FloatingPointCommon.Error["];
SELECT code FROM
invalidOperation => DebugPutString["invalidOperation"];
overflow => DebugPutString["overflow"];
divisionByZero => DebugPutString["divisionByZero"];
underflow => DebugPutString["underflow"];
inexactResult => DebugPutString["inexactResult"];
other => DebugPutString["other"];
ENDCASE => DebugPutString["??"];
DebugPutString["] when testing "];
DebugPutString[msg];
DebugPutString["\n"];
};
PrintClass: PROC [class: FloatingPointCommon.NumberType, msg: STRING] = {
DebugPutString[msg];
SELECT class FROM
zero => DebugPutString["zero"];
subnormal => DebugPutString["subnormal"];
normal => DebugPutString["normal"];
infinity => DebugPutString["infinity"];
quiet => DebugPutString["quiet"];
signaling => DebugPutString["signaling"];
other => DebugPutString["other"];
ENDCASE => DebugPutString["??"];
};
Routines written in C
Includes: PROC = UNCHECKED MACHINE CODE {
"*";
"#include <stdio.h>\n";
"#include <math.h>\n";
"."
};
LocalSprintReal: UNSAFE PROC [b: CharBuffer, r: PREAL] = UNCHECKED MACHINE CODE {
"+void helpSprintReal (b, r) char *b; float *r; {sprintf(b, \"%1.8g\", *r);};.helpSprintReal"
};
LocalSprintDReal: UNSAFE PROC [b: CharBuffer, d: PDREAL] = UNCHECKED MACHINE CODE {
"+void helpSprintDReal (b, d) char *b; double *d; {sprintf(b, \"%1.8g\", *d);};.helpSprintDReal"
};
DebugPutChar: PROC [c: CHAR] = TRUSTED MACHINE CODE {
"XR�ugPutChar"
};
Initialization
Includes[];
TestSupport[];
TestFns[];
TestErrors[];
END.