autotest.fsx

(*
autotest.fsx
20100826 - [email protected]

Inspired by ruby autotest.

Tracks a set of projects, building and testing them automatically with Gallio 
as they are modified.

Should work with xUnit.Net, MbUnit, NUnit, MsTest, or whatever other framework 
you can run with Gallio.

Auto-jumps to failure locations in Vim or Visual Studio 2010.

This lets you develop in an editor of your choice, not having to think about 
what buttons to press to build and run tests or use the mouse to get to 
failures.


Pending features:
  Detect if vs is already building anything, do nothing until done if so
  Option to run tests until first failure and cancel testing thread immediately
  Run recently failed tests sooner
  Accumulate timing statistics
  Run slowest tests last
*)

let MSBUILD = "C:/Windows/Microsoft.NET/Framework/v4.0.30319/msbuild.exe"
let MSBUILD_SLN = "Publisher/Publisher.sln"
let MSBUILD_CONFIGURATION = "Local"
let SLN_FOLDER = "" (* github dies on this "Core\\" *)
let GALLIO_BIN = "C:/Program Files/Gallio/bin"
let PROJECT_PATTERN = sprintf @"../Publisher/%s/bin/Debug/DTC.%s.dll"
let GVIM = "C:/Program Files (x86)/Vim/vim72/gvim.exe"

type Mode = Vim | VisualStudio
let DEFAULT_MODE = VisualStudio

let Projects = [
  "Shared"
  "ReferenceParser"
  "Parser"
  "Formats"
  "Data"
  "Doctypes"
]


#r "EnvDTE"

open System
open System.Runtime.InteropServices
open System.IO
open System.Diagnostics
open System.Text.RegularExpressions

#r "Gallio.dll"

open Gallio.Runner
open Gallio.Model
open Gallio.Runtime.Logging

let launcher = new TestLauncher()
let setup = new Gallio.Runtime.RuntimeSetup()
setup.AddPluginDirectory GALLIO_BIN
setup.RuntimePath <- GALLIO_BIN
launcher.RuntimeSetup <- setup
launcher.TestProject.TestPackage.ShadowCopy <- true

launcher.Logger <-
  { new ILogger with
        member x.Log(s:LogSeverity,m:string) = ()
        member x.Log(s:LogSeverity,m:string,e:System.Exception) = ()
        member x.Log(s:LogSeverity,m:string,e:Gallio.Common.Diagnostics.ExceptionData) = ()
  }

launcher.ProgressMonitorProvider <- Gallio.Runtime.ProgressMonitoring.NullProgressMonitorProvider.Instance


type AutotestRunner() =
  let mutable w = new FileSystemWatcher()
  let mutable mode = DEFAULT_MODE
  let mutable autoOpen = true
  let mutable hasOpened = false
  let mutable hasFailed = false
  let mutable stopOnFailure = true
  let mutable results  = [] : TestLauncherResult list
  let mutable failures = [] : Reports.Schema.TestStepRun seq list
  let mutable skips    = [] : Reports.Schema.TestStepRun seq list

  let fileInfo path = new FileInfo(path)
  let dirOf path = (fileInfo path).DirectoryName
  let nameOf path = (fileInfo path).Name

  let projectsHas project =
    List.exists ((=) project) Projects 

  let projectForPath(path:string) =
    let project = nameOf (dirOf path)
    if projectsHas project then Some project
    else None

  let runGetOutput x args =
    let p = new Process()
    let s = p.StartInfo
    s.FileName <- x
    s.Arguments <- args
    s.UseShellExecute <- false
    s.RedirectStandardOutput <- true
    let r = p.Start()
    p.WaitForExit()
    p.ExitCode, p.StandardOutput.ReadToEnd()

  let run x args =
    let p = new Process()
    let s = p.StartInfo
    s.FileName <- x
    s.Arguments <- args
    s.CreateNoWindow <- true
    s.UseShellExecute <- false
    p.Start() |> ignore
    ()


  let build(project:string) =
    printfn "Building %s..." project
    let root = dirOf System.Environment.CurrentDirectory
    let args = sprintf "%s/%s /verbosity:quiet /nologo /p:Configuration=%s /t:%s%s" root MSBUILD_SLN MSBUILD_CONFIGURATION SLN_FOLDER project
    runGetOutput MSBUILD args

  let edit (path:string) (line:int) =
    printfn "Opening %s to line %i" path line
    match mode with
    | Vim -> 
      run GVIM (sprintf "--remote-silent %s" path)
      System.Threading.Thread.Sleep 200
      run GVIM (sprintf "--remote-send %iggzv" line)
    | VisualStudio ->
      let app = Marshal.GetActiveObject("VisualStudio.DTE") :?> EnvDTE.DTE
      let window = app.ItemOperations.OpenFile(path, EnvDTE.Constants.vsViewKindTextView)
      let sel = window.Selection :?> EnvDTE.TextSelection
      sel.GotoLine(line, true)
      sel.Cancel()

  let fix (x:Reports.Schema.TestStepRun) =
    printfn "Loading up '%s' for fixage" x.Step.FullName
    hasOpened <- true
    let loc = x.Step.CodeLocation
    edit loc.Path loc.Line
      
  let slowestTests(r:TestLauncherResult) =
    r.Report.TestPackageRun.AllTestStepRuns 
    |> Seq.filter (fun x -> x.Step.IsTestCase) 
    |> Seq.sortBy (fun x -> x.StartTime - x.EndTime) 
    

  let isFailure (x:Reports.Schema.TestStepRun) = 
    x.Result.Outcome.Status = TestStatus.Failed
    &&
    x.Step.IsTestCase

  let isSkipped (x:Reports.Schema.TestStepRun) = 
    x.Result.Outcome.Status = TestStatus.Skipped
    &&
    x.Step.IsTestCase

  let addResult (r:TestLauncherResult) =
    printfn "%s" r.ResultSummary
    let slowest =
      slowestTests r 
      |> Seq.map (fun x -> x.Step.FullName, (x.EndTime - x.StartTime).TotalMilliseconds)
    printfn "Slowest: %A" slowest
    results <- r :: results

    let steps = r.Report.TestPackageRun.AllTestStepRuns 
    let failed_steps = steps |> Seq.filter isFailure
    if not (Seq.isEmpty failed_steps) then
      hasFailed <- true
      if autoOpen && not hasOpened then fix (Seq.head failed_steps)
      failures <- failed_steps :: failures
    let skipped_steps = steps |> Seq.filter isSkipped
    if not (Seq.isEmpty skipped_steps) then
      skips <- skipped_steps :: skips

  

  let editMsbuildError(s:string) =
    let errors =
      s.Split('\n') 
      |> Seq.filter (fun x -> x.Contains(": error") )
    if Seq.isEmpty errors then () else
    let e = Seq.head errors
    let start = e.IndexOf "("
    let path = e.Substring(0, start)
    let line = e.Substring(start + 1, (e.IndexOf ",") - start - 1) |> int
    edit path line

  let runProject p =
    if stopOnFailure && hasFailed then () else
    let exitcode, output = build p
    if exitcode > 0 then
      printfn "%s" output
      editMsbuildError output
      printfn "Waiting for you to fix the build"
      hasFailed <- true
    else
      printfn "Testing %s..." p
      let addPattern x = launcher.AddFilePattern <| PROJECT_PATTERN x x
      launcher.ClearFilePatterns()
      addPattern p
      launcher.Run() |> addResult

  let runTests these =
    these |> List.iter runProject

  let runTestsStartingWith(project:string) =
    project :: (List.filter (fun x -> not (x = project)) Projects)
    |> runTests

  let runAllTests() =
    Projects
    |> runTests


  static member watch(path:string) =
    let a = new AutotestRunner()
    a.Init path
    a.Start()
    a

  member self.Watcher = w
  member self.VisualStudio = mode <- VisualStudio
  member self.Vim = mode <- Vim
  member self.AutoOpen = autoOpen
  member self.Results = results
  member self.Failures = failures
  member self.Skips = skips
    
  member self.Init(path:string) = 
    self.Watcher.Path <- path

    self.Watcher.IncludeSubdirectories <- true
    self.Watcher.Changed.Add self.Trigger
    self.Watcher.Deleted.Add self.Trigger
    self.Watcher.Renamed.Add self.Trigger
    self.Watcher.Created.Add self.Trigger

  member self.Start() = self.Watcher.EnableRaisingEvents <- true
  member self.Stop()  = self.Watcher.EnableRaisingEvents <- false

  member self.Trigger (e:FileSystemEventArgs) =
    let has = e.FullPath.Contains
    if has ".svn" || has "\\bin" || has "\\Build" then ()
    else self.RunPath e.FullPath

  member self.Cancel() =
    hasFailed <- true
    launcher.Cancel()

  member self.Reset() =
    hasOpened <- false
    hasFailed <- false


  member self.Test(project:string option) =
    match project with
    | Some p ->
      runTestsStartingWith p
    | None ->
      printfn "No specific project detected, running all tests"
      runAllTests ()
    if hasFailed then
      Console.ForegroundColor <- ConsoleColor.Red
      printfn "DONE. FAILED."
    else
      Console.ForegroundColor <- ConsoleColor.Green
      printfn "DONE. AWESOME."
    Console.ForegroundColor <- ConsoleColor.Gray


  member self.RunPath(path:string) =
    self.Stop()
    self.Reset()
    let project = projectForPath path
    self.Test project
    self.Start()

  member self.Fix(n:int) =
    failures
    |> Seq.head
    |> Seq.nth n
    |> fix

  member self.Skipped(n:int) =
    skips
    |> Seq.head
    |> Seq.nth n
    |> fix


let a = AutotestRunner.watch "../"


// vim:ft=fs