diff --git a/src/FSharp.Build/FSharpEmbedResXSource.fs b/src/FSharp.Build/FSharpEmbedResXSource.fs index 4b34660b2a8..29a2ceefd19 100644 --- a/src/FSharp.Build/FSharpEmbedResXSource.fs +++ b/src/FSharp.Build/FSharpEmbedResXSource.fs @@ -10,14 +10,20 @@ open System.Xml.Linq open Microsoft.Build.Framework open Microsoft.Build.Utilities -type FSharpEmbedResXSource() = - let mutable _buildEngine: IBuildEngine MaybeNull = null - let mutable _hostObject: ITaskHost MaybeNull = null +type FSharpEmbedResXSource() as this = + inherit Task() let mutable _embeddedText: ITaskItem[] = [||] let mutable _generatedSource: ITaskItem[] = [||] let mutable _outputPath: string = "" let mutable _targetFramework: string = "" + let failTask fmt = + Printf.ksprintf + (fun msg -> + this.Log.LogError msg + raise TaskFailed) + fmt + let boilerplate = @"// @@ -36,7 +42,7 @@ module internal {1} = let generateSource (resx: string) (fullModuleName: string) (generateLegacy: bool) (generateLiteral: bool) = try - let printMessage = printfn "FSharpEmbedResXSource: %s" + let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt let justFileName = Path.GetFileNameWithoutExtension(resx) let sourcePath = Path.Combine(_outputPath, justFileName + ".fs") @@ -46,7 +52,7 @@ module internal {1} = && File.Exists(sourcePath) && File.GetLastWriteTimeUtc(resx) <= File.GetLastWriteTimeUtc(sourcePath) then - printMessage (sprintf "Skipping generation: '%s' since it is up-to-date." sourcePath) + printMessage "Skipping generation: '%s' since it is up-to-date." sourcePath Some(sourcePath) else let namespaceName, moduleName = @@ -63,7 +69,7 @@ module internal {1} = || _targetFramework.StartsWith("netcoreapp1.") ) - printMessage (sprintf "Generating code for target framework %s" _targetFramework) + printMessage "Generating code for target framework %s" _targetFramework let sb = StringBuilder() @@ -72,7 +78,7 @@ module internal {1} = if generateGetObject then sb.AppendLine(boilerplateGetObject) |> ignore - printMessage <| sprintf "Generating: %s" sourcePath + printMessage "Generating: %s" sourcePath let body = let xname = XName.op_Implicit @@ -82,12 +88,12 @@ module internal {1} = (fun (sb: StringBuilder) (node: XElement) -> let name = match node.Attribute(xname "name") with - | null -> failwith (sprintf "Missing resource name on element '%s'" (node.ToString())) + | null -> failTask "Missing resource name on element '%O'" node | attr -> attr.Value let docComment = match node.Elements(xname "value").FirstOrDefault() with - | null -> failwith <| sprintf "Missing resource value for '%s'" name + | null -> failTask "Missing resource value for '%s'" name | element -> element.Value.Trim() let identifier = @@ -118,7 +124,7 @@ module internal {1} = sb File.WriteAllText(sourcePath, body.ToString()) - printMessage <| sprintf "Done: %s" sourcePath + printMessage "Done: %s" sourcePath Some(sourcePath) with e -> printf "An exception occurred when processing '%s'\n%s" resx (e.ToString()) @@ -141,16 +147,8 @@ module internal {1} = [] member _.GeneratedSource = _generatedSource - interface ITask with - member _.BuildEngine - with get () = _buildEngine - and set (value) = _buildEngine <- value - - member _.HostObject - with get () = _hostObject - and set (value) = _hostObject <- value - - member this.Execute() = + override this.Execute() = + try let getBooleanMetadata (metadataName: string) (defaultValue: bool) (item: ITaskItem) = match item.GetMetadata(metadataName) with | value when String.IsNullOrWhiteSpace(value) -> defaultValue @@ -158,7 +156,7 @@ module internal {1} = match value.ToLowerInvariant() with | "true" -> true | "false" -> false - | _ -> failwith (sprintf "Expected boolean value for '%s' found '%s'" metadataName value) + | _ -> failTask "Expected boolean value for '%s' found '%s'" metadataName value let mutable success = true @@ -181,4 +179,6 @@ module internal {1} = |] _generatedSource <- generatedSource - success + success && not this.Log.HasLoggedErrors + with TaskFailed -> + false diff --git a/src/FSharp.Build/FSharpEmbedResourceText.fs b/src/FSharp.Build/FSharpEmbedResourceText.fs index 77002aa4f54..7790a783271 100644 --- a/src/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/FSharp.Build/FSharpEmbedResourceText.fs @@ -6,24 +6,32 @@ open System.IO open Microsoft.Build.Framework open Microsoft.Build.Utilities -type FSharpEmbedResourceText() = - let mutable _buildEngine: IBuildEngine MaybeNull = null - let mutable _hostObject: ITaskHost MaybeNull = null +/// A special exception that when thrown signifies that +/// the task should end with failure. It is assumed that +/// the task has already emitted the error message. +exception TaskFailed + +type FSharpEmbedResourceText() as this = + inherit Task() let mutable _embeddedText: ITaskItem[] = [||] let mutable _generatedSource: ITaskItem[] = [||] let mutable _generatedResx: ITaskItem[] = [||] let mutable _outputPath: string = "" let PrintErr (fileName, line, msg) = - printfn "%s(%d): error : %s" fileName line msg + this.Log.LogError(null, null, null, fileName, line, 0, 0, 0, msg, Array.empty) let Err (fileName, line, msg) = PrintErr(fileName, line, msg) - printfn "Note that the syntax of each line is one of these three alternatives:" - printfn "# comment" - printfn "ident,\"string\"" - printfn "errNum,ident,\"string\"" - failwith (sprintf "there were errors in the file '%s'" fileName) + + let hint = + "Note that the syntax of each line is one of these three alternatives: +# comment +ident,\"string\" +errNum,ident,\"string\"" + + this.Log.LogMessage(MessageImportance.High, hint) + raise TaskFailed let xmlBoilerPlateString = @" @@ -192,7 +200,7 @@ type FSharpEmbedResourceText() = if s.StartsWith "\"" && s.EndsWith "\"" then s.Substring(1, s.Length - 2) else - failwith "error message string should be quoted" + Err(null, 0, "error message string should be quoted") let ParseLine fileName lineNum (txt: string) = let mutable errNum = None @@ -361,8 +369,7 @@ open Printf let generateResxAndSource (fileName: string) = try - let printMessage message = - printfn "FSharpEmbedResourceText: %s" message + let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt let justFileName = Path.GetFileNameWithoutExtension(fileName) // .txt @@ -391,35 +398,33 @@ open Printf && (File.GetLastWriteTimeUtc(fileName) <= File.GetLastWriteTimeUtc(outXmlFileName)) if condition5 then - printMessage (sprintf "Skipping generation of %s and %s from %s since up-to-date" outFileName outXmlFileName fileName) + printMessage "Skipping generation of %s and %s from %s since up-to-date" outFileName outXmlFileName fileName Some(fileName, outFileName, outXmlFileName) else - printMessage ( - sprintf - "Generating %s and %s from %s, because condition %d is false, see FSharpEmbedResourceText.fs in the F# source" - outFileName - outXmlFileName - fileName - (if not condition1 then 1 - elif not condition2 then 2 - elif not condition3 then 3 - elif not condition4 then 4 - else 5) - ) - - printMessage (sprintf "Reading %s" fileName) + printMessage + "Generating %s and %s from %s, because condition %d is false, see FSharpEmbedResourceText.fs in the F# source" + outFileName + outXmlFileName + fileName + (if not condition1 then 1 + elif not condition2 then 2 + elif not condition3 then 3 + elif not condition4 then 4 + else 5) + + printMessage "Reading %s" fileName let lines = File.ReadAllLines(fileName) |> Array.mapi (fun i s -> i, s) // keep line numbers |> Array.filter (fun (i, s) -> not (s.StartsWith "#")) // filter out comments - printMessage (sprintf "Parsing %s" fileName) + printMessage "Parsing %s" fileName let stringInfos = lines |> Array.map (fun (i, s) -> ParseLine fileName i s) // now we have array of (lineNum, ident, str, holes, netFormatString) // str has %d, netFormatString has {0} - printMessage (sprintf "Validating %s" fileName) + printMessage "Validating %s" fileName // validate that all the idents are unique let allIdents = new System.Collections.Generic.Dictionary() @@ -436,7 +441,7 @@ open Printf allIdents.Add(ident, line) - printMessage (sprintf "Validating uniqueness of %s" fileName) + printMessage "Validating uniqueness of %s" fileName // validate that all the strings themselves are unique let allStrs = new System.Collections.Generic.Dictionary() @@ -456,7 +461,7 @@ open Printf allStrs.Add(str, (line, ident)) - printMessage (sprintf "Generating %s" outFileName) + printMessage "Generating %s" outFileName use outStream = File.Create outFileName use out = new StreamWriter(outStream) fprintfn out "// This is a generated file; the original input is '%s'" fileName @@ -466,7 +471,7 @@ open Printf let theResourceName = justFileName fprintfn out "%s" (StringBoilerPlate theResourceName) - printMessage (sprintf "Generating resource methods for %s" outFileName) + printMessage "Generating resource methods for %s" outFileName // gen each resource method stringInfos |> Seq.iter (fun (lineNum, (optErrNum, ident), str, holes, netFormatString) -> @@ -520,7 +525,7 @@ open Printf justPercentsFromFormatString (actualArgs.ToString())) - printMessage (sprintf "Generating .resx for %s" outFileName) + printMessage "Generating .resx for %s" outFileName fprintfn out "" // gen validation method fprintfn out " /// Call this method once to validate that all known resources are valid; throws if not" @@ -548,7 +553,7 @@ open Printf use outXmlStream = File.Create outXmlFileName xd.Save outXmlStream - printMessage (sprintf "Done %s" outFileName) + printMessage "Done %s" outFileName Some(fileName, outFileName, outXmlFileName) with e -> PrintErr(fileName, 0, sprintf "An exception occurred when processing '%s'\n%s" fileName (e.ToString())) @@ -570,17 +575,9 @@ open Printf [] member _.GeneratedResx = _generatedResx - interface ITask with - member _.BuildEngine - with get () = _buildEngine - and set (value) = _buildEngine <- value - - member _.HostObject - with get () = _hostObject - and set (value) = _hostObject <- value - - member this.Execute() = + override this.Execute() = + try let generatedFiles = this.EmbeddedText |> Array.choose (fun item -> generateResxAndSource item.ItemSpec) @@ -609,4 +606,6 @@ open Printf _generatedSource <- generatedSource _generatedResx <- generatedResx - generatedResult + generatedResult && not this.Log.HasLoggedErrors + with TaskFailed -> + false diff --git a/src/FSharp.Build/SubstituteText.fs b/src/FSharp.Build/SubstituteText.fs index 0f036da0a86..2e4950a62b3 100644 --- a/src/FSharp.Build/SubstituteText.fs +++ b/src/FSharp.Build/SubstituteText.fs @@ -5,11 +5,10 @@ namespace FSharp.Build open System open System.IO open Microsoft.Build.Framework +open Microsoft.Build.Utilities type SubstituteText() = - - let mutable _buildEngine: IBuildEngine MaybeNull = null - let mutable _hostObject: ITaskHost MaybeNull = null + inherit Task() let mutable copiedFiles = new ResizeArray() let mutable embeddedResources: ITaskItem[] = [||] @@ -22,74 +21,65 @@ type SubstituteText() = [] member _.CopiedFiles = copiedFiles.ToArray() - interface ITask with - member _.BuildEngine - with get () = _buildEngine - and set (value) = _buildEngine <- value - - member _.HostObject - with get () = _hostObject - and set (value) = _hostObject <- value - - member _.Execute() = - copiedFiles.Clear() - - if not (isNull embeddedResources) then - for item in embeddedResources do - // Update ITaskItem metadata to point to new location - let sourcePath = item.GetMetadata("FullPath") - - let pattern1 = item.GetMetadata("Pattern1") - let pattern2 = item.GetMetadata("Pattern2") - - // Is there any replacement to do? - if not (String.IsNullOrWhiteSpace(pattern1) && String.IsNullOrWhiteSpace(pattern2)) then - if not (String.IsNullOrWhiteSpace(sourcePath)) then - try - let getTargetPathFrom key = - let md = item.GetMetadata(key) - let path = Path.GetDirectoryName(md) - let fileName = Path.GetFileName(md) - let target = Path.Combine(path, @"..\resources", fileName) + override _.Execute() = + copiedFiles.Clear() + + if not (isNull embeddedResources) then + for item in embeddedResources do + // Update ITaskItem metadata to point to new location + let sourcePath = item.GetMetadata("FullPath") + + let pattern1 = item.GetMetadata("Pattern1") + let pattern2 = item.GetMetadata("Pattern2") + + // Is there any replacement to do? + if not (String.IsNullOrWhiteSpace(pattern1) && String.IsNullOrWhiteSpace(pattern2)) then + if not (String.IsNullOrWhiteSpace(sourcePath)) then + try + let getTargetPathFrom key = + let md = item.GetMetadata(key) + let path = Path.GetDirectoryName(md) + let fileName = Path.GetFileName(md) + let target = Path.Combine(path, @"..\resources", fileName) + target + + // Copy from the location specified in Identity + let sourcePath = item.GetMetadata("Identity") + + // Copy to the location specified in TargetPath unless no TargetPath is provided, then use Identity + let targetPath = + let identityPath = getTargetPathFrom "Identity" + let intermediateTargetPath = item.GetMetadata("IntermediateTargetPath") + + if not (String.IsNullOrWhiteSpace(intermediateTargetPath)) then + let fileName = Path.GetFileName(identityPath) + let target = Path.Combine(intermediateTargetPath, fileName) target + else + identityPath - // Copy from the location specified in Identity - let sourcePath = item.GetMetadata("Identity") - - // Copy to the location specified in TargetPath unless no TargetPath is provided, then use Identity - let targetPath = - let identityPath = getTargetPathFrom "Identity" - let intermediateTargetPath = item.GetMetadata("IntermediateTargetPath") - - if not (String.IsNullOrWhiteSpace(intermediateTargetPath)) then - let fileName = Path.GetFileName(identityPath) - let target = Path.Combine(intermediateTargetPath, fileName) - target - else - identityPath - - item.ItemSpec <- targetPath + item.ItemSpec <- targetPath - // Transform file - let mutable contents = File.ReadAllText(sourcePath) + // Transform file + let mutable contents = File.ReadAllText(sourcePath) - if not (String.IsNullOrWhiteSpace(pattern1)) then - let replacement = item.GetMetadata("Replacement1") - contents <- contents.Replace(pattern1, replacement) + if not (String.IsNullOrWhiteSpace(pattern1)) then + let replacement = item.GetMetadata("Replacement1") + contents <- contents.Replace(pattern1, replacement) - if not (String.IsNullOrWhiteSpace(pattern2)) then - let replacement = item.GetMetadata("Replacement2") - contents <- contents.Replace(pattern2, replacement) + if not (String.IsNullOrWhiteSpace(pattern2)) then + let replacement = item.GetMetadata("Replacement2") + contents <- contents.Replace(pattern2, replacement) - let directory = Path.GetDirectoryName(targetPath) + let directory = Path.GetDirectoryName(targetPath) - if not (Directory.Exists(directory)) then - Directory.CreateDirectory(directory) |> ignore + if not (Directory.Exists(directory)) then + Directory.CreateDirectory(directory) |> ignore - File.WriteAllText(targetPath, contents) - with _ -> - () + File.WriteAllText(targetPath, contents) + with _ -> + () - copiedFiles.Add(item) + copiedFiles.Add(item) - true + true diff --git a/src/FSharp.Build/WriteCodeFragment.fs b/src/FSharp.Build/WriteCodeFragment.fs index ab390ae4a59..7df19fad327 100644 --- a/src/FSharp.Build/WriteCodeFragment.fs +++ b/src/FSharp.Build/WriteCodeFragment.fs @@ -9,14 +9,20 @@ open System.Text open Microsoft.Build.Framework open Microsoft.Build.Utilities -type WriteCodeFragment() = - let mutable _buildEngine: IBuildEngine MaybeNull = null - let mutable _hostObject: ITaskHost MaybeNull = null +type WriteCodeFragment() as this = + inherit Task() let mutable _outputDirectory: ITaskItem MaybeNull = null let mutable _outputFile: ITaskItem MaybeNull = null let mutable _language: string = "" let mutable _assemblyAttributes: ITaskItem[] = [||] + let failTask fmt = + Printf.ksprintf + (fun msg -> + this.Log.LogError msg + raise TaskFailed) + fmt + static let escapeString (str: string) = let sb = str.ToCharArray() @@ -37,7 +43,7 @@ type WriteCodeFragment() = sb.Append("\"").ToString() - static member GenerateAttribute(item: ITaskItem, language: string) = + member _.GenerateAttribute(item: ITaskItem, language: string) = let attributeName = item.ItemSpec let args = @@ -70,7 +76,7 @@ type WriteCodeFragment() = match Int32.TryParse indexString with | (true, index) -> (index, value) - | (false, _) -> failwith (sprintf "Unable to parse '%s' as an index" indexString)) + | (false, _) -> failTask "Unable to parse '%s' as an index" indexString) |> List.sortBy fst // assign ordered parameters to array let orderedParametersArray = @@ -96,7 +102,7 @@ type WriteCodeFragment() = | "f#" -> sprintf "[]" attributeName args | "c#" -> sprintf "[assembly: %s(%s)]" attributeName args | "vb" -> sprintf "" attributeName args - | _ -> failwith "Language name must be one of F#, C# or VB" + | _ -> failTask "Language name must be one of F#, C# or VB" // adding this property to maintain API equivalence with the MSBuild task member _.Language @@ -116,56 +122,45 @@ type WriteCodeFragment() = with get () = _outputFile and set (value) = _outputFile <- value - interface ITask with - member _.BuildEngine - with get () = _buildEngine - and set (value) = _buildEngine <- value - - member _.HostObject - with get () = _hostObject - and set (value) = _hostObject <- value - - member _.Execute() = - try - match _outputFile with - | Null -> failwith "Output location must be specified" - | NonNull outputFile -> - let boilerplate = - match _language.ToLowerInvariant() with - | "f#" -> - "// \n// Generated by the FSharp WriteCodeFragment class.\n// \nnamespace FSharp\n\nopen System\nopen System.Reflection\n" - | "c#" -> - "// \n// Generated by the FSharp WriteCodeFragment class.\n// \n\nusing System;\nusing System.Reflection;" - | "vb" -> - "'------------------------------------------------------------------------------\n' \n' Generated by the FSharp WriteCodeFragment class.\n' \n'------------------------------------------------------------------------------\n\nOption Strict Off\nOption Explicit On\n\nImports System\nImports System.Reflection" - | _ -> failwith "Language name must be one of F#, C# or VB" - - let sb = StringBuilder().AppendLine(boilerplate).AppendLine() - - let code = - (sb, _assemblyAttributes) - ||> Array.fold (fun (sb: StringBuilder) (item: ITaskItem) -> - sb.AppendLine(WriteCodeFragment.GenerateAttribute(item, _language.ToLowerInvariant()))) - - if _language.ToLowerInvariant() = "f#" then - code.AppendLine("do()") |> ignore - - let fileName = outputFile.ItemSpec - - let outputFileItem = - match _outputDirectory with - | Null -> outputFile - | NonNull outputDirectory -> - if Path.IsPathRooted(fileName) then - outputFile - else - TaskItem(Path.Combine(outputDirectory.ItemSpec, fileName)) :> ITaskItem - - let codeText = code.ToString() - File.WriteAllText(fileName, codeText) - _outputFile <- outputFileItem - true - - with e -> - printf "Error writing code fragment: %s" (e.ToString()) - false + override this.Execute() = + try + match _outputFile with + | Null -> failTask "Output location must be specified" + | NonNull outputFile -> + let boilerplate = + match _language.ToLowerInvariant() with + | "f#" -> + "// \n// Generated by the FSharp WriteCodeFragment class.\n// \nnamespace FSharp\n\nopen System\nopen System.Reflection\n" + | "c#" -> + "// \n// Generated by the FSharp WriteCodeFragment class.\n// \n\nusing System;\nusing System.Reflection;" + | "vb" -> + "'------------------------------------------------------------------------------\n' \n' Generated by the FSharp WriteCodeFragment class.\n' \n'------------------------------------------------------------------------------\n\nOption Strict Off\nOption Explicit On\n\nImports System\nImports System.Reflection" + | _ -> failTask "Language name must be one of F#, C# or VB" + + let sb = StringBuilder().AppendLine(boilerplate).AppendLine() + + let code = + (sb, _assemblyAttributes) + ||> Array.fold (fun (sb: StringBuilder) (item: ITaskItem) -> + sb.AppendLine(this.GenerateAttribute(item, _language.ToLowerInvariant()))) + + if _language.ToLowerInvariant() = "f#" then + code.AppendLine("do()") |> ignore + + let fileName = outputFile.ItemSpec + + let outputFileItem = + match _outputDirectory with + | Null -> outputFile + | NonNull outputDirectory -> + if Path.IsPathRooted(fileName) then + outputFile + else + TaskItem(Path.Combine(outputDirectory.ItemSpec, fileName)) :> ITaskItem + + let codeText = code.ToString() + File.WriteAllText(fileName, codeText) + _outputFile <- outputFileItem + not this.Log.HasLoggedErrors + with TaskFailed -> + false diff --git a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs index d295f60f4ee..49ad920c449 100644 --- a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs +++ b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs @@ -13,7 +13,7 @@ type WriteCodeFragmentFSharpTests() = let verifyAttribute (attributeName:string) (parameters:(string*string) list) (expectedAttributeText:string) = let taskItem = TaskItem(attributeName) parameters |> List.iter (fun (key, value) -> taskItem.SetMetadata(key, value)) - let actualAttributeText = WriteCodeFragment.GenerateAttribute (taskItem :> ITaskItem, "f#") + let actualAttributeText = (new WriteCodeFragment()).GenerateAttribute (taskItem :> ITaskItem, "f#") let fullExpectedAttributeText = "[]" Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) @@ -43,7 +43,7 @@ type WriteCodeFragmentCSharpTests() = let verifyAttribute (attributeName:string) (parameters:(string*string) list) (expectedAttributeText:string) = let taskItem = TaskItem(attributeName) parameters |> List.iter (fun (key, value) -> taskItem.SetMetadata(key, value)) - let actualAttributeText = WriteCodeFragment.GenerateAttribute (taskItem :> ITaskItem, "c#") + let actualAttributeText = (new WriteCodeFragment()).GenerateAttribute (taskItem :> ITaskItem, "c#") let fullExpectedAttributeText = "[assembly: " + expectedAttributeText + "]" Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) @@ -75,7 +75,7 @@ type WriteCodeFragmentVisualBasicTests() = let verifyAttribute (attributeName:string) (parameters:(string*string) list) (expectedAttributeText:string) = let taskItem = TaskItem(attributeName) parameters |> List.iter (fun (key, value) -> taskItem.SetMetadata(key, value)) - let actualAttributeText = WriteCodeFragment.GenerateAttribute (taskItem :> ITaskItem, "vb") + let actualAttributeText = (new WriteCodeFragment()).GenerateAttribute (taskItem :> ITaskItem, "vb") let fullExpectedAttributeText = "" Assert.AreEqual(fullExpectedAttributeText, actualAttributeText)