I have used cutest in the past for creation of a test suite.
http://cutest.sourceforge.net/
It consists of two small. I translated the entire code of cutest to FreeBASIC
cutest.bi
Code: Select all
#IFNDEF CU_TEST_H
#DEFINE CU_TEST_H
#ifndef NULL
#define NULL 0
#endif
#ifdef __FB_UNIX__
#define NEWLINE !"\r"
#else
#define NEWLINE !"\r\n"
#endif
' #include <setjmp.h>
#INCLUDE ONCE "crt/setjmp.bi" '__HEADERS__: setjmp.h
' #include <stdarg.h>
#INCLUDE ONCE "crt/stdarg.bi" '__HEADERS__: stdarg.h
#DEFINE CUTEST_VERSION !"CuTest 1.5"
/' CuString '/
DECLARE FUNCTION CuStrAlloc ( _
BYVAL size AS INTEGER) AS ZSTRING PTR
DECLARE FUNCTION CuStrCopy ( _
BYVAL old AS CONST ZSTRING PTR) AS ZSTRING PTR
#DEFINE CU_ALLOC(TYPE_) (cast(TYPE_ ptr,malloc(SIZEOF(TYPE_))))
#DEFINE HUGE_STRING_LEN 8192
#DEFINE STRING_MAX 256
#DEFINE STRING_INC 256
TYPE CuString
AS INTEGER length
AS INTEGER size
AS ZSTRING PTR buffer
END TYPE
DECLARE SUB CuStringInit ( _
BYVAL str_TJF AS CuString PTR)
DECLARE FUNCTION CuStringNew () AS CuString PTR
DECLARE SUB CuStringRead ( _
BYVAL str_TJF AS CuString PTR, _
BYVAL path AS CONST ZSTRING PTR)
DECLARE SUB CuStringAppend ( _
BYREF str_TJF AS CuString PTR, _
BYVAL text AS CONST ZSTRING PTR)
DECLARE SUB CuStringAppendChar ( _
BYVAL str_TJF AS CuString PTR, _
BYVAL ch AS UBYTE)
DECLARE SUB CuStringInsert ( _
BYVAL str_TJF AS CuString PTR, _
BYVAL text AS CONST ZSTRING PTR, _
BYVAL pos_TJF AS INTEGER)
DECLARE SUB CuStringResize ( _
BYREF str_TJF AS CuString PTR, _
BYVAL newSize AS INTEGER)
DECLARE SUB CuStringDelete ( _
byref str_TJF AS CuString PTR)
TYPE CuTest_ as CuTest
TYPE TestFunction AS SUB (BYVAL _TJF AS CuTest_ PTR)
/' CuTest '/
TYPE CuTest
AS ZSTRING PTR name
AS TestFunction function
AS INTEGER failed
AS INTEGER ran
AS CONST ZSTRING PTR message
AS jmp_buf PTR jumpBuf
END TYPE
DECLARE SUB CuTestInit ( _
BYVAL t AS CuTest PTR, _
BYVAL name_TJF AS CONST ZSTRING PTR, _
BYVAL function_TJF AS TestFunction)
DECLARE FUNCTION CuTestNew ( _
BYVAL name_TJF AS CONST ZSTRING PTR, _
BYVAL function_TJF AS TestFunction) AS CuTest PTR
DECLARE SUB CuTestRun ( _
BYVAL tc AS CuTest PTR)
DECLARE SUB CuTestDelete ( _
BYREF t AS CuTest PTR)
/' Internal versions of assert functions -- use the public versions '/
DECLARE SUB CuFail_Line ( _
BYVAL tc AS CuTest PTR, _
BYVAL file AS CONST ZSTRING PTR, _
BYVAL line_TJF AS INTEGER, _
BYVAL message2 AS CONST ZSTRING PTR, _
BYVAL message AS CONST ZSTRING PTR)
DECLARE SUB CuAssert_Line ( _
BYVAL tc AS CuTest PTR, _
BYVAL file AS CONST ZSTRING PTR, _
BYVAL line_TJF AS INTEGER, _
BYVAL message AS CONST ZSTRING PTR, _
BYVAL condition AS INTEGER)
DECLARE SUB CuAssertStrEquals_LineMsg ( _
BYVAL tc AS CuTest PTR, _
BYVAL file AS CONST ZSTRING PTR, _
BYVAL line_TJF AS INTEGER, _
BYVAL message AS CONST ZSTRING PTR, _
BYVAL expected AS CONST ZSTRING PTR, _
BYVAL actual AS CONST ZSTRING PTR)
DECLARE SUB CuAssertIntEquals_LineMsg ( _
BYVAL tc AS CuTest PTR, _
BYVAL file AS CONST ZSTRING PTR, _
BYVAL line_TJF AS INTEGER, _
BYVAL message AS CONST ZSTRING PTR, _
BYVAL expected AS INTEGER, _
BYVAL actual AS INTEGER)
DECLARE SUB CuAssertDblEquals_LineMsg ( _
BYVAL tc AS CuTest PTR, _
BYVAL file AS CONST ZSTRING PTR, _
BYVAL line_TJF AS INTEGER, _
BYVAL message AS CONST ZSTRING PTR, _
BYVAL expected AS DOUBLE, _
BYVAL actual AS DOUBLE, _
BYVAL delta AS DOUBLE)
DECLARE SUB CuAssertPtrEquals_LineMsg ( _
BYVAL tc AS CuTest PTR, _
BYVAL file AS CONST ZSTRING PTR, _
BYVAL line_TJF AS INTEGER, _
BYVAL message AS CONST ZSTRING PTR, _
BYVAL expected AS ANY PTR, _
BYVAL actual AS ANY PTR)
/' public assert functions '/
#DEFINE CuFail(tc, ms) CuFail_Line( (tc), __FILE__, __LINE__, NULL, (ms))
#DEFINE CuAssert(tc, ms, cond) CuAssert_Line((tc), __FILE__, __LINE__, (ms), (cond))
#DEFINE CuAssertTrue(tc, cond) CuAssert_Line((tc), __FILE__, __LINE__, !"assert failed", (cond))
#DEFINE CuAssertStrEquals(tc,ex,ac) CuAssertStrEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac))
#DEFINE CuAssertStrEquals_Msg(tc,ms,ex,ac) CuAssertStrEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac))
#DEFINE CuAssertIntEquals(tc,ex,ac) CuAssertIntEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac))
#DEFINE CuAssertIntEquals_Msg(tc,ms,ex,ac) CuAssertIntEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac))
#DEFINE CuAssertDblEquals(tc,ex,ac,dl) CuAssertDblEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac),(dl))
#DEFINE CuAssertDblEquals_Msg(tc,ms,ex,ac,dl) CuAssertDblEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac),(dl))
#DEFINE CuAssertPtrEquals(tc,ex,ac) CuAssertPtrEquals_LineMsg((tc),__FILE__,__LINE__,NULL,(ex),(ac))
#DEFINE CuAssertPtrEquals_Msg(tc,ms,ex,ac) CuAssertPtrEquals_LineMsg((tc),__FILE__,__LINE__,(ms),(ex),(ac))
#DEFINE CuAssertPtrNotNull(tc,p) CuAssert_Line((tc),__FILE__,__LINE__,!"null pointer unexpected",(p <> NULL))
#DEFINE CuAssertPtrNotNullMsg(tc,msg,p) CuAssert_Line((tc),__FILE__,__LINE__,(msg),(p <> NULL))
/' CuSuite '/
#DEFINE MAX_TEST_CASES 1024
#DEFINE SUITE_ADD_TEST(SUITE,TEST) CuSuiteAdd(SUITE, CuTestNew(#TEST, TEST))
TYPE CuSuite
AS INTEGER count
AS CuTest PTR list(0 TO MAX_TEST_CASES-1)
AS INTEGER failCount
END TYPE
DECLARE SUB CuSuiteInit ( _
BYVAL testSuite AS CuSuite PTR)
DECLARE FUNCTION CuSuiteNew () AS CuSuite PTR
DECLARE SUB CuSuiteDelete ( _
BYREF testSuite AS CuSuite PTR)
DECLARE SUB CuSuiteAdd ( _
BYVAL testSuite AS CuSuite PTR, _
BYVAL testCase AS CuTest PTR)
DECLARE SUB CuSuiteAddSuite ( _
BYVAL testSuite AS CuSuite PTR, _
BYVAL testSuite2 AS CuSuite PTR)
DECLARE SUB CuSuiteRun ( _
BYVAL testSuite AS CuSuite PTR)
DECLARE SUB CuSuiteSummary ( _
BYVAL testSuite AS CuSuite PTR, _
BYVAL summary AS CuString PTR)
DECLARE SUB CuSuiteDetails ( _
BYVAL testSuite AS CuSuite PTR, _
BYVAL details AS CuString PTR)
/' CU_TEST_H '/
#ENDIF ' CU_TEST_H
cutest.bas
Code: Select all
#include "crt/setjmp.bi"
#include "crt/stdlib.bi"
#include "crt/stdio.bi"
#include "crt/string.bi"
#include "crt/math.bi"
#include "CuTest.bi"
/'-------------------------------------------------------------------------*
* CuStr
*-------------------------------------------------------------------------'/
function CuStrAlloc(byval size as integer) as zstring ptr
dim newStr as zstring ptr = cast(zstring ptr,malloc( sizeof(zstring) * (size) ))
return newStr
end function
function CuStrCopy(byval old as const zstring ptr) as zstring ptr
dim len_ as integer = len(*old)
dim newStr as zstring ptr = CuStrAlloc(len_ + 1)
strcpy(newStr, cast(any ptr,strptr(*old)))
return newStr
end function
/'-------------------------------------------------------------------------*
* CuString
*-------------------------------------------------------------------------'/
sub CuStringInit(byval str_ as CuString ptr)
str_->length = 0
str_->size = STRING_MAX
str_->buffer = cast(zstring ptr,malloc(sizeof(zstring) * str_->size))
str_->buffer[0] = asc(!"\0")
end sub
function CuStringNew() as CuString ptr
dim str_ as CuString ptr = cast(CuString ptr,malloc(sizeof(CuString)))
str_->length = 0
str_->size = STRING_MAX
str_->buffer = cast(zstring ptr,malloc(sizeof(zstring) * str_->size))
str_->buffer[0] = asc(!"\0")
return str_
end function
sub CuStringDelete(byref str_ as CuString ptr)
if (str_ = 0) then return
free(str_->buffer)
free(str_)
end sub
sub CuStringResize(byref str_ as CuString ptr, byval newSize as integer)
str_->buffer = cast(zstring ptr,realloc(str_->buffer, sizeof(zstring) * newSize))
str_->size = newSize
end sub
sub CuStringAppend(byref str_ as CuString ptr, byval text as const zstring ptr)
dim length as integer
if (text = 0) then
text = @"NULL"
end if
length = len(*text)
if (str_->length + length + 1 >= str_->size) then
CustringResize(str_, str_->length + length + 1 + STRING_INC)
end if
str_->length += length
strcat(str_->buffer, cast(any ptr,text))
end sub
sub CustringAppendChar(byval str_ as Custring ptr, byval ch as ubyte)
dim text as zstring * 2
text[0] = ch
text[1] = asc(!"\0")
CustringAppend(str_, text)
end sub
sub CuStringInsert(byval str_ as CuString ptr, byval text as const zstring ptr, byval pos_ as integer)
var length = len(*text)
if (pos_ > str_->length) then
pos_ = str_->length
end if
if (str_->length + length + 1 >= str_->size) then
CustringResize(str_, str_->length + length + 1 + STRING_INC)
end if
memmove(str_->buffer + pos_ + length, str_->buffer + pos_, (str_->length - pos_) + 1)
str_->length += length
memcpy(str_->buffer + pos_, cast(any ptr,text), length)
end sub
/'-------------------------------------------------------------------------*
* CuTest
*-------------------------------------------------------------------------'/
sub CuTestInit(byval t as CuTest ptr, byval name_ as const zstring ptr, byval function_ as TestFunction)
t->name = CuStrCopy(name_)
t->failed = 0
t->ran = 0
t->message = NULL
t->function = function_
t->jumpBuf = NULL
end sub
function CuTestNew(byval name_ as const zstring ptr, byval function_ as TestFunction) as CuTest ptr
dim tc as CuTest ptr = CU_ALLOC(CuTest)
CuTestInit(tc, name_, function_)
return tc
end function
sub CuTestDelete(byref t as CuTest ptr)
if (t = 0) then return
free(t->name)
free(t)
end sub
sub CuTestRun(byval tc as CuTest ptr)
dim buf as jmp_buf
tc->jumpBuf = @buf
var retval = setjmp(buf)
if (retval = 0) then
tc->ran = 1
(tc->function)(tc)
end if
tc->jumpBuf = 0
end sub
sub CuFailInternal(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
byval line_ as integer, byval string_ as CuString ptr)
dim buf(0 to HUGE_STRING_LEN) as ubyte
sprintf(@buf(0), "%s:%d: ", file_, line_)
CuStringInsert(string_, @buf(0), 0)
tc->failed = 1
tc->message = string_->buffer
if (tc->jumpBuf <> 0) then longjmp(*(tc->jumpBuf), 0)
end sub
sub CuFail_Line(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
byval line_ as integer, byval message2 as const zstring ptr,_
byval message as const zstring ptr)
dim string_ as CuString
CuStringInit(@string_)
if (message2 <> NULL) then
CuStringAppend(@string_, message2)
CuStringAppend(@string_, @": ")
end if
CuStringAppend(@string_, message)
CuFailInternal(tc, file_, line_, @string_)
end sub
sub CuAssert_Line(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
byval line_ as integer, byval message as const zstring ptr, _
byval condition as integer)
if (condition) then return
CuFail_Line(tc, file_, line_, NULL, message)
end sub
sub CuAssertStrEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr,_
byval line_ as integer, byval message as const zstring ptr,_
byval expected as const zstring ptr, _
byval actual as const zstring ptr)
dim string_ as CuString
if ((expected = NULL andalso actual = NULL) orelse _
(expected <> NULL andalso actual <> NULL andalso _
strcmp(cast(any ptr,expected), cast(any ptr,actual)) = 0)) then
return
end if
CuStringInit(@string_)
if (message <> NULL) then
CuStringAppend(@string_, message)
CuStringAppend(@string_, @": ")
end if
CuStringAppend(@string_, @"expected <")
CuStringAppend(@string_, expected)
CuStringAppend(@string_, @"> but was <")
CuStringAppend(@string_, actual)
CuStringAppend(@string_, @">")
CuFailInternal(tc, file_, line_, @string_)
end sub
sub CuAssertIntEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr,_
byval line_ as integer, byval message as const zstring ptr,_
byval expected as integer, _
byval actual as integer)
dim buf as zstring * STRING_MAX
if (expected = actual) then return
sprintf(buf, "expected <%d> but was <%d>", expected, actual)
CuFail_Line(tc, file_, line_, message, buf)
end sub
sub CuAssertDblEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr, _
byval line_ as integer, byval message as const zstring ptr,_
byval expected as double , byval actual as double,_
byval delta as double)
dim buf as zstring * STRING_MAX
if (fabs(expected - actual) <= delta) then return
sprintf(buf, "expected <%f> but was <%f>", expected, actual)
CuFail_Line(tc, file_, line_, message, buf)
end sub
sub CuAssertPtrEquals_LineMsg(byval tc as CuTest ptr, byval file_ as const zstring ptr,_
byval line_ as integer, byval message as const zstring ptr,_
byval expected as any ptr, byval actual as any ptr)
dim buf as zstring * STRING_MAX
if (expected = actual) then return
sprintf(buf, "expected pointer <0x%p> but was <0x%p>", expected, actual)
CuFail_Line(tc, file_, line_, message, buf)
end sub
/'-------------------------------------------------------------------------*
* CuSuite
*-------------------------------------------------------------------------'/
sub CuSuiteInit(byval testSuite as CuSuite ptr)
testSuite->count = 0
testSuite->failCount = 0
memset(@testSuite->list(0), 0, sizeof(testSuite->list))
end sub
function CuSuiteNew() as CuSuite ptr
dim testSuite as CuSuite ptr = CU_ALLOC(CuSuite)
CuSuiteInit(testSuite)
return testSuite
end function
sub CuSuiteDelete(byref testSuite as CuSuite ptr)
dim n as uinteger
for n = 0 to MAX_TEST_CASES - 1
if (testSuite->list(n)) then
CuTestDelete(testSuite->list(n))
end if
next n
free(testSuite)
end sub
sub CuSuiteAdd(byval testSuite as CuSuite ptr, byval testCase as CuTest ptr)
assert(testSuite->count < MAX_TEST_CASES)
testSuite->list(testSuite->count) = testCase
testSuite->count += 1
end sub
sub CuSuiteAddSuite(byval testSuite as CuSuite ptr, byval testSuite2 as CuSuite ptr)
dim i as integer
for i = 0 to testSuite2->count - 1
dim testCase as CuTest ptr = testSuite2->list(i)
CuSuiteAdd(testSuite, testCase)
next i
end sub
sub CuSuiteRun(byval testSuite as CuSuite ptr)
dim i as integer
for i = 0 to testSuite->count - 1
dim testCase as CuTest ptr = testSuite->list(i)
CuTestRun(testCase)
if (testCase->failed) then
testSuite->failCount += 1
end if
next i
end sub
sub CuSuiteSummary(byval testSuite as CuSuite ptr, byval summary as CuString ptr)
dim i as integer
for i = 0 to testSuite->count -1
dim testCase as CuTest ptr = testSuite->list(i)
CuStringAppend(summary, iif(testCase->failed,@"F",@"."))
next i
CuStringAppend(summary, @(NEWLINE & NEWLINE))
end sub
sub CuSuiteDetails(byval testSuite as CuSuite ptr, byval details as CuString ptr)
dim i as integer
''s is used for formatted string concatenation
dim s as string
dim failcount as integer
if (testSuite->failCount = 0) then
dim passCount as integer = testSuite->count - testSuite->failCount
dim testword as zstring ptr
if (passcount = 1) then
testword = @"test"
else
testword = @"tests"
end if
dim s as string
s = "OK (" & passCount & " " & *testWord & NEWLINE
CuStringAppend(details,strptr(s))
else
if (testSuite->failCount = 1) then
s = !"There was 1 failure:" & NEWLINE
CuStringAppend(details, strptr(s))
else
s = "There were " & testSuite->failCount & !" failures:" & NEWLINE
CuStringAppend(details, strptr(s))
end if
for i as integer = 0 to testSuite->count - 1
dim testCase as CuTest ptr = testSuite->list(i)
if (testCase->failed) then
failCount += 1
s = failCount & ") " & *(testCase->name) & ": " & *(testCase->message) & NEWLINE
CuStringAppend(details, strptr(s))
end if
next i
s = NEWLINE & "!!!FAILURES!!!" & NEWLINE
CuStringAppend(details, strptr(s))
s = "Runs: " & testSuite->count
CuStringAppend(details, strptr(s))
s = "Passes: " & testSuite->count - testSuite->failCount
CuStringAppend(details, strptr(s))
s = "Fails: " & testSuite->failCount & NEWLINE
CuStringAppend(details, strptr(s))
end if
end sub
Code should be correct. It works much like the cunit testing framework as used by the
FreeBASIC developers.
Every test case is a sub. All subs get added to a suite. The test cases from one
suite can be added to those of some other suite. This allows for the creation of separate suites
(so you can break up testing into several suits) that can be joined.
The main suite (=join of all suites) is the one that will actually execute all of the tests.
During the run the test suite reports outcome of tests (including errors).
I am going to generate some test cases using cutest to see if that'll work out.
I will be using your source code as downloadable from sourceforge.net (possibly exchanging files
with files you posted verbatim on this forum).
I hope I will be able to come up with some good test cases. And hopefully find some bugs.