Merge pull request #25 from OlegZee/dev

Publishing new features (cp + fixes)

XakeLibTests/StorageTests.fs

@@ -31,9 +31,9 @@ module private impl =
     let logger = ConsoleLogger Verbosity.Diag
 
     let createResult name =
-        { (name
+        { ([name
            |> File.make
-           |> FileTarget
+           |> FileTarget]
            |> makeResult) with Depends =
                                    [ "abc.c" |> mkFileTarget |> ArtifactDep
                                      Var("DEBUG", Some "false") ]
@@ -55,7 +55,7 @@ let Setup() =
 [<Test>]
 let ``persists simple data``() =
 
-    let testee = makeResult <| (mkFileTarget "abc.exe")
+    let testee = makeResult <| [mkFileTarget "abc.exe"]
 
     let testee =
         { testee with

XakeLibTests/SystemTaskTests.fs

@@ -18,7 +18,8 @@ let ``shell``() =
         rules [
             "main" => recipe {
 
-                do! Shell {ShellOptions.Default with
+                do! Shell {
+                    ShellOptions.Default with
                         Command = "dir"; Args = ["*.*"]
                         WorkingDir = Some "."; UseClr = true; FailOnErrorLevel = true} |> Recipe.Ignore
 

XakeLibTests/XakeLibTests.fsproj

@@ -58,13 +58,6 @@
     <None Include="paket.references" />
     <Compile Include="SystemTaskTests.fs" />
   </ItemGroup>
-  <ItemGroup>
-    <ProjectReference Include="..\core\Xake.Core.fsproj">
-      <Name>Xake.Core</Name>
-      <Project>{6b39c22f-6741-428d-b21a-33580af7bd8e}</Project>
-      <Private>True</Private>
-    </ProjectReference>
-  </ItemGroup>
   <PropertyGroup>
     <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
   </PropertyGroup>
@@ -106,4 +99,11 @@
       <Paket>True</Paket>
     </Reference>
   </ItemGroup>
+  <ItemGroup>
+    <ProjectReference Include="..\core\Xake.fsproj">
+      <Name>Xake</Name>
+      <Project>{6b39c22f-6741-428d-b21a-33580af7bd8e}</Project>
+      <Private>True</Private>
+    </ProjectReference>
+  </ItemGroup>
 </Project>

XakeLibTests/XakeScriptTests.fs

@@ -384,6 +384,56 @@ let ``executes several dependent rules``() =
 
     Assert.AreEqual(11, !count)
 
+[<Test>]
+let ``executes in parallel``() =
+
+    let steps = System.Collections.Generic.List<int>()
+
+    do xake { XakeOptions with Threads = 4 } {
+        rules [
+            "main" <== ["rule1"; "rule2"; "rule3"]
+            "rule1" => action {
+                do! Async.Sleep(40)
+                steps.Add 1
+            }
+            "rule2" => action {
+                do! Async.Sleep(20)
+                steps.Add 2
+            }
+            "rule3" => action {
+                do! Async.Sleep(10)
+                steps.Add 3
+            }
+        ]
+    }
+
+    Assert.That(steps, Is.EqualTo([3; 2; 1] |> List.toArray))
+
+[<Test>]
+let ``op <<< executes one by one``() =
+
+    let steps = System.Collections.Generic.List<int>()
+
+    do xake { XakeOptions with Threads = 4 } {
+        rules [
+            "main" <<< ["rule1"; "rule2"; "rule3"]
+            "rule1" => action {
+                do! Async.Sleep(40)
+                steps.Add 1
+            }
+            "rule2" => action {
+                do! Async.Sleep(20)
+                steps.Add 2
+            }
+            "rule3" => action {
+                do! Async.Sleep(10)
+                steps.Add 3
+            }
+        ]
+    }
+
+    Assert.AreEqual(steps, [1; 2; 3] |> List.toArray)
+
 [<Test>]
 let ``writes dependencies to a build database``() =
 
@@ -424,7 +474,7 @@ let ``writes dependencies to a build database``() =
     try
         match testee.PostAndReply <| fun ch -> DatabaseApi.GetResult ((PhonyAction "test"), ch) with
         | Some {
-                BuildResult.Result = PhonyAction "test"
+                BuildResult.Targets = [PhonyAction "test"]
                 Depends = [
                             ArtifactDep (PhonyAction "aaa"); ArtifactDep (PhonyAction "deeplyNested");
                             FileDep (fileDep, depDate)
@@ -437,8 +487,8 @@ let ``writes dependencies to a build database``() =
 
         match testee.PostAndReply <| fun ch -> DatabaseApi.GetResult ((PhonyAction "test1"), ch) with
         | Some {
-                BuildResult.Result = PhonyAction "test1"
-                BuildResult.Depends = [ArtifactDep (PhonyAction "aaa")]
+                Targets = [PhonyAction "test1"]
+                Depends = [ArtifactDep (PhonyAction "aaa")]
                 //BuildResult.Steps = []
             } -> true
         | _ -> false

core/CommonLib.fs

@@ -11,7 +11,7 @@ module internal CommonLib =
     /// <param name="f"></param>
     let memoize f =
         let cache = ref Map.empty
-        let lck = new System.Object()
+        let lck = System.Object()
         fun x ->
             match !cache |> Map.tryFind (K x) with
             | Some v -> v
@@ -24,6 +24,23 @@ module internal CommonLib =
                         cache := !cache |> Map.add (K x) res
                         res)
 
+
+    ///**Description**
+    /// Memoizes the recursive function. Memoized function is passed as first argument to f.
+    ///**Parameters**
+    ///  * `f` - parameter of type `('a -> 'b) -> 'a -> 'b` The function to be memoized.
+    ///
+    ///**Output Type**
+    ///  * `'a -> 'b`
+    ///
+    ///**Exceptions**
+    ///
+    let memoizeRec f =
+        let rec fn x = f fm x
+        and fm = fn |> memoize
+        in
+        fm
+
     /// <summary>
     /// Takes n first elements from a list.
     /// </summary>

core/Database.fs

@@ -4,15 +4,15 @@ module BuildLog =
     open Xake
     open System
 
-    let XakeDbVersion = "0.3"
+    let XakeDbVersion = "0.4"
 
     type Database = { Status : Map<Target, BuildResult> }
 
     (* API *)
 
     /// Creates a new build result
     let makeResult target = 
-        { Result = target
+        { Targets = target
           Built = DateTime.Now
           Depends = []
           Steps = [] }
@@ -21,8 +21,8 @@ module BuildLog =
     let newDatabase() = { Database.Status = Map.empty }
 
     /// Adds result to a database
-    let internal addResult db result = 
-        { db with Status = db.Status |> Map.add (result.Result) result }
+    let internal addResult db result =
+        { db with Status = result.Targets |> List.fold (fun m i -> Map.add i result m) db.Status }
 
 type 't Agent = 't MailboxProcessor
 
@@ -72,12 +72,12 @@ module Storage =
         let result = 
             wrap 
                 ((fun (r, built, deps, steps) -> 
-                 { Result = r
+                 { Targets = r
                    Built = built
                    Depends = deps
                    Steps = steps }), 
-                 fun r -> (r.Result, r.Built, r.Depends, r.Steps)) 
-                (quad target date (list dependency) (list step))
+                 fun r -> (r.Targets, r.Built, r.Depends, r.Steps)) 
+                (quad (list target) date (list dependency) (list step))
 
         let dbHeader = 
             wrap 

core/DependencyAnalysis.fs

@@ -85,17 +85,17 @@ let getChangeReasons ctx getTargetDeps target =
     | Some {BuildResult.Depends = []} ->
         [ChangeReason.Other "No dependencies", Some "It means target is not \"pure\" and depends on something beyond our control (oracle)"]
 
-    | Some {BuildResult.Depends = depends; Result = result} ->
-        let dep_state = getDepState (Util.getVar ctx.Options) (toFileList ctx.Options.ProjectRoot) getTargetDeps
+    | Some {BuildResult.Depends = depends; Targets = result} ->
+        let depState = getDepState (Util.getVar ctx.Options) (toFileList ctx.Options.ProjectRoot) getTargetDeps
 
         depends
-            |> List.map dep_state
+            |> List.map depState
             |> List.filter (fst >> (<>) ChangeReason.NotChanged)
             |> collapseFilesChanged
             |> function
             | [] ->
                 match result with
-                | FileTarget file when not (File.exists file) ->
+                | targetList when targetList |> List.exists (function | FileTarget file when not (File.exists file) -> true | _ -> false) ->
                     [ChangeReason.Other "target file does not exist", Some "The file has to be rebuilt regardless all its dependencies were not changed"]
                 | _ -> []
             | ls -> ls
@@ -118,8 +118,9 @@ let getDurationDeps ctx getDeps t =
 /// Dumps all dependencies for particular target
 let dumpDeps (ctx: ExecContext) (target: Target list) =
 
-    let rec getDeps = getChangeReasons ctx (fun x -> getDeps x) |> memoize
-    let doneTargets = new System.Collections.Hashtable()
+    let getDeps = getChangeReasons ctx |> memoizeRec
+
+    let doneTargets = System.Collections.Hashtable()
     let indent i = String.replicate i "  "
 
     let rec displayNestedDeps ii =

core/DotnetTasks.fs

@@ -40,14 +40,12 @@ module internal Impl =
     let getRelative (root:string) (path:string) =
 
         // TODO reimplement and test
-
-        if isEmpty root then path
-        elif path.ToLowerInvariant().StartsWith (root.ToLowerInvariant()) then
-            // cut the trailing "\"
-            let d = if root.Length < path.Length then 1 else 0
-            path.Substring(root.Length + d)
-        else
+        match true with
+        | _ when isEmpty root ->
             path
+        | _ when path.ToLowerInvariant().StartsWith (root.ToLowerInvariant()) ->
+            path.Substring(root.Length).TrimStart('/', '\\')
+        | _ -> path
 
     let endsWith e (str:string) = str.EndsWith (e, System.StringComparison.OrdinalIgnoreCase)
     let (|EndsWith|_|) e str = if endsWith e str then Some () else None
@@ -67,8 +65,8 @@ module internal Impl =
 
     /// Parses the compiler output and returns messageLevel
     let levelFromString defaultLevel (text:string) :Level =
-        if text.IndexOf "): warning " > 0 then Level.Warning
-        else if text.IndexOf "): error " > 0 then Level.Error
+        if text.Contains "): warning " then Level.Warning
+        else if text.Contains "): error " then Level.Error
         else defaultLevel
     let inline coalesce ls = //: 'a option list -> 'a option =
         ls |> List.fold (fun r a -> if Option.isSome r then r else a) None