From 6e3ba11ed7fe0d416ddd3123dd42d766da501617 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 12 Jul 2019 12:54:49 +0200 Subject: [PATCH] Member constraints and PrimitiveConstraints --- tests/fsharp/Compiler/CompilerAssert.fs | 23 +++- .../ConstraintSolver/MemberConstraints.fs | 45 ++++++++ .../ConstraintSolver/PrimitiveConstraints.fs | 109 ++++++++++++++++++ tests/fsharp/FSharpSuite.Tests.fsproj | 4 +- .../E_MemberConstraints01.fs | 6 - .../ConstraintSolving/E_PrimConstraint04.fs | 16 --- .../ConstraintSolving/MemberConstraints01.fs | 24 ---- .../ConstraintSolving/PrimConstraint01.fs | 26 ----- .../ConstraintSolving/PrimConstraint02.fs | 33 ------ .../ConstraintSolving/PrimConstraint03.fs | 23 ---- .../ConstraintSolving/env.lst | 8 -- 11 files changed, 175 insertions(+), 142 deletions(-) create mode 100644 tests/fsharp/Compiler/ConstraintSolver/MemberConstraints.fs create mode 100644 tests/fsharp/Compiler/ConstraintSolver/PrimitiveConstraints.fs delete mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_MemberConstraints01.fs delete mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_PrimConstraint04.fs delete mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/MemberConstraints01.fs delete mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint01.fs delete mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint02.fs delete mode 100644 tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint03.fs diff --git a/tests/fsharp/Compiler/CompilerAssert.fs b/tests/fsharp/Compiler/CompilerAssert.fs index 9c748455498..ca4a7a8b93b 100644 --- a/tests/fsharp/Compiler/CompilerAssert.fs +++ b/tests/fsharp/Compiler/CompilerAssert.fs @@ -110,11 +110,15 @@ module CompilerAssert = Assert.IsEmpty(typeCheckResults.Errors, sprintf "Type Check errors: %A" typeCheckResults.Errors) - - - let TypeCheckWithErrors (source: string) expectedTypeErrors = + let TypeCheckWithErrorsAndOptions options (source: string) expectedTypeErrors = lock gate <| fun () -> - let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously + let parseResults, fileAnswer = + checker.ParseAndCheckFileInProject( + "test.fs", + 0, + SourceText.ofString source, + { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}) + |> Async.RunSynchronously Assert.IsEmpty(parseResults.Errors, sprintf "Parse errors: %A" parseResults.Errors) @@ -137,8 +141,14 @@ module CompilerAssert = Assert.AreEqual(expectedErrorMsg, info.Message, "expectedErrorMsg") ) + let TypeCheckWithErrors (source: string) expectedTypeErrors = + TypeCheckWithErrorsAndOptions [||] source expectedTypeErrors + + let TypeCheckSingleErrorWithOptions options (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = + TypeCheckWithErrorsAndOptions options source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] + let TypeCheckSingleError (source: string) (expectedServerity: FSharpErrorSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = - TypeCheckWithErrors (source: string) [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] + TypeCheckWithErrors source [| expectedServerity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] let CompileExe (source: string) = compile true source (fun (errors, _) -> @@ -168,6 +178,9 @@ module CompilerAssert = let errors = p.StandardError.ReadToEnd () if not (String.IsNullOrWhiteSpace errors) then Assert.Fail errors + + if p.ExitCode <> 0 then + Assert.Fail(sprintf "Program exited with exit code %d" p.ExitCode) ) let CompileLibraryAndVerifyIL (source: string) (f: ILVerifier -> unit) = diff --git a/tests/fsharp/Compiler/ConstraintSolver/MemberConstraints.fs b/tests/fsharp/Compiler/ConstraintSolver/MemberConstraints.fs new file mode 100644 index 00000000000..d422c9b31fd --- /dev/null +++ b/tests/fsharp/Compiler/ConstraintSolver/MemberConstraints.fs @@ -0,0 +1,45 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework +open FSharp.Compiler.SourceCodeServices + +[] +module MemberConstraints = + + [] + let ``we can overload operators on a type and not add all the extra jazz such as inlining and the ^ operator.``() = + CompilerAssert.CompileExeAndRun + """ +type Foo(x : int) = + member this.Val = x + + static member (-->) ((src : Foo), (target : Foo)) = new Foo(src.Val + target.Val) + static member (-->) ((src : Foo), (target : int)) = new Foo(src.Val + target) + + static member (+) ((src : Foo), (target : Foo)) = new Foo(src.Val + target.Val) + static member (+) ((src : Foo), (target : int)) = new Foo(src.Val + target) + +let x = Foo(3) --> 4 +let y = Foo(3) --> Foo(4) +let x2 = Foo(3) + 4 +let y2 = Foo(3) + Foo(4) + +if x.Val <> 7 then exit 1 +if y.Val <> 7 then exit 1 +if x2.Val <> 7 then exit 1 +if y2.Val <> 7 then exit 1 + """ + + [] + let ``Invalid member constraint with ErrorRanges``() = // Regression test for FSharp1.0:2262 + CompilerAssert.TypeCheckSingleErrorWithOptions + [| "--test:ErrorRanges" |] + """ +let inline length (x: ^a) : int = (^a : (member Length : int with get, set) (x, ())) + """ + FSharpErrorSeverity.Error + 697 + (2, 42, 2, 75) + "Invalid constraint" diff --git a/tests/fsharp/Compiler/ConstraintSolver/PrimitiveConstraints.fs b/tests/fsharp/Compiler/ConstraintSolver/PrimitiveConstraints.fs new file mode 100644 index 00000000000..fbfedfb550d --- /dev/null +++ b/tests/fsharp/Compiler/ConstraintSolver/PrimitiveConstraints.fs @@ -0,0 +1,109 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open NUnit.Framework +open FSharp.Compiler.SourceCodeServices + +[] +module PrimitiveConstraints = + + [] + let ``Test primitive : constraints``() = + CompilerAssert.CompileExeAndRun + """ +#light + +type Foo(x : int) = + member this.Value = x + override this.ToString() = "Foo" + +type Bar(x : int) = + inherit Foo(-1) + member this.Value2 = x + override this.ToString() = "Bar" + +let test1 (x : Foo) = x.Value +let test2 (x : Bar) = (x.Value, x.Value2) + +let f = new Foo(128) +let b = new Bar(256) + +if test1 f <> 128 then exit 1 +if test2 b <> (-1, 256) then exit 1 +""" + + [] + let ``Test primitive :> constraints``() = + CompilerAssert.CompileExeAndRun + """ +#light +type Foo(x : int) = + member this.Value = x + override this.ToString() = "Foo" + +type Bar(x : int) = + inherit Foo(-1) + member this.Value2 = x + override this.ToString() = "Bar" + +type Ram(x : int) = + inherit Foo(10) + member this.ValueA = x + override this.ToString() = "Ram" + +let test (x : Foo) = (x.Value, x.ToString()) + +let f = new Foo(128) +let b = new Bar(256) +let r = new Ram(314) + +if test f <> (128, "Foo") then exit 1 +if test b <> (-1, "Bar") then exit 1 +if test r <> (10, "Ram") then exit 1 +""" + + [] + let ``Test primitive : null constraint``() = + CompilerAssert.CompileExeAndRun + """ +let inline isNull<'a when 'a : null> (x : 'a) = + match x with + | null -> "is null" + | _ -> (x :> obj).ToString() + +let runTest = + // Wrapping in try block to work around FSB 1989 + try + if isNull null <> "is null" then exit 1 + if isNull "F#" <> "F#" then exit 1 + true + with _ -> exit 1 + +if runTest <> true then exit 1 + +exit 0 +""" + + [] + /// Title: Type checking oddity + /// + /// This suggestion was resolved as by design, + /// so the test makes sure, we're emitting error message about 'not being a valid object construction expression' + let ``Invalid object constructor``() = // Regression test for FSharp1.0:4189 + CompilerAssert.TypeCheckWithErrorsAndOptions + [| "--test:ErrorRanges" |] + """ +type ImmutableStack<'a> private(items: 'a list) = + + member this.Push item = ImmutableStack(item::items) + member this.Pop = match items with | [] -> failwith "No elements in stack" | x::xs -> x,ImmutableStack(xs) + + // Notice type annotation is commented out, which results in an error + new(col (*: seq<'a>*)) = ImmutableStack(List.ofSeq col) + + """ + [| FSharpErrorSeverity.Error, 41, (4, 29, 4, 56), "A unique overload for method 'ImmutableStack`1' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: new : col:'b -> ImmutableStack<'a>, private new : items:'a list -> ImmutableStack<'a>" + FSharpErrorSeverity.Error, 41, (5, 93, 5, 111), "A unique overload for method 'ImmutableStack`1' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: new : col:'b -> ImmutableStack<'a>, private new : items:'a list -> ImmutableStack<'a>" + FSharpErrorSeverity.Error, 41, (8, 30, 8, 60), "A unique overload for method 'ImmutableStack`1' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: new : col:'b -> ImmutableStack<'a> when 'b :> seq<'c>, private new : items:'a list -> ImmutableStack<'a>" + FSharpErrorSeverity.Error, 696, (8, 30, 8, 60), "This is not a valid object construction expression. Explicit object constructors must either call an alternate constructor or initialize all fields of the object and specify a call to a super class constructor." |] \ No newline at end of file diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 6335b5172cd..037e5dc5b5f 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -1,4 +1,4 @@ - + @@ -33,6 +33,8 @@ + + diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_MemberConstraints01.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_MemberConstraints01.fs deleted file mode 100644 index 643ec7f7db7..00000000000 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_MemberConstraints01.fs +++ /dev/null @@ -1,6 +0,0 @@ -// #Regression #Conformance #TypeInference #TypeConstraints -// Regression test for FSharp1.0:2262 -// We should emit an error, not ICE -//Invalid constraint - -let inline length (x: ^a) : int = (^a : (member Length : int with get, set) (x, ())) diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_PrimConstraint04.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_PrimConstraint04.fs deleted file mode 100644 index 08dcbfde122..00000000000 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/E_PrimConstraint04.fs +++ /dev/null @@ -1,16 +0,0 @@ -// #Regression #Conformance #TypeInference #TypeConstraints -// Regression test for FSharp1.0:4189 -// Title: Type checking oddity - -// This suggestion was resolved as by design, -// so the test makes sure, we're emitting error message about 'not being avalid object construction expression' - -//This is not a valid object construction expression\. Explicit object constructors must either call an alternate constructor or initialize all fields of the object and specify a call to a super class constructor\.$ - -type ImmutableStack<'a> private(items: 'a list) = - - member this.Push item = ImmutableStack(item::items) - member this.Pop = match items with | [] -> failwith "No elements in stack" | x::xs -> x,ImmutableStack(xs) - - // Notice type annotation is commented out, which results in an error - new(col (*: seq<'a>*)) = ImmutableStack(List.ofSeq col) diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/MemberConstraints01.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/MemberConstraints01.fs deleted file mode 100644 index af263142458..00000000000 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/MemberConstraints01.fs +++ /dev/null @@ -1,24 +0,0 @@ -// #Conformance #TypeInference #TypeConstraints -// Verify you can overload operators on a type and not add all the extra jazz -// such as inlining and the ^ operator. - -type Foo(x : int) = - member this.Val = x - - static member (-->) ((src : Foo), (target : Foo)) = new Foo(src.Val + target.Val) - static member (-->) ((src : Foo), (target : int)) = new Foo(src.Val + target) - - static member (+) ((src : Foo), (target : Foo)) = new Foo(src.Val + target.Val) - static member (+) ((src : Foo), (target : int)) = new Foo(src.Val + target) - -let x = Foo(3) --> 4 -let y = Foo(3) --> Foo(4) -let x2 = Foo(3) + 4 -let y2 = Foo(3) + Foo(4) - -if x.Val <> 7 then exit 1 -if y.Val <> 7 then exit 1 -if x2.Val <> 7 then exit 1 -if y2.Val <> 7 then exit 1 - -exit 0 diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint01.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint01.fs deleted file mode 100644 index e9b11b1c99f..00000000000 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint01.fs +++ /dev/null @@ -1,26 +0,0 @@ -// #Conformance #TypeInference #TypeConstraints -#light - -// Test primitive constraints - -// Test ':' constraints - -type Foo(x : int) = - member this.Value = x - override this.ToString() = "Foo" - -type Bar(x : int) = - inherit Foo(-1) - member this.Value2 = x - override this.ToString() = "Bar" - -let test1 (x : Foo) = x.Value -let test2 (x : Bar) = (x.Value, x.Value2) - -let f = new Foo(128) -let b = new Bar(256) - -if test1 f <> 128 then exit 1 -if test2 b <> (-1, 256) then exit 1 - -exit 0 diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint02.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint02.fs deleted file mode 100644 index b410f4e528f..00000000000 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint02.fs +++ /dev/null @@ -1,33 +0,0 @@ -// #Conformance #TypeInference #TypeConstraints - -#light - -// Test primitive constraints - -// Test ':>' constraints - -type Foo(x : int) = - member this.Value = x - override this.ToString() = "Foo" - -type Bar(x : int) = - inherit Foo(-1) - member this.Value2 = x - override this.ToString() = "Bar" - -type Ram(x : int) = - inherit Foo(10) - member this.ValueA = x - override this.ToString() = "Ram" - -let test (x : Foo) = (x.Value, x.ToString()) - -let f = new Foo(128) -let b = new Bar(256) -let r = new Ram(314) - -if test f <> (128, "Foo") then exit 1 -if test b <> (-1, "Bar") then exit 1 -if test r <> (10, "Ram") then exit 1 - -exit 0 diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint03.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint03.fs deleted file mode 100644 index 7f9a072fd65..00000000000 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/PrimConstraint03.fs +++ /dev/null @@ -1,23 +0,0 @@ -// #Conformance #TypeInference #TypeConstraints -#light - -// Test primitive constraints - -// Test ': null' constraints - -let inline isNull<'a when 'a : null> (x : 'a) = - match x with - | null -> "is null" - | _ -> (x :> obj).ToString() - -let runTest = - // Wrapping in try block to work around FSB 1989 - try - if isNull null <> "is null" then exit 1 - if isNull "F#" <> "F#" then exit 1 - true - with _ -> exit 1 - -if runTest <> true then exit 1 - -exit 0 diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/env.lst b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/env.lst index 4b89bcc2ba8..041ba830d0b 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/env.lst +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/ConstraintSolving/env.lst @@ -1,10 +1,5 @@ SOURCE=E_NoImplicitDowncast01.fs SCFLAGS="--test:ErrorRanges --flaterrors" # E_NoImplicitDowncast01.fs - SOURCE=PrimConstraint01.fs # PrimConstraint01.fs - SOURCE=PrimConstraint02.fs # PrimConstraint02.fs - SOURCE=PrimConstraint03.fs # PrimConstraint03.fs - SOURCE=E_PrimConstraint04.fs SCFLAGS="--test:ErrorRanges" # E_PrimConstraint04.fs - SOURCE=E_TypeFuncDeclaredExplicit01.fs # E_TypeFuncDeclaredExplicit01.fs SOURCE=ValueRestriction01.fs # ValueRestriction01.fs @@ -16,7 +11,4 @@ SOURCE=DelegateConstraint01.fs # DelegateConstraint01.fs SOURCE=E_DelegateConstraint01.fs # E_DelegateConstraint01.fs - SOURCE=MemberConstraints01.fs # MemberConstraints01.fs - SOURCE=E_MemberConstraints01.fs SCFLAGS="--test:ErrorRanges" # E_MemberConstraints01.fs - SOURCE=ConstructorConstraint01.fs # ConstructorConstraint01.fs \ No newline at end of file