diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 6bc0b3e73b..2110af9fd0 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -92,7 +92,12 @@ let ActivePatternElemsOfValRef g (vref: ValRef) = false else let _, apReturnTy = stripFunTy g vref.TauType - isStructTy g apReturnTy + let hasStructAttribute() = + vref.Attribs + |> List.exists (function + | Attrib(targetsOpt = Some(System.AttributeTargets.ReturnValue)) as a -> IsMatchingFSharpAttribute g g.attrib_StructAttribute a + | _ -> false) + isStructTy g apReturnTy || hasStructAttribute() apinfo.ActiveTags |> List.mapi (fun i _ -> APElemRef(apinfo, vref, i, isStructRetTy)) | None -> [] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/StructTypes/StructActivePatterns.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/StructTypes/StructActivePatterns.fs new file mode 100644 index 0000000000..1c0e4e63ae --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/StructTypes/StructActivePatterns.fs @@ -0,0 +1,71 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module FSharp.Compiler.ComponentTests.Conformance.StructActivePatterns + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + + +[] +let ``Struct active pattern is possible`` () = + Fs """ +[] +let rec (|IsOne|_|) someNumber = + match someNumber with + | 1 -> ValueSome 1 + | _ -> ValueNone +""" + |> withOptions ["--warnaserror+"] + |> typecheck + |> shouldSucceed + +[] +let ``Struct active pattern must not lie about its return value when using Struct attribute`` () = + Fs """ +[] +let rec (|IsOne|_|) someNumber = + match someNumber with + | 1 -> Some 1 + | _ -> None +""" + |> withOptions ["--warnaserror+"] + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 1,Line 2, Col 1 , Line 3, Col 31, """This expression was expected to have type + ''a voption' +but here has type + 'int option' """) + +[] +let ``Voption active pattern fails if not using return:Struct attribute`` () = + Fs """ +let rec (|IsOne|_|) someNumber = + match someNumber with + | 1 -> ValueSome 1 + | _ -> ValueNone +""" + |> withOptions ["--warnaserror+"] + |> typecheck + |> shouldFail + |> withSingleDiagnostic (Error 1,Line 2, Col 9 , Line 2, Col 31, """This expression was expected to have type + ''a option' +but here has type + 'int voption' """) + +[] +let ``Rec struct active pattern is possible`` () = + Fs """ +[] +let rec (|HasOne|_|) xs = + match xs with + | [] -> ValueNone + | h::_ when h = 1 -> ValueSome true + | _::tail -> + match tail with + | HasOne x -> ValueSome x + | _ -> ValueNone +""" + |> withOptions ["--warnaserror+"] + |> typecheck + |> shouldSucceed \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 9f8f23b83c..756dbbce13 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -90,6 +90,7 @@ +