RunningTests.vb

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WinUnit - Maria Blees ([email protected])
'
' [ With modifications by Nate Silva to fix "Current function is not a WinUnit
' test (BEGIN_TEST)" - see http://goo.gl/Znfb ]
'
' This module contains macros for running tests.
'
' In order to use these, make sure that the variable
' WinUnitPath in the _Variables module is set to where
' WinUnit.exe is on your local machine.
'
' RunTestsInSelectedProject - runs all tests in the project
'   selected in Solution Explorer.  You must have only one project
'   selected, and it must be a C/C++ project.
'
' RunTestAtCursor - runs the test containing the cursor in the
'   active document.  The active document must be a C/C++ file and
'   must be a member of a currently opened C/C++ project.
'
' RunAllTestsInFile - runs all the tests in the currently active file.
'   The active file must be a C/C++ file and must be a member of a
'   currently opened C/C++ project.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Imports System
Imports EnvDTE
Imports EnvDTE80
Imports System.Diagnostics
Imports Microsoft.VisualStudio.VCProjectEngine
Imports System.IO
Imports System.Text
Imports System.Collections.Generic

Public Module RunningTests

    ' This is the prefix that must be on function names in order for them to be
    ' considered a runnable test (note that parameters are not checked).
    Private TestPrefix As String = "TEST_"

    ' Run all the tests in the project selected in Solution Explorer.
    Public Sub RunTestsInSelectedProject()
        Dim testResultsPane As OutputPane = GetTestOutputPane()
        Dim outputPane As OutputPane = GetProgramOutputPane()

        Dim proj As Project = GetSelectedProject(outputPane)
        If proj Is Nothing Then
            outputPane.WriteLine("Nothing to run.")
            Exit Sub
        End If

        Dim projectConfiguration As VCConfiguration = GetCurrentConfigurationForProject(proj, outputPane)
        If projectConfiguration Is Nothing Then
            outputPane.WriteLine("Project {0} is not a C/C++ project.", proj.Name)
            Exit Sub
        End If

        BuildProjectAndDependencies(proj, outputPane)
        outputPane.Activate()
        RunTestsInProject(projectConfiguration, outputPane, testResultsPane)
    End Sub

    ' Same as above, but passing in the configuration and output panes.  This is also
    ' used in one of the RunningTestsWithCoverage macros.
    Public Sub RunTestsInProject(ByVal projectConfiguration As VCConfiguration, _
                                 ByVal ow As OutputPane, _
                                 ByVal testOutput As OutputPane)

        Dim testFile As String = GetProjectOutput(projectConfiguration)

        If String.IsNullOrEmpty(testFile) Then
            ow.WriteLine("Select a VC++ project and ensure that its output path is valid.")
            Exit Sub
        End If


        Dim args As String = testFile
        Dim workingDirectory As String = Path.GetDirectoryName(testFile)

        RunWinUnitWithArgs(testFile, workingDirectory, ow, testOutput)

    End Sub

    ' Run the single test that the cursor is at in the active document.
    Public Sub RunTestAtCursor()
        Dim testOutput As OutputPane = GetTestOutputPane()
        Dim outputPane As OutputPane = GetProgramOutputPane()

        Dim proj As Project = GetActiveDocumentProject(outputPane)
        If proj Is Nothing Then
            outputPane.WriteLine("Nothing to run.")
            Exit Sub
        End If

        Dim projectConfiguration As VCConfiguration = GetCurrentConfigurationForProject(proj, outputPane)
        If projectConfiguration Is Nothing Then
            outputPane.WriteLine("Project {0} is not a C/C++ project.", proj.Name)
            Exit Sub
        End If

        BuildProjectAndDependencies(proj, outputPane)
        outputPane.Activate()
        RunTestAtCursor(projectConfiguration, outputPane, testOutput)
    End Sub

    ' Same as above, but you pass in the project configuration and output panes.
    ' Used in RunningTestsWithCoverage.
    Public Sub RunTestAtCursor(ByVal projectConfiguration As VCConfiguration, _
                               ByVal ow As OutputPane, _
                               ByVal testOutput As OutputPane)

        Dim testName As String = GetCurrentTestName(ow)
        If String.IsNullOrEmpty(testName) Then
            ow.WriteLine("No test function selected.")
            Exit Sub
        End If
        'If Not currentFunctionName.StartsWith(TestPrefix) Then
        '    ow.WriteLine("Current function is not a WinUnit test ({0}).", currentFunctionName)
        '    Exit Sub
        'End If

        'Dim testName As String = currentFunctionName.Remove(0, TestPrefix.Length)

        RunSingleTest(projectConfiguration, testName, ow, testOutput)
    End Sub

    ' Run all tests in the currently active document (provided it's a C/C++ file
    ' and is a member of an open C/C++ project).
    Public Sub RunAllTestsInFile()
        Dim testOutput As OutputPane = GetTestOutputPane()
        Dim outputPane As OutputPane = GetProgramOutputPane()

        Dim proj As Project = GetActiveDocumentProject(outputPane)
        If proj Is Nothing Then
            outputPane.WriteLine("Nothing to run.")
            Exit Sub
        End If

        Dim projectConfiguration As VCConfiguration = GetCurrentConfigurationForProject(proj, outputPane)
        If projectConfiguration Is Nothing Then
            outputPane.WriteLine("Project {0} is not a C/C++ project.", proj.Name)
            Exit Sub
        End If

        BuildProjectAndDependencies(proj, outputPane)
        outputPane.Activate()
        RunAllTestsInActiveFile(projectConfiguration, outputPane, testOutput)
    End Sub

    ' Same as above but takes a project configuration and output panes.
    ' Used in RunningTestsWithCoverage.
    Public Sub RunAllTestsInActiveFile(ByVal projectConfiguration As VCConfiguration, _
                                       ByVal ow As OutputPane, _
                                       ByVal testOutput As OutputPane)

        Dim testList As List(Of String) = GetAllTestsInActiveFile(ow)
        If (testList Is Nothing) Then
            Exit Sub
        End If

        RunListOfTests(projectConfiguration, testList, ow, testOutput)

    End Sub

    ' Retrieves the $(TargetPath) for the given project.
    Private Function GetProjectOutput(ByVal projectConfiguration As VCConfiguration) As String
        Return projectConfiguration.Evaluate("$(TargetPath)")
    End Function

    ' Run WinUnit with the given args, in the given working directory.  Outputs general
    ' informational output to the main output pane and test output to the test output pane.
    ' Activates the test output pane at the end if tests were executed.
    Private Sub RunWinUnitWithArgs(ByVal args As String, _
                                   ByVal workingDirectory As String, _
                                   ByVal ow As OutputPane, _
                                   ByVal testOutput As OutputPane)
        Dim winUnitTool As String = _Variables.WinUnitPath
        If Not File.Exists(winUnitTool) Then
            ow.WriteLine("Could not find {0}.  Ensure it exists or change _Variables settings.", winUnitTool)
            Exit Sub
        End If

        ow.WriteLine("Running ""{0} {1}""...", winUnitTool, args)

        Dim sc As StringCapture = New StringCapture()

        Dim exitCode As Integer = sc.RunProcess(winUnitTool, args, workingDirectory)
        Dim output As String = sc.GetOutput()
        testOutput.Write(output)

        testOutput.Activate()
    End Sub

    Private Function GetCurrentTestName(ByVal ow As OutputPane) As String

        Dim doc As Document = DTE.ActiveDocument
        If (doc Is Nothing) Then
            ow.WriteLine("No document is open.")
            Exit Function
        End If
        Dim fileMod As FileCodeModel = doc.ProjectItem.FileCodeModel
        If (fileMod Is Nothing) Then
            ow.WriteLine("Unable to get the FileCodeModel.")
            Exit Function
        End If

        If (DTE.ActiveDocument.Language <> EnvDTE.Constants.dsCPP) Then
            ow.WriteLine("Active document must be a C/C++ file.")
            Exit Function
        End If

        Dim codeElement As CodeElement = fileMod.CodeElementFromPoint(DTE.ActiveDocument.Selection.ActivePoint, vsCMElement.vsCMElementFunction)
        If (codeElement Is Nothing) Then
            ow.WriteLine("No function selected")
            Exit Function
        End If

        Return ExtractTestName(codeElement)

    End Function

    Private Sub RunSingleTest(ByVal projectConfiguration As VCConfiguration, _
                              ByVal testName As String, _
                              ByVal ow As OutputPane, _
                              ByVal testOutput As OutputPane)

        Dim testList As List(Of String) = New List(Of String)
        testList.Add(testName)
        RunListOfTests(projectConfiguration, testList, ow, testOutput)

    End Sub

    Private Sub RunListOfTests(ByVal projectConfiguration As VCConfiguration, _
                               ByVal testList As List(Of String), _
                               ByVal ow As OutputPane, _
                               ByVal testOutput As OutputPane)
        Dim sb As StringBuilder = New StringBuilder()
        sb.Append("( ")

        Dim testName As String
        For Each testName In testList
            sb.Append(testName)
            sb.Append(" ")
        Next

        sb.Append(")")

        Dim testFile As String = GetProjectOutput(projectConfiguration)
        Dim args As String = String.Format("-e {0} {1}", sb.ToString(), testFile)

        RunWinUnitWithArgs(args, Path.GetDirectoryName(testFile), ow, testOutput)

    End Sub

    Private Function GetAllTestsInActiveFile(ByVal ow As OutputPane) As List(Of String)

        Dim doc As Document = DTE.ActiveDocument
        If (doc Is Nothing) Then
            ow.WriteLine("No document is open.")
            Exit Function
        End If
        Dim fileMod As FileCodeModel = doc.ProjectItem.FileCodeModel
        If (fileMod Is Nothing) Then
            ow.WriteLine("Unable to get the FileCodeModel.")
            Exit Function
        End If

        If (DTE.ActiveDocument.Language <> EnvDTE.Constants.dsCPP) Then
            ow.WriteLine("Active document must be a C/C++ file.")
            Exit Function
        End If

        Dim elements As CodeElements = fileMod.CodeElements

        Dim functionList As List(Of String) = New List(Of String)

        GetFunctionElements(elements, functionList)

        Return functionList

    End Function

    Private Sub GetFunctionElements(ByVal elements As CodeElements, _
                                ByRef functionList As List(Of String))
        Dim currentElement As CodeElement2
        For Each currentElement In elements

            If currentElement.Kind = vsCMElement.vsCMElementFunction Then
                Dim testName As String = ExtractTestName(currentElement)
                If Not String.IsNullOrEmpty(testName) Then
                    functionList.Add(testName)
                End If
            End If

            Dim childElements As CodeElements = Nothing

            childElements = currentElement.Children

            If (Not (childElements Is Nothing)) Then
                If (childElements.Count > 0) Then
                    GetFunctionElements(childElements, functionList)
                End If
            End If
        Next

    End Sub

    Private Function ExtractTestName(ByVal codeElement As CodeElement) As String

        Dim result As String
        Dim displayName As String = codeElement.DisplayName()

        If (displayName.StartsWith("BEGIN_TEST")) Then
            Dim openParenPos As Integer = displayName.IndexOf("(")
            If (openParenPos <> -1) Then
                Dim endPos As Integer = displayName.IndexOf(",", openParenPos)
                If (endPos = -1) Then
                    endPos = displayName.IndexOf(")", openParenPos)
                End If
                If (endPos <> -1) Then
                    Dim length As Integer = endPos - openParenPos - 1
                    result = displayName.Substring(openParenPos + 1, length).Trim()
                End If
            End If
        End If
        Return result

    End Function

End Module