Emit FS0755 for CompiledName on multi-value let-bindings

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -1,5 +1,6 @@
 ### Fixed
 
+* Fix `[<CompiledName>]` silently producing duplicate IL entries (FS0192/FS2014) when applied to a multi-value let-binding (e.g. `let a, b = 1, 2`); now emits FS0755 at type-check time. ([Issue #6131](https://github.com/dotnet/fsharp/issues/6131))
 * Suppress hover/symbol resolution for wildcard `_` patterns inside `member _.…` bodies that incorrectly showed `val _: T` tooltip. ([PR #19760](https://github.com/dotnet/fsharp/pull/19760))
 * Deduplicate format specifier locations in computation expressions so editor tooling no longer reports duplicate entries for the same `%` specifier. ([Issue #16419](https://github.com/dotnet/fsharp/issues/16419), [PR #19791](https://github.com/dotnet/fsharp/pull/19791))
 * Reject non-function bindings for single-case and partial active pattern names with FS1209, matching the existing multi-case behavior. ([PR #19763](https://github.com/dotnet/fsharp/pull/19763))

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -1525,6 +1525,23 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec
     vspec
 
 let MakeAndPublishVals (cenv: cenv) env (altActualParent, inSig, declKind, valRecInfo, valSchemes, attrs, xmlDoc, literalValue) =
+    let g = cenv.g
+
+    // [<CompiledName>] on a binding that publishes more than one val (e.g. tuple,
+    // record, list, cons, `let x as y = ...` destructures, multi-case active patterns)
+    // would silently propagate the same compiled name to every introduced value and
+    // produce duplicate IL entries (FS0192/FS2014) during codegen. Catch it here where
+    // the post-generalization val count is authoritative. See dotnet/fsharp#6131.
+    if Map.count valSchemes > 1 then
+        match attrs with
+        | ValAttribString g WellKnownValAttributes.CompiledNameAttribute _ ->
+            let m =
+                (Map.toList valSchemes, range0)
+                ||> List.foldBack (fun (_, ValScheme(id = id)) acc ->
+                    if Range.equals acc range0 then id.idRange else unionRanges id.idRange acc)
+            errorR(Error(FSComp.SR.tcCompiledNameAttributeMisused(), m))
+        | _ -> ()
+
     Map.foldBack
         (fun name (valscheme: ValScheme) values ->
           Map.add name (MakeAndPublishVal cenv env (altActualParent, inSig, declKind, valRecInfo, valscheme, attrs, xmlDoc, literalValue, false), valscheme.GeneralizedType) values)

tests/FSharp.Compiler.ComponentTests/Attributes/CompiledNameMultipleValues.fs

@@ -0,0 +1,73 @@
+namespace FSharp.Compiler.ComponentTests.Attributes
+
+open Xunit
+open FSharp.Test.Compiler
+
+module CompiledNameMultipleValues =
+
+    [<Theory>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet a, b = 1, 2")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet (a, b) = 1, 2")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet ((a, b), c) = (1, 2), 3")>]
+    [<InlineData("module M\ntype R = { F: int; G: int }\n[<CompiledName(\"X\")>]\nlet { F = a; G = b } = { F = 1; G = 2 }")>]
+    [<InlineData("module M\ntype T = Pair of int * int\n[<CompiledName(\"X\")>]\nlet (Pair(a, b)) = Pair(1, 2)")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet (Some (a, b)) = Some (1, 2)")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet [| a; b |] = [| 1; 2 |]")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet a :: b = [1; 2]")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet (x as y) = 1")>]
+    let ``CompiledName on multi-value let-binding produces FS0755`` (source: string) =
+        FSharp source
+        |> typecheck
+        |> shouldFail
+        |> withErrorCode 755
+        |> ignore
+
+    [<Fact>]
+    let ``CompiledName on tuple binding fires FS0755 exactly once`` () =
+        let source = "module M\n[<CompiledName(\"X\")>]\nlet a, b, c = 1, 2, 3"
+        let result =
+            FSharp source
+            |> typecheck
+            |> shouldFail
+
+        let diag755Count =
+            result.Output.Diagnostics
+            |> List.filter (fun d -> d.Error = Error 755)
+            |> List.length
+        Assert.Equal(1, diag755Count)
+
+    [<Fact>]
+    let ``CompiledName on single-value let-binding still compiles`` () =
+        FSharp "module M\n[<CompiledName(\"X\")>]\nlet a = 1"
+        |> compile
+        |> shouldSucceed
+        |> withWarnings []
+        |> ignore
+
+    [<Theory>]
+    [<InlineData("module M\nlet a, b = 1, 2")>]
+    [<InlineData("module M\nlet (a, b) = 1, 2")>]
+    [<InlineData("module M\ntype R = { F: int; G: int }\nlet { F = a; G = b } = { F = 1; G = 2 }")>]
+    let ``Multi-value let-binding without CompiledName still compiles`` (source: string) =
+        FSharp source
+        |> compile
+        |> shouldSucceed
+        |> withWarnings []
+        |> ignore
+
+    [<Theory>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet (Some x) = Some 1")>]
+    [<InlineData("module M\ntype Box = Box of int\n[<CompiledName(\"X\")>]\nlet (Box x) = Box 1")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet a, _ = 1, 2")>]
+    [<InlineData("module M\ntype R = { F: int; G: int }\n[<CompiledName(\"X\")>]\nlet { F = a } = { F = 1; G = 2 }")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet [| a |] = [| 1 |]")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet a :: _ = [1; 2]")>]
+    [<InlineData("module M\n[<CompiledName(\"X\")>]\nlet (|Even|Odd|) n = if n % 2 = 0 then Even else Odd")>]
+    let ``CompiledName on single-value destructure does not fire FS0755`` (source: string) =
+        let result = FSharp source |> typecheck
+        let diags =
+            match result with
+            | CompilationResult.Success r -> r.Diagnostics
+            | CompilationResult.Failure r -> r.Diagnostics
+        let fs755 = diags |> List.filter (fun d -> d.Error = Error 755)
+        Assert.Empty(fs755)

tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj

@@ -500,6 +500,7 @@
     <Compile Include="FSharpChecker\FindReferences.fs" />
     <Compile Include="FSharpChecker\SemanticClassificationRegressions.fs" />
     <Compile Include="Attributes\AttributeCtorSetPropAccess.fs" />
+    <Compile Include="Attributes\CompiledNameMultipleValues.fs" />
   </ItemGroup>
 
   <ItemGroup>