diff --git a/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs b/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs index 6cdd83a5992..f14c2495c37 100644 --- a/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs +++ b/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs @@ -18,7 +18,7 @@ module MemberConstraints = |> withSingleDiagnostic (Error 697, Line 2, Col 43, Line 2, Col 76, "Invalid constraint") [] - let ``we can overload operators on a type and not add all the extra jazz such as inlining and the ^ operator.``() = + let ``We can overload operators on a type and not add all the extra jazz such as inlining and the ^ operator.``() = FSharp """ type Foo(x : int) = @@ -40,8 +40,9 @@ elif y.Val <> 7 then failwith "y.Val <> 7" elif x2.Val <> 7 then failwith "x2.Val <> 7" elif y2.Val <> 7 then failwith "x.Val <> 7" else () - """ +""" |> asExe |> compile |> run - // OR |> compileAsExeAndRun + |> shouldSucceed + |> withExitCode 0 diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 14e96dfa23b..f3ae6022550 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -38,9 +38,10 @@ + - + diff --git a/tests/fsharp/Compiler/Language/CodeQuotationTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs similarity index 92% rename from tests/fsharp/Compiler/Language/CodeQuotationTests.fs rename to tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs index c3feb8277a4..16ee721cd0c 100644 --- a/tests/fsharp/Compiler/Language/CodeQuotationTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs @@ -1,15 +1,14 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace FSharp.Compiler.UnitTests +namespace FSharp.Compiler.Language.CodeQuatation -open NUnit.Framework +open Xunit open FSharp.Test.Utilities.Compiler open FSharp.Quotations.Patterns -[] module CodeQuotationsTests = - [] + [] let ``Quotation on op_UnaryPlus(~+) compiles and runs`` () = Fsx """ open FSharp.Linq.RuntimeHelpers @@ -39,5 +38,4 @@ let z : unit = |> asExe |> withOptions ["--langversion:preview"] |> compileAndRun - - + |> shouldSucceed diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 6c6c51b10da..88c137194ce 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -61,13 +61,20 @@ module rec Compiler = Range: Range Message: string } - type Output = - { OutputPath: string option - Adjust: int - Errors: ErrorInfo list - Warnings: ErrorInfo list } + type ExecutionOutput = + { ExitCode: int + StdOut: string + StdErr: string } - type CompilationResult = + type Output = + { OutputPath: string option + Dependencies: string list + Adjust: int + Errors: ErrorInfo list + Warnings: ErrorInfo list + Output: ExecutionOutput option } + + type TestResult = | Success of Output | Failure of Output @@ -220,17 +227,19 @@ module rec Compiler = | IL _ -> failwith "TODO: Process references for IL" loop [] references - let private compileFSharpCompilation compilation ignoreWarnings : CompilationResult = + let private compileFSharpCompilation compilation ignoreWarnings : TestResult = - let ((err: FSharpErrorInfo[], outputFilePath: string), _) = CompilerAssert.CompileRaw(compilation) + let ((err: FSharpErrorInfo[], outputFilePath: string), deps) = CompilerAssert.CompileRaw(compilation) let (errors, warnings) = err |> fromFSharpErrorInfo let result = - { OutputPath = None - Adjust = 0 - Warnings = warnings - Errors = errors } + { OutputPath = None + Dependencies = deps + Adjust = 0 + Warnings = warnings + Errors = errors + Output = None } // Treat warnings as errors if "IgnoreWarnings" is false if errors.Length > 0 || (warnings.Length > 0 && not ignoreWarnings) then @@ -240,7 +249,7 @@ module rec Compiler = Success { result with Warnings = warnings OutputPath = Some outputFilePath } - let private compileFSharp (fsSource: FSharpCompilationSource) : CompilationResult = + let private compileFSharp (fsSource: FSharpCompilationSource) : TestResult = let source = getSource fsSource.Source let sourceKind = fsSource.SourceKind @@ -253,7 +262,7 @@ module rec Compiler = compileFSharpCompilation compilation fsSource.IgnoreWarnings - let private compileCSharpCompilation (compilation: CSharpCompilation) : CompilationResult = + let private compileCSharpCompilation (compilation: CSharpCompilation) : TestResult = let outputPath = Path.Combine(Path.GetTempPath(), "FSharpCompilerTests", Path.GetRandomFileName()) @@ -265,17 +274,19 @@ module rec Compiler = let cmplResult = compilation.Emit (output) let result = - { OutputPath = None - Adjust = 0 - Warnings = [] - Errors = [] } + { OutputPath = None + Dependencies = [] + Adjust = 0 + Warnings = [] + Errors = [] + Output = None } if cmplResult.Success then Success { result with OutputPath = Some output } else Failure result - let private compileCSharp (csSource: CSharpCompilationSource) : CompilationResult = + let private compileCSharp (csSource: CSharpCompilationSource) : TestResult = let source = getSource csSource.Source let name = defaultArg csSource.Name (Guid.NewGuid().ToString ()) @@ -301,24 +312,26 @@ module rec Compiler = cmpl |> compileCSharpCompilation - let compile (cUnit: CompilationUnit) : CompilationResult = + let compile (cUnit: CompilationUnit) : TestResult = match cUnit with | FS fs -> compileFSharp fs | CS cs -> compileCSharp cs | _ -> failwith "TODO" - let private typecheckFSharpWithBaseline (options: string list) (dir: string) (file: string) : CompilationResult = + let private typecheckFSharpWithBaseline (options: string list) (dir: string) (file: string) : TestResult = // Since TypecheckWithErrorsAndOptionsAgainsBaseLine throws if doesn't match expected baseline, - // We return a successfull CompilationResult if it succeeds. + // We return a successfull TestResult if it succeeds. CompilerAssert.TypeCheckWithErrorsAndOptionsAgainstBaseLine (Array.ofList options) dir file Success - { OutputPath = None - Adjust = 0 - Warnings = [] - Errors = [] } - - let private typecheckFSharpSource (fsSource: FSharpCompilationSource) : CompilationResult = + { OutputPath = None + Dependencies = [] + Adjust = 0 + Warnings = [] + Errors = [] + Output = None } + + let private typecheckFSharpSource (fsSource: FSharpCompilationSource) : TestResult = let source = getSource fsSource.Source let options = fsSource.Options |> Array.ofList @@ -327,10 +340,12 @@ module rec Compiler = let (errors, warnings) = err |> fromFSharpErrorInfo let result = - { OutputPath = None - Adjust = 0 - Warnings = warnings - Errors = errors } + { OutputPath = None + Dependencies = [] + Adjust = 0 + Warnings = warnings + Errors = errors + Output = None } // Treat warnings as errors if "IgnoreWarnings" is false; if errors.Length > 0 || (warnings.Length > 0 && not fsSource.IgnoreWarnings) then @@ -339,23 +354,29 @@ module rec Compiler = else Success { result with Warnings = warnings } - let private typecheckFSharp (fsSource: FSharpCompilationSource) : CompilationResult = + let private typecheckFSharp (fsSource: FSharpCompilationSource) : TestResult = match fsSource.Source with | Baseline (f, d) -> typecheckFSharpWithBaseline fsSource.Options f d | _ -> typecheckFSharpSource fsSource - let typecheck (cUnit: CompilationUnit) : CompilationResult = + let typecheck (cUnit: CompilationUnit) : TestResult = match cUnit with | FS fs -> typecheckFSharp fs | _ -> failwith "Typecheck only supports F#" - let run (cResult: CompilationResult ) : unit = - match cResult with - | Failure o -> failwith (sprintf "Compilation should be successfull in order to run.\n Errors: %A" (o.Errors @ o.Warnings)) + let run (result: TestResult) : TestResult = + match result with + | Failure f -> failwith (sprintf "Compilation should be successfull in order to run.\n Errors: %A" (f.Errors @ f.Warnings)) | Success s -> match s.OutputPath with | None -> failwith "Compilation didn't produce any output. Unable to run. (did you forget to set output type to Exe?)" - | Some p -> CompilerAssert.Run p + | Some p -> + let (exitCode, output, errors) = CompilerAssert.ExecuteAndReturnResult (p, s.Dependencies, false) + let executionResult = { s with Output = Some { ExitCode = exitCode; StdOut = output; StdErr = errors } } + if exitCode = 0 then + Success executionResult + else + Failure executionResult let compileAndRun = compile >> run @@ -406,36 +427,36 @@ module rec Compiler = checkEqual "Message" expectedMessage actualMessage) () - let adjust (adjust: int) (result: CompilationResult) : CompilationResult = + let adjust (adjust: int) (result: TestResult) : TestResult = match result with | Success s -> Success { s with Adjust = adjust } | Failure f -> Failure { f with Adjust = adjust } - let shouldSucceed (result: CompilationResult) : CompilationResult = + let shouldSucceed (result: TestResult) : TestResult = match result with | Success _ -> result | Failure r -> let message = sprintf "Compilation failed (expected to succeed).\n All errors:\n%A" (r.Errors @ r.Warnings) failwith message - let shouldFail (result: CompilationResult) : CompilationResult = + let shouldFail (result: TestResult) : TestResult = match result with | Success _ -> failwith "Compilation was \"Success\" (expected: \"Failure\")." | Failure _ -> result - let private assertResultsCategory (what: string) (selector: Output -> ErrorInfo list) (expected: ErrorInfo list) (result: CompilationResult) : CompilationResult = + let private assertResultsCategory (what: string) (selector: Output -> ErrorInfo list) (expected: ErrorInfo list) (result: TestResult) : TestResult = match result with | Success r | Failure r -> assertErrors what r.Adjust (selector r) expected result - let withResults (expectedResults: ErrorInfo list) result : CompilationResult = + let withResults (expectedResults: ErrorInfo list) result : TestResult = assertResultsCategory "Results" (fun r -> r.Warnings @ r.Errors) expectedResults result - let withResult (expectedResult: ErrorInfo ) (result: CompilationResult) : CompilationResult = + let withResult (expectedResult: ErrorInfo ) (result: TestResult) : TestResult = withResults [expectedResult] result - let withDiagnostics (expected: (ErrorType * Line * Col * Line * Col * string) list) (result: CompilationResult) : CompilationResult = + let withDiagnostics (expected: (ErrorType * Line * Col * Line * Col * string) list) (result: TestResult) : TestResult = let (expectedResults: ErrorInfo list) = expected |> List.map( @@ -450,58 +471,86 @@ module rec Compiler = Message = message }) withResults expectedResults result - let withSingleDiagnostic (expected: (ErrorType * Line * Col * Line * Col * string)) (result: CompilationResult) : CompilationResult = + let withSingleDiagnostic (expected: (ErrorType * Line * Col * Line * Col * string)) (result: TestResult) : TestResult = withDiagnostics [expected] result - let withErrors (expectedErrors: ErrorInfo list) (result: CompilationResult) : CompilationResult = + let withErrors (expectedErrors: ErrorInfo list) (result: TestResult) : TestResult = assertResultsCategory "Errors" (fun r -> r.Errors) expectedErrors result - let withError (expectedError: ErrorInfo) (result: CompilationResult) : CompilationResult = + let withError (expectedError: ErrorInfo) (result: TestResult) : TestResult = withErrors [expectedError] result - let checkCodes (expected: int list) (selector: Output -> ErrorInfo list) (result: CompilationResult) : CompilationResult = + let checkCodes (expected: int list) (selector: Output -> ErrorInfo list) (result: TestResult) : TestResult = match result with | Success r | Failure r -> assertErrorNumbers (selector r) expected result - let withErrorCodes (expectedCodes: int list) (result: CompilationResult) : CompilationResult = + let withErrorCodes (expectedCodes: int list) (result: TestResult) : TestResult = checkCodes expectedCodes (fun r -> r.Errors) result - let withErrorCode (expectedCode: int) (result: CompilationResult) : CompilationResult = + let withErrorCode (expectedCode: int) (result: TestResult) : TestResult = withErrorCodes [expectedCode] result - let withWarnings (expectedWarnings: ErrorInfo list) (result: CompilationResult) : CompilationResult = + let withWarnings (expectedWarnings: ErrorInfo list) (result: TestResult) : TestResult = assertResultsCategory "Warnings" (fun r -> r.Warnings) expectedWarnings result - let withWarning (expectedWarning: ErrorInfo) (result: CompilationResult) : CompilationResult = + let withWarning (expectedWarning: ErrorInfo) (result: TestResult) : TestResult = withWarnings [expectedWarning] result - let withWarningCodes (expectedCodes: int list) (result: CompilationResult) : CompilationResult = + let withWarningCodes (expectedCodes: int list) (result: TestResult) : TestResult = checkCodes expectedCodes (fun r -> r.Warnings) result - let withWarningCode (expectedCode: int) (result: CompilationResult) : CompilationResult = + let withWarningCode (expectedCode: int) (result: TestResult) : TestResult = withWarningCodes [expectedCode] result - let private checkErrorMessages (messages: string list) (selector: Output -> ErrorInfo list) (result: CompilationResult) : CompilationResult = + let private checkErrorMessages (messages: string list) (selector: Output -> ErrorInfo list) (result: TestResult) : TestResult = match result with | Success r | Failure r -> assertErrorMessages (selector r) messages result - let withMessages (messages: string list) (result: CompilationResult) : CompilationResult = + let withMessages (messages: string list) (result: TestResult) : TestResult = checkErrorMessages messages (fun r -> r.Warnings @ r.Errors) result - let withMessage (message: string) (result: CompilationResult) : CompilationResult = + let withMessage (message: string) (result: TestResult) : TestResult = withMessages [message] result - let withErrorMessages (messages: string list) (result: CompilationResult) : CompilationResult = + let withErrorMessages (messages: string list) (result: TestResult) : TestResult = checkErrorMessages messages (fun r -> r.Errors) result - let withErrorMessage (message: string) (result: CompilationResult) : CompilationResult = + let withErrorMessage (message: string) (result: TestResult) : TestResult = withErrorMessages [message] result - let withWarningMessages (messages: string list) (result: CompilationResult) : CompilationResult = + let withWarningMessages (messages: string list) (result: TestResult) : TestResult = checkErrorMessages messages (fun r -> r.Warnings) result - let withWarningMessage (message: string) (result: CompilationResult) : CompilationResult = + let withWarningMessage (message: string) (result: TestResult) : TestResult = withWarningMessages [message] result + + let withExitCode (expectedExitCode: int) (result: TestResult) : TestResult = + match result with + | Success r | Failure r -> + match r.Output with + | None -> failwith "Execution output is missing, cannot check exit code." + | Some o -> Assert.AreEqual(o.ExitCode, expectedExitCode, sprintf "Exit code was expected to be: %A, but got %A." expectedExitCode o.ExitCode) + result + + let private checkOutput (category: string) (substring: string) (selector: ExecutionOutput -> string) (result: TestResult) : TestResult = + match result with + | Success r | Failure r -> + match r.Output with + | None -> failwith (sprintf "Execution output is missing cannot check \"%A\"" category) + | Some o -> + let where = selector o + if not (where.Contains(substring)) then + failwith (sprintf "\nThe following substring:\n %A\nwas not found in the %A\nOutput:\n %A" substring category where) + result + + let withOutputContains (substring: string) (result: TestResult) : TestResult = + checkOutput "STDERR/STDOUT" substring (fun o -> o.StdOut + "\n" + o.StdErr) result + + let withStdOutContains (substring: string) (result: TestResult) : TestResult = + checkOutput "STDOUT" substring (fun o -> o.StdOut) result + + let withStdErrContains (substring: string) (result: TestResult) : TestResult = + checkOutput "STDERR" substring (fun o -> o.StdErr) result diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 4956b3e2035..e74ef790b16 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -370,6 +370,74 @@ let main argv = 0""" Directory.CreateDirectory(compileDirectory) |> ignore compileCompilationAux compileDirectory (ResizeArray()) false cmpl + static let executeBuiltAppAndReturnResult (outputFilePath: string) (deps: string list) : (int * string * string) = + let out = Console.Out + let err = Console.Error + + let stdout = StringBuilder () + let stderr = StringBuilder () + + let outWriter = new StringWriter (stdout) + let errWriter = new StringWriter (stderr) + + let mutable exitCode = 0 + + try + try + Console.SetOut(outWriter) + Console.SetError(errWriter) + (executeBuiltApp outputFilePath deps) |> ignore + with e -> + let errorMessage = if e.InnerException <> null then (e.InnerException.ToString()) else (e.ToString()) + stderr.Append (errorMessage) |> ignore + exitCode <- -1 + finally + Console.SetOut(out) + Console.SetError(err) + outWriter.Close() + errWriter.Close() + + (exitCode, stdout.ToString(), stderr.ToString()) + + static let executeBuiltAppNewProcessAndReturnResult (outputFilePath: string) : (int * string * string) = + let mutable pinfo = ProcessStartInfo() + pinfo.RedirectStandardError <- true + pinfo.RedirectStandardOutput <- true +#if !NETCOREAPP + pinfo.FileName <- outputFilePath +#else + pinfo.FileName <- "dotnet" + pinfo.Arguments <- outputFilePath + + let runtimeconfig = """ +{ + "runtimeOptions": { + "tfm": "netcoreapp3.1", + "framework": { + "name": "Microsoft.NETCore.App", + "version": "3.1.0" + } + } +}""" + let runtimeconfigPath = Path.ChangeExtension(outputFilePath, ".runtimeconfig.json") + File.WriteAllText(runtimeconfigPath, runtimeconfig) + use _disposal = + { new IDisposable with + member _.Dispose() = try File.Delete runtimeconfigPath with | _ -> () } +#endif + pinfo.UseShellExecute <- false + let p = Process.Start pinfo + + let output = p.StandardOutput.ReadToEnd() + let errors = p.StandardError.ReadToEnd() + + let exited = p.WaitForExit(120000) + + let exitCode = if not exited then -2 else p.ExitCode + + (exitCode, output, errors) + + static member CompileWithErrors(cmpl: Compilation, expectedErrors, ?ignoreWarnings) = let ignoreWarnings = defaultArg ignoreWarnings false lock gate (fun () -> @@ -382,6 +450,13 @@ let main argv = 0""" static member CompileRaw(cmpl: Compilation) = lock gate (fun () -> returnCompilation cmpl) + static member ExecuteAndReturnResult (outputFilePath: string, deps: string list, newProcess: bool) = + // If we execute in-process (true by default), then the only way of getting STDOUT is to redirect it to SB, and STDERR is from catching an exception. + if not newProcess then + executeBuiltAppAndReturnResult outputFilePath deps + else + executeBuiltAppNewProcessAndReturnResult outputFilePath + static member Execute(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess, ?onOutput) = let ignoreWarnings = defaultArg ignoreWarnings false let beforeExecute = defaultArg beforeExecute (fun _ _ -> ()) @@ -392,40 +467,8 @@ let main argv = 0""" assertErrors 0 ignoreWarnings errors [||] beforeExecute outputFilePath deps if newProcess then - let mutable pinfo = ProcessStartInfo() - pinfo.RedirectStandardError <- true - pinfo.RedirectStandardOutput <- true -#if !NETCOREAPP - pinfo.FileName <- outputFilePath -#else - pinfo.FileName <- "dotnet" - pinfo.Arguments <- outputFilePath - - let runtimeconfig = - """ -{ - "runtimeOptions": { - "tfm": "netcoreapp3.1", - "framework": { - "name": "Microsoft.NETCore.App", - "version": "3.1.0" - } - } -} - """ - - let runtimeconfigPath = Path.ChangeExtension(outputFilePath, ".runtimeconfig.json") - File.WriteAllText(runtimeconfigPath, runtimeconfig) - use _disposal = - { new IDisposable with - member _.Dispose() = try File.Delete runtimeconfigPath with | _ -> () } -#endif - pinfo.UseShellExecute <- false - let p = Process.Start pinfo - let errors = p.StandardError.ReadToEnd() - let output = p.StandardOutput.ReadToEnd() - Assert.True(p.WaitForExit(120000)) - if p.ExitCode <> 0 then + let (exitCode, output, errors) = executeBuiltAppNewProcessAndReturnResult outputFilePath + if exitCode <> 0 then Assert.Fail errors onOutput output else @@ -620,9 +663,6 @@ let main argv = 0""" static member RunScript source expectedErrorMessages = CompilerAssert.RunScriptWithOptions [||] source expectedErrorMessages - static member Run (exe: string) = - executeBuiltApp exe [] - static member ParseWithErrors (source: string) expectedParseErrors = let sourceFileName = "test.fs" let parsingOptions = { FSharpParsingOptions.Default with SourceFiles = [| sourceFileName |] } diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 1c4f337025d..7d74fa10984 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -42,7 +42,6 @@ -