File: Tests.vb

package info (click to toggle)
mono-basic 2.6.2-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 18,852 kB
  • ctags: 809
  • sloc: cs: 8,852; makefile: 516; sh: 307
file content (312 lines) | stat: -rwxr-xr-x 10,852 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
' 
' Visual Basic.Net COmpiler
' Copyright (C) 2004 - 2006 Rolf Bjarne Kvinge, rbjarnek at users.sourceforge.net
' 
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Lesser General Public
' License as published by the Free Software Foundation; either
' version 2.1 of the License, or (at your option) any later version.
' 
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
' Lesser General Public License for more details.
' 
' You should have received a copy of the GNU Lesser General Public
' License along with this library; if not, write to the Free Software
' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
' 

''' <summary>
''' A list of tests.
''' </summary>
''' <remarks></remarks>
<Serializable()> _
Public Class Tests
    Inherits TestList

    Private m_Path As String
    Private m_Parent As Tests
    Private m_ContainedTests As New Generic.List(Of Tests)
    Private m_SkipCleanTests As Boolean
    Private m_Recursive As Boolean
    Private m_KnownFailures As New Generic.List(Of String)

    ''' <summary>
    ''' The total time all tests have been executing.
    ''' </summary>
    ''' <value></value>
    ''' <remarks></remarks>
    ReadOnly Property ExecutionTimeRecursive() As TimeSpan
        Get
            Dim result As TimeSpan
            result = MyBase.ExecutionTime

            For Each list As Tests In m_ContainedTests
                result += list.ExecutionTimeRecursive
            Next
            Return result
        End Get
    End Property

    Property SkipCleanTests() As Boolean
        Get
            Return m_SkipCleanTests
        End Get
        Set(ByVal value As Boolean)
            m_SkipCleanTests = value
            For Each item As Tests In m_ContainedTests
                item.SkipCleanTests = value
            Next
        End Set
    End Property

    ReadOnly Property RecursiveCount() As Integer
        Get
            Dim result As Integer
            For Each item As Tests In m_ContainedTests
                result += item.RecursiveCount
            Next
            result += Me.Count
            Return result
        End Get
    End Property

    ReadOnly Property GetGreenRecursiveCount() As Integer
        Get
            Dim result As Integer
            For Each item As Tests In m_ContainedTests
                result += item.GetGreenRecursiveCount
            Next
            result += Me.GetTestsCount(Test.Results.Success, Test.Results.Success)
            Return result
        End Get
    End Property

    Sub GetTestsCountRecursive(ByVal result() As Integer)
        For Each item As Tests In m_ContainedTests
            item.GetTestsCountRecursive(result)
        Next
        GetTestsCount(result)
    End Sub

    ReadOnly Property GetGreenCount() As Integer
        Get
            Return Me.GetTestsCount(Test.Results.Success, Test.Results.Success)
        End Get
    End Property

    ReadOnly Property GetRedRecursiveCount() As Integer
        Get
            Dim result As Integer
            For Each item As Tests In m_ContainedTests
                result += item.GetRedRecursiveCount
            Next
            result += Me.GetTestsCount(Test.Results.Failed, Test.Results.Failed)
            Return result
        End Get
    End Property

    ReadOnly Property GetRedCount() As Integer
        Get
            Return Me.GetTestsCount(Test.Results.Failed, Test.Results.Failed)
        End Get
    End Property

    Function GetAllTestsInTree() As TestList
        Dim result As New TestList()
        result.AddRange(Me)
        For Each tests As Tests In m_ContainedTests
            result.AddRange(tests.GetAllTestsInTree)
        Next
        Return result
    End Function

    ReadOnly Property ContainedTests() As Generic.List(Of Tests)
        Get
            Return m_ContainedTests
        End Get
    End Property

    ReadOnly Property Path() As String
        Get
            Return m_Path
        End Get
    End Property

    ''' <summary>
    ''' Create a new test run.
    ''' </summary>
    ''' <param name="Path">The path to the folders where the tests are.</param>
    ''' <param name="CompilerPath">The path to the compiler.</param>
    ''' <remarks></remarks>
    Sub New(ByVal Parent As Tests, ByVal Path As String, ByVal CompilerPath As String, ByVal VBCPath As String, Optional ByVal Recursive As Boolean = True)
        MyBase.New(CompilerPath, VBCPath)
        'Console.WriteLine("Loading: " & Path)
        'If Parent IsNot Nothing Then
        '    Console.WriteLine(" Parent: " & Parent.Path)
        'End If
        'Console.WriteLine(Environment.StackTrace)
        m_Parent = Parent
        m_Path = Path
        m_Recursive = Recursive

        Refresh()
    End Sub

    Public Overrides Sub Add(ByVal Test As Test)
        MyBase.Add(Test)
        Test.KnownFailure = IsKnownFailure(Test.Name)
    End Sub

    Function IsKnownFailure(ByVal Name As String) As Boolean
        'Console.WriteLine("Checking if " & Name & " is a known failure.")
        If m_KnownFailures.Contains(Name) Then
            'Console.WriteLine("YES")
            'Console.WriteLine(Environment.StackTrace)
            Return True
        End If
        If m_Parent IsNot Nothing Then
            'Console.WriteLine("Checking in parent, path: " & m_Path)
            Return m_Parent.IsKnownFailure(IO.Path.Combine(IO.Path.GetFileName(m_Path), Name))
        End If
        Return False
    End Function

    Sub Update()
        'Get all the code files in the directory.
        Dim files() As String = IO.Directory.GetFiles(m_Path, "*.vb")

        Array.Sort(files)

        'Remove files that aren't there anymore
        Dim j As Integer = 0
        While j < Me.Count
            Dim test As Test = Me(j)
            Do While test.Files.Count > 0 AndAlso Array.BinarySearch(files, test.Files(0)) < 0
                test.Files.RemoveAt(0)
            Loop
            If test.Files.Count = 0 Then
                Me.RemoveAt(j)
            Else
                j += 1
            End If
        End While

        'Add all new files
        For Each file As String In files
            Dim newName As String = Test.GetTestName(file)
            Dim newTest, oldTest As Test
            oldTest = Item(newName)
            If oldTest Is Nothing Then
                newTest = New Test(file, Me)
                Add(newTest)
            ElseIf oldTest.Files.Contains(file) = False Then
                oldTest.Files.Add(file)
            End If
        Next

        If m_Recursive Then
            Dim dirs As Generic.List(Of String) = GetContainedTestDirectories()
            For i As Integer = 0 To m_ContainedTests.Count - 1
                Dim tests As Tests = m_ContainedTests(i)
                If dirs.Contains(tests.Path) = False Then
                    m_ContainedTests.RemoveAt(i) : i -= 1
                End If
            Next
            For i As Integer = 0 To dirs.Count - 1
                Dim dir As String = dirs(i)
                Dim oldTests As Tests = Nothing

                For Each containedtests As Tests In m_ContainedTests
                    If containedtests.Path = dir Then
                        oldTests = containedtests
                        Exit For
                    End If
                Next
                If oldTests IsNot Nothing Then
                    oldTests.Update()
                Else
                    m_ContainedTests.Add(New Tests(Me, dir, MyBase.VBNCPath, MyBase.VBCPath))
                End If
            Next
        End If
    End Sub

    Sub Refresh()
        Me.Clear()
        Me.m_ContainedTests.Clear()
        m_KnownFailures.Clear()

        'Get known failures
        Dim knownFailures As String = IO.Path.Combine(m_Path, "KnownFailures.txt")
        If IO.File.Exists(knownFailures) Then
            Dim comment As String
            Dim test As String
            For Each line As String In IO.File.ReadAllLines(knownFailures)
                line = line.Trim
                If line.IndexOf("'"c) >= 0 Then
                    comment = line.Substring(line.IndexOf("'"c) + 1)
                    test = line.Substring(0, line.IndexOf("'"c))
                Else
                    test = line
                End If
                test = test.Trim
                test = test.Replace("\"c, System.IO.Path.DirectorySeparatorChar)
                If test = String.Empty Then Continue For
                'Console.WriteLine("Added known failure: " & test)
                m_KnownFailures.Add(test.Replace("\"c, IO.Path.DirectorySeparatorChar))
            Next
            Console.WriteLine("Found " & m_KnownFailures.Count & " known failures in " & knownFailures)
        End If

        'Get all the code files in the directory.
        Dim files() As String = IO.Directory.GetFiles(m_Path, "*.vb")
        Array.Sort(files)
        For Each file As String In files
            Dim newTest, oldTest As Test
            newTest = New Test(file, Me)
            oldTest = Item(newTest.Name)
            If oldTest Is Nothing Then
                Add(newTest)
            ElseIf oldTest.Files.Contains(file) = False Then
                oldTest.Files.Add(file)
            End If
        Next

        If m_Recursive Then
            Dim dirs As Generic.List(Of String) = GetContainedTestDirectories()
            For Each dir As String In dirs
                m_ContainedTests.Add(New Tests(Me, dir, MyBase.VBNCPath, MyBase.VBCPath))
            Next
        End If
    End Sub

    Function GetContainedTestDirectories() As Generic.List(Of String)
        Dim result As New Generic.List(Of String)
        Dim dirs() As String = IO.Directory.GetDirectories(m_Path)

        Array.Sort(dirs)

        'Add all the subdirectories (only if they are neither hidden nor system directories and they 
        'must not be named "testoutput"
        For Each dir As String In dirs
            If System.IO.Path.GetFileName(dir).StartsWith(".") Then Continue For

            Dim dirAttr As IO.FileAttributes = IO.File.GetAttributes(dir)
            If Not (CBool(dirAttr And (IO.FileAttributes.Hidden Or IO.FileAttributes.System))) Then
                If dir.EndsWith("testoutput", StringComparison.InvariantCultureIgnoreCase) = False Then
                    result.Add(IO.Path.GetFullPath(dir))
                End If
            End If
        Next
        Return result
    End Function

    Function FindContainedTestList(ByVal Path As String) As Tests
        For Each item As Tests In m_ContainedTests
            If item.Path = Path Then Return item
        Next
        Return Nothing
    End Function
End Class