Experimental use of memory mapped files to see if those work better t…

…han pipes on Linu

AltCover.Recorder/Recorder.fs

@@ -6,6 +6,10 @@ namespace AltCover.Recorder
 open System
 open System.Collections.Generic
 open System.IO
+#if NET2
+#else
+open System.IO.MemoryMappedFiles
+#endif
 open System.Runtime.CompilerServices
 open System.Runtime.InteropServices
 open System.Xml
@@ -66,6 +70,16 @@ module Instance =
   /// </summary>
   let private mutex = new System.Threading.Mutex(false, Token + ".mutex");
 
+  /// <summary>
+  /// Inter-process communications
+  /// </summary>
+  let mutable channel : Stream = null
+#if NET2
+  let mutable share : MemoryStream = null // TODO
+#else
+  let mutable share : MemoryMappedFile = null
+#endif
+
   /// <summary>
   /// Load the XDocument
   /// </summary>
@@ -158,11 +172,20 @@ module Instance =
   let private WithVisitsLocked =
     Locking.WithLockerLocked Visits
 
+  let private formatter = System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
+  let private push (moduleId:string) hitPointId =
+     formatter.Serialize(channel, (moduleId, hitPointId))
+
+  let internal Signal f g =
+     match channel with
+     | null -> WithVisitsLocked f
+     | _ -> g()
+
   /// <summary>
   /// This method flushes hit count buffers.
   /// </summary>
-  let internal FlushCounter _ _ =
-     WithVisitsLocked (fun () ->
+  let internal FlushCounter finish _ =
+     Signal (fun () ->
       match Visits.Count with
       | 0 -> ()
       | _ -> let counts = Dictionary<string, Dictionary<int, int>> Visits
@@ -172,22 +195,44 @@ module Instance =
              let flushStart = UpdateReport counts coverageFile
              let delta = TimeSpan(DateTime.UtcNow.Ticks - flushStart.Ticks)
              Console.Out.WriteLine("Coverage statistics flushing took {0:N} seconds", delta.TotalSeconds))
+            (fun () ->
+             printfn "pushing flush %A" finish
+             if finish then
+               push null -1
+               use local1 = channel
+               share.Dispose()
+               channel <- null
+               share <- null
+               local1.Flush())
 
   /// <summary>
   /// This method is executed from instrumented assemblies.
   /// </summary>
   /// <param name="moduleId">Assembly being visited</param>
   /// <param name="hitPointId">Sequence Point identifier</param>
   let Visit moduleId hitPointId =
-   if not <| String.IsNullOrEmpty(moduleId) then
-    WithVisitsLocked (fun () -> if not (Visits.ContainsKey moduleId)
-                                    then Visits.[moduleId] <- new Dictionary<int, int>()
-                                if not (Visits.[moduleId].ContainsKey hitPointId) then
-                                    Visits.[moduleId].Add(hitPointId, 1)
-                                else
-                                    Visits.[moduleId].[hitPointId] <- 1 + Visits.[moduleId].[hitPointId])
+    if not <| String.IsNullOrEmpty(moduleId) then
+      Signal (fun () -> if not (Visits.ContainsKey moduleId)
+                        then Visits.[moduleId] <- new Dictionary<int, int>()
+                        if not (Visits.[moduleId].ContainsKey hitPointId) then
+                            Visits.[moduleId].Add(hitPointId, 1)
+                        else
+                            Visits.[moduleId].[hitPointId] <- 1 + Visits.[moduleId].[hitPointId])
+                  (fun () -> push moduleId hitPointId)
+
+  let internal OpenChannel name =
+#if NET2
+    ignore name
+#else
+    try
+      share <- MemoryMappedFile.OpenExisting name
+      channel <- share.CreateViewStream() :> Stream
+    with
+    | :? FileNotFoundException -> ()
+#endif
 
   // Register event handling
   do
     AppDomain.CurrentDomain.DomainUnload.Add(FlushCounter false)
-    AppDomain.CurrentDomain.ProcessExit.Add(FlushCounter true)
+    AppDomain.CurrentDomain.ProcessExit.Add(FlushCounter true)
+    OpenChannel Token

Shadow.Tests/Shadow.Tests.fs

@@ -4,12 +4,20 @@ namespace Shadow.TestsCore
 #if NET4
 namespace Shadow.Tests4
 #else
+#if NET2
 namespace Shadow.Tests2
+#else
+namespace Shadow.TestsMono
+#endif
 #endif
 #endif
 
 open System
 open System.Collections.Generic
+#if NET2
+#else
+open System.IO.MemoryMappedFiles
+#endif
 open System.IO
 open System.Reflection
 open System.Xml
@@ -112,6 +120,102 @@ type AltCoverTests() = class
     finally
       Instance.Visits.Clear()
 
+#if NET2
+#else
+#if NET4
+#else
+  [<Test>]
+#endif
+#endif
+  member self.MappedVisitShouldSignal() =
+    Assert.That (Instance.channel, Is.Null, "channel unexpected")
+    Assert.That (Instance.share, Is.Null, "share unexpected")
+    let token = Guid.NewGuid().ToString() + "VisitShouldSignal"
+    printfn "token = %s" token
+#if NET2
+    use server = new MemoryStream()
+    use channel = new MemoryStream()
+#else
+    use server = MemoryMappedFile.CreateNew(token, 65536L)
+    use channel = server.CreateViewStream()
+    printfn "Created ViewStream"
+#endif
+    try
+      Instance.OpenChannel token
+      Assert.That (Instance.channel, Is.Not.Null, "channel unexpected fail to create")
+      use clientChannel = Instance.channel
+      use clientShare = Instance.share
+      printfn "Created client"
+      try
+        let expected = ("name", 23)
+        let formatter = System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
+        printfn "about to act"
+        //async {
+        Instance.Visit "name" 23
+        //} |> Async.Start
+        printfn "about to read %d" channel.Length
+        let result = formatter.Deserialize(channel) :?> (string*int)
+        Assert.That (Instance.Visits, Is.Empty, "unexpected local write")
+        Assert.That (result, Is.EqualTo expected, "unexpected result")
+        printfn "after all work"
+      finally
+        printfn "finally 1"
+        Instance.channel <- null
+        Instance.share <- null
+    finally
+      printfn "finally 2"
+      Instance.Visits.Clear()
+    printfn "all done"
+
+#if NET2
+#else
+#if NET4
+#else
+  [<Test>]
+#endif
+#endif
+  member self.MappedFlushShouldTidyUp() =
+    Assert.That (Instance.channel, Is.Null, "channel unexpected")
+    Assert.That (Instance.share, Is.Null, "share unexpected")
+    let token = Guid.NewGuid().ToString() + "FlushShouldTidyUp"
+    printfn "token = %s" token
+#if NET2
+    use server = new MemoryStream()
+    use channel = new MemoryStream()
+#else
+    use server = MemoryMappedFile.CreateNew(token, 65536L)
+    use channel = server.CreateViewStream()
+    printfn "Created ViewStream"
+#endif
+    try
+      Instance.OpenChannel token
+      Assert.That (Instance.channel, Is.Not.Null, "channel unexpected fail to create")
+      use clientChannel = Instance.channel
+      use clientShare = Instance.share
+      printfn "Created client"
+      try
+        let expected = ("name", 23)
+        let formatter = System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
+        printfn "About to act"
+        formatter.Serialize(Instance.channel, expected)
+        Instance.FlushCounter true ()
+        printfn "About to read"
+        let result = formatter.Deserialize(channel) :?> (string*int)
+        let result' = formatter.Deserialize(channel) :?> (string*int)
+        printfn "About to assert"
+        Assert.That (Instance.Visits, Is.Empty, "unexpected local write")
+        Assert.That (result, Is.EqualTo expected, "unexpected result")
+        Assert.That (result' |> fst |> String.IsNullOrEmpty, Is.True, "unexpected end-of-message")
+        printfn "done"
+      finally
+        printfn "first finally"
+        Instance.channel <- null
+        Instance.share <- null
+    finally
+      printfn "second finally"
+      Instance.Visits.Clear()
+    printfn "all done"
+
   member private self.UpdateReport a b =
     Instance.UpdateReport a b
     |> ignore

Shadow.Tests/Shadow.Tests.fsproj

@@ -11,6 +11,8 @@
     <AssemblyName>AltCover.Shadow.Tests</AssemblyName>
     <TargetFrameworkVersion>v4.7</TargetFrameworkVersion>
     <TargetFSharpCoreVersion>4.4.1.0</TargetFSharpCoreVersion>
+    <ExtraDefines Condition="'$(TRAVIS_JOB_NUMBER)' == ''">NET4</ExtraDefines>
+    <ExtraDefines Condition="'$(TRAVIS_JOB_NUMBER)' != ''"></ExtraDefines>
     <UseStandardResourceNames>true</UseStandardResourceNames>
     <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
     <Name>Shadow.Tests</Name>
@@ -27,7 +29,7 @@
     <WarningsAsErrors>
     </WarningsAsErrors>
     <OtherFlags>--keyfile:$(SolutionDir)Build\Infrastructure.snk</OtherFlags>
-    <DefineConstants>TRACE;DEBUG;CODE_ANALYSIS;NET4</DefineConstants>
+    <DefineConstants>TRACE;DEBUG;CODE_ANALYSIS;$(ExtraDefines)</DefineConstants>
     <WarningLevel>4</WarningLevel>
   </PropertyGroup>
   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
@@ -40,7 +42,7 @@
     <WarningsAsErrors>
     </WarningsAsErrors>
     <OtherFlags>--keyfile:$(SolutionDir)Build\Infrastructure.snk</OtherFlags>
-    <DefineConstants>TRACE</DefineConstants>
+    <DefineConstants>TRACE;$(ExtraDefines)</DefineConstants>
     <WarningLevel>4</WarningLevel>
   </PropertyGroup>
   <PropertyGroup>