← DL-Pascal collectioncov06.pas
DOWNLOAD ORIGINAL FILE
{ DL-Pascal Coverage Section 6: Math Functions }
{ DL-Pascal 1.2 known bugs documented: }
{ BUG_NEGREAL: comparing negative reals > >= < <= }
{ gives wrong result. Workaround: a-b > 0 form. }
{ BUG_REALINIT: real var init with integer constant }
{ is not cast. Workaround: use decimal point. }
{ BUG_ARCSINH0: ArcSinH(0) crashes. Skip. }
{ BUG_ARCTANH0: ArcTanH(0) crashes. Skip. }
{ For each non-crashing bug: first expose it, }
{ then show the workaround giving correct result. }
{ Expected: runs without error, displays results. }
{$D-C-R-}
PROGRAM Section6;
VAR
r, r2, r3 : Real;
i : Integer;
PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
IF passed THEN
WriteLn('OK ', msg)
ELSE
WriteLn('FAIL ', msg);
END;
{ Near always use subtraction form, never direct negative comparison }
FUNCTION Near(a, b, tol : Real) : Boolean;
VAR diff : Real;
BEGIN
diff := a - b;
IF diff < 0.0 THEN diff := -diff;
Near := diff < tol;
END;
{ ---- BUG_NEGREAL demonstration ---- }
PROCEDURE TestNegRealBug;
VAR a, b : Real;
BEGIN
WriteLn(' [BUG_NEGREAL] negative real comparison');
a := -3.0; b := -5.0;
{ Expose the bug: a > b should be True (-3 > -5) but DL-Pascal gets it wrong }
IF a > b THEN
WriteLn(' BUG_NEGREAL > : got True (correct on this machine?)')
ELSE
WriteLn(' BUG_NEGREAL > : got False (BUG confirmed - -3 > -5 is True)');
IF a < b THEN
WriteLn(' BUG_NEGREAL < : got True (BUG confirmed - -3 < -5 is False)')
ELSE
WriteLn(' BUG_NEGREAL < : got False (correct on this machine?)');
{ Workaround: use a-b > 0 instead of a > b }
r := a - b; { r = -3 - (-5) = 2 }
Check('BUG_NEGREAL workaround a>b', r > 0.0); { 2 > 0 is safe }
r := b - a; { r = -5 - (-3) = -2 }
Check('BUG_NEGREAL workaround a<b', r < 0.0); { note: -2<0 also buggy! }
{ Fully safe workaround: subtract and compare to zero via Near }
r := a - b;
Check('BUG_NEGREAL safe a>b', r > 0.0);
Check('BUG_NEGREAL safe a<b', Near(b-a, 0.0, 2.0) AND NOT (b = a));
END;
{ ---- BUG_REALINIT demonstration ---- }
PROCEDURE TestRealInitBug;
VAR
a : Real; { uninitialised will be used to show bug }
b : Real;
BEGIN
WriteLn(' [BUG_REALINIT] real variable init with integer');
{ Expose: initialise with integer literal wrong internal representation }
{ In DL-Pascal you can write: var x:real=123; }
{ but the cast is not made. We simulate by assigning an integer expr. }
i := 123;
a := i; { integer assigned to real â may not cast correctly }
WriteLn(' BUG_REALINIT: a := 123 (integer) -> a = ', a:1:6);
{ Workaround: use decimal point literal }
b := 123.0;
Check('BUG_REALINIT workaround', b = 123.0);
WriteLn(' BUG_REALINIT: b := 123.0 (real) -> b = ', b:1:6);
END;
{ ---- Basic math ---- }
PROCEDURE TestBasicMath;
BEGIN
Check('Abs int pos', Abs(7) = 7);
Check('Abs int neg', Abs(-7) = 7);
Check('Abs int zero', Abs(0) = 0);
r := Abs(-3.5);
Check('Abs real neg', r = 3.5);
r := Abs(3.5);
Check('Abs real pos', r = 3.5);
Check('Sqr 0', Sqr(0) = 0);
Check('Sqr 5', Sqr(5) = 25);
Check('Sqr -4', Sqr(-4) = 16);
r := Sqr(2.5);
Check('Sqr real', r = 6.25);
r := Sqrt(0.0); Check('Sqrt 0', r = 0.0);
r := Sqrt(4.0); Check('Sqrt 4', r = 2.0);
r := Sqrt(9.0); Check('Sqrt 9', r = 3.0);
r := Sqrt(2.0); Check('Sqrt 2', Near(r, 1.41421356, 1E-6));
r := Sqrt(Sqr(5.0));
Check('Sqrt(Sqr)', Near(r, 5.0, 1E-10));
END;
{ ---- Rounding ---- }
PROCEDURE TestRounding;
BEGIN
i := Trunc(3.9); Check('Trunc 3.9', i = 3);
i := Trunc(3.1); Check('Trunc 3.1', i = 3);
i := Trunc(-3.9); Check('Trunc -3.9', i = -3);
i := Trunc(-3.1); Check('Trunc -3.1', i = -3);
i := Round(3.4); Check('Round 3.4', i = 3);
i := Round(3.5); Check('Round 3.5', i = 4);
i := Round(-3.4); Check('Round -3.4', i = -3);
i := Round(-3.5); Check('Round -3.5', i = -4);
r := Frac(3.75); Check('Frac 3.75', Near(r, 0.75, 1E-10));
r := Frac(5.0); Check('Frac whole', r = 0.0);
{ BUG_NEGREAL: Frac(-3.75) = -0.75, negative comparison }
r := Frac(-3.75);
WriteLn(' BUG_NEGREAL Frac: direct r<0 = ', r < 0.0); { may be wrong }
r2 := r - (-0.75);
Check('Frac -3.75 workaround', r2 = 0.0);
r := Int(3.75); Check('Int 3.75', r = 3.0);
r := Int(5.0); Check('Int whole', r = 5.0);
{ BUG_NEGREAL: Int(-3.75) = -3.0 }
r := Int(-3.75);
WriteLn(' BUG_NEGREAL Int: direct r<0 = ', r < 0.0);
r2 := r - (-3.0);
Check('Int -3.75 workaround', r2 = 0.0);
r := Ceil(3.1); Check('Ceil 3.1', r = 4.0);
r := Ceil(4.0); Check('Ceil 4.0', r = 4.0);
r := Ceil(-3.1); r2 := r - (-3.0);
Check('Ceil -3.1 workaround', r2 = 0.0);
r := Floor(3.9); Check('Floor 3.9', r = 3.0);
r := Floor(4.0); Check('Floor 4.0', r = 4.0);
r := Floor(-3.1); r2 := r - (-4.0);
Check('Floor -3.1 workaround', r2 = 0.0);
r := RoundDigit(3.14159, 3);
Check('RoundDig 3', Near(r, 3.14, 0.001));
r := RoundDigit(3.14159, 5);
Check('RoundDig 5', Near(r, 3.1416, 0.00001));
END;
{ ---- Logarithms and exponential ---- }
PROCEDURE TestLogExp;
CONST LN10 = 2.30258509299;
BEGIN
r := Exp(0.0); Check('Exp 0', r = 1.0);
r := Exp(1.0); Check('Exp 1=e', Near(r, 2.71828182845, 1E-8));
r := Exp(-1.0); Check('Exp -1', Near(r, 0.36787944117, 1E-8));
r := Ln(1.0); Check('Ln 1', r = 0.0);
r := Ln(2.0); Check('Ln 2', Near(r, 0.69314718056, 1E-8));
r := Exp(Ln(5.0)); Check('Exp(Ln)', Near(r, 5.0, 1E-8));
r := Log(1.0); Check('Log 1', r = 0.0);
r := Log(10.0); Check('Log 10', Near(r, 1.0, 1E-10));
r := Log(100.0); Check('Log 100', Near(r, 2.0, 1E-10));
r := Log(7.0);
r2 := Ln(7.0) / LN10;
Check('Log vs Ln', Near(r, r2, 1E-8));
END;
{ ---- Power ---- }
PROCEDURE TestPower;
BEGIN
r := Power(2.0, 10.0); Check('Power 2^10', Near(r, 1024.0, 0.001));
r := Power(4.0, 0.5); Check('Power 4^0.5', Near(r, 2.0, 1E-8));
r := Power(2.0, -1.0); Check('Power 2^-1', Near(r, 0.5, 1E-10));
r := PowerInt(2.0, 10); Check('PowInt 2^10', Near(r, 1024.0, 1E-8));
r := PowerInt(3.0, 0); Check('PowInt 3^0', Near(r, 1.0, 1E-10));
r := PowerInt(2.0, -3); Check('PowInt 2^-3', Near(r, 0.125, 1E-10));
{ BUG_NEGREAL: PowerInt(-2,3) = -8, negative result }
r := PowerInt(-2.0, 3);
WriteLn(' BUG_NEGREAL PowInt: direct r<0 = ', r < 0.0);
r2 := r - (-8.0);
Check('PowInt -2^3 workaround', r2 = 0.0);
r := PowerInt(-2.0, 4);
Check('PowInt -2^4', Near(r, 16.0, 1E-8));
END;
{ ---- Trig radians ---- }
PROCEDURE TestTrigRadians;
CONST PI = 3.14159265358979;
PI2 = 1.57079632679490;
BEGIN
angle := 1;
r := Sin(0.0); Check('Sin 0', r = 0.0);
r := Sin(PI2); Check('Sin pi/2', Near(r, 1.0, 1E-8));
r := Sin(PI); Check('Sin pi=0', Near(r, 0.0, 1E-8));
r := Cos(0.0); Check('Cos 0', Near(r, 1.0, 1E-8));
r := Cos(PI2); Check('Cos pi/2=0', Near(r, 0.0, 1E-8));
{ BUG_NEGREAL: Cos(PI) = -1, negative result }
r := Cos(PI);
WriteLn(' BUG_NEGREAL Cos(pi): direct r<-0.9 = ', r < -0.9);
r2 := r - (-1.0);
Check('Cos pi workaround', r2 = 0.0);
r := Tan(0.0); Check('Tan 0', r = 0.0);
r := Tan(PI/4.0); Check('Tan pi/4', Near(r, 1.0, 1E-8));
r := Sin(1.0); r2 := Cos(1.0);
r3 := r*r + r2*r2;
Check('sin2+cos2=1', Near(r3, 1.0, 1E-8));
END;
{ ---- Trig degrees ---- }
PROCEDURE TestTrigDegrees;
BEGIN
angle := 0;
r := Sin(90.0); Check('Sin 90=1', Near(r, 1.0, 1E-8));
r := Sin(180.0); Check('Sin 180=0', Near(r, 0.0, 1E-8));
r := Cos(0.0); Check('Cos 0=1', Near(r, 1.0, 1E-8));
r := Cos(90.0); Check('Cos 90=0', Near(r, 0.0, 1E-8));
r := Cos(60.0); Check('Cos 60=0.5', Near(r, 0.5, 1E-8));
r := Tan(45.0); Check('Tan 45=1', Near(r, 1.0, 1E-8));
r := Sin(37.0); r2 := Cos(37.0);
Check('sin2+cos2 deg', Near(r*r+r2*r2, 1.0, 1E-8));
angle := 1;
END;
{ ---- Inverse trig ---- }
PROCEDURE TestArcTrig;
CONST PI = 3.14159265358979;
PI2 = 1.57079632679490;
BEGIN
angle := 1;
r := ArcSin(0.0); Check('ArcSin 0', r = 0.0);
r := ArcSin(1.0); Check('ArcSin 1', Near(r, PI2, 1E-8));
{ BUG_NEGREAL: ArcSin(-1) = -pi/2 }
r := ArcSin(-1.0);
WriteLn(' BUG_NEGREAL ArcSin(-1): direct r<0 = ', r < 0.0);
r2 := r - (-PI2);
Check('ArcSin -1 workaround', r2 = 0.0);
r := ArcCos(1.0); Check('ArcCos 1=0', Near(r, 0.0, 1E-8));
r := ArcCos(0.0); Check('ArcCos 0', Near(r, PI2, 1E-8));
r := ArcCos(-1.0); Check('ArcCos -1=pi',Near(r, PI, 1E-8));
r := ArcTan(0.0); Check('ArcTan 0', r = 0.0);
r := ArcTan(1.0); Check('ArcTan 1', Near(r, PI/4.0, 1E-8));
{ BUG_NEGREAL: ArcTan(-1) = -pi/4 }
r := ArcTan(-1.0);
WriteLn(' BUG_NEGREAL ArcTan(-1): direct r<0 = ', r < 0.0);
r2 := r - (-PI/4.0);
Check('ArcTan -1 workaround', r2 = 0.0);
r := Sin(ArcSin(0.5)); Check('Sin(ArcSin)', Near(r, 0.5, 1E-8));
r := Cos(ArcCos(0.5)); Check('Cos(ArcCos)', Near(r, 0.5, 1E-8));
r := Tan(ArcTan(2.0)); Check('Tan(ArcTan)', Near(r, 2.0, 1E-8));
END;
{ ---- Hyperbolic ---- }
PROCEDURE TestHyperbolic;
BEGIN
angle := 1;
{ BUG_ARCSINH0: ArcSinH(0) CRASHES â do not call }
{ r := ArcSinH(0.0); }
WriteLn(' BUG_ARCSINH0: ArcSinH(0) skipped (crashes)');
r := SinH(1.0); Check('SinH 1', Near(r, 1.17520119364, 1E-8));
r := ArcSinH(1.0); Check('ArcSinH 1', Near(r, 0.88137358702, 1E-8));
r2 := SinH(1.5); r := ArcSinH(r2);
Check('ArcSinH(SinH)', Near(r, 1.5, 1E-8));
r := CosH(0.0); Check('CosH 0=1', Near(r, 1.0, 1E-10));
r := CosH(1.0); Check('CosH 1', Near(r, 1.54308063482, 1E-8));
r := ArcCosH(1.0); Check('ArcCosH 1=0', Near(r, 0.0, 1E-8));
r2 := CosH(1.5); r := ArcCosH(r2);
Check('ArcCosH(CosH)', Near(r, 1.5, 1E-8));
{ BUG_ARCTANH0: ArcTanH(0) CRASHES â do not call }
{ r := ArcTanH(0.0); }
WriteLn(' BUG_ARCTANH0: ArcTanH(0) skipped (crashes)');
r := TanH(1.0); Check('TanH 1', Near(r, 0.76159415595, 1E-8));
r := ArcTanH(0.5); Check('ArcTanH 0.5', Near(r, 0.54930614434, 1E-8));
r2 := TanH(0.8); r := ArcTanH(r2);
Check('ArcTanH(TanH)', Near(r, 0.8, 1E-8));
{ cosh^2 - sinh^2 = 1 }
r := CosH(1.0); r2 := SinH(1.0);
r3 := r*r - r2*r2;
Check('cosh2-sinh2=1', Near(r3, 1.0, 1E-6));
END;
{ ---- Identities ---- }
PROCEDURE TestIdentities;
CONST PI = 3.14159265358979;
BEGIN
angle := 1;
{ Euler: Cos(pi)=-1, Sin(pi)=0 }
r := Cos(PI); r2 := r - (-1.0); Check('Euler cos', r2 = 0.0);
r := Sin(PI); Check('Euler sin', Near(r, 0.0, 1E-8));
r := Log(3.0 * 7.0);
r2 := Log(3.0) + Log(7.0);
Check('Log product', Near(r, r2, 1E-8));
r := Ln(PowerInt(2.0, 5));
r2 := 5.0 * Ln(2.0);
Check('Ln power', Near(r, r2, 1E-8));
r := Sin(2.0 * 0.6);
r2 := 2.0 * Sin(0.6) * Cos(0.6);
Check('Sin double', Near(r, r2, 1E-8));
r := Sqrt(7.0);
r2 := Power(7.0, 0.5);
Check('Sqrt=Power', Near(r, r2, 1E-8));
END;
{ ---- Main ---- }
BEGIN
WriteLn('=== Section 6: Math Functions ===');
WriteLn(' (DL-Pascal 1.2 bugs exposed + workarounds)');
WriteLn;
WriteLn('-- Bug Demonstrations --');
TestNegRealBug; WriteLn;
TestRealInitBug; WriteLn;
WriteLn('-- Basic Math --');
TestBasicMath; WriteLn;
WriteLn('-- Rounding --');
TestRounding; WriteLn;
WriteLn('-- Log/Exp --');
TestLogExp; WriteLn;
WriteLn('-- Power --');
TestPower; WriteLn;
WriteLn('-- Trig radians --');
TestTrigRadians; WriteLn;
WriteLn('-- Trig degrees --');
TestTrigDegrees; WriteLn;
WriteLn('-- ArcTrig --');
TestArcTrig; WriteLn;
WriteLn('-- Hyperbolic --');
TestHyperbolic; WriteLn;
WriteLn('-- Identities --');
TestIdentities; WriteLn;
angle := 1;
WriteLn('=== Section 6 complete ===');
END.