Respecting manual Message property in an Exception type definition (#14352)

* Respecting manual Message property in an Exception type definition

* Fantomas applied

* Fixing failing test

src/Compiler/AbstractIL/il.fs

@@ -2073,6 +2073,9 @@ type ILMethodDef
     member x.WithAbstract(condition) =
         x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.Abstract))
 
+    member x.WithVirtual(condition) =
+        x.With(attributes = (x.Attributes |> conditionalAdd condition MethodAttributes.Virtual))
+
     member x.WithAccess(access) =
         x.With(
             attributes =

src/Compiler/AbstractIL/il.fsi

@@ -1134,6 +1134,7 @@ type ILMethodDef =
     member internal WithHideBySig: bool -> ILMethodDef
     member internal WithFinal: bool -> ILMethodDef
     member internal WithAbstract: bool -> ILMethodDef
+    member internal WithVirtual: bool -> ILMethodDef
     member internal WithAccess: ILMemberAccess -> ILMethodDef
     member internal WithNewSlot: ILMethodDef
     member internal WithSecurity: bool -> ILMethodDef

src/Compiler/CodeGen/IlxGen.fs

@@ -11429,8 +11429,14 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) =
                     let ilFieldName = ComputeFieldName exnc fld
 
                     let ilMethodDef =
+                        let def =
                             mkLdfldMethodDef (ilMethName, reprAccess, false, ilThisTy, ilFieldName, ilPropType, [])
 
+                        if ilPropName = "Message" then
+                            def.WithVirtual(true)
+                        else
+                            def
+
                     let ilFieldDef =
                         mkILInstanceField (ilFieldName, ilPropType, None, ILMemberAccess.Assembly)
 
@@ -11516,6 +11522,7 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) =
                     cenv.g.langVersion.SupportsFeature(LanguageFeature.BetterExceptionPrinting)
                     && not (exnc.HasMember g "get_Message" [])
                     && not (exnc.HasMember g "Message" [])
+                    && not (fspecs |> List.exists (fun rf -> rf.DisplayNameCore = "Message"))
                 then
                     yield! GenPrintingMethod cenv eenv "get_Message" ilThisTy m
             ]

tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/AddMessageProperty.fs

+exception MyCustomExc of field:int
+let f() =
+    try
+        raise (MyCustomExc(42))
+    with
+        | MyCustomExc _ as e  -> e.Message
+    
+
+let result = f()
+printfn "%s" result
+if result <> "MyCustomExc 42" then failwith "Failed: 1"
+

tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs

@@ -55,6 +55,34 @@ module ExceptionDefinition =
         |> compileExeAndRun
         |> shouldSucceed
 
+        // SOURCE=AddMessageProperty.fs                                                               # AddMessageProperty
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"AddMessageProperty.fs"|])>]
+    let``AddMessageProperty`` compilation =
+        compilation
+        |> asExe
+        |> withOptions ["--warnaserror+"; "--nowarn:988"]
+        |> compileExeAndRun
+        |> shouldSucceed
+
+     // SOURCE=ManualMessagePropertyWinsOverAutomaticOne.fs                                                               # ManualMessagePropertyWinsOverAutomaticOne
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"ManualMessagePropertyWinsOverAutomaticOne.fs"|])>]
+    let``ManualMessagePropertyWinsOverAutomaticOne`` compilation =
+        compilation
+        |> asExe
+        |> withOptions ["--warnaserror+"; "--nowarn:988"]
+        |> compileExeAndRun
+        |> shouldSucceed
+
+     // SOURCE=PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs                                                               # PrivateMessagePropertyIsNotReplacingBuiltinMessage
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs"|])>]
+    let``PrivateMessagePropertyIsNotReplacingBuiltinMessage`` compilation =
+        compilation
+        |> asExe
+        |> withOptions ["--nowarn:988"]
+        |> ignoreWarnings
+        |> compileExeAndRun
+        |> shouldSucceed
+
     // SOURCE=CatchWOTypecheck01.fs                                                            # CatchWOTypeCheck01
     [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"CatchWOTypecheck01.fs"|])>]
     let``CatchWOTypecheck01_fs`` compilation =

tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ManualMessagePropertyWinsOverAutomaticOne.fs

+exception MyCustomExc of Message:string
+let f() =
+    try
+        raise (MyCustomExc("This should be the message!"))
+    with
+        | MyCustomExc m as e  -> e.Message
+    
+
+let result = f()
+printfn "%s" result
+if result <> "This should be the message!" then failwith $"Failed: 1. Message is '{result}' instead"
+

tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs

+exception MyCustomExc of int
+    with 
+        member private this.Message = "This must remain secret!"
+    end
+
+let f() =
+    try
+        raise (MyCustomExc(42))
+    with
+        |  e  -> e.Message
+    
+
+let result = f()
+printfn "%s" result
+if result = "This must remain secret!" then failwith $"Failed: 1. Secret private string was leaked."
+