Commit 7395093f authored by Benoît Minisini's avatar Benoît Minisini

'gb.util' and 'gb.settings' are not required anymore.

[GB.TEST]
* NEW: 'gb.util' and 'gb.settings' are not required anymore.
* NEW: Add an Helper module that implements the functions replacing what was used in 'gb.util' and 'gb.settings'.
* BUG: Rewrite the GetTestSuiteByName() method without 'gb.settings', and fix it. It was completely broken.
parent 0447fc17
......@@ -4,8 +4,6 @@ Startup=ZzzDoSth
Icon=.hidden/gb.test.png
Version=3.14.90
VersionFile=1
Component=gb.util
Component=gb.settings
Description="A Gambas component for unittesting and test-driven programming."
Authors="Christof Thalhofer\nTobias Boege"
TabSize=4
......
' Gambas module file
Private $iSectionSize As Integer
Private $iSectionPos As Integer
Private Sub GotoNextSection(hFile As File)
$iSectionPos += $iSectionSize
Seek #hFile, $iSectionPos
$iSectionSize = Read #hFile As Integer
$iSectionPos += 4
End
Private Sub ReadZeroString(hFile As File) As String
Dim sStr As String
Dim iPos As Integer
Do
sStr &= Read #hFile, Min(16, Lof(hFile) - Seek(hFile))
iPos = InStr(sStr, Chr$(0))
If iPos Then Return Left(sStr, iPos - 1)
Loop
End
Public Sub CheckTestModule(Name As String) As String
Dim sPath As String
Dim hFile As File
Dim iVal As Integer
Dim iParent As Integer
Dim iFlag As Short
Dim bDebug As Boolean
Dim iStringPos As Integer
Dim sName As String
sPath = ".../.gambas" &/ UCase(Name)
If Not Exist(sPath) Then Error.Raise("Class not found")
$iSectionPos = 0
$iSectionSize = 0
hFile = Open sPath
Seek #hFile, 8
iVal = Read #hFile As Integer
If iVal <> &H12345678 Then hFile.ByteOrder = 1 - hFile.ByteOrder
Seek #hFile, 12
iVal = Read #hFile As Integer
bDebug = iVal And 1
$iSectionSize = 16
GotoNextSection(hFile) ' info
Seek #hFile, $iSectionPos
iParent = Read #hFile As Short
iFlag = Read #hFile As Short
'hStat.Exported = BTst(iFlag, 0)
'hStat.AutoCreate = BTst(iFlag, 1)
'hStat.Optional = BTst(iFlag, 2)
'hStat.NoCreate = BTst(iFlag, 3)
'hStat.HasFast = BTst(iFlag, 4)
If BTst(iFlag, 5) Then
GotoNextSection(hFile) ' description
GotoNextSection(hFile) ' constant
GotoNextSection(hFile) ' reference
If iParent <> -1 Then
Seek #hFile, $iSectionPos + iParent * 4
iParent = Read #hFile As Integer
iParent = Abs(iParent)
Endif
Do
iStringPos = $iSectionPos
Try GotoNextSection(hFile)
If Error Then Break
Loop
Seek #hFile, iStringPos
sName = ReadZeroString(hFile)
Close hFile
Endif
Return sName
End
Public Function GetTestSuiteByName(Name As String) As String
Dim hFile As File
Dim sLine As String
Dim sName As String
Dim sTests As String
Dim bName As Boolean
Dim bTests As Boolean
If Name Begins "@" Then Name = Mid$(Name, 2)
hFile = Open ".../.test"
For Each sLine In hFile.Lines
If sLine Begins "[" Then
bName = False
bTests = False
Else If sLine Begins "Name=" Then
sName = UnQuote(Mid$(sLine, 6))
If bTests And If sName = Name Then Return sTests
bName = True
Else If sLine Begins "Tests=" Then
sTests = UnQuote(Mid$(sLine, 7))
If bName And If sName = Name Then Return sTests
bTests = True
Endif
Next
' Dim Set As New Settings(Application.Path &/ ".test")
' Dim sKey As String
'
' If Name Begins "@" Then
' Name = Right(Name, String.Len(Name) - 1)
' Endif
'
' For Each sKey In Set.Keys
' If Set[sKey &/ "Name"] = Name Then
' Return Set[sKey &/ "Tests"]
' Endif
' Next
'
Error.Raise(Subst(("Could not find a test suite with the name '&1'"), Name))
End
......@@ -131,6 +131,6 @@ Public Sub FindTestSuiteByName()
Dim sName As String = "Keep this test suite, it is necessary for testing gb.test."
Assert.Equals(MTest.GetTestSuiteByName(sName), "TInternals.FindTestSuiteByName")
Assert.Equals(Helper.GetTestSuiteByName(sName), "TInternals.FindTestSuiteByName")
End
' Gambas module file
''' Helper functions for Test class (that need to be tested but should not be exported)
'' fiddle out testsuite's tests out of .test file
Public Function GetTestSuiteByName(Name As String) As String
Dim Set As New Settings(Application.Path &/ ".test")
Dim sKey As String
If Name Begins "@" Then
Name = Right(Name, String.Len(Name) - 1)
Endif
For Each sKey In Set.Keys
If Set[sKey &/ "Name"] = Name Then
Return Set[sKey &/ "Tests"]
Endif
Next
Error.Raise(Subst(("Could not find a test suite with the name '&1'."), Name))
End
......@@ -63,7 +63,7 @@ Public Sub Main(Optional Tests As String)
If Tests Begins "@" Then
'a test suite was called by name
sTestsuite = Tests
Tests = MTest.GetTestSuiteByName(Tests)
Tests = Helper.GetTestSuiteByName(Tests)
Endif
' run tests
......@@ -216,22 +216,21 @@ Private Function GetAllTestModules() As Class[]
Dim TestClass As Class
Dim TestModules As New Class[]
Dim sNames As New String[]
Dim aNames As New String[]
Dim sName As String
Dim hStat As ClassStat
Component.Load("gb.util")
For Each sName In Dir(".../.gambas")
hStat = Class.Stat("..." &/ sName)
If hStat.Test Then sNames.Add(hStat.Name)
sName = Helper.CheckTestModule(sName)
If sName Then aNames.Add(sName)
Next
Assert sNames
Assert aNames
sNames.Sort
aNames.Sort
For Each sName In sNames
For Each sName In aNames
TestClass = __Test.Load(sName)
If Not TestClass Then Error.Raise(Subst$(("Could not load test module '&1'"), sName))
TestModules.Add(TestClass)
......@@ -408,14 +407,13 @@ End
Private Sub PrintAllTestModules()
Dim sName As String
Dim hStat As ClassStat
Dim aTest As New String[]
Component.Load("gb.util")
For Each sName In Dir(".../.gambas")
hStat = Class.Stat("..." &/ sName)
If hStat.Test Then aTest.Add(hStat.Name)
sName = Helper.CheckTestModule(sName)
If sName Then aTest.Add(sName)
Next
Print aTest.Join();
......@@ -447,3 +445,4 @@ Private Sub FromString(Tests As String)
Next
End
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment