Infer string type when using nameof pattern (#14065)

Co-authored-by: NTomas Grosup <tomasgrosup@microsoft.com>

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

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
+
+    [<Fact>]
+    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
+
+
+    [<Fact>]
+    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
+