Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ module MemberConstraints =
|> withSingleDiagnostic (Error 697, Line 2, Col 43, Line 2, Col 76, "Invalid constraint")

[<Fact>]
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) =
Expand All @@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -38,9 +38,10 @@
<Compile Include="ErrorMessages\WrongSyntaxInForLoop.fs" />
<Compile Include="ErrorMessages\ConfusingTypeName.fs" />
<Compile Include="Language\CompilerDirectiveTests.fs" />
<Compile Include="Language\CodeQuotationTests.fs" />
<Compile Include="ConstraintSolver\PrimitiveConstraints.fs" />
<Compile Include="ConstraintSolver\MemberConstraints.fs" />
<Compile Include="Interop/SimpleInteropTests.fs" />
<Compile Include="Interop\SimpleInteropTests.fs" />
</ItemGroup>

<ItemGroup>
Expand Down
Original file line number Diff line number Diff line change
@@ -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

[<TestFixture>]
module CodeQuotationsTests =

[<Test>]
[<Fact>]
let ``Quotation on op_UnaryPlus(~+) compiles and runs`` () =
Fsx """
open FSharp.Linq.RuntimeHelpers
Expand Down Expand Up @@ -39,5 +38,4 @@ let z : unit =
|> asExe
|> withOptions ["--langversion:preview"]
|> compileAndRun


|> shouldSucceed
173 changes: 111 additions & 62 deletions tests/FSharp.Test.Utilities/Compiler.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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())

Expand All @@ -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 ())
Expand All @@ -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

Expand All @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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(
Expand All @@ -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
Loading