diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 2767cca37de..88998544d52 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -555,8 +555,8 @@ and TcPatLongIdentNewDef warnOnUpperForId warnOnUpper (cenv: cenv) env ad valRep | [arg] when g.langVersion.SupportsFeature LanguageFeature.NameOf && IsNameOf cenv env ad m id -> match TcNameOfExpr cenv env tpenv (ConvSynPatToSynExpr arg) with - | Expr.Const(c, m, _) -> (fun _ -> TPat_const (c, m)), patEnv - | _ -> failwith "Impossible: TcNameOfExpr must return an Expr.Const" + | Expr.Const(Const.String s, m, _) -> TcConstPat warnOnUpper cenv env vFlags patEnv ty (SynConst.String(s, SynStringKind.Regular, m)) m + | _ -> failwith "Impossible: TcNameOfExpr must return an Expr.Const of type string" | _ -> let _, acc = TcArgPats warnOnUpper cenv env vFlags patEnv args diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NameofTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NameofTests.fs index 3c338e02203..27e7ca95bec 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NameofTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NameofTests.fs @@ -60,3 +60,72 @@ if actual <> expected then failwith $"Expected nameof({{expected}}) to be '{{exp |> withLangVersion50 |> compileAndRun |> shouldSucceed + + [] + let ``nameof() in a pattern should return the correct type`` () = + let source = $""" +open Microsoft.FSharp.Reflection +let f x = match x with nameof x -> true | _ -> false + +let expected = "System.String -> System.Boolean" +let elms s = if FSharpType.IsFunction s then + let domain, range = FSharpType.GetFunctionElements s + $"{{domain}} -> {{range}}" + else + "" +let fType = f.GetType() +let actual = elms fType +if actual <> expected then failwith $"Expected type to be '{{expected}}', but got '{{actual}}'" + """ + Fsx source + |> asExe + |> withLangVersion50 + |> ignoreWarnings + |> compileAndRun + |> shouldSucceed + + + [] + let ``nameof works for pattern matching of DU case names`` () = + let source = """ +/// Simplified version of EventStore's API +type RecordedEvent = { EventType: string; Data: string } + +/// My concrete type: +type MyEvent = + | A of string + | B of string + +let deserialize (e: RecordedEvent) : MyEvent = + printfn "EventType is '%s'" e.EventType + printfn "Nameof A is '%s'" (nameof A) + printfn "Nameof B is '%s'" (nameof B) + match e.EventType with + | nameof A -> A e.Data + | nameof B -> B e.Data + | t -> failwithf "Invalid EventType: '%s'" t + +let getData event = + match event with + | A amsg -> amsg + | B bmsg -> bmsg + +let re1 = { EventType = nameof A; Data = "hello" } +let re2 = { EventType = nameof B; Data = "world" } + +let a = deserialize re1 +let b = deserialize re2 + +if not((getData a) = re1.Data) then + failwith $"Record1 mismatch;; {getData a} <> {re1.Data}" + +if not((getData b) = re2.Data) then + failwith $"Record1 mismatch;; {getData b} <> {re2.Data}" + """ + Fsx source + |> asExe + |> withLangVersionPreview + |> ignoreWarnings + |> compileAndRun + |> shouldSucceed +