From 243d87151a2c14e4562c9638bae056981813f991 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 18 Nov 2022 14:35:08 +0100 Subject: [PATCH 1/3] Respecting manual Message property in an Exception type definition --- src/Compiler/AbstractIL/il.fs | 3 +++ src/Compiler/AbstractIL/il.fsi | 1 + src/Compiler/CodeGen/IlxGen.fs | 6 ++++- .../AddMessageProperty.fs | 12 +++++++++ .../ExceptionDefinitions.fs | 27 +++++++++++++++++++ ...nualMessagePropertyWinsOverAutomaticOne.fs | 12 +++++++++ ...agePropertyIsNotReplacingBuiltinMessage.fs | 16 +++++++++++ 7 files changed, 76 insertions(+), 1 deletion(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/AddMessageProperty.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ManualMessagePropertyWinsOverAutomaticOne.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index e0a5bb576aa..e2cca7d1809 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/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 = diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 3ea66ef5bf2..cf4400582cb 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/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 diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index a5dad6c8907..b000c3ad319 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11429,7 +11429,10 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = let ilFieldName = ComputeFieldName exnc fld let ilMethodDef = - mkLdfldMethodDef (ilMethName, reprAccess, false, ilThisTy, ilFieldName, ilPropType, []) + 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 +11519,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 ] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/AddMessageProperty.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/AddMessageProperty.fs new file mode 100644 index 00000000000..37c80e67893 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/AddMessageProperty.fs @@ -0,0 +1,12 @@ +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" + diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs index 6a86d47321b..e41a1fcd398 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs @@ -55,6 +55,33 @@ module ExceptionDefinition = |> compileExeAndRun |> shouldSucceed + // SOURCE=AddMessageProperty.fs # AddMessageProperty + [] + let``AddMessageProperty`` compilation = + compilation + |> asExe + |> withOptions ["--warnaserror+"; "--nowarn:988"] + |> compileExeAndRun + |> shouldSucceed + + // SOURCE=ManualMessagePropertyWinsOverAutomaticOne.fs # ManualMessagePropertyWinsOverAutomaticOne + [] + let``ManualMessagePropertyWinsOverAutomaticOne`` compilation = + compilation + |> asExe + |> withOptions ["--warnaserror+"; "--nowarn:988"] + |> compileExeAndRun + |> shouldSucceed + + // SOURCE=PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs # PrivateMessagePropertyIsNotReplacingBuiltinMessage + [] + let``PrivateMessagePropertyIsNotReplacingBuiltinMessage`` compilation = + compilation + |> asExe + |> withOptions ["--warnaserror+"; "--nowarn:988"] + |> compileExeAndRun + |> shouldSucceed + // SOURCE=CatchWOTypecheck01.fs # CatchWOTypeCheck01 [] let``CatchWOTypecheck01_fs`` compilation = diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ManualMessagePropertyWinsOverAutomaticOne.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ManualMessagePropertyWinsOverAutomaticOne.fs new file mode 100644 index 00000000000..8067c494d78 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ManualMessagePropertyWinsOverAutomaticOne.fs @@ -0,0 +1,12 @@ +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" + diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs new file mode 100644 index 00000000000..73c8b01c3ff --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/PrivateMessagePropertyIsNotReplacingBuiltinMessage.fs @@ -0,0 +1,16 @@ +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." + From 258de2400179ace64f475c446e2b2043de7bab1d Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 18 Nov 2022 15:27:59 +0100 Subject: [PATCH 2/3] Fantomas applied --- src/Compiler/CodeGen/IlxGen.fs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index b000c3ad319..01edf861376 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11429,10 +11429,13 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = let ilFieldName = ComputeFieldName exnc fld let ilMethodDef = - let def = mkLdfldMethodDef (ilMethName, reprAccess, false, ilThisTy, ilFieldName, ilPropType, []) + let def = + mkLdfldMethodDef (ilMethName, reprAccess, false, ilThisTy, ilFieldName, ilPropType, []) + if ilPropName = "Message" then def.WithVirtual(true) - else def + else + def let ilFieldDef = mkILInstanceField (ilFieldName, ilPropType, None, ILMemberAccess.Assembly) From 662941ed38b5bd7a8a48060971fcbbd6f5763061 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 18 Nov 2022 16:58:26 +0100 Subject: [PATCH 3/3] Fixing failing test --- .../ExceptionDefinitions/ExceptionDefinitions.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs index e41a1fcd398..fa91ce4572e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/ExceptionDefinitions/ExceptionDefinitions.fs @@ -78,7 +78,8 @@ module ExceptionDefinition = let``PrivateMessagePropertyIsNotReplacingBuiltinMessage`` compilation = compilation |> asExe - |> withOptions ["--warnaserror+"; "--nowarn:988"] + |> withOptions ["--nowarn:988"] + |> ignoreWarnings |> compileExeAndRun |> shouldSucceed