Skip to content

Commit

Permalink
Merge branch 'develop/test-tracking' into release/Byakko
Browse files Browse the repository at this point in the history
# Conflicts: -- accept incoming
#	ReleaseNotes.md
  • Loading branch information
SteveGilham committed Mar 23, 2018
2 parents ee420d9 + 161e1bc commit 0aef5ac
Show file tree
Hide file tree
Showing 42 changed files with 1,890 additions and 520 deletions.
38 changes: 26 additions & 12 deletions AltCover.Recorder/Base.fs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,14 @@ open System.Globalization
open System.IO
open System.Xml

type ReportFormat = NCover = 0 | OpenCover = 1
type ReportFormat = NCover = 0 | OpenCover = 1 | OpenCoverWithTracking = 2

[<System.Runtime.InteropServices.ProgIdAttribute("ExcludeFromCodeCoverage hack for OpenCover issue 615")>]
type internal Track =
| Null
| Time of int64
| Call of int
| Both of (int64 * int)

module Counter =
/// <summary>
Expand Down Expand Up @@ -56,7 +63,8 @@ module Counter =
/// </summary>
/// <param name="hitCounts">The coverage results to incorporate</param>
/// <param name="coverageFile">The coverage file to update as a stream</param>
let internal UpdateReport (postProcess:XmlDocument -> unit) own (counts:Dictionary<string, Dictionary<int, int>>) format coverageFile =
let internal UpdateReport (postProcess:XmlDocument -> unit) (pointProcess:XmlElement -> Track list -> unit)
own (counts:Dictionary<string, Dictionary<int, int * Track list>>) format coverageFile =
let flushStart = DateTime.UtcNow
let coverageDocument = ReadXDocument coverageFile
let root = coverageDocument.DocumentElement
Expand All @@ -78,6 +86,7 @@ module Counter =
System.Diagnostics.FileVersionInfo.GetVersionInfo(System.Reflection.Assembly.GetExecutingAssembly().Location).FileVersion)

let (m, i, m', s, v) = match format with
| ReportFormat.OpenCoverWithTracking
| ReportFormat.OpenCover -> ("//Module", "hash", "Classes/Class/Methods/Method", "SequencePoints/SequencePoint", "vc")
| _ -> ("//module", "moduleId", "method", "seqpnt", "visitcount")
coverageDocument.SelectNodes(m)
Expand All @@ -98,7 +107,8 @@ module Counter =
|> Seq.cast<XmlElement>
|> Seq.toList |> List.rev)
|> Seq.mapi (fun counter pt -> ((match format with
| ReportFormat.OpenCover -> "uspid" |> pt.GetAttribute |> FindIndexFromUspid
| ReportFormat.OpenCoverWithTracking
| ReportFormat.OpenCover -> "uspid" |> pt.GetAttribute |> FindIndexFromUspid
| _ -> counter),
pt))
|> Seq.filter (fst >> moduleHits.ContainsKey)
Expand All @@ -109,8 +119,10 @@ module Counter =
System.Globalization.NumberStyles.Integer,
System.Globalization.CultureInfo.InvariantCulture) |> snd
// Treat -ve visit counts (an exemption added in analysis) as zero
let visits = moduleHits.[counter] + (max 0 vc)
pt.SetAttribute(v, visits.ToString(CultureInfo.InvariantCulture))))
let (count, l) = moduleHits.[counter]
let visits = (max 0 vc) + count + l.Length
pt.SetAttribute(v, visits.ToString(CultureInfo.InvariantCulture))
pointProcess pt l))

postProcess coverageDocument

Expand All @@ -120,14 +132,16 @@ module Counter =
if own then WriteXDocument coverageDocument coverageFile
flushStart

let DoFlush postProcess own counts format report =
let internal DoFlush postProcess pointProcess own counts format report =
use coverageFile = new FileStream(report, FileMode.Open, FileAccess.ReadWrite, FileShare.None, 4096, FileOptions.SequentialScan)
let flushStart = UpdateReport postProcess own counts format coverageFile
let flushStart = UpdateReport postProcess pointProcess own counts format coverageFile
TimeSpan(DateTime.UtcNow.Ticks - flushStart.Ticks)

let AddVisit (counts:Dictionary<string, Dictionary<int, int>>) moduleId hitPointId =
if not (counts.ContainsKey moduleId) then counts.[moduleId] <- Dictionary<int, int>()
let internal AddVisit (counts:Dictionary<string, Dictionary<int, int * Track list>>) moduleId hitPointId context =
if not (counts.ContainsKey moduleId) then counts.[moduleId] <- Dictionary<int, int * Track list>()
if not (counts.[moduleId].ContainsKey hitPointId) then
counts.[moduleId].Add(hitPointId, 1)
else
counts.[moduleId].[hitPointId] <- 1 + counts.[moduleId].[hitPointId]
counts.[moduleId].Add(hitPointId, (0,[]))
let n, l = counts.[moduleId].[hitPointId]
counts.[moduleId].[hitPointId] <- match context with
| Null -> (1 + n, l)
| something -> (n, something :: l)
102 changes: 85 additions & 17 deletions AltCover.Recorder/Recorder.fs
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ type internal Close =

[<System.Runtime.InteropServices.ProgIdAttribute("ExcludeFromCodeCoverage hack for OpenCover issue 615")>]
type internal Carrier =
| SequencePoint of String*int
| SequencePoint of String*int*Track

[<System.Runtime.InteropServices.ProgIdAttribute("ExcludeFromCodeCoverage hack for OpenCover issue 615")>]
type internal Message =
Expand Down Expand Up @@ -52,7 +52,7 @@ module Instance =
/// <summary>
/// Accumulation of visit records
/// </summary>
let internal Visits = new Dictionary<string, Dictionary<int, int>>();
let internal Visits = new Dictionary<string, Dictionary<int, int * Track list>>();

/// <summary>
/// Gets the unique token for this instance
Expand All @@ -68,6 +68,51 @@ module Instance =
[<MethodImplAttribute(MethodImplOptions.NoInlining)>]
let CoverageFormat = ReportFormat.NCover

/// <summary>
/// Gets the frequency of time sampling
/// This property's IL code is modified to store the user chosen override if applicable
/// </summary>
[<MethodImplAttribute(MethodImplOptions.NoInlining)>]
let Timer = 0L

/// <summary>
/// Gets or sets the current test method
/// </summary>
type private CallStack =
[<ThreadStatic;DefaultValue>]
static val mutable private instance:Option<CallStack>

val mutable private caller:int list
private new (x:int) = {caller = [x]}

static member Instance =
match CallStack.instance with
| None -> CallStack.instance <- Some (CallStack(0))
| _ -> ()

CallStack.instance.Value

member self.Push x = self.caller <- x :: self.caller
//let s = sprintf "push %d -> %A" x self.caller
//System.Diagnostics.Debug.WriteLine(s)

member self.Pop () = self.caller <- match self.caller with
| []
| [0] -> [0]
| _::xs -> xs
//let s = sprintf "pop -> %A"self.caller
//System.Diagnostics.Debug.WriteLine(s)

member self.CallerId () = Seq.head self.caller
(*let x = Seq.head self.caller
let s = sprintf "peek %d" x
System.Diagnostics.Debug.WriteLine(s)
x*)

let Push x = CallStack.Instance.Push x
let Pop () = CallStack.Instance.Pop ()
let CallerId () = CallStack.Instance.CallerId ()

/// <summary>
/// Serialize access to the report file across AppDomains for the classic mode
/// </summary>
Expand All @@ -76,7 +121,7 @@ module Instance =
/// <summary>
/// Reporting back to the mother-ship
/// </summary>
let mutable internal trace = Tracer.Create (ReportFile + ".bin")
let mutable internal trace = Tracer.Create (ReportFile + ".acv")

let internal WithMutex (f : bool -> 'a) =
let own = mutex.WaitOne(1000)
Expand All @@ -93,26 +138,26 @@ module Instance =
(fun () ->
match Visits.Count with
| 0 -> ()
| _ -> let counts = Dictionary<string, Dictionary<int, int>> Visits
| _ -> let counts = Dictionary<string, Dictionary<int, int * Track list>> Visits
Visits.Clear()
WithMutex (fun own ->
let delta = Counter.DoFlush ignore own counts CoverageFormat ReportFile
let delta = Counter.DoFlush ignore (fun _ _ -> ()) own counts CoverageFormat ReportFile
GetResource "Coverage statistics flushing took {0:N} seconds"
|> Option.iter (fun s -> Console.Out.WriteLine(s, delta.TotalSeconds))
))

let internal TraceVisit moduleId hitPointId =
trace.OnVisit Visits moduleId hitPointId
let internal TraceVisit moduleId hitPointId context =
trace.OnVisit Visits moduleId hitPointId context

/// <summary>
/// This method is executed from instrumented assemblies.
/// </summary>
/// <param name="moduleId">Assembly being visited</param>
/// <param name="hitPointId">Sequence Point identifier</param>
let internal VisitImpl moduleId hitPointId =
let internal VisitImpl moduleId hitPointId context =
if not <| String.IsNullOrEmpty(moduleId) then
trace.OnConnected (fun () -> TraceVisit moduleId hitPointId)
(fun () -> Counter.AddVisit Visits moduleId hitPointId)
trace.OnConnected (fun () -> TraceVisit moduleId hitPointId context)
(fun () -> Counter.AddVisit Visits moduleId hitPointId context)

let rec private loop (inbox:MailboxProcessor<Message>) =
async {
Expand All @@ -122,11 +167,11 @@ module Instance =
| None -> return! loop inbox
| Some msg ->
match msg with
| AsyncItem (SequencePoint (moduleId, hitPointId)) ->
VisitImpl moduleId hitPointId
| AsyncItem (SequencePoint (moduleId, hitPointId, context)) ->
VisitImpl moduleId hitPointId context
return! loop inbox
| Item (SequencePoint (moduleId, hitPointId), channel)->
VisitImpl moduleId hitPointId
| Item (SequencePoint (moduleId, hitPointId, context), channel)->
VisitImpl moduleId hitPointId context
channel.Reply ()
return! loop inbox
| Finish (mode, channel) ->
Expand All @@ -142,20 +187,43 @@ module Instance =
let internal Backlog () =
mailbox.CurrentQueueLength

let internal VisitSelection (f: unit -> bool) moduleId hitPointId =
let private IsOpenCoverRunner() =
(CoverageFormat = ReportFormat.OpenCoverWithTracking) &&
((trace.Definitive && trace.Runner) ||
(ReportFile <> "Coverage.Default.xml" && System.IO.File.Exists (ReportFile + ".acv")))

let internal Granularity() = Timer

let internal Clock () = DateTime.UtcNow.Ticks

let internal PayloadSelection clock frequency wantPayload =
if wantPayload () then
match (frequency(), CallerId()) with
| (0L, 0) -> Null
| (t, 0) -> Time (t*(clock()/t))
| (0L, n) -> Call n
| (t, n) -> Both (t*(clock()/t), n)
else Null

let internal PayloadControl = PayloadSelection Clock

let internal PayloadSelector enable =
PayloadControl Granularity enable

let internal VisitSelection (f: unit -> bool) track moduleId hitPointId =
// When writing to file for the runner to process,
// make this semi-synchronous to avoid choking the mailbox
// Backlogs of over 90,000 items were observed in self-test
// which failed to drain during the ProcessExit grace period
// when sending only async messages.
let message = SequencePoint (moduleId, hitPointId)
let message = SequencePoint (moduleId, hitPointId, track)
if f() then
mailbox.TryPostAndReply ((fun c -> Item (message, c)), 10) |> ignore
else message |> AsyncItem |> mailbox.Post

let Visit moduleId hitPointId =
VisitSelection (fun () -> trace.IsConnected() || Backlog() > 10)
moduleId hitPointId
(PayloadSelector IsOpenCoverRunner) moduleId hitPointId

let internal FlushCounter (finish:Close) _ =
mailbox.PostAndReply (fun c -> Finish (finish, c))
Expand Down
42 changes: 27 additions & 15 deletions AltCover.Recorder/Tracer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,8 @@ open System.IO.Compression

type Tracer = {
Tracer : string
Runner : bool
Definitive : bool
Stream : System.IO.Stream
Formatter : System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
}
Expand All @@ -18,56 +20,66 @@ type Tracer = {
static member Create (name:string) =
{
Tracer = name
Runner = false
Definitive = false
Stream = null
Formatter = System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
}

member this.IsConnected () =
match this.Stream with
| null -> false
| _ -> File.Exists this.Tracer
| _ -> this.Runner

member this.Connect () =
if File.Exists this.Tracer then
Seq.initInfinite (fun i -> Path.ChangeExtension(this.Tracer,
sprintf ".%d.bin" i))
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 DeflateStream(fs, CompressionMode.Compress)
Runner = true })
|> Seq.head
else
this

member this.Close() =
this.Stream.Dispose()

member this.Push (moduleId:string) hitPointId =
member internal this.Push (moduleId:string) hitPointId context =
let stream = this.Stream
this.Formatter.Serialize(stream, (moduleId, hitPointId))
this.Formatter.Serialize(stream, match context with
| Null -> (moduleId, hitPointId) :> obj
| _ -> (moduleId, hitPointId, context) :> obj)

member this.CatchUp (visits:Dictionary<string, Dictionary<int, int>>) =
member internal this.CatchUp (visits:Dictionary<string, Dictionary<int, int * Track list>>) =
let empty = Null
visits.Keys
|> Seq.iter (fun moduleId ->
visits.[moduleId].Keys
|> Seq.iter (fun hitPointId -> for i = 1 to visits.[moduleId].[hitPointId] do
this.Push moduleId hitPointId))
|> Seq.iter (fun hitPointId -> let n, l = visits.[moduleId].[hitPointId]
let push = this.Push moduleId hitPointId
[seq {1 .. n} |> Seq.map (fun _ -> empty )
l |> List.toSeq]
|> Seq.concat |> Seq.iter push
))
visits.Clear()

member this.OnStart () =
if this.Tracer <> "Coverage.Default.xml.bin" then
this.Connect ()
else this
let running = if this.Tracer <> "Coverage.Default.xml.acv" then
this.Connect () else this
{running with Definitive = true}

member this.OnConnected f g =
if this.IsConnected() then f()
else g ()

member this.OnFinish visits =
member internal this.OnFinish visits =
this.CatchUp visits
this.Push null -1
this.Push null -1 Null
this.Stream.Flush()
this.Close()

member this.OnVisit visits moduleId hitPointId =
member internal this.OnVisit visits moduleId hitPointId context =
this.CatchUp visits
this.Push moduleId hitPointId
this.Push moduleId hitPointId context
5 changes: 5 additions & 0 deletions AltCover.sln
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Shadow.Tests2", "Shadow.Tes
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WeakNameTests", "WeakNameTests\WeakNameTests.fsproj", "{57B8EF6F-1EE4-473B-B5B8-7C2D8213637A}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Shadow.Adapter", "Shadow.Adapter\Shadow.Adapter.fsproj", "{24BFB835-2DAC-45D4-AFDA-F9C2F13B41DD}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Expand Down Expand Up @@ -92,6 +94,9 @@ Global
{57B8EF6F-1EE4-473B-B5B8-7C2D8213637A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{57B8EF6F-1EE4-473B-B5B8-7C2D8213637A}.Debug|Any CPU.Build.0 = Debug|Any CPU
{57B8EF6F-1EE4-473B-B5B8-7C2D8213637A}.Release|Any CPU.ActiveCfg = Release|Any CPU
{24BFB835-2DAC-45D4-AFDA-F9C2F13B41DD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{24BFB835-2DAC-45D4-AFDA-F9C2F13B41DD}.Debug|Any CPU.Build.0 = Debug|Any CPU
{24BFB835-2DAC-45D4-AFDA-F9C2F13B41DD}.Release|Any CPU.ActiveCfg = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
Expand Down
Loading

0 comments on commit 0aef5ac

Please sign in to comment.