Fix Fake.Core.Target performance

* Fixes various Stackoverflows by making stuff tail recursive
* fix traverse algorithms by using visited hashsets
* Make sure to skip duplicated dependencies
* Other improvements seen in the profiler (ie String.Equals instead of toLower)

Fixes #2036

.vscode/launch.json

@@ -27,14 +27,26 @@
             "name": "Run Tests",
             "type": "coreclr",
             "request": "launch",
-            "preLaunchTask": "dotnet:build:fake.sln",
+            "preLaunchTask": "dotnet:build:fake-unittests.fsproj",
             "program": "${workspaceRoot}/src/test/Fake.Core.UnitTests/bin/Debug/netcoreapp2.1/Fake.Core.UnitTests.dll",
             "args": [],
             "cwd": "${workspaceRoot}",
             "console": "internalConsole",
             "stopAtEntry": false,
             "internalConsoleOptions": "openOnSessionStart"
         },
+        {
+            "name": "Run Specific Test",
+            "type": "coreclr",
+            "request": "launch",
+            "preLaunchTask": "dotnet:build:fake-unittests.fsproj",
+            "program": "${workspaceRoot}/src/test/Fake.Core.UnitTests/bin/Debug/netcoreapp2.1/Fake.Core.UnitTests.dll",
+            "args": ["--run", "Fake.Core.Target.Tests/basic performance #2036"],
+            "cwd": "${workspaceRoot}",
+            "console": "internalConsole",
+            "stopAtEntry": false,
+            "internalConsoleOptions": "openOnSessionStart"
+        },
         {
             "name": ".NET Core Attach",
             "type": "coreclr",

.vscode/tasks.json

@@ -49,6 +49,29 @@
                 "dotnet:restore:fake-netcore.fsproj"
             ]
         },
+        {
+            "label": "dotnet:restore:fake-unittests.fsproj",            
+            "group": "build",
+            "command": "dotnet restore src/test/Fake.Core.UnitTests/Fake.Core.UnitTests.fsproj",
+            "type": "shell",
+            "presentation": {
+                "reveal": "always"
+            },
+            "problemMatcher": "$msCompile"
+        },
+        {
+            "label": "dotnet:build:fake-unittests.fsproj",            
+            "group": "build",
+            "command": "dotnet build src/test/Fake.Core.UnitTests/Fake.Core.UnitTests.fsproj",
+            "type": "shell",
+            "presentation": {
+                "reveal": "always"
+            },
+            "problemMatcher": "$msCompile",
+            "dependsOn": [
+                "dotnet:restore:fake-unittests.fsproj"
+            ]
+        },
         {
             "label": "dotnet:run:unitTests",            
             "group": "test",

RELEASE_NOTES.md

@@ -1,8 +1,9 @@
 # Release Notes
 
-## 5.9.2 - tbd
+## 5.9.2-alpha - 2018-10-14
 
-* tbd
+* BUGFIX: `Fake.Core.Target` module no longer crashes with stackoverflow on some occations - https://github.com/fsharp/FAKE/pull/2156
+* PERFORMANCE: The `Fake.Core.Target` module is now several orders of magnitude faster when using lots of targets - https://github.com/fsharp/FAKE/pull/2156
 
 ## 5.9.1 - 2018-10-14
 

src/app/Fake.Core.Target/Target.fs

@@ -7,6 +7,8 @@ open System.Threading.Tasks
 open System.Threading
 open FSharp.Control.Reactive
 open System.Collections.Immutable
+open System
+open System.Collections.Generic
 module internal TargetCli =
     let targetCli =
         """
@@ -241,13 +243,15 @@ module Target =
     let internal checkIfDependencyCanBeAddedCore fGetDependencies targetName dependentTargetName =
         let target = get targetName
         let dependentTarget = get dependentTargetName
+        let visited = HashSet<string>(StringComparer.OrdinalIgnoreCase)
 
         let rec checkDependencies dependentTarget =
-              fGetDependencies dependentTarget
-              |> List.iter (fun dep ->
-                   if String.Equals(dep, targetName, StringComparison.OrdinalIgnoreCase) then
-                      failwithf "Cyclic dependency between %s and %s" targetName dependentTarget.Name
-                   checkDependencies (get dep))
+            if visited.Add dependentTarget.Name then
+                fGetDependencies dependentTarget
+                |> List.iter (fun dep ->
+                    if String.Equals(dep, targetName, StringComparison.OrdinalIgnoreCase) then
+                        failwithf "Cyclic dependency between %s and %s" targetName dependentTarget.Name
+                    checkDependencies (get dep))
 
         checkDependencies dependentTarget
         target,dependentTarget
@@ -267,14 +271,34 @@ module Target =
     let internal dependencyAtFront targetName dependentTargetName =
         let target,_ = checkIfDependencyCanBeAdded targetName dependentTargetName
 
-        getTargetDict().[targetName] <- { target with Dependencies = dependentTargetName :: target.Dependencies }
+        let hasDependency =
+           target.Dependencies
+           |> Seq.exists (fun d -> String.Equals(d, dependentTargetName, StringComparison.OrdinalIgnoreCase))
+        if not hasDependency then
+            getTargetDict().[targetName] <- 
+                { target with 
+                    Dependencies = dependentTargetName :: target.Dependencies
+                    SoftDependencies =
+                        target.SoftDependencies
+                        |> List.filter (fun d -> not (String.Equals(d, dependentTargetName, StringComparison.OrdinalIgnoreCase)))
+                }
 
     /// Appends the dependency to the list of soft dependencies.
     /// [omit]
     let internal softDependencyAtFront targetName dependentTargetName =
         let target,_ = checkIfDependencyCanBeAdded targetName dependentTargetName
 
-        getTargetDict().[targetName] <- { target with SoftDependencies = dependentTargetName :: target.SoftDependencies }
+        let hasDependency =
+           target.Dependencies
+           |> Seq.exists (fun d -> String.Equals(d, dependentTargetName, StringComparison.OrdinalIgnoreCase))
+        let hasSoftDependency =
+           target.SoftDependencies
+           |> Seq.exists (fun d -> String.Equals(d, dependentTargetName, StringComparison.OrdinalIgnoreCase))
+        match hasDependency, hasSoftDependency with
+        | true, _ -> ()
+        | false, true -> ()
+        | false, false ->
+            getTargetDict().[targetName] <- { target with SoftDependencies = dependentTargetName :: target.SoftDependencies }
 
     /// Adds the dependency to the list of dependencies.
     /// [omit]
@@ -346,19 +370,24 @@ module Target =
     // Helper function for visiting targets in a dependency tree. Returns a set containing the names of the all the
     // visited targets, and a list containing the targets visited ordered such that dependencies of a target appear earlier
     // in the list than the target.
-    let private visitDependencies fVisit targetName =
+    let private visitDependencies repeatVisit fVisit targetName =
         let visit fGetDependencies fVisit targetName =
-            let visited = new HashSet<_>()
-            let ordered = new List<_>()
-            let rec visitDependenciesAux level (depType,targetName) =
-                let target = get targetName
-                let isVisited = visited.Contains targetName
-                visited.Add targetName |> ignore
-                fVisit (target, depType, level, isVisited)
-                (fGetDependencies target) |> Seq.iter (visitDependenciesAux (level + 1))
-                if not isVisited then ordered.Add targetName
-            visitDependenciesAux 0 (DependencyType.Hard, targetName)
-            visited, ordered
+            let visited = new HashSet<_>(StringComparer.OrdinalIgnoreCase)
+            let rec visitDependenciesAux orderedTargets = function
+                // NOTE: should be tail recursive
+                | (level, depType, targetName) :: workLeft ->
+                    let target = get targetName
+                    match visited.Add targetName with
+                    | added when added || repeatVisit ->
+                        fVisit (target, depType, level)
+                        let newLeft = (fGetDependencies target |> Seq.map (fun (depType, targetName) -> (level + 1, depType, targetName)) |> Seq.toList) @ workLeft
+                        let newOrdered = if added then (targetName :: orderedTargets) else orderedTargets
+                        visitDependenciesAux newOrdered newLeft
+                    | _ ->
+                        visitDependenciesAux orderedTargets workLeft                        
+                | _ -> orderedTargets
+            let orderedTargets = visitDependenciesAux [] [(0, DependencyType.Hard, targetName)]
+            visited, orderedTargets
 
         // First pass is to accumulate targets in (hard) dependency graph
         let visited, _ = visit (fun t -> t.Dependencies |> List.rev |> withDependencyType DependencyType.Hard) ignore targetName
@@ -383,15 +412,14 @@ module Target =
             let appendfn fmt = Printf.ksprintf (sb.AppendLine >> ignore) fmt
 
             appendfn "%sDependencyGraph for Target %s:" (if verbose then String.Empty else "Shortened ") target.Name
-            let logDependency ((t: Target), depType, level, isVisited) =
-                if verbose ||  not isVisited then
-                    let indent = (String(' ', level * 3))
-                    if depType = DependencyType.Soft then
-                        appendfn "%s<=? %s" indent t.Name
-                    else
-                        appendfn "%s<== %s" indent t.Name
+            let logDependency ((t: Target), depType, level) =
+                let indent = (String(' ', level * 3))
+                if depType = DependencyType.Soft then
+                    appendfn "%s<=? %s" indent t.Name
+                else
+                    appendfn "%s<== %s" indent t.Name
 
-            let _ = visitDependencies logDependency target.Name
+            let _ = visitDependencies verbose logDependency target.Name
             //appendfn ""
             //sb.Length <- sb.Length - Environment.NewLine.Length
             Trace.log <| sb.ToString()
@@ -455,40 +483,38 @@ module Target =
     let internal determineBuildOrder (target : string) =
         let _ = get target
 
-        let rec visitDependenciesAux fGetDependencies (visited:string list) level (_depType, targetName) =
-            let target = get targetName
-            let isVisited =
-                visited
-                |> Seq.exists (fun t -> String.Equals(t, targetName, StringComparison.OrdinalIgnoreCase))
-            //fVisit (target, depType, level, isVisited)
-            let dependencies =
-                fGetDependencies target
-                |> Seq.collect (visitDependenciesAux fGetDependencies (String.toLower targetName::visited) (level + 1))
-                |> Seq.distinctBy (fun t -> String.toLower t.Name)
-                |> Seq.toList
-            if not isVisited then target :: dependencies
-            else dependencies
+        let rec visitDependenciesAux previousDependencies = function
+            // NOTE: should be tail recursive
+            | (visited, level, targetName) :: workLeft ->
+                let target = get targetName
+                let isVisited =
+                    visited
+                    |> Seq.exists (fun t -> String.Equals(t, targetName, StringComparison.OrdinalIgnoreCase))
+                if isVisited then
+                    visitDependenciesAux previousDependencies workLeft
+                else
+                    let deps =
+                        target.Dependencies
+                        |> List.map (fun (t) -> (String.toLower targetName::visited), level + 1, t)
+                    let newVisitedDeps = target :: previousDependencies
+                    visitDependenciesAux newVisitedDeps (deps @ workLeft)
+            | _ ->
+                previousDependencies
+                |> List.distinctBy (fun (t) -> String.toLower t.Name)
 
         // first find the list of targets we "have" to build
-        let targets = visitDependenciesAux (fun t -> t.Dependencies |> List.rev |> withDependencyType DependencyType.Hard) [] 0 (DependencyType.Hard, target)
+        let targets = visitDependenciesAux [] [[], 0, target]
 
         // Try to build the optimal tree by starting with the targets without dependencies and remove them from the list iteratively
-        let baseDict =
-            ImmutableDictionary.Empty
-                .WithComparers(StringComparer.OrdinalIgnoreCase)
-
-        let fromTargets targets =
-            baseDict
-                .AddRange(targets |> Seq.map (fun t -> KeyValuePair<_,_>(t.Name, t)))
-
-        let rec findOrder (targetLeft:Target list) =
-            let targetsDict = fromTargets targetLeft
+        let targetLeftSet = HashSet<_>(StringComparer.OrdinalIgnoreCase)
+        targets |> Seq.map (fun t -> t.Name) |> Seq.iter (targetLeftSet.Add >> ignore)
+        let rec findOrder progress (targetLeft:Target list) =
+            // NOTE: Should be tail recursive
             let isValidTarget name =
-                targetsDict.ContainsKey(name)
-                //|> Seq.exists (fun t -> System.String.Equals(t.Name, name, System.StringComparison.OrdinalIgnoreCase))
+                targetLeftSet.Contains(name)
+
             let canBeExecuted (t:Target) =
                 t.Dependencies @ t.SoftDependencies
-                //|> List.rev
                 |> Seq.filter isValidTarget
                 |> Seq.isEmpty
             let map =
@@ -504,8 +530,12 @@ module Target =
                 | true, ts -> ts
                 | _ -> []
             if List.isEmpty execute then failwithf "Could not progress build order in %A" targetLeft
-            List.toArray execute :: if List.isEmpty left then [] else findOrder left
-        findOrder targets
+            if List.isEmpty left then
+                List.rev (List.toArray execute :: progress)
+            else
+                execute |> Seq.map (fun t -> t.Name) |> Seq.iter (targetLeftSet.Remove >> ignore)
+                findOrder (List.toArray execute :: progress) left      
+        findOrder [] targets
 
     /// Runs a single target without its dependencies... only when no error has been detected yet.
     let internal runSingleTarget (target : Target) (context:TargetContext) =

src/test/Fake.Core.UnitTests/Fake.ContextHelper.fs

@@ -2,11 +2,38 @@ module Fake.ContextHelper
 
 open Fake.Core
 open Expecto
+open System.Diagnostics
+
+
+let time f =
+    let sw = Stopwatch.StartNew()
+    f ()
+    sw.Stop
+    sw.Elapsed
+
+let withFakeContext name f =
+    use execContext = Fake.Core.Context.FakeExecutionContext.Create false (sprintf "text.fsx - %s" name) []
+    Fake.Core.Context.setExecutionContext (Fake.Core.Context.RuntimeContext.Fake execContext)
+    try f ()
+    finally 
+        Fake.Core.Context.removeExecutionContext()
+
+
+let withMaxTime maxTime name f =
+    let t = time f
+    printfn "Test '%s' finished in '%O'" name t
+    Expect.isLessThanOrEqual t maxTime "Expected test to finish faster than the given maxTime."
+
+
+let testCaseAssertTime maxTime name f =
+    testCase name <| fun arg ->
+        withMaxTime maxTime name (fun () -> f arg)
 
 let fakeContextTestCase name f =
     testCase name <| fun arg ->
-      use execContext = Fake.Core.Context.FakeExecutionContext.Create false (sprintf "text.fsx - %s" name) []
-      Fake.Core.Context.setExecutionContext (Fake.Core.Context.RuntimeContext.Fake execContext)
-      try f arg
-      finally 
-        Fake.Core.Context.removeExecutionContext()
+        withFakeContext name (fun () -> f arg)
+
+let fakeContextTestCaseAssertTime maxTime name f =   
+    testCase name <| fun arg ->
+        withFakeContext name (fun () -> 
+            withMaxTime maxTime name (fun () -> f arg))