From d0bc86450ff0aa6434d68fc06d3b45d5540e1151 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 7 Dec 2022 15:56:40 +0100 Subject: [PATCH 01/16] Time reporting to a file --- src/Compiler/Driver/CompilerConfig.fs | 3 +++ src/Compiler/Driver/CompilerConfig.fsi | 4 ++++ src/Compiler/Driver/CompilerOptions.fs | 18 +++++++++++++++++- 3 files changed, 24 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 91a2e9fde3d..ed0b8274bad 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -517,6 +517,7 @@ type TcConfigBuilder = /// show times between passes? mutable showTimes: bool + mutable reportTimeToFile : string option mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool @@ -740,6 +741,7 @@ type TcConfigBuilder = productNameForBannerText = FSharpProductName showBanner = true showTimes = false + reportTimeToFile = None showLoadedAssemblies = false continueAfterParseFailure = false #if !NO_TYPEPROVIDERS @@ -1296,6 +1298,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.productNameForBannerText = data.productNameForBannerText member _.showBanner = data.showBanner member _.showTimes = data.showTimes + member _.reportTimeToFile = data.reportTimeToFile member _.showLoadedAssemblies = data.showLoadedAssemblies member _.continueAfterParseFailure = data.continueAfterParseFailure #if !NO_TYPEPROVIDERS diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 70abf7beb63..621973a98fe 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -426,6 +426,8 @@ type TcConfigBuilder = mutable showTimes: bool + mutable reportTimeToFile: string option + mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool @@ -748,6 +750,8 @@ type TcConfig = member showTimes: bool + member reportTimeToFile: string option + member showLoadedAssemblies: bool member continueAfterParseFailure: bool diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 0881e8c9179..90210c7e042 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -1741,6 +1741,15 @@ let internalFlags (tcConfigB: TcConfigBuilder) = None ) + // "Render timing profiles for compilation to a file" + CompilerOption( + "reportTimeToFile", + tagString, + OptionString(fun s -> tcConfigB.reportTimeToFile <- Some s), + Some(InternalCommandLineOption("reportTimeToFile", rangeCmdArgs)), + None + ) + #if !NO_TYPEPROVIDERS // "Display information about extension type resolution") CompilerOption( @@ -2371,7 +2380,7 @@ let ReportTime (tcConfig: TcConfig) descr = | Some ("fsc-fail") -> failwith "simulated" | _ -> () - if (tcConfig.showTimes || verbose) then + if (tcConfig.showTimes || verbose || tcConfig.reportTimeToFile.IsSome) then // Note that timing calls are relatively expensive on the startup path so we don't // make this call unless showTimes has been turned on. let p = Process.GetCurrentProcess() @@ -2403,6 +2412,13 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 1 maxGen] spanGC[Operators.min 2 maxGen] prevDescr + + match tcConfig.reportTimeToFile with + | Some f -> + if not (File.Exists(f)) then + File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) + File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},,%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) + | None -> () tStart From c9425bd466a6a6682ceac25091185fbcea4393e1 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:15:18 +0100 Subject: [PATCH 02/16] initial sketch --- FSharpBuild.Directory.Build.props | 1 + src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Driver/CompilerOptions.fs | 75 +++++++++++++--------- src/Compiler/Driver/fsc.fs | 2 +- src/Compiler/Service/service.fs | 2 +- src/Compiler/Utilities/Activity.fs | 78 ++++++++++++++++++++++- src/Compiler/Utilities/Activity.fsi | 18 ++++++ 7 files changed, 143 insertions(+), 35 deletions(-) diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props index 0c8d9cef75c..21e531409e8 100644 --- a/FSharpBuild.Directory.Build.props +++ b/FSharpBuild.Directory.Build.props @@ -27,6 +27,7 @@ $(OtherFlags) --nowarn:3384 $(OtherFlags) --times --nowarn:75 $(OtherFlags) --test:ParallelCheckingWithSignatureFilesOn + $(OtherFlags) $(AdditionalFscCmdFlags) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d4ff82dd1da..f36e85846d6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -12095,6 +12095,6 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames) let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false) - assert(vspec.InlineInfo = inlineFlag) + //assert(vspec.InlineInfo = inlineFlag) vspec, tpenv) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 90210c7e042..b7c3bcd0b03 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2348,37 +2348,39 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = let mutable tPrev: (DateTime * DateTime * float * int[]) option = None let mutable nPrev: (string * IDisposable) option = None +let private SimulateException simulateConfig = + match simulateConfig with + | Some ("fsc-oom") -> raise (OutOfMemoryException()) + | Some ("fsc-an") -> raise (ArgumentNullException("simulated")) + | Some ("fsc-invop") -> raise (InvalidOperationException()) + | Some ("fsc-av") -> raise (AccessViolationException()) + | Some ("fsc-aor") -> raise (ArgumentOutOfRangeException()) + | Some ("fsc-dv0") -> raise (DivideByZeroException()) + | Some ("fsc-nfn") -> raise (NotFiniteNumberException()) + | Some ("fsc-oe") -> raise (OverflowException()) + | Some ("fsc-atmm") -> raise (ArrayTypeMismatchException()) + | Some ("fsc-bif") -> raise (BadImageFormatException()) + | Some ("fsc-knf") -> raise (System.Collections.Generic.KeyNotFoundException()) + | Some ("fsc-ior") -> raise (IndexOutOfRangeException()) + | Some ("fsc-ic") -> raise (InvalidCastException()) + | Some ("fsc-ip") -> raise (InvalidProgramException()) + | Some ("fsc-ma") -> raise (MemberAccessException()) + | Some ("fsc-ni") -> raise (NotImplementedException()) + | Some ("fsc-nr") -> raise (NullReferenceException()) + | Some ("fsc-oc") -> raise (OperationCanceledException()) + | Some ("fsc-fail") -> failwith "simulated" + | _ -> () + let ReportTime (tcConfig: TcConfig) descr = match nPrev with | None -> () - | Some (prevDescr, prevActivity) -> - use _ = prevActivity // Finish the previous diagnostics activity by .Dispose() at the end of this block - + | Some (prevDescr, _) -> if tcConfig.pause then dprintf "[done '%s', entering '%s'] press to continue... " prevDescr descr Console.ReadLine() |> ignore // Intentionally putting this right after the pause so a debugger can be attached. - match tcConfig.simulateException with - | Some ("fsc-oom") -> raise (OutOfMemoryException()) - | Some ("fsc-an") -> raise (ArgumentNullException("simulated")) - | Some ("fsc-invop") -> raise (InvalidOperationException()) - | Some ("fsc-av") -> raise (AccessViolationException()) - | Some ("fsc-aor") -> raise (ArgumentOutOfRangeException()) - | Some ("fsc-dv0") -> raise (DivideByZeroException()) - | Some ("fsc-nfn") -> raise (NotFiniteNumberException()) - | Some ("fsc-oe") -> raise (OverflowException()) - | Some ("fsc-atmm") -> raise (ArrayTypeMismatchException()) - | Some ("fsc-bif") -> raise (BadImageFormatException()) - | Some ("fsc-knf") -> raise (System.Collections.Generic.KeyNotFoundException()) - | Some ("fsc-ior") -> raise (IndexOutOfRangeException()) - | Some ("fsc-ic") -> raise (InvalidCastException()) - | Some ("fsc-ip") -> raise (InvalidProgramException()) - | Some ("fsc-ma") -> raise (MemberAccessException()) - | Some ("fsc-ni") -> raise (NotImplementedException()) - | Some ("fsc-nr") -> raise (NullReferenceException()) - | Some ("fsc-oc") -> raise (OperationCanceledException()) - | Some ("fsc-fail") -> failwith "simulated" - | _ -> () + SimulateException tcConfig.simulateException + if (tcConfig.showTimes || verbose || tcConfig.reportTimeToFile.IsSome) then // Note that timing calls are relatively expensive on the startup path so we don't @@ -2392,12 +2394,22 @@ let ReportTime (tcConfig: TcConfig) descr = let tStart = match tPrev, nPrev with - | Some (tStart, tPrev, utPrev, gcPrev), Some (prevDescr, _) -> + | Some (tStart, tPrev, utPrev, gcPrev), Some (prevDescr, prevActivity) -> let spanGC = [| for i in 0..maxGen -> GC.CollectionCount i - gcPrev[i] |] let t = tNow - tStart let tDelta = tNow - tPrev let utDelta = utNow - utPrev + match prevActivity with + | :? System.Diagnostics.Activity as a when isNotNull a -> + a.AddTag(Activity.Tags.gc0,spanGC[Operators.min 0 maxGen]) |> ignore + a.AddTag(Activity.Tags.gc1,spanGC[Operators.min 1 maxGen]) |> ignore + a.AddTag(Activity.Tags.gc2,spanGC[Operators.min 2 maxGen]) |> ignore + a.AddTag(Activity.Tags.outputDllFile,tcConfig.outputFile |> Option.defaultValue String.Empty) |> ignore + a.AddTag(Activity.Tags.cpuDelta,utDelta) |> ignore + a.AddTag(Activity.Tags.realDelta,tDelta.TotalSeconds) |> ignore + | _ -> () + printf "Real: %4.1f Realdelta: %4.1f Cpu: %4.1f Cpudelta: %4.1f Mem: %3d" t.TotalSeconds @@ -2413,12 +2425,12 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 2 maxGen] prevDescr - match tcConfig.reportTimeToFile with - | Some f -> - if not (File.Exists(f)) then - File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) - File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},,%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) - | None -> () + //match tcConfig.reportTimeToFile with + //| Some f -> + // if not (File.Exists(f)) then + // File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) + // File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) + //| None -> () tStart @@ -2426,6 +2438,7 @@ let ReportTime (tcConfig: TcConfig) descr = tPrev <- Some(tStart, tNow, utNow, gcNow) + nPrev |> Option.iter (fun (_,act) -> if isNotNull act then act.Dispose()) nPrev <- Some(descr, Activity.startNoTags descr) let ignoreFailureOnMono1_1_16 f = diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index e8ec56fa5a5..53a55ca0da3 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -575,7 +575,7 @@ let main1 errorRecovery e rangeStartup delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 - + tcConfig.reportTimeToFile |> Option.iter(fun f -> Activity.addCsvFileListener f |> disposables.Register) let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 07c1f518725..bcc7ef6c431 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -685,7 +685,7 @@ type BackgroundCompiler "BackgroundCompiler.CheckFileInProject" [| "project", options.ProjectFileName - "fileName", fileName + Activity.Tags.fileName, fileName "userOpName", userOpName |] diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 2ae87433ce5..e9c936f4686 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -4,15 +4,35 @@ namespace FSharp.Compiler.Diagnostics open System open System.Diagnostics +open System.IO +open System.Text +open System.Collections.Concurrent +open System.Threading.Tasks [] module Activity = + module Tags = + let fileName = "fileName" + let project = "project" + let qualifiedNameOfFile = "qualifiedNameOfFile" + let userOpName = "userOpName" + let length = "length" + let cache = "cache" + let cpuDelta = "cpuDelta" + let realDelta = "realDelta" + let gc0 = "gc0" + let gc1 = "gc1" + let gc2 = "gc2" + let outputDllFile = "outputDllFile" + + let AllKnownTags = [|fileName;project;qualifiedNameOfFile;userOpName;length;cache;cpuDelta;realDelta;gc0;gc1;gc2;outputDllFile|] + let private activitySourceName = "fsc" let private activitySource = new ActivitySource(activitySourceName) let start (name: string) (tags: (string * string) seq) : IDisposable = - let activity = activitySource.StartActivity(name) + let activity = activitySource.StartActivity(name) match activity with | null -> () @@ -23,3 +43,59 @@ module Activity = activity let startNoTags (name: string) : IDisposable = activitySource.StartActivity(name) + + let private escapeStringForCsv (o:obj) = + if isNull o then + "" + else + let mutable txtVal = o.ToString() + let hasComma = txtVal.IndexOf(',') > -1 + let hasQuote = txtVal.IndexOf('"') > -1 + + if hasQuote then + txtVal <- txtVal.Replace("\"","\\\"") + + if hasQuote || hasComma then + "\"" + txtVal + "\"" + else + txtVal + + + let private createCsvRow (a : Activity) = + let endTime = a.StartTimeUtc + a.Duration + let startTimeString = a.StartTimeUtc.ToString("HH-mm-ss.ffff") + let endTimeString = endTime.ToString("HH-mm-ss.ffff") + let duration = a.Duration.TotalMilliseconds + + let sb = new StringBuilder(128) + + Printf.bprintf sb "%s,%s,%s,%f,%s,%s" a.DisplayName startTimeString endTimeString duration a.Id a.ParentId + Tags.AllKnownTags |> Array.iter (fun t -> + sb.Append(',') |> ignore + sb.Append(escapeStringForCsv(a.GetTagItem(t))) |> ignore) + + sb.ToString() + + let addCsvFileListener pathToFile = + if pathToFile |> File.Exists |> not then + File.WriteAllLines(pathToFile,["Name,StartTime,EndTime,Duration,Id,ParentId," + String.concat "," Tags.AllKnownTags]) + + let messages = new BlockingCollection(new ConcurrentQueue()) + + let l = new ActivityListener( + ShouldListenTo = (fun a -> a.Name = activitySourceName), + Sample = (fun _ -> ActivitySamplingResult.AllData), + ActivityStopped = (fun a -> messages.Add(createCsvRow a))) + + ActivitySource.AddActivityListener(l) + + let writerTask = + Task.Factory.StartNew(fun () -> + use sw = new StreamWriter(path = pathToFile, append = true) + for msg in messages.GetConsumingEnumerable() do + sw.WriteLine(msg)) + + {new IDisposable with + member this.Dispose() = + messages.CompleteAdding() + writerTask.Wait()} \ No newline at end of file diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index edf0d890c19..773bd23477c 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -9,6 +9,24 @@ open System [] module internal Activity = + module Tags = + val fileName : string + val qualifiedNameOfFile : string + val project : string + val userOpName : string + val length : string + val cache : string + val cpuDelta : string + val realDelta : string + val gc0 : string + val gc1 : string + val gc2 : string + val outputDllFile : string + + val AllKnownTags : string[] + val startNoTags: name: string -> IDisposable val start: name: string -> tags: (string * string) seq -> IDisposable + + val addCsvFileListener: pathToFile: string -> IDisposable From 9b7b86c0d8b08dfed657aea03d63f9e905dae449 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:16:29 +0100 Subject: [PATCH 03/16] formatting --- src/Compiler/Driver/CompilerConfig.fs | 2 +- src/Compiler/Driver/CompilerOptions.fs | 28 ++++++---- src/Compiler/Driver/fsc.fs | 5 +- src/Compiler/Utilities/Activity.fs | 71 +++++++++++++++++--------- src/Compiler/Utilities/Activity.fsi | 30 +++++------ 5 files changed, 85 insertions(+), 51 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index ed0b8274bad..6413940aba5 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -517,7 +517,7 @@ type TcConfigBuilder = /// show times between passes? mutable showTimes: bool - mutable reportTimeToFile : string option + mutable reportTimeToFile: string option mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index b7c3bcd0b03..db0ae6b03fe 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2348,7 +2348,7 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = let mutable tPrev: (DateTime * DateTime * float * int[]) option = None let mutable nPrev: (string * IDisposable) option = None -let private SimulateException simulateConfig = +let private SimulateException simulateConfig = match simulateConfig with | Some ("fsc-oom") -> raise (OutOfMemoryException()) | Some ("fsc-an") -> raise (ArgumentNullException("simulated")) @@ -2380,7 +2380,6 @@ let ReportTime (tcConfig: TcConfig) descr = Console.ReadLine() |> ignore // Intentionally putting this right after the pause so a debugger can be attached. SimulateException tcConfig.simulateException - if (tcConfig.showTimes || verbose || tcConfig.reportTimeToFile.IsSome) then // Note that timing calls are relatively expensive on the startup path so we don't @@ -2401,13 +2400,16 @@ let ReportTime (tcConfig: TcConfig) descr = let utDelta = utNow - utPrev match prevActivity with - | :? System.Diagnostics.Activity as a when isNotNull a -> - a.AddTag(Activity.Tags.gc0,spanGC[Operators.min 0 maxGen]) |> ignore - a.AddTag(Activity.Tags.gc1,spanGC[Operators.min 1 maxGen]) |> ignore - a.AddTag(Activity.Tags.gc2,spanGC[Operators.min 2 maxGen]) |> ignore - a.AddTag(Activity.Tags.outputDllFile,tcConfig.outputFile |> Option.defaultValue String.Empty) |> ignore - a.AddTag(Activity.Tags.cpuDelta,utDelta) |> ignore - a.AddTag(Activity.Tags.realDelta,tDelta.TotalSeconds) |> ignore + | :? System.Diagnostics.Activity as a when isNotNull a -> + a.AddTag(Activity.Tags.gc0, spanGC[Operators.min 0 maxGen]) |> ignore + a.AddTag(Activity.Tags.gc1, spanGC[Operators.min 1 maxGen]) |> ignore + a.AddTag(Activity.Tags.gc2, spanGC[Operators.min 2 maxGen]) |> ignore + + a.AddTag(Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty) + |> ignore + + a.AddTag(Activity.Tags.cpuDelta, utDelta) |> ignore + a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds) |> ignore | _ -> () printf @@ -2424,7 +2426,7 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 1 maxGen] spanGC[Operators.min 2 maxGen] prevDescr - + //match tcConfig.reportTimeToFile with //| Some f -> // if not (File.Exists(f)) then @@ -2438,7 +2440,11 @@ let ReportTime (tcConfig: TcConfig) descr = tPrev <- Some(tStart, tNow, utNow, gcNow) - nPrev |> Option.iter (fun (_,act) -> if isNotNull act then act.Dispose()) + nPrev + |> Option.iter (fun (_, act) -> + if isNotNull act then + act.Dispose()) + nPrev <- Some(descr, Activity.startNoTags descr) let ignoreFailureOnMono1_1_16 f = diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 53a55ca0da3..75a0fa1f9c1 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -575,7 +575,10 @@ let main1 errorRecovery e rangeStartup delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 - tcConfig.reportTimeToFile |> Option.iter(fun f -> Activity.addCsvFileListener f |> disposables.Register) + + tcConfig.reportTimeToFile + |> Option.iter (fun f -> Activity.addCsvFileListener f |> disposables.Register) + let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index e9c936f4686..e808e22398f 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -26,13 +26,27 @@ module Activity = let gc2 = "gc2" let outputDllFile = "outputDllFile" - let AllKnownTags = [|fileName;project;qualifiedNameOfFile;userOpName;length;cache;cpuDelta;realDelta;gc0;gc1;gc2;outputDllFile|] + let AllKnownTags = + [| + fileName + project + qualifiedNameOfFile + userOpName + length + cache + cpuDelta + realDelta + gc0 + gc1 + gc2 + outputDllFile + |] let private activitySourceName = "fsc" let private activitySource = new ActivitySource(activitySourceName) let start (name: string) (tags: (string * string) seq) : IDisposable = - let activity = activitySource.StartActivity(name) + let activity = activitySource.StartActivity(name) match activity with | null -> () @@ -44,58 +58,69 @@ module Activity = let startNoTags (name: string) : IDisposable = activitySource.StartActivity(name) - let private escapeStringForCsv (o:obj) = + let private escapeStringForCsv (o: obj) = if isNull o then "" - else + else let mutable txtVal = o.ToString() let hasComma = txtVal.IndexOf(',') > -1 let hasQuote = txtVal.IndexOf('"') > -1 - + if hasQuote then - txtVal <- txtVal.Replace("\"","\\\"") - + txtVal <- txtVal.Replace("\"", "\\\"") + if hasQuote || hasComma then "\"" + txtVal + "\"" else txtVal - - let private createCsvRow (a : Activity) = + let private createCsvRow (a: Activity) = let endTime = a.StartTimeUtc + a.Duration let startTimeString = a.StartTimeUtc.ToString("HH-mm-ss.ffff") let endTimeString = endTime.ToString("HH-mm-ss.ffff") - let duration = a.Duration.TotalMilliseconds + let duration = a.Duration.TotalMilliseconds let sb = new StringBuilder(128) Printf.bprintf sb "%s,%s,%s,%f,%s,%s" a.DisplayName startTimeString endTimeString duration a.Id a.ParentId - Tags.AllKnownTags |> Array.iter (fun t -> + + Tags.AllKnownTags + |> Array.iter (fun t -> sb.Append(',') |> ignore - sb.Append(escapeStringForCsv(a.GetTagItem(t))) |> ignore) + sb.Append(escapeStringForCsv (a.GetTagItem(t))) |> ignore) sb.ToString() let addCsvFileListener pathToFile = if pathToFile |> File.Exists |> not then - File.WriteAllLines(pathToFile,["Name,StartTime,EndTime,Duration,Id,ParentId," + String.concat "," Tags.AllKnownTags]) + File.WriteAllLines( + pathToFile, + [ + "Name,StartTime,EndTime,Duration,Id,ParentId," + + String.concat "," Tags.AllKnownTags + ] + ) let messages = new BlockingCollection(new ConcurrentQueue()) - let l = new ActivityListener( - ShouldListenTo = (fun a -> a.Name = activitySourceName), - Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStopped = (fun a -> messages.Add(createCsvRow a))) + let l = + new ActivityListener( + ShouldListenTo = (fun a -> a.Name = activitySourceName), + Sample = (fun _ -> ActivitySamplingResult.AllData), + ActivityStopped = (fun a -> messages.Add(createCsvRow a)) + ) ActivitySource.AddActivityListener(l) - - let writerTask = + + let writerTask = Task.Factory.StartNew(fun () -> - use sw = new StreamWriter(path = pathToFile, append = true) + use sw = new StreamWriter(path = pathToFile, append = true) + for msg in messages.GetConsumingEnumerable() do sw.WriteLine(msg)) - {new IDisposable with - member this.Dispose() = + { new IDisposable with + member this.Dispose() = messages.CompleteAdding() - writerTask.Wait()} \ No newline at end of file + writerTask.Wait() + } diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index 773bd23477c..0b9ccd0a4a7 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -9,21 +9,21 @@ open System [] module internal Activity = - module Tags = - val fileName : string - val qualifiedNameOfFile : string - val project : string - val userOpName : string - val length : string - val cache : string - val cpuDelta : string - val realDelta : string - val gc0 : string - val gc1 : string - val gc2 : string - val outputDllFile : string - - val AllKnownTags : string[] + module Tags = + val fileName: string + val qualifiedNameOfFile: string + val project: string + val userOpName: string + val length: string + val cache: string + val cpuDelta: string + val realDelta: string + val gc0: string + val gc1: string + val gc2: string + val outputDllFile: string + + val AllKnownTags: string[] val startNoTags: name: string -> IDisposable From 3a0c03a56a26f34d0b1c187f271dc31a83345f80 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:19:26 +0100 Subject: [PATCH 04/16] Add remarks --- src/Compiler/Driver/CompilerOptions.fs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index db0ae6b03fe..ba58f223890 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2401,6 +2401,9 @@ let ReportTime (tcConfig: TcConfig) descr = match prevActivity with | :? System.Diagnostics.Activity as a when isNotNull a -> + // Yes, there is duplicity of code between the console reporting and Activity collection right now. + // If current --times behaviour can be changed (=breaking change to the layout etc.), the GC and CPU time collecting logic can move to Activity + // (if a special Tag is set for an activity, the listener itself could evaluate CPU and GC info and set it a.AddTag(Activity.Tags.gc0, spanGC[Operators.min 0 maxGen]) |> ignore a.AddTag(Activity.Tags.gc1, spanGC[Operators.min 1 maxGen]) |> ignore a.AddTag(Activity.Tags.gc2, spanGC[Operators.min 2 maxGen]) |> ignore From 2e72cf6477781317c03652a68d4e51a75fa0249b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 15:52:17 +0100 Subject: [PATCH 05/16] csv row building refactored --- src/Compiler/Driver/CompilerOptions.fs | 6 ++++-- src/Compiler/Utilities/Activity.fs | 27 ++++++++++++++------------ 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index ba58f223890..986bd6fe228 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2411,8 +2411,10 @@ let ReportTime (tcConfig: TcConfig) descr = a.AddTag(Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty) |> ignore - a.AddTag(Activity.Tags.cpuDelta, utDelta) |> ignore - a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds) |> ignore + a.AddTag(Activity.Tags.cpuDelta, utDelta.ToString("000.000")) |> ignore + + a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds.ToString("000.000")) + |> ignore | _ -> () printf diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index e808e22398f..a7615c50c39 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -19,8 +19,8 @@ module Activity = let userOpName = "userOpName" let length = "length" let cache = "cache" - let cpuDelta = "cpuDelta" - let realDelta = "realDelta" + let cpuDelta = "cpuDelta(s)" + let realDelta = "realDelta(s)" let gc0 = "gc0" let gc1 = "gc1" let gc2 = "gc2" @@ -75,19 +75,22 @@ module Activity = txtVal let private createCsvRow (a: Activity) = - let endTime = a.StartTimeUtc + a.Duration - let startTimeString = a.StartTimeUtc.ToString("HH-mm-ss.ffff") - let endTimeString = endTime.ToString("HH-mm-ss.ffff") - let duration = a.Duration.TotalMilliseconds - let sb = new StringBuilder(128) - Printf.bprintf sb "%s,%s,%s,%f,%s,%s" a.DisplayName startTimeString endTimeString duration a.Id a.ParentId + let appendWithLeadingComma (s: string) = + sb.Append(',') |> ignore + sb.Append(s) |> ignore + + // "Name,StartTime,EndTime,Duration,Id,ParentId" + sb.Append(a.DisplayName) |> ignore + appendWithLeadingComma (a.StartTimeUtc.ToString("HH-mm-ss.ffff")) + appendWithLeadingComma ((a.StartTimeUtc + a.Duration).ToString("HH-mm-ss.ffff")) + appendWithLeadingComma (a.Duration.TotalSeconds.ToString("000.0000")) + appendWithLeadingComma (a.Id) + appendWithLeadingComma (a.ParentId) Tags.AllKnownTags - |> Array.iter (fun t -> - sb.Append(',') |> ignore - sb.Append(escapeStringForCsv (a.GetTagItem(t))) |> ignore) + |> Array.iter (fun t -> a.GetTagItem(t) |> escapeStringForCsv |> appendWithLeadingComma) sb.ToString() @@ -96,7 +99,7 @@ module Activity = File.WriteAllLines( pathToFile, [ - "Name,StartTime,EndTime,Duration,Id,ParentId," + "Name,StartTime,EndTime,Duration(s),Id,ParentId," + String.concat "," Tags.AllKnownTags ] ) From cde7a25352630d1be14dc54d2e22bd51e5942f34 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 16:17:58 +0100 Subject: [PATCH 06/16] support for rootId added --- src/Compiler/Utilities/Activity.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index a7615c50c39..64d99262648 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -89,6 +89,11 @@ module Activity = appendWithLeadingComma (a.Id) appendWithLeadingComma (a.ParentId) + let rec rootID (act: Activity) = + if isNull act.ParentId then act.Id else rootID act.Parent + + appendWithLeadingComma (rootID a) + Tags.AllKnownTags |> Array.iter (fun t -> a.GetTagItem(t) |> escapeStringForCsv |> appendWithLeadingComma) @@ -99,7 +104,7 @@ module Activity = File.WriteAllLines( pathToFile, [ - "Name,StartTime,EndTime,Duration(s),Id,ParentId," + "Name,StartTime,EndTime,Duration(s),Id,ParentId,RootId," + String.concat "," Tags.AllKnownTags ] ) From a71d7364087af523688adccb2da7c46b9b23d6b8 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 16:37:03 +0100 Subject: [PATCH 07/16] Tracking whole file compilation, to make it the root activity for fsc.exe invocation --- src/Compiler/Driver/fsc.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 75a0fa1f9c1..11a2aca70e9 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -577,7 +577,9 @@ let main1 exiter.Exit 1 tcConfig.reportTimeToFile - |> Option.iter (fun f -> Activity.addCsvFileListener f |> disposables.Register) + |> Option.iter (fun f -> + Activity.addCsvFileListener f |> disposables.Register + Activity.start "FSC compilation" [ Activity.Tags.outputDllFile , tcConfig.outputFile |> Option.defaultValue String.Empty] |> disposables.Register) let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) From 506f1468532a60667d60008901f334dd8423e550 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 16:54:53 +0100 Subject: [PATCH 08/16] Formatting using Fantomas --- src/Compiler/Driver/fsc.fs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 11a2aca70e9..53e5bc51f69 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -577,9 +577,15 @@ let main1 exiter.Exit 1 tcConfig.reportTimeToFile - |> Option.iter (fun f -> + |> Option.iter (fun f -> Activity.addCsvFileListener f |> disposables.Register - Activity.start "FSC compilation" [ Activity.Tags.outputDllFile , tcConfig.outputFile |> Option.defaultValue String.Empty] |> disposables.Register) + + Activity.start + "FSC compilation" + [ + Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty + ] + |> disposables.Register) let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) From b2e51b5dd7c15427d2aa1a42d27612b629218a5e Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Dec 2022 17:50:47 +0100 Subject: [PATCH 09/16] Apply suggestions from code review --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Driver/CompilerOptions.fs | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index f36e85846d6..d4ff82dd1da 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -12095,6 +12095,6 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames) let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false) - //assert(vspec.InlineInfo = inlineFlag) + assert(vspec.InlineInfo = inlineFlag) vspec, tpenv) diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 986bd6fe228..ef8ab1e45f0 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2432,13 +2432,6 @@ let ReportTime (tcConfig: TcConfig) descr = spanGC[Operators.min 2 maxGen] prevDescr - //match tcConfig.reportTimeToFile with - //| Some f -> - // if not (File.Exists(f)) then - // File.WriteAllLines(f,["Realdelta,CpuDelta,WorkingSet,GC0,GC1,GC2,Outputfile,PhaseName"]) - // File.AppendAllLines(f,[$"%f{tDelta.TotalSeconds},%f{utDelta},%i{wsNow},%i{spanGC[Operators.min 0 maxGen]},%i{spanGC[Operators.min 1 maxGen]},%i{spanGC[Operators.min 2 maxGen]},{tcConfig.outputFile |> Option.defaultValue String.Empty},{prevDescr}"]) - //| None -> () - tStart | _ -> DateTime.Now From a5bc3bd8113d2f824632ff001e1d8d2c37d85307 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Dec 2022 10:08:49 +0100 Subject: [PATCH 10/16] Changing literal strings to Activity.Tags.*** --- src/Compiler/Checking/CheckDeclarations.fs | 8 +-- src/Compiler/Driver/ParseAndCheckInputs.fs | 2 +- src/Compiler/Service/FSharpCheckerResults.fs | 4 +- src/Compiler/Service/IncrementalBuild.fs | 8 +-- src/Compiler/Service/service.fs | 64 ++++++++++---------- 5 files changed, 43 insertions(+), 43 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 7ea1c4b3429..4f74ce59c61 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5316,8 +5316,8 @@ let CheckOneImplFile use _ = Activity.start "CheckDeclarations.CheckOneImplFile" [| - "fileName", fileName - "qualifiedNameOfFile", qualNameOfFile.Text + Activity.Tags.fileName, fileName + Activity.Tags.qualifiedNameOfFile, qualNameOfFile.Text |] let cenv = cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt, @@ -5450,8 +5450,8 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin use _ = Activity.start "CheckDeclarations.CheckOneSigFile" [| - "fileName", sigFile.FileName - "qualifiedNameOfFile", sigFile.QualifiedName.Text + Activity.Tags.fileName, sigFile.FileName + Activity.Tags.qualifiedNameOfFile, sigFile.QualifiedName.Text |] let cenv = cenv.Create diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index ac36b76477c..b384a93bf9e 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1205,7 +1205,7 @@ let CheckOneInputAux cancellable { try use _ = - Activity.start "ParseAndCheckInputs.CheckOneInput" [| "fileName", inp.FileName |] + Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, inp.FileName |] CheckSimulateException tcConfig diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 25c94ca5c5c..90ee7a80151 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2347,7 +2347,7 @@ module internal ParseAndCheckFile = let parseFile (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) - use act = Activity.start "ParseAndCheckFile.parseFile" [| "fileName", fileName |] + use act = Activity.start "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName |] let errHandler = DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) @@ -2504,7 +2504,7 @@ module internal ParseAndCheckFile = cancellable { use _ = - Activity.start "ParseAndCheckFile.CheckOneFile" [| "fileName", mainInputFileName; "length", sourceText.Length.ToString() |] + Activity.start "ParseAndCheckFile.CheckOneFile" [| Activity.Tags.fileName, mainInputFileName; Activity.Tags.length, sourceText.Length.ToString() |] let parsedMainInput = parseResults.ParseTree diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 578eb5558f0..b62585266c7 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -127,7 +127,7 @@ module IncrementalBuildSyntaxTree = use act = Activity.start "IncrementalBuildSyntaxTree.parse" [| - "fileName", source.FilePath + Activity.Tags.fileName, source.FilePath "buildPhase", BuildPhase.Parse.ToString() "canSkip", canSkip.ToString() |] @@ -475,7 +475,7 @@ type BoundModel private (tcConfig: TcConfig, let! res = defaultTypeCheck () return res | Some syntaxTree -> - use _ = Activity.start "BoundModel.TypeCheck" [|"fileName", syntaxTree.FileName|] + use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] let sigNameOpt = if partialCheck then this.BackingSignature @@ -538,7 +538,7 @@ type BoundModel private (tcConfig: TcConfig, // Build symbol keys let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then - use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|"fileName", fileName|] + use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] let sResolutions = sink.GetResolutions() let builder = ItemKeyStoreBuilder() let preventDuplicates = HashSet({ new IEqualityComparer with @@ -1043,7 +1043,7 @@ module IncrementalBuilderStateHelpers = let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = GraphNode(node { - use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|"projectOutFile", initialState.outfile|] + use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.outputDllFile, initialState.outfile|] // Compute last bound model then get all the evaluated models. let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue() let boundModels = diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index bcc7ef6c431..c20024e9d73 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -287,7 +287,7 @@ type BackgroundCompiler let CreateOneIncrementalBuilder (options: FSharpProjectOptions, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.CreateOneIncrementalBuilder" [| "project", options.ProjectFileName |] + Activity.start "BackgroundCompiler.CreateOneIncrementalBuilder" [| Activity.Tags.project, options.ProjectFileName |] Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CreateOneIncrementalBuilder", options.ProjectFileName) let projectReferences = getProjectReferences options userOpName @@ -479,7 +479,7 @@ type BackgroundCompiler member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, userOpName: string) = async { use _ = - Activity.start "BackgroundCompiler.ParseFile" [| "fileName", fileName; "userOpName", userOpName; "cache", cache.ToString() |] + Activity.start "BackgroundCompiler.ParseFile" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName; Activity.Tags.cache, cache.ToString() |] if cache then let hash = sourceText.GetHashCode() |> int64 @@ -506,7 +506,7 @@ type BackgroundCompiler member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| "fileName", fileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -535,7 +535,7 @@ type BackgroundCompiler member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = node { - use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| "fileName", fileName |] + use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) @@ -642,9 +642,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.CheckFileInProjectAllowingStaleCachedResults" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! cachedResults = @@ -684,9 +684,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.CheckFileInProject" [| - "project", options.ProjectFileName + Activity.Tags.project, options.ProjectFileName Activity.Tags.fileName, fileName - "userOpName", userOpName + Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -712,9 +712,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -758,9 +758,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.ParseAndCheckFileInProject" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -850,9 +850,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.FindReferencesInFile" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName "symbol", symbol.FullName |] @@ -878,9 +878,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName |] let! builderOpt, _ = getOrCreateBuilder (options, userOpName) @@ -902,9 +902,9 @@ type BackgroundCompiler Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" [| - "project", options.ProjectFileName - "fileName", fileName - "userOpName", _userOpName + Activity.Tags.project, options.ProjectFileName + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, _userOpName |] match sourceText with @@ -980,7 +980,7 @@ type BackgroundCompiler member _.GetAssemblyData(options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetAssemblyData" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.GetAssemblyData" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] let! builderOpt, _ = getOrCreateBuilder (options, userOpName) @@ -1003,7 +1003,7 @@ type BackgroundCompiler /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options, userOpName) = use _ = - Activity.start "BackgroundCompiler.ParseAndCheckProject" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.ParseAndCheckProject" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] bc.ParseAndCheckProjectImpl(options, userOpName) @@ -1022,7 +1022,7 @@ type BackgroundCompiler _userOpName ) = use _ = - Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| "fileName", fileName; "userOpName", _userOpName |] + Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] cancellable { use diagnostics = new DiagnosticsScope() @@ -1109,7 +1109,7 @@ type BackgroundCompiler member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.InvalidateConfiguration" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.InvalidateConfiguration" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then parseCacheLock.AcquireLock(fun ltok -> @@ -1120,7 +1120,7 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = - use _ = Activity.start "BackgroundCompiler.ClearCache" [| "userOpName", _userOpName |] + use _ = Activity.start "BackgroundCompiler.ClearCache" [|Activity.Tags.userOpName, _userOpName |] lock gate (fun () -> options @@ -1128,7 +1128,7 @@ type BackgroundCompiler member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.NotifyProjectCleaned" [| "project", options.ProjectFileName; "userOpName", userOpName |] + Activity.start "BackgroundCompiler.NotifyProjectCleaned" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] async { let! ct = Async.CancellationToken @@ -1296,7 +1296,7 @@ type FSharpChecker member _.MatchBraces(fileName, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - use _ = Activity.start "FSharpChecker.MatchBraces" [| "fileName", fileName; "userOpName", userOpName |] + use _ = Activity.start "FSharpChecker.MatchBraces" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] let hash = sourceText.GetHashCode() |> int64 async { @@ -1348,7 +1348,7 @@ type FSharpChecker member _.Compile(argv: string[], ?userOpName: string) = let _userOpName = defaultArg userOpName "Unknown" - use _ = Activity.start "FSharpChecker.Compile" [| "userOpName", _userOpName |] + use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { let ctok = CompilationThreadToken() From 376701e66a01affa1ab854c7b368032d5b13cb26 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Dec 2022 10:10:02 +0100 Subject: [PATCH 11/16] Fantomas applied --- src/Compiler/Service/FSharpCheckerResults.fs | 11 +++- src/Compiler/Service/service.fs | 55 ++++++++++++++++---- 2 files changed, 54 insertions(+), 12 deletions(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 90ee7a80151..f2b88684b5c 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2347,7 +2347,9 @@ module internal ParseAndCheckFile = let parseFile (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) - use act = Activity.start "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName |] + + use act = + Activity.start "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName |] let errHandler = DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) @@ -2504,7 +2506,12 @@ module internal ParseAndCheckFile = cancellable { use _ = - Activity.start "ParseAndCheckFile.CheckOneFile" [| Activity.Tags.fileName, mainInputFileName; Activity.Tags.length, sourceText.Length.ToString() |] + Activity.start + "ParseAndCheckFile.CheckOneFile" + [| + Activity.Tags.fileName, mainInputFileName + Activity.Tags.length, sourceText.Length.ToString() + |] let parsedMainInput = parseResults.ParseTree diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index c20024e9d73..9af88d75880 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -479,7 +479,13 @@ type BackgroundCompiler member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, userOpName: string) = async { use _ = - Activity.start "BackgroundCompiler.ParseFile" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName; Activity.Tags.cache, cache.ToString() |] + Activity.start + "BackgroundCompiler.ParseFile" + [| + Activity.Tags.fileName, fileName + Activity.Tags.userOpName, userOpName + Activity.Tags.cache, cache.ToString() + |] if cache then let hash = sourceText.GetHashCode() |> int64 @@ -506,7 +512,9 @@ type BackgroundCompiler member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" + [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) @@ -535,7 +543,9 @@ type BackgroundCompiler member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = node { - use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] + use _ = + Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| Activity.Tags.fileName, fileName |] + let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) @@ -980,7 +990,12 @@ type BackgroundCompiler member _.GetAssemblyData(options, userOpName) = node { use _ = - Activity.start "BackgroundCompiler.GetAssemblyData" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.GetAssemblyData" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] let! builderOpt, _ = getOrCreateBuilder (options, userOpName) @@ -1003,7 +1018,12 @@ type BackgroundCompiler /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options, userOpName) = use _ = - Activity.start "BackgroundCompiler.ParseAndCheckProject" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.ParseAndCheckProject" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] bc.ParseAndCheckProjectImpl(options, userOpName) @@ -1022,7 +1042,9 @@ type BackgroundCompiler _userOpName ) = use _ = - Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] + Activity.start + "BackgroundCompiler.GetProjectOptionsFromScript" + [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, _userOpName |] cancellable { use diagnostics = new DiagnosticsScope() @@ -1109,7 +1131,12 @@ type BackgroundCompiler member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.InvalidateConfiguration" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.InvalidateConfiguration" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then parseCacheLock.AcquireLock(fun ltok -> @@ -1120,7 +1147,7 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = - use _ = Activity.start "BackgroundCompiler.ClearCache" [|Activity.Tags.userOpName, _userOpName |] + use _ = Activity.start "BackgroundCompiler.ClearCache" [| Activity.Tags.userOpName, _userOpName |] lock gate (fun () -> options @@ -1128,7 +1155,12 @@ type BackgroundCompiler member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName) = use _ = - Activity.start "BackgroundCompiler.NotifyProjectCleaned" [| Activity.Tags.project, options.ProjectFileName; Activity.Tags.userOpName, userOpName |] + Activity.start + "BackgroundCompiler.NotifyProjectCleaned" + [| + Activity.Tags.project, options.ProjectFileName + Activity.Tags.userOpName, userOpName + |] async { let! ct = Async.CancellationToken @@ -1296,7 +1328,10 @@ type FSharpChecker member _.MatchBraces(fileName, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - use _ = Activity.start "FSharpChecker.MatchBraces" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] + + use _ = + Activity.start "FSharpChecker.MatchBraces" [| Activity.Tags.fileName, fileName; Activity.Tags.userOpName, userOpName |] + let hash = sourceText.GetHashCode() |> int64 async { From 4f2ab14ebbf429f090a1ad9c45e793ee13f06502 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 13 Dec 2022 09:55:18 +0100 Subject: [PATCH 12/16] Task.Factory.StartNew ==> backgroundTask{} --- src/Compiler/Utilities/Activity.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 64d99262648..1a9601b8611 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -8,6 +8,7 @@ open System.IO open System.Text open System.Collections.Concurrent open System.Threading.Tasks +open Microsoft.FSharp.Control [] module Activity = @@ -121,11 +122,12 @@ module Activity = ActivitySource.AddActivityListener(l) let writerTask = - Task.Factory.StartNew(fun () -> + backgroundTask { use sw = new StreamWriter(path = pathToFile, append = true) for msg in messages.GetConsumingEnumerable() do - sw.WriteLine(msg)) + sw.WriteLine(msg) + } { new IDisposable with member this.Dispose() = From bb2f83bad8abd35ac2a9c3090e19e9817ae3feef Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 13 Dec 2022 12:42:45 +0100 Subject: [PATCH 13/16] Aligning "--times" cmd options, moving file writer to MBP --times : enables console reporting --times: enables .csv reporting to a file Both these flags can be used at the same time --- src/Compiler/Driver/CompilerConfig.fs | 6 +++--- src/Compiler/Driver/CompilerConfig.fsi | 4 ++-- src/Compiler/Driver/CompilerOptions.fs | 12 +++++------ src/Compiler/Driver/fsc.fs | 2 +- src/Compiler/Utilities/Activity.fs | 28 +++++++++++--------------- 5 files changed, 24 insertions(+), 28 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 6413940aba5..54e45ead3cc 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -517,7 +517,7 @@ type TcConfigBuilder = /// show times between passes? mutable showTimes: bool - mutable reportTimeToFile: string option + mutable writeTimesToFile: string option mutable showLoadedAssemblies: bool mutable continueAfterParseFailure: bool @@ -741,7 +741,7 @@ type TcConfigBuilder = productNameForBannerText = FSharpProductName showBanner = true showTimes = false - reportTimeToFile = None + writeTimesToFile = None showLoadedAssemblies = false continueAfterParseFailure = false #if !NO_TYPEPROVIDERS @@ -1298,7 +1298,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.productNameForBannerText = data.productNameForBannerText member _.showBanner = data.showBanner member _.showTimes = data.showTimes - member _.reportTimeToFile = data.reportTimeToFile + member _.writeTimesToFile = data.writeTimesToFile member _.showLoadedAssemblies = data.showLoadedAssemblies member _.continueAfterParseFailure = data.continueAfterParseFailure #if !NO_TYPEPROVIDERS diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 621973a98fe..95e26b637ef 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -426,7 +426,7 @@ type TcConfigBuilder = mutable showTimes: bool - mutable reportTimeToFile: string option + mutable writeTimesToFile: string option mutable showLoadedAssemblies: bool @@ -750,7 +750,7 @@ type TcConfig = member showTimes: bool - member reportTimeToFile: string option + member writeTimesToFile: string option member showLoadedAssemblies: bool diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index ef8ab1e45f0..5d800416450 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -1741,12 +1741,12 @@ let internalFlags (tcConfigB: TcConfigBuilder) = None ) - // "Render timing profiles for compilation to a file" + // "Write timing profiles for compilation to a file" CompilerOption( - "reportTimeToFile", - tagString, - OptionString(fun s -> tcConfigB.reportTimeToFile <- Some s), - Some(InternalCommandLineOption("reportTimeToFile", rangeCmdArgs)), + "times", + tagFile, + OptionString(fun s -> tcConfigB.writeTimesToFile <- Some s), + Some(InternalCommandLineOption("times", rangeCmdArgs)), None ) @@ -2381,7 +2381,7 @@ let ReportTime (tcConfig: TcConfig) descr = // Intentionally putting this right after the pause so a debugger can be attached. SimulateException tcConfig.simulateException - if (tcConfig.showTimes || verbose || tcConfig.reportTimeToFile.IsSome) then + if (tcConfig.showTimes || verbose || tcConfig.writeTimesToFile.IsSome) then // Note that timing calls are relatively expensive on the startup path so we don't // make this call unless showTimes has been turned on. let p = Process.GetCurrentProcess() diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 53e5bc51f69..705d6bb3832 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -576,7 +576,7 @@ let main1 delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 - tcConfig.reportTimeToFile + tcConfig.writeTimesToFile |> Option.iter (fun f -> Activity.addCsvFileListener f |> disposables.Register diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 1a9601b8611..2b1c6234db3 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -6,9 +6,6 @@ open System open System.Diagnostics open System.IO open System.Text -open System.Collections.Concurrent -open System.Threading.Tasks -open Microsoft.FSharp.Control [] module Activity = @@ -110,27 +107,26 @@ module Activity = ] ) - let messages = new BlockingCollection(new ConcurrentQueue()) + let sw = new StreamWriter(path = pathToFile, append = true) + let msgQueue = MailboxProcessor.Start(fun inbox -> + async { + while true do + let! msg = inbox.Receive() + do! sw.WriteLineAsync(msg) |> Async.AwaitTask + }) let l = new ActivityListener( ShouldListenTo = (fun a -> a.Name = activitySourceName), Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStopped = (fun a -> messages.Add(createCsvRow a)) + ActivityStopped = (fun a -> msgQueue.Post(createCsvRow a)) ) ActivitySource.AddActivityListener(l) - let writerTask = - backgroundTask { - use sw = new StreamWriter(path = pathToFile, append = true) - - for msg in messages.GetConsumingEnumerable() do - sw.WriteLine(msg) - } - { new IDisposable with member this.Dispose() = - messages.CompleteAdding() - writerTask.Wait() - } + l.Dispose() // Unregister from listening new activities first + (msgQueue :> IDisposable).Dispose() // Wait for the msg queue to be written out + sw.Dispose() // Only then flush the messages and close the file + } \ No newline at end of file From 721875a103b3756b75eb40ad5f6003aba128e321 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 13 Dec 2022 14:22:41 +0100 Subject: [PATCH 14/16] formatting --- src/Compiler/Utilities/Activity.fs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 2b1c6234db3..ad44341cb7f 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -108,12 +108,15 @@ module Activity = ) let sw = new StreamWriter(path = pathToFile, append = true) - let msgQueue = MailboxProcessor.Start(fun inbox -> - async { - while true do - let! msg = inbox.Receive() - do! sw.WriteLineAsync(msg) |> Async.AwaitTask - }) + + let msgQueue = + MailboxProcessor.Start + (fun inbox -> + async { + while true do + let! msg = inbox.Receive() + do! sw.WriteLineAsync(msg) |> Async.AwaitTask + }) let l = new ActivityListener( @@ -129,4 +132,4 @@ module Activity = l.Dispose() // Unregister from listening new activities first (msgQueue :> IDisposable).Dispose() // Wait for the msg queue to be written out sw.Dispose() // Only then flush the messages and close the file - } \ No newline at end of file + } From cf41a298d497d1f704fa0b42dc42614cf1d0778f Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 13 Dec 2022 14:54:47 +0100 Subject: [PATCH 15/16] --times tests added --- .../CompilerOptions/fsc/times/times.fs | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs index dcdd57b4000..6bc77d45a8e 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs @@ -5,6 +5,8 @@ namespace FSharp.Compiler.ComponentTests.CompilerOptions.fsc open Xunit open FSharp.Test open FSharp.Test.Compiler +open System +open System.IO module times = @@ -47,3 +49,46 @@ module times = |> withDiagnosticMessageMatches "Unrecognized option: '--times\+'" |> ignore + [] + let ``times - to console`` compilation = + let oldConsole = Console.Out + let sw = new StringWriter() + Console.SetOut(sw) + use _ = {new IDisposable with + member this.Dispose() = Console.SetOut(oldConsole) } + + compilation + |> asFsx + |> withOptions ["--times"] + |> ignoreWarnings + |> compile + |> shouldSucceed + |> ignore + + let consoleContents = sw.ToString() + Assert.Contains("Parse inputs",consoleContents) + Assert.Contains("Typecheck",consoleContents) + Assert.Contains("Mem",consoleContents) + Assert.Contains("Realdelta",consoleContents) + + + [] + let ``times - to csv file`` compilation = + let tempPath = Path.Combine(Path.GetTempPath(),Guid.NewGuid().ToString() + ".csv") + use _ = {new IDisposable with + member this.Dispose() = File.Delete(tempPath) } + + compilation + |> asFsx + |> withOptions ["--times:"+tempPath] + |> ignoreWarnings + |> compile + |> shouldSucceed + |> ignore + + let csvContents = File.ReadAllLines(tempPath) + + Assert.Contains("Name,StartTime,EndTime,Duration(s),Id,ParentId,RootId",csvContents[0]) + Assert.Contains(csvContents, fun row -> row.Contains("Typecheck")) + Assert.Contains(csvContents, fun row -> row.Contains("Parse inputs")) + From 04879628fe594e2d3fe78b0e6b1452d76545679f Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 13 Dec 2022 22:17:53 +0100 Subject: [PATCH 16/16] Update src/Compiler/Utilities/Activity.fs Co-authored-by: Petr Pokorny --- src/Compiler/Utilities/Activity.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index ad44341cb7f..f352d81ea1e 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -83,7 +83,7 @@ module Activity = sb.Append(a.DisplayName) |> ignore appendWithLeadingComma (a.StartTimeUtc.ToString("HH-mm-ss.ffff")) appendWithLeadingComma ((a.StartTimeUtc + a.Duration).ToString("HH-mm-ss.ffff")) - appendWithLeadingComma (a.Duration.TotalSeconds.ToString("000.0000")) + appendWithLeadingComma (a.Duration.TotalSeconds.ToString("000.0000", System.Globalization.CultureInfo.InvariantCulture)) appendWithLeadingComma (a.Id) appendWithLeadingComma (a.ParentId)