← DL-Pascal collection

cov03.pas

DOWNLOAD ORIGINAL FILE

{ DL-Pascal Coverage Section 3: Procedures and Functions }
{ Exercises value/var params, nested procedures,         }
{ recursion, forward declarations, function variables,   }
{ procedure variables, and parameter edge cases.         }
{ Expected: runs without error, displays results.        }
{$D-C-R-}

PROGRAM Section3;

VAR
  i, j  : Integer;
  li    : LongInt;
  r     : Real;
  b     : Boolean;

PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
  IF passed THEN
    WriteLn('OK   ', msg)
  ELSE
    WriteLn('FAIL ', msg);
END;

{ ---- Value vs VAR parameters ---- }

PROCEDURE AddOne(n : Integer);
BEGIN
  n := n + 1;  { value param - caller unchanged }
END;

PROCEDURE AddOneVar(VAR n : Integer);
BEGIN
  n := n + 1;  { var param - caller changed }
END;

PROCEDURE TestValueVar;
VAR n : Integer;
BEGIN
  n := 5;
  AddOne(n);
  Check('Value param unchanged', n = 5);

  n := 5;
  AddOneVar(n);
  Check('VAR param changed', n = 6);

  { Multiple var params }
  i := 3; j := 7;
  AddOneVar(i); AddOneVar(j);
  Check('Multi VAR params', (i = 4) AND (j = 8));
END;

{ ---- Swap via VAR params ---- }

PROCEDURE Swap(VAR a, b : Integer);
VAR tmp : Integer;
BEGIN
  tmp := a; a := b; b := tmp;
END;

PROCEDURE TestSwap;
BEGIN
  i := 10; j := 20;
  Swap(i, j);
  Check('Swap integers', (i = 20) AND (j = 10));

  { Swap back }
  Swap(i, j);
  Check('Swap back', (i = 10) AND (j = 20));
END;

{ ---- Functions ---- }

FUNCTION Square(n : Integer) : Integer;
BEGIN
  Square := n * n;
END;

FUNCTION Max(a, b : Integer) : Integer;
BEGIN
  IF a > b THEN Max := a ELSE Max := b;
END;

FUNCTION Min(a, b : Integer) : Integer;
BEGIN
  IF a < b THEN Min := a ELSE Min := b;
END;

FUNCTION AbsVal(n : Integer) : Integer;
BEGIN
  IF n < 0 THEN AbsVal := -n ELSE AbsVal := n;
END;

FUNCTION RealSquare(x : Real) : Real;
BEGIN
  RealSquare := x * x;
END;

PROCEDURE TestFunctions;
BEGIN
  Check('Square 5',     Square(5) = 25);
  Check('Square 0',     Square(0) = 0);
  Check('Square -3',    Square(-3) = 9);
  Check('Max 3 7',      Max(3, 7) = 7);
  Check('Max 7 3',      Max(7, 3) = 7);
  Check('Max equal',    Max(5, 5) = 5);
  Check('Min 3 7',      Min(3, 7) = 3);
  Check('AbsVal neg',   AbsVal(-9) = 9);
  Check('AbsVal pos',   AbsVal(9) = 9);
  r := RealSquare(2.5);
  Check('RealSquare',   r = 6.25);

  { Function in expression }
  i := Square(3) + Square(4);
  Check('Func in expr', i = 25);

  { Nested function calls }
  i := Max(Square(2), Square(3));
  Check('Nested func',  i = 9);

  { Function result as param }
  i := AbsVal(Min(-5, -3));
  Check('Func as param', i = 5);
END;

{ ---- Recursion ---- }

FUNCTION Factorial(n : Integer) : LongInt;
BEGIN
  IF n <= 1 THEN Factorial := 1
  ELSE Factorial := n * Factorial(n - 1);
END;

FUNCTION Fibonacci(n : Integer) : Integer;
BEGIN
  IF n <= 1 THEN Fibonacci := n
  ELSE Fibonacci := Fibonacci(n-1) + Fibonacci(n-2);
END;

FUNCTION Power(base : Real; exp : Integer) : Real;
BEGIN
  IF exp = 0 THEN Power := 1.0
  ELSE IF exp > 0 THEN Power := base * Power(base, exp-1)
  ELSE Power := 1.0 / Power(base, -exp);
END;

FUNCTION GCD(a, b : Integer) : Integer;
BEGIN
  IF b = 0 THEN GCD := a
  ELSE GCD := GCD(b, a MOD b);
END;

PROCEDURE TestRecursion;
BEGIN
  Check('Factorial 0',  Factorial(0) = 1);
  Check('Factorial 1',  Factorial(1) = 1);
  Check('Factorial 5',  Factorial(5) = 120);
  Check('Factorial 10', Factorial(10) = 3628800);
  Check('Fibonacci 0',  Fibonacci(0) = 0);
  Check('Fibonacci 1',  Fibonacci(1) = 1);
  Check('Fibonacci 7',  Fibonacci(7) = 13);
  Check('Fibonacci 10', Fibonacci(10) = 55);
  r := Power(2.0, 10);
  Check('Power 2^10',   r = 1024.0);
  r := Power(2.0, 0);
  Check('Power 2^0',    r = 1.0);
  r := Power(2.0, -1);
  Check('Power 2^-1',   r = 0.5);
  Check('GCD 12 8',     GCD(12, 8) = 4);
  Check('GCD 100 75',   GCD(100, 75) = 25);
  Check('GCD prime',    GCD(17, 13) = 1);
END;

{ ---- Forward declarations ---- }

PROCEDURE IsEven(n : Integer); FORWARD;

PROCEDURE IsOdd(n : Integer);
BEGIN
  IF n = 0 THEN
    Check('Mutual recur odd', False)  { should not reach 0 via odd path }
  ELSE IF n = 1 THEN
    Check('Mutual recur odd=1', True)
  ELSE
    IsEven(n - 1);
END;

PROCEDURE IsEven(n : Integer);
BEGIN
  IF n = 0 THEN
    Check('Mutual recur even=0', True)
  ELSE
    IsOdd(n - 1);
END;

PROCEDURE TestForward;
BEGIN
  IsEven(4);   { 4->odd(3)->even(2)->odd(1)->check }
  IsOdd(5);    { 5->even(4)->odd(3)->even(2)->odd(1)->check }
END;

{ ---- Nested procedures ---- }

PROCEDURE TestNested;
VAR outerN : Integer;

  PROCEDURE Inner1;
  BEGIN
    outerN := outerN + 1;  { accesses outer variable }
  END;

  PROCEDURE Inner2(VAR n : Integer);
  VAR localN : Integer;

    PROCEDURE DeepInner;
    BEGIN
      localN := localN * 2;
    END;

  BEGIN
    localN := n;
    DeepInner;
    n := localN;
  END;

BEGIN
  outerN := 10;
  Inner1;
  Check('Nested access outer', outerN = 11);
  Inner1;
  Check('Nested access outer 2', outerN = 12);

  i := 5;
  Inner2(i);
  Check('Nested deep inner', i = 10);
END;

{ ---- Multiple return paths ---- }

FUNCTION Sign(n : Integer) : Integer;
BEGIN
  IF n > 0 THEN BEGIN Sign :=  1; Exit; END;
  IF n < 0 THEN BEGIN Sign := -1; Exit; END;
  Sign := 0;
END;

FUNCTION FirstPosDiv(n : Integer) : Integer;
{ Return smallest divisor > 1, or n if prime }
VAR d : Integer;
BEGIN
  d := 2;
  WHILE d * d <= n DO BEGIN
    IF n MOD d = 0 THEN BEGIN
      FirstPosDiv := d;
      Exit;
    END;
    Inc(d);
  END;
  FirstPosDiv := n;
END;

PROCEDURE TestExit;
BEGIN
  Check('Sign pos',    Sign(5)  =  1);
  Check('Sign neg',    Sign(-3) = -1);
  Check('Sign zero',   Sign(0)  =  0);
  Check('PrimDiv 12',  FirstPosDiv(12) = 2);
  Check('PrimDiv 15',  FirstPosDiv(15) = 3);
  Check('PrimDiv 7',   FirstPosDiv(7)  = 7);
  Check('PrimDiv 49',  FirstPosDiv(49) = 7);
END;

{ ---- Procedure/Function variables ---- }

TYPE
  TIntFunc  = FUNCTION(n : Integer) : Integer;
  TIntProc  = PROCEDURE(VAR n : Integer);

FUNCTION Double(n : Integer) : Integer;
BEGIN Double := n * 2; END;

FUNCTION Triple(n : Integer) : Integer;
BEGIN Triple := n * 3; END;

PROCEDURE TestProcVars;
VAR
  fn  : TIntFunc;
  pr  : TIntProc;
BEGIN
  fn := Double;
  Check('Func var double', fn(5) = 10);

  fn := Triple;
  Check('Func var triple', fn(5) = 15);

  { Function var in expression }
  fn := Square;
  i  := fn(4) + fn(3);
  Check('Func var expr', i = 25);

  pr := AddOneVar;
  i  := 7;
  pr(i);
  Check('Proc var', i = 8);
END;

{ ---- String parameter ---- }

FUNCTION StrLen(s : STRING) : Integer;
BEGIN
  StrLen := Length(s);
END;

{$V-}
PROCEDURE AppendBang(VAR s : STRING);
BEGIN
  s := s + '!';
END;

PROCEDURE TestStringParams;
VAR s : STRING[20];
BEGIN
  Check('StrLen hello',  StrLen('Hello') = 5);
  Check('StrLen empty',  StrLen('') = 0);

  s := 'Hi';
  AppendBang(s);
  Check('VAR string',    s = 'Hi!');
  AppendBang(s);
  Check('VAR string x2', s = 'Hi!!');
  {$V+}
END;

{ ---- Accumulator pattern ---- }

PROCEDURE Accumulate(VAR sum : LongInt; val : Integer);
BEGIN
  sum := sum + val;
END;

PROCEDURE TestAccumulate;
VAR sum : LongInt;
    n   : Integer;
BEGIN
  sum := 0;
  FOR n := 1 TO 100 DO Accumulate(sum, n);
  Check('Accumulate 1..100', sum = 5050);

  sum := 0;
  FOR n := 1 TO 10 DO Accumulate(sum, Square(n));
  Check('Accumulate squares', sum = 385);  { sum of 1^2..10^2 }
END;

{ ---- Main ---- }
BEGIN
  WriteLn('=== Section 3: Procedures and Functions ===');
  WriteLn;

  WriteLn('-- Value vs VAR --');
  TestValueVar;
  WriteLn;

  WriteLn('-- Swap --');
  TestSwap;
  WriteLn;

  WriteLn('-- Functions --');
  TestFunctions;
  WriteLn;

  WriteLn('-- Recursion --');
  TestRecursion;
  WriteLn;

  WriteLn('-- Forward --');
  TestForward;
  WriteLn;

  WriteLn('-- Nested --');
  TestNested;
  WriteLn;

  WriteLn('-- Exit --');
  TestExit;
  WriteLn;

  WriteLn('-- Proc/Func Vars --');
  TestProcVars;
  WriteLn;

  WriteLn('-- String Params --');
  TestStringParams;
  WriteLn;

  WriteLn('-- Accumulate --');
  TestAccumulate;
  WriteLn;

  WriteLn('=== Section 3 complete ===');
END.