Commit 7dcd32d1 authored by Randall Morgan's avatar Randall Morgan

[GB.GSL]

* NEW: Added Test Suite Gambas Project to GSL Component.

git-svn-id: svn://localhost/gambas/trunk@4527 867c0c6c-44f3-4631-809d-bfa615b0a4ec
parent a786448d
[Desktop Entry]
Icon=./.icon.png
# Gambas Project File 3.0
# Compiled with Gambas 3.0.90
Title=test
Startup=MMain
Version=0.0.1
Component=gb.gsl
Component=gb.option
Component=gb.xml
TabSize=2
[Breakpoints]
Count=0
[DebugWindow]
Count=0
[DebugWindow/Tests]
Geometry=[0,0,210,210]
[DebugWindow/v]
Geometry=[0,0,210,210]
[OpenFile]
Active=1
File[1]=".src/MMain.module:168.2"
File[2]=".src/TestSuite.class:115.39"
File[3]=".src/Test.class:128.80"
File[4]=".src/TestComplex.class:19.16"
Count=4
[Watches]
Count=0
This diff is collapsed.
This diff is collapsed.
' Gambas class file
' ==================================================================
' @Class: TestSuite
' @Author: R Morgan <rmorgan62@gmail.com>
' @Date: 03/01/2012
' @Ver: 0.01
' @Desc: A framework for running unit and regression tests.
' ==================================================================
Public Name As String ' Name of test, usually the function or method name.
Public msgError As String ' Error Message if any
Public hasError As Boolean = False ' True is we find an error
Public Expected As Variant ' Expected Value
Public Result As Variant ' Result value
Public ExpType As String ' Expected Datatype
Public ResType As String ' Result Datatype
Public Note As String ' Note on test
'-------------------------------------------------------------------
'@Sub: AddError
'@Desc: This method simply adds the passed error string to the
'error message array.
'@Ver:0.01
'@First: 03/01/2012
'@Returns: Void
'@Param msg - A string containing the error message
'-------------------------------------------------------------------
Public Sub AddError(msg As String)
Me.msgError = msg
Me.hasError = True
End
'-------------------------------------------------------------------
'@Func; TypeError
'@Desc: This method creates an error message for a type error
'@Ver:0.01
'@First: 03/01/2012
'@Returns: A string containing the type error message.
'@Param msg - A string containing the type as a string.
'-------------------------------------------------------------------
Public Function TypeError(gotType As String, expectedType As String) As String
Dim msg As String
msg = "Type error :<<< Expected type: " & expectedType & " Got type: " & gotType & " >>>"
Return msg
End
'-------------------------------------------------------------------
'@Desc: This method simply adds the passed error string to the
'error message array.
'@Ver:0.01
'@First: 03/01/2012
'@Returns: Void
'@Param msg - A string containing the error message
'-------------------------------------------------------------------
Public Function ValueError(gotValue As Variant, expectedValue As Variant) As String
Dim msg As String
msg = "Value error: <<< Expected: " & Str(expectedValue) & " Got: " & Str(gotValue) & " >>>"
Return msg
End
'-------------------------------------------------------------------
'@Desc: This method simply adds the passed error string to the
'error message array.
'@Ver:0.01
'@First: 03/01/2012
'@Returns: Void
'@Param msg - A string containing the error message
'-------------------------------------------------------------------
Public Function getTypeString(p As Variant) As String
Select Case TypeOf(p)
Case gb.NULL
Return "NULL"
Case gb.Boolean
Return "Boolean"
Case gb.Byte
Return "Byte"
Case gb.Class
Return "Class"
Case gb.Date
Return "Date"
Case gb.Float
Return "Float"
Case gb.Integer
Return "Integer"
Case gb.Long
Return "Long"
Case gb.Object
Return "Object"
Case gb.Pointer
Return "Pointer"
Case gb.Short
Return "Short"
Case gb.Single
Return "Single"
Case gb.String
Return "String"
Case gb.Variant
Return "Variant"
Default
Return "Unknown"
End Select
End
'-------------------------------------------------------------------
'@Desc: This method tests the given values for equality in both
' type and value.
'@Ver:0.01
'@First: 03/01/2012
'@Returns:
'@Param: func - A string containing the function that was tested.
'@Param: result - A variant value containing the actual result of
' the test.
'@Param: expected - A variant value containing the expected result
'value for the test.
'-------------------------------------------------------------------
Public Sub Run(func As String, result As Variant, expected As Variant, Optional note As String) As Boolean
Dim err As Boolean = False
Me.Name = func
Me.Note = note
Me.Expected = expected
Me.ExpType = getTypeString(expected)
Me.Result = result
Me.ResType = getTypeString(result)
If TypeOf(result) <> TypeOf(expected) Then
AddError(TypeError(Me.ResType, Me.ExpType))
err = True
Else
If result <> expected Then
AddError(ValueError(Me.Result, Me.Expected))
err = True
Endif
Endif
Return Me.hasError
End
' Gambas class file
' ==================================================================
' @Class: TestSuite
' @Author: R Morgan <rmorgan62@gmail.com>
' @Date: 03/01/2012
' @Ver: 0.01
' @Desc: A framework for running unit and regression tests.
' ==================================================================
Public Name As String ' Name of test, usually the function or method name.
Public msgError As String ' Error Message if any
Public hasError As Boolean = False ' True is we find an error
Public Expected As Variant ' Expected Value
Public Result As Variant ' Result value
Public ExpType As String ' Expected Datatype
Public ResType As String ' Result Datatype
Public Note As String ' Note on test
'-------------------------------------------------------------------
'@Sub: AddError
'@Desc: This method simply adds the passed error string to the
'error message array.
'@Ver:0.01
'@First: 03/01/2012
'@Returns: Void
'@Param msg - A string containing the error message
'-------------------------------------------------------------------
Public Sub AddError(msg As String)
Me.msgError = msg
Me.hasError = True
End
'-------------------------------------------------------------------
'@Func; TypeError
'@Desc: This method creates an error message for a type error
'@Ver:0.01
'@First: 03/01/2012
'@Returns: A string containing the type error message.
'@Param msg - A string containing the type as a string.
'-------------------------------------------------------------------
Public Function TypeError(gotType As String, expectedType As String) As String
Dim msg As String
msg = "Type error :<<< Expected type: " & expectedType & " Got type: " & gotType & " >>>"
Return msg
End
'-------------------------------------------------------------------
'@Desc: This method simply adds the passed error string to the
'error message array.
'@Ver:0.01
'@First: 03/01/2012
'@Returns: Void
'@Param msg - A string containing the error message
'-------------------------------------------------------------------
Public Function ValueError(gotValue As Variant, expectedValue As Variant) As String
Dim msg As String
msg = "Value error: <<< Expected: " & Str(expectedValue) & " Got: " & Str(gotValue) & " >>>"
Return msg
End
'-------------------------------------------------------------------
'@Desc: This method simply adds the passed error string to the
'error message array.
'@Ver:0.01
'@First: 03/01/2012
'@Returns: Void
'@Param msg - A string containing the error message
'-------------------------------------------------------------------
Public Function getTypeString(p As Variant) As String
Select Case TypeOf(p)
Case gb.NULL
Return "NULL"
Case gb.Boolean
Return "Boolean"
Case gb.Byte
Return "Byte"
Case gb.Class
Return "Class"
Case gb.Date
Return "Date"
Case gb.Float
Return "Float"
Case gb.Integer
Return "Integer"
Case gb.Long
Return "Long"
Case gb.Object
Return "Object"
Case gb.Pointer
Return "Pointer"
Case gb.Short
Return "Short"
Case gb.Single
Return "Single"
Case gb.String
Return "String"
Case gb.Variant
Return "Variant"
Default
Return "Unknown"
End Select
End
'-------------------------------------------------------------------
'@Desc: This method tests the given values for equality in both
' type and value.
'@Ver:0.01
'@First: 03/01/2012
'@Returns:
'@Param: func - A string containing the function that was tested.
'@Param: result - A variant value containing the actual result of
' the test.
'@Param: expected - A variant value containing the expected result
'value for the test.
'-------------------------------------------------------------------
Public Sub Run(func As String, result As Variant, expected As Variant, Optional note As String) As Boolean
Dim err As Boolean = False
Me.Name = func
Me.Note = note
Me.Expected = expected
Me.ExpType = getTypeString(expected)
Me.Result = result
Me.ResType = getTypeString(result)
If TypeOf(result) <> TypeOf(expected) Then
AddError(TypeError(Me.ResType, Me.ExpType))
err = True
Else
If result <> expected Then
AddError(ValueError(Me.Result, Me.Expected))
err = True
Endif
Endif
Return Me.hasError
End
' Gambas class file
Inherits Test
Public Sub IsEqual(z1 As Complex, z2 As Complex) As Boolean
If (z1.Real = z2.Real) And z1.Imag = z2.Imag Then
Return True
Else
Return False
Endif
End
Public Sub Run(func As String, result As Variant, expected As Variant, Optional note As String) As Boolean
Dim err As Boolean = False
Me.Name = func
Me.Note = note
Me.Expected = expected
Me.ExpType = Me.getTypeString(expected)
Me.Result = result
Me.ResType = Me.getTypeString(result)
If TypeOf(result) <> gb.Object And TypeOf(expected) <> gb.Object Then
' Not an object so run parent code
If TypeOf(result) <> TypeOf(expected) Then
Me.AddError(Me.TypeError(Me.ResType, Me.ExpType))
err = True
Else
If result <> expected Then
Me.AddError(Me.ValueError(Me.Result, Me.Expected))
err = True
Endif
Endif
Else
'We have objects that need special processing
If TypeOf(result) <> TypeOf(expected) Then
Me.AddError(Me.TypeError(Me.ResType, Me.ExpType))
err = True
Else
If result Is Complex And expected Is Complex Then
If IsEqual(result, expected) Then
Me.Result = result.ToString()
Me.ResType = "Complex Object"
Me.Expected = expected.ToString()
Me.ExpType = "Complex Object"
Else
Me.AddError(Me.ValueError(result.ToString, expected.ToString))
err = True
Endif
Endif
Endif
Endif
Return Me.hasError
End
' Gambas class file
Inherits Test
Public Sub IsEqual(z1 As Complex, z2 As Complex) As Boolean
If (z1.Real = z2.Real) And z1.Imag = z2.Imag Then
Return True
Else
Return False
Endif
End
Public Sub Run(func As String, result As Variant, expected As Variant, Optional note As String) As Boolean
Dim err As Boolean = False
Me.Name = func
Me.Expected = expected
Me.ExpType = Me.getTypeString(expected)
Me.Result = result
Me.ResType = Me.getTypeString(result)
If TypeOf(result) <> gb.Object And TypeOf(expected) <> gb.Object Then
' Not an object so run parent code
If TypeOf(result) <> TypeOf(expected) Then
Me.AddError(Me.TypeError(Me.ResType, Me.ExpType))
err = True
Else
If result <> expected Then
Me.AddError(Me.ValueError(Me.Result, Me.Expected))
err = True
Endif
Endif
Else
'We have objects that need special processing
If TypeOf(result) <> TypeOf(expected) Then
Me.AddError(Me.TypeError(Me.ResType, Me.ExpType))
err = True
Else
If result Is Complex And expected Is Complex Then
If IsEqual(result, expected) Then
Me.Result = result.ToString()
Me.ResType = "Complex Object"
Me.Expected = expected.ToString()
Me.ExpType = "Complex Object"
Else
Me.AddError(Me.ValueError(result.ToString, expected.ToString))
err = True
Endif
Endif
Endif
Endif
Return Me.hasError
End
' Gambas class file
' ==================================================================
' @Class: TestSuite
' @Author: R Morgan <rmorgan62@gmail.com>
' @Date: 03/01/2012
' @Ver: 0.01
' @Desc: A framework for running unit and regression tests.
' ==================================================================
Public numErrors As Integer
Public msgErrors As New String[]
Private numTests As Integer
Public Tests As New Test[]
Public hasErrors As Boolean
Public HeaderChar As String = "="
Public HeaderWidth As Integer = 40
Public TestHeaderChar As String = "-"
Public TestHeaderWidth As Integer = 40
Public Name As String
Public Note As String
Public NoteHeaderChar As String = "*"
Public NoteHeaderWidth As Integer = 40
Public ShowTestNotes As Boolean = False
Public Sub AddTest(t As Test)
Tests.Add(t)
numTests += 1
End
Public Procedure ErrorCount() As Integer
Dim i As Integer
Dim t As Test
For i = 0 To Tests.Length - 1
t = Tests[i]
If t.hasError Then
Me.numErrors += 1
Me.hasErrors = True
Endif
Next
Return Me.numErrors
End
Public Sub ShowHeader()
Dim Header As String
Me.ErrorCount()
Header = String$(Me.HeaderWidth, Me.HeaderChar)
Header &= "\n " & Name & " test\n"
Header &= " Date: " & Date() & "\n"
Header &= " Time: " & Time() & "\n"
If Me.hasErrors Then
Header &= " Failure:" & Me.numErrors & " errors occurred.\n"
Else
Header &= " Success: All tests passed.\n"
Endif
Header &= " There are " & numTests & " test in this run.\n"
Header &= String$(Me.HeaderWidth, Me.HeaderChar)
Header &= "\n\n"
Print Header
End
Public Sub ShowNotes()
Dim Header As String
If Len(Me.Note) > 0 Then
Header = String$(Me.NoteHeaderWidth, Me.NoteHeaderChar)
Header &= "\n"
Header &= Me.Note & "\n"
Header &= String$(Me.NoteHeaderWidth, Me.NoteHeaderChar)
Header &= "\n\n"
Print Header
Endif
End
Public Sub ShowTest(idx As Integer)
Dim t As New Test
Dim header As String
Dim cnt As Integer = idx + 1
t = Tests[idx]
header = String$(Me.TestHeaderWidth, Me.TestHeaderChar)
header &= "\n #" & cnt & " " & t.Name & "\n"
If t.hasError Then
header &= " Status: <<<<< Failure >>>>> \n"
header &= " Error: " & t.msgError & "\n"
Else
header &= " Status: Passed \n"
Endif
header &= " Expected result: " & Str(t.Expected) & "\n of type: " & t.ExpType & "\n"
header &= " Recieved result: " & Str(t.Result) & "\n of type: " & t.ResType & "\n"
If ShowTestNotes And Len(t.Note) <> 0 Then
header &= " Notes: " & t.Note & "\n"
Endif
header &= String$(Me.TestHeaderWidth, Me.TestHeaderChar)
Print header
End
Public Sub ShowTests()
Dim t As Test
Dim i As Integer
Me.ShowHeader()
Me.ShowNotes()
i = 0
For i = 0 To Tests.Length - 1
ShowTest(i)
Next
End
' Gambas class file
' ==================================================================
' @Class: TestSuite
' @Author: R Morgan <rmorgan62@gmail.com>
' @Date: 03/01/2012
' @Ver: 0.01
' @Desc: A framework for running unit and regression tests.
' ==================================================================
Public numErrors As Integer
Public msgErrors As New String[]
Private numTests As Integer
Public Tests As New Test[]
Public hasErrors As Boolean
Public HeaderChar As String = "="
Public HeaderWidth As Integer = 40
Public TestHeaderChar As String = "-"
Public TestHeaderWidth As Integer = 40
Public Name As String
Public Note As String
Public NoteHeaderChar As String = "*"
Public NoteHeaderWidth As Integer = 40
Public ShowTestNotes As Boolean = False
Public Sub AddTest(t As Test)
Tests.Add(t)
numTests += 1
End
Public Procedure ErrorCount() As Integer
Dim i As Integer
Dim t As Test
For i = 0 To Tests.Length - 1
t = Tests[i]
If t.hasError Then
Me.numErrors += 1
Me.hasErrors = True
Endif
Next
Return Me.numErrors
End
Public Sub ShowHeader()
Dim Header As String
Me.ErrorCount()
Header = String$(Me.HeaderWidth, Me.HeaderChar)
Header &= "\n " & Name & " test\n"
Header &= " Date: " & Date() & "\n"
Header &= " Time: " & Time() & "\n"
If Me.hasErrors Then
Header &= " Failure:" & Me.numErrors & " errors occurred.\n"
Else
Header &= " Success: All tests passed.\n"
Endif
Header &= " There are " & numTests & " test in this run.\n"
Header &= String$(Me.HeaderWidth, Me.HeaderChar)
Header &= "\n\n"
Print Header
End
Public Sub ShowNotes()
Dim Header As String
If Len(Me.Note) > 0 Then
Header = String$(Me.NoteHeaderWidth, Me.NoteHeaderChar)
Header &= "\n"
Header &= Me.Note & "\n"
Header &= String$(Me.NoteHeaderWidth, Me.NoteHeaderChar)
Header &= "\n\n"
Print Header
Endif
End
Public Sub ShowTest(idx As Integer)
Dim t As New Test
Dim header As String
Dim cnt As Integer = idx + 1
t = Tests[idx]
header = String$(Me.TestHeaderWidth, Me.TestHeaderChar)
header &= "\n #" & cnt & " " & t.Name & "\n"
If t.hasError Then
header &= " Status: <<<<< Failure >>>>> \n"
header &= " Error: " & t.msgError & "\n"
Else
header &= " Status: Passed \n"
Endif
header &= " Expected result: " & Str(t.Expected) & "\n of type: " & t.ExpType & "\n"
header &= " Recieved result: " & Str(t.Result) & "\n of type: " & t.ResType & "\n"
If ShowTestNotes Then
header &= " Notes: " & t.Note & "\n"
Endif
header &= String$(Me.TestHeaderWidth, Me.TestHeaderChar)
Print header
End
Public Sub ShowTests()
Dim t As Test