Where Is My TPUnit?
I couldn't find any unit testing framework for Turbo Pascal. The closest thing I could find was FPCUnit packaged with Free Pascal. Unfortunately it's not compatible with good old TP. So I had to roll my own. I started with some minimalist infrastructure.
TYPE TestCase = OBJECT PROCEDURE AssertEquals(msg:String; expect, act:Longint); PROCEDURE AssertNil(msg:String; act:Pointer); { other asserts ... } PROCEDURE Fail(msg:String); { TestCase } PROCEDURE SetUp; VIRTUAL; PROCEDURE TearDown; VIRTUAL; END; PROCEDURE TestCase.AssertEquals(msg:String; expect, act:Longint); VAR ex, ac:String; BEGIN IF expect <> act THEN BEGIN Str(expect, ex); Str(act, ac); Fail(Concat(msg,' expected ',ex,' but was ',ac)); END; END; ... PROCEDURE TestCase.Fail(msg:String); BEGIN TearDown; Writeln(' - FAILED'); Writeln(msg); Halt(1); END; PROCEDURE TestCase.SetUp; BEGIN END; PROCEDURE TestCase.TearDown; BEGIN END;Subclasses may overwrite
SetUp
or TearDown
, add test methods and call Assert
s. To keep it simple the first failed assertion stops program execution. What's missing is some kind of procedure RunTest
that would wrap a particular test method inside calls to SetUp
and TearDown
. Hmm - function variables might be handy here. In case you are not familiar with them, here is an example:{$F+} {needs far calls for function variables} TYPE FuncVar = PROCEDURE; PROCEDURE FancyMethod(method:FuncVar); BEGIN method; { invokes the method } END; PROCEDURE SomeMethod; ... VAR v:FuncVar; BEGIN v := SomeMethod; FancyMethod(v); END.Unfortunately Turbo Pascal does not allow class methods (e.g.
TestCase.AssertEquals
) to be used as function variables. (At least I couldn't figure.) Obviously self
is an implicit parameter of all such methods. Well not obviously, but analysing the generated machine code helps ;-)SomeMethod; { -> 0E E8 D1 FB } push CS { because of $F+ } call fbe1 { address of SomeMethod in CS } cls.ClassProc; { -> BF 70 00 1E 57 0E E8 ED FB } mov DI, #0070 { address of object cls in DS } push DS push DI { first parameter is self } push CS call fbed { address of ClassProc in CS }Using this knowledge
TestCase.RunTest
is implemented a bit dirty using an untyped Pointer
argument:PROCEDURE CallClassPtr(pt:Pointer; VAR cls:TestCase); VAR s,o:Word; BEGIN s := Seg(cls); o := Ofs(cls); ASM mov DI, [o] mov AX, [s] push AX push DI call [pt.dword] END; END; PROCEDURE TestCase.RunTest(name:String; testMethod:Pointer); BEGIN Write('TEST ', name); SetUp; CallClassPtr(testMethod, self); TearDown; END;The Prime Factors Kata
Having a simple TPUnit in place, it's time for the kata itself. The seven test methods of
PrimeFactorsTest
,PROCEDURE PrimeFactorsTest.Run; BEGIN RunTest('TestOne', @PrimeFactorsTest.TestOne ); RunTest('TestTwo', @PrimeFactorsTest.TestTwo ); RunTest('TestThree', @PrimeFactorsTest.TestThree ); RunTest('TestFour', @PrimeFactorsTest.TestFour ); RunTest('TestSix', @PrimeFactorsTest.TestSix ); RunTest('TestEight', @PrimeFactorsTest.TestEight ); RunTest('TestNine', @PrimeFactorsTest.TestNine ); END;yield
FUNCTION TPrimeFactors.generate(i:Longint):ArrayListPtr; VAR factors:ArrayListPtr; candidate:Longint; BEGIN factors := new(ArrayListPtr, Init); FOR candidate := 2 TO i DO BEGIN WHILE i MOD candidate = 0 DO BEGIN factors^.Add(candidate); i := i DIV candidate; END; END; generate := factors; END;
ArrayListPtr
is a pointer to a variable sized, user defined list backed by an array of Longint
s, similar to Java's ArrayList<Integer>
. I can't deny I'm a Java guy. Everything I code looks like Java :-) (Probably I would have used a linked list back then instead of a complex object. Something likeTYPE PrimeFactorPtr = ^PrimeFactor; PrimeFactor = RECORD value:LongInt; next:PrimeFactorPtr; END;Still the procedure body looks the same and the kata does not change much.)
(Download full source)