Merge branch 'develop/Caba' into release/Caba

AltCover.Recorder/Recorder.fs

@@ -5,6 +5,7 @@ namespace AltCover.Recorder
 
 open System
 open System.Collections.Generic
+open System.IO
 open System.Reflection
 open System.Resources
 open System.Runtime.CompilerServices
@@ -13,15 +14,17 @@ open System.Runtime.CompilerServices
 type internal Close =
     | DomainUnload
     | ProcessExit
+    | Pause
+    | Resume
 
 [<System.Runtime.InteropServices.ProgIdAttribute("ExcludeFromCodeCoverage hack for OpenCover issue 615")>]
 type internal Carrier =
     | SequencePoint of String*int*Track
 
 [<System.Runtime.InteropServices.ProgIdAttribute("ExcludeFromCodeCoverage hack for OpenCover issue 615")>]
 type internal Message =
-    | AsyncItem of Carrier
-    | Item of Carrier*AsyncReplyChannel<unit>
+    | AsyncItem of Carrier seq
+    | Item of Carrier seq*AsyncReplyChannel<unit>
     | Finish of Close * AsyncReplyChannel<unit>
 
 module Instance =
@@ -47,7 +50,8 @@ module Instance =
   /// <summary>
   /// Accumulation of visit records
   /// </summary>
-  let internal Visits = new Dictionary<string, Dictionary<int, int * Track list>>();
+  let internal Visits = new Dictionary<string, Dictionary<int, int * Track list>>()
+  let internal buffer = List<Carrier> ()
 
   /// <summary>
   /// Gets the unique token for this instance
@@ -113,10 +117,12 @@ module Instance =
   /// </summary>
   let internal mutex = new System.Threading.Mutex(false, Token + ".mutex");
 
+  let SignalFile () = ReportFile + ".acv"
+
   /// <summary>
   /// Reporting back to the mother-ship
   /// </summary>
-  let mutable internal trace = Tracer.Create (ReportFile + ".acv")
+  let mutable internal trace = Tracer.Create (SignalFile ())
 
   let internal WithMutex (f : bool -> 'a) =
     let own = mutex.WaitOne(1000)
@@ -125,10 +131,17 @@ module Instance =
     finally
       if own then mutex.ReleaseMutex()
 
+  let InitialiseTrace () =
+    WithMutex (fun _ -> let t = Tracer.Create (SignalFile ())
+                        trace <- t.OnStart ())
+
+  let internal Watcher = new FileSystemWatcher()
+  let mutable internal Recording = true
+
   /// <summary>
   /// This method flushes hit count buffers.
   /// </summary>
-  let internal FlushCounterImpl _ =
+  let internal FlushAll () =
     trace.OnConnected (fun () -> trace.OnFinish Visits)
       (fun () ->
       match Visits.Count with
@@ -141,6 +154,20 @@ module Instance =
                 |> Option.iter (fun s -> Console.Out.WriteLine(s, delta.TotalSeconds))
              ))
 
+  let FlushPause () =
+    ("PauseHandler")
+    |> GetResource
+    |> Option.iter Console.Out.WriteLine
+    FlushAll ()
+    InitialiseTrace()
+
+  let FlushResume () =
+    ("ResumeHandler")
+    |> GetResource
+    |> Option.iter Console.Out.WriteLine
+    Visits.Clear()
+    InitialiseTrace ()
+
   let internal TraceVisit moduleId hitPointId context =
      trace.OnVisit Visits moduleId hitPointId context
 
@@ -161,28 +188,43 @@ module Instance =
   let mutable internal mailbox = MakeDefaultMailbox()
   let mutable internal mailboxOK = false
 
+  let internal Post (x : Carrier) =
+    match x with
+    | SequencePoint (moduleId, hitPointId, context) ->
+      VisitImpl moduleId hitPointId context
+
   let rec private loop (inbox:MailboxProcessor<Message>) =
-          async {
-             if Object.ReferenceEquals (inbox, mailbox) then
-                 // release the wait every half second
-                 let! opt = inbox.TryReceive(500)
-                 match opt with
-                 | None -> return! loop inbox
-                 | Some msg ->
-                     match msg with
-                     | AsyncItem (SequencePoint (moduleId, hitPointId, context)) ->
-                         VisitImpl moduleId hitPointId context
-                         return! loop inbox
-                     | Item (SequencePoint (moduleId, hitPointId, context), channel)->
-                         VisitImpl moduleId hitPointId context
-                         channel.Reply ()
-                         return! loop inbox
-                     | Finish (mode, channel) ->
-                         FlushCounterImpl mode
-                         channel.Reply ()
-                         mailboxOK <- false
-                         (inbox :> IDisposable).Dispose()
-          }
+    async {
+      if Object.ReferenceEquals (inbox, mailbox) then
+        // release the wait every half second
+        let! opt = inbox.TryReceive(500)
+        match opt with
+        | None -> return! loop inbox
+        | Some msg ->
+            match msg with
+            | AsyncItem s ->
+              s |>
+              Seq.iter Post
+              return! loop inbox
+            | Item (s, channel) ->
+              s |>
+              Seq.iter Post
+              channel.Reply ()
+              return! loop inbox
+            | Finish (Pause, channel) ->
+                FlushPause()
+                channel.Reply ()
+                return! loop inbox
+            | Finish (Resume, channel) ->
+                FlushResume ()
+                channel.Reply ()
+                return! loop inbox
+            | Finish (_, channel) ->
+                FlushAll ()
+                channel.Reply ()
+                mailboxOK <- false
+                (inbox :> IDisposable).Dispose()
+        }
 
   let internal MakeMailbox () =
     new MailboxProcessor<Message>(loop)
@@ -224,6 +266,12 @@ module Instance =
     PayloadControl Granularity enable
 
   let mutable internal Wait = 10
+  let mutable internal Capacity = 127
+
+  let UnbufferedVisit (f: unit -> bool)  =
+    if f() then
+     mailbox.TryPostAndReply ((fun c -> Item (buffer |> Seq.toArray, c)), Wait) |> ignore
+    else buffer |> Seq.toArray |> Array.toSeq |> AsyncItem |> mailbox.Post
 
   let internal VisitSelection (f: unit -> bool) track moduleId hitPointId =
     // When writing to file for the runner to process,
@@ -232,27 +280,33 @@ module Instance =
     // which failed to drain during the ProcessExit grace period
     // when sending only async messages.
     let message = SequencePoint (moduleId, hitPointId, track)
-    if f() then
-       mailbox.TryPostAndReply ((fun c -> Item (message, c)), Wait) |> ignore
-    else message |> AsyncItem |> mailbox.Post
+    lock (buffer) (fun () ->
+    buffer.Add message
+    if buffer.Count > Capacity then
+      UnbufferedVisit f
+      buffer.Clear()
+      )
 
   let Visit moduleId hitPointId =
-   if mailboxOK then
+    if Recording && mailboxOK then
      VisitSelection (fun () -> trace.IsConnected() || Backlog() > 10)
                      (PayloadSelector IsOpenCoverRunner) moduleId hitPointId
 
   let internal FlushCounter (finish:Close) _ =
    if mailboxOK then
-    mailbox.PostAndReply (fun c -> Finish (finish, c))
+       Recording <- finish = Resume
+       if not Recording then UnbufferedVisit (fun _ -> true)
+       buffer.Clear()
+       mailbox.TryPostAndReply ((fun c -> Finish (finish, c)), 2000) |> ignore
 
   let internal AddErrorHandler (box:MailboxProcessor<'a>) =
     box.Error.Add MailboxError
 
   let internal SetErrorAction () =
     ErrorAction <- DisplayError
 
-  // unit test helpers -- avoid issues with cross CLR version calls
   let internal RunMailbox () =
+    Recording <- true
     (mailbox :> IDisposable).Dispose()
     mailbox <- MakeMailbox ()
     mailboxOK <- true
@@ -261,8 +315,22 @@ module Instance =
     mailbox.Start()
 
   // Register event handling
+  let DoPause =
+    FlushCounter Pause
+
+  let DoResume =
+    FlushCounter Resume
+
+  let internal StartWatcher() =
+     Watcher.Path <- Path.GetDirectoryName <| SignalFile()
+     Watcher.Filter <- Path.GetFileName <| SignalFile()
+     Watcher.Created.Add DoResume
+     Watcher.Deleted.Add DoPause
+     Watcher.EnableRaisingEvents <- Watcher.Path |> String.IsNullOrEmpty |> not
+
   do
     AppDomain.CurrentDomain.DomainUnload.Add(FlushCounter DomainUnload)
     AppDomain.CurrentDomain.ProcessExit.Add(FlushCounter ProcessExit)
-    WithMutex (fun _ -> trace <- trace.OnStart ())
+    StartWatcher ()
+    InitialiseTrace ()
     RunMailbox ()

AltCover.Recorder/Strings.resx

@@ -123,6 +123,54 @@
   <data name="Coverage statistics flushing took {0:N} seconds.eo" xml:space="preserve">
     <value>Kovraj statistika skribado prenis {0:N} sekundojn</value>
   </data>
+  <data name="DomainUnload.en" xml:space="preserve">
+    <value>AppDomain shutdown started</value>
+  </data>
+  <data name="DomainUnload.eo" xml:space="preserve">
+    <value>AppDomain sistemfermo komenciĝis</value>
+  </data>
+  <data name="DomainUnloadHandler.en" xml:space="preserve">
+    <value>Finalizing AppDomain coverage report</value>
+  </data>
+  <data name="DomainUnloadHandler.eo" xml:space="preserve">
+    <value>Finante AppDomain kovraj raporto</value>
+  </data>
+  <data name="Pause.en" xml:space="preserve">
+    <value>Pause command received</value>
+  </data>
+  <data name="Pause.eo" xml:space="preserve">
+    <value>Paŭzo komandon ricevita</value>
+  </data>
+  <data name="PauseHandler.en" xml:space="preserve">
+    <value>Pausing...</value>
+  </data>
+  <data name="PauseHandler.eo" xml:space="preserve">
+    <value>Paŭzante ...</value>
+  </data>
+  <data name="ProcessExit.en" xml:space="preserve">
+    <value>Shutdown started</value>
+  </data>
+  <data name="ProcessExit.eo" xml:space="preserve">
+    <value>Sistemfermo komenciĝis</value>
+  </data>
+  <data name="ProcessExitHandler.en" xml:space="preserve">
+    <value>Finalizing overall coverage report</value>
+  </data>
+  <data name="ProcessExitHandler.eo" xml:space="preserve">
+    <value>Finante totala kovraj raporto</value>
+  </data>
+  <data name="Resume.en" xml:space="preserve">
+    <value>Resume command received</value>
+  </data>
+  <data name="Resume.eo" xml:space="preserve">
+    <value>Rekomenci komandon ricevita</value>
+  </data>
+  <data name="ResumeHandler.en" xml:space="preserve">
+    <value>Resuming...</value>
+  </data>
+  <data name="ResumeHandler.eo" xml:space="preserve">
+    <value>Resumante...</value>
+  </data>
   <data name="Recorder error.en" xml:space="preserve">
     <value>Recorder error</value>
   </data>

AltCover.Recorder/Tracer.fs

@@ -37,7 +37,7 @@ type Tracer = {
                                                         sprintf ".%d.acv" i))
         |> Seq.filter (File.Exists >> not)
         |> Seq.map (fun f -> let fs = File.OpenWrite f
-                             { this with Stream = new DeflateStream(fs, CompressionMode.Compress)
+                             { this with Stream = new BufferedStream(new DeflateStream(fs, CompressionMode.Compress))
                                          Runner = true })
         |> Seq.head
       else
@@ -67,7 +67,7 @@ type Tracer = {
 
     member this.OnStart () =
       let running = if this.Tracer <> "Coverage.Default.xml.acv" then
-                        this.Connect () else this
+                       this.Connect () else this
       {running with Definitive = true}
 
     member this.OnConnected f g =

AltCover.sln

@@ -31,6 +31,7 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Build Items", "Build Items"
 		Build\get-nuget.ps1 = Build\get-nuget.ps1
 		Build\Infrastructure.snk = Build\Infrastructure.snk
 		Build\Recorder.snk = Build\Recorder.snk
+		Build\rules-mono.xml = Build\rules-mono.xml
 		Build\rules.xml = Build\rules.xml
 		Build\SelfTest.snk = Build\SelfTest.snk
 		Build\setup.fsx = Build\setup.fsx
@@ -59,6 +60,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "XTests", "XTests\XTests.fsp
 EndProject
 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Sample4", "Sample4\Sample4.fsproj", "{607161F1-86BE-471A-9837-3D19BFAAA5FA}"
 EndProject
+Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Sample8", "Sample8\Sample8.csproj", "{44ABC8FE-4277-47FA-BB76-61A105392182}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -117,6 +120,9 @@ Global
 		{607161F1-86BE-471A-9837-3D19BFAAA5FA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
 		{607161F1-86BE-471A-9837-3D19BFAAA5FA}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{607161F1-86BE-471A-9837-3D19BFAAA5FA}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{44ABC8FE-4277-47FA-BB76-61A105392182}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{44ABC8FE-4277-47FA-BB76-61A105392182}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{44ABC8FE-4277-47FA-BB76-61A105392182}.Release|Any CPU.ActiveCfg = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE
@@ -128,6 +134,7 @@ Global
 		{D1F77A3C-6B04-41B7-9507-FC1A7263CD3D} = {1441B3F4-72F8-4BB5-B9DF-29767F6719F1}
 		{4FA35926-FB21-4F1B-BB55-465D472EE027} = {1441B3F4-72F8-4BB5-B9DF-29767F6719F1}
 		{607161F1-86BE-471A-9837-3D19BFAAA5FA} = {1441B3F4-72F8-4BB5-B9DF-29767F6719F1}
+		{44ABC8FE-4277-47FA-BB76-61A105392182} = {1441B3F4-72F8-4BB5-B9DF-29767F6719F1}
 	EndGlobalSection
 	GlobalSection(ExtensibilityGlobals) = postSolution
 		SolutionGuid = {9BBC0EFA-53F6-4254-B7D9-EF1BAC0AD19E}

AltCover/AltCover.fs

@@ -265,24 +265,22 @@ module Main =
       |> Seq.fold (fun (accumulator : AssemblyInfo list) info ->
            let fullName = info.FullName
            ImageLoadResilient(fun () ->
-             let def = AssemblyDefinition.ReadAssembly(fullName)
-             try
-               let assemblyPdb = ProgramDatabase.GetPdbWithFallback def
-               if def |> Visitor.IsIncluded |> Visitor.IsInstrumented &&
-                  Option.isSome assemblyPdb then
-                  String.Format(CultureInfo.CurrentCulture,
-                                 (CommandLine.resources.GetString "instrumenting"),
-                                 fullName) |> Output.Info
-
-                  { Path = fullName
-                    Name = def.Name.Name
-                    Refs = def.MainModule.AssemblyReferences
-                           |> Seq.map (fun r -> r.Name)
-                           |> Seq.toList} :: accumulator
+             use stream = File.OpenRead(fullName)
+             use def = AssemblyDefinition.ReadAssembly(stream)
+             let assemblyPdb = ProgramDatabase.GetPdbWithFallback def
+             if def |> Visitor.IsIncluded |> Visitor.IsInstrumented &&
+                Option.isSome assemblyPdb then
+                String.Format(CultureInfo.CurrentCulture,
+                               (CommandLine.resources.GetString "instrumenting"),
+                               fullName) |> Output.Info
+
+                { Path = fullName
+                  Name = def.Name.Name
+                  Refs = def.MainModule.AssemblyReferences
+                         |> Seq.map (fun r -> r.Name)
+                         |> Seq.toList} :: accumulator
                else
-                  accumulator
-             finally
-               (def :> IDisposable).Dispose()) (fun () -> accumulator)
+                  accumulator) (fun () -> accumulator)
         ) []
 
     // sort the assemblies into order so that the depended-upon are processed first