From 7f6689b461425179e70c635ac801b48585792775 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Wed, 8 Oct 2025 07:28:47 +0100 Subject: [PATCH 1/8] WIP --- .../Checking/Expressions/CheckExpressions.fs | 36 +++++++++++ .../NameIsBoundMultipleTimesTests.fs | 64 +++++++++++++++++++ .../FSharp.Compiler.ComponentTests.fsproj | 1 + 3 files changed, 101 insertions(+) create mode 100644 tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 6979f20f0e0..9abf2b2eaa1 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -11296,6 +11296,42 @@ and TcNonRecursiveBinding declKind cenv env tpenv ty binding = | _ -> () | _ -> () + // Report duplicate bound names across curried argument patterns in non-recursive bindings + let reportDuplicateAcrossArgs (declPattern: SynPat) = + let rec collect acc (p: SynPat) = + match p with + | SynPat.FromParseError(p, _) + | SynPat.Paren(p, _) -> collect acc p + | SynPat.Tuple(_, ps, _, _) + | SynPat.ArrayOrList(_, ps, _) -> List.fold collect acc ps + | SynPat.As(lhs, rhs, _) -> + let acc = collect acc lhs + collect acc rhs + | SynPat.Named(SynIdent(id, _), _, _, _) -> id :: acc + | SynPat.LongIdent(argPats = SynArgPats.Pats ps) -> List.fold collect acc ps + | SynPat.Or(p1, p2, _, _) -> collect (collect acc p1) p2 + | SynPat.Ands(pats, _) -> List.fold collect acc pats + | SynPat.Record(fieldPats = fields) -> + (acc, fields) + ||> List.fold (fun acc (NamePatPairField(_, _, _, pat, _)) -> collect acc pat) + | SynPat.ListCons(lhsPat = l; rhsPat = r) -> collect (collect acc l) r + | SynPat.OptionalVal(id, _) -> id :: acc + | _ -> acc + match declPattern with + | SynPat.LongIdent(argPats = SynArgPats.Pats argPats) -> + let seen = System.Collections.Generic.HashSet() + for pat in argPats do + let names = collect [] pat + for id in List.rev names do + if not (System.String.IsNullOrEmpty id.idText) then + if not (seen.Add id.idText) then + errorR (VarBoundTwice id) + () + | _ -> () + + match binding with + | SynBinding(headPat = pat) -> reportDuplicateAcrossArgs pat + let binding = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env binding let explicitTyparInfo, tpenv = TcNonrecBindingTyparDecls cenv env tpenv binding TcNormalizedBinding declKind cenv env tpenv ty None NoSafeInitInfo ([], explicitTyparInfo) binding diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs new file mode 100644 index 00000000000..cb0d9f0a387 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs @@ -0,0 +1,64 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace ErrorMessages + +open Xunit +open FSharp.Test.Compiler + +module NameIsBoundMultipleTimes = + [] + let ``Name is bound multiple times is reported``() = + Fsx """ +let f1 a a = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 10, Line 2, Col 11, "'a' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported in 'as' pattern 1``() = + Fsx """ +let f2 (a, b as c) c = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 20, Line 2, Col 21, "'c' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported in 'as' pattern 2``() = + Fsx """ +let f4 (a, b, c as d) a c = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 23, Line 2, Col 24, "'a' is bound twice in this pattern") + (Error 38, Line 2, Col 25, Line 2, Col 26, "'c' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported in 'as' pattern 3``() = + Fsx """ +let f5 (a, b, c as d) a d = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 23, Line 2, Col 24, "'a' is bound twice in this pattern"); + (Error 38, Line 2, Col 25, Line 2, Col 26, "'d' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported 2`` () = + Fsx """ +let (++) e1 e1 = if e1 then e1 else false +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 13, Line 2, Col 15, "'e1' is bound twice in this pattern") + ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 960057baf98..29847415be2 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -230,6 +230,7 @@ + From 0c40a201f226486af6f92895a48f821980ae48a2 Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 10 Oct 2025 16:35:21 +0100 Subject: [PATCH 2/8] Name is bound multiple times is not reported in 'as' pattern --- src/Compiler/Checking/CheckBasics.fs | 2 +- src/Compiler/Checking/CheckBasics.fsi | 4 + src/Compiler/Checking/CheckPatterns.fs | 90 ++++++++++++------- src/Compiler/Checking/CheckPatterns.fsi | 2 + .../Checking/Expressions/CheckExpressions.fs | 40 +-------- .../NameIsBoundMultipleTimesTests.fs | 76 ++++++++++++++++ 6 files changed, 146 insertions(+), 68 deletions(-) diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index 7cbca970cc3..3b37e1d9702 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -325,7 +325,7 @@ type TcFileState = TcPat: WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv // forward call - TcSimplePats: TcFileState -> bool -> CheckConstraints -> TType -> TcEnv -> TcPatLinearEnv -> SynSimplePats -> string list * TcPatLinearEnv + TcSimplePats: TcFileState -> bool -> CheckConstraints -> TType -> TcEnv -> TcPatLinearEnv -> SynSimplePats -> (SynPat list * SynExpr) option -> bool -> string list * TcPatLinearEnv // forward call TcSequenceExpressionEntry: TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 179752c394c..32f0f93720f 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/src/Compiler/Checking/CheckBasics.fsi @@ -295,6 +295,8 @@ type TcFileState = -> TcEnv -> TcPatLinearEnv -> SynSimplePats + -> (SynPat list * SynExpr) option + -> bool -> string list * TcPatLinearEnv // forward call @@ -345,6 +347,8 @@ type TcFileState = -> TcEnv -> TcPatLinearEnv -> SynSimplePats + -> (SynPat list * SynExpr) option + -> bool -> string list * TcPatLinearEnv) * tcSequenceExpressionEntry: (TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv) * diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index b7ad664fc6f..c8beea08bca 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -145,47 +145,77 @@ and ValidateOptArgOrder (synSimplePats: SynSimplePats) = List.iter (fun pat -> if isOptArg pat then hitOptArg <- true elif hitOptArg then error(Error(FSComp.SR.tcOptionalArgsMustComeAfterNonOptionalArgs(), m))) pats -/// Bind the patterns used in argument position for a function, method or lambda. -and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synSimplePats = +/// Bind the patterns used in the argument position for a function, method or lambda. +and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synSimplePats (parsedData: (SynPat list * SynExpr) option) (isFirst: bool) = - let g = cenv.g - let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv - - // validate optional argument declaration + let rec collectBoundIdTextsFromPat (acc: string list) (p: SynPat) : string list = + match p with + | SynPat.FromParseError(p, _) + | SynPat.Paren(p, _) -> collectBoundIdTextsFromPat acc p + | SynPat.Tuple(_, ps, _, _) + | SynPat.ArrayOrList(_, ps, _) -> List.fold collectBoundIdTextsFromPat acc ps + | SynPat.As(lhs, rhs, _) -> collectBoundIdTextsFromPat (collectBoundIdTextsFromPat acc lhs) rhs + | SynPat.Named(SynIdent(id, _), _, _, _) + | SynPat.OptionalVal(id, _) -> id.idText :: acc + | SynPat.LongIdent(argPats = SynArgPats.Pats ps) -> List.fold collectBoundIdTextsFromPat acc ps + | SynPat.Or(p1, p2, _, _) -> collectBoundIdTextsFromPat (collectBoundIdTextsFromPat acc p1) p2 + | SynPat.Ands(pats, _) -> List.fold collectBoundIdTextsFromPat acc pats + | SynPat.Record(fieldPats = fields) -> + (acc, fields) + ||> List.fold (fun acc (NamePatPairField(_, _, _, pat, _)) -> collectBoundIdTextsFromPat acc pat) + | SynPat.ListCons(lhsPat = l; rhsPat = r) -> collectBoundIdTextsFromPat (collectBoundIdTextsFromPat acc l) r + | _ -> acc + + let augmentTakenNamesFromFirstGroup (isFirst: bool) (parsedData: (SynPat list * SynExpr) option) (patEnvOut: TcPatLinearEnv) : TcPatLinearEnv = + match isFirst, parsedData, patEnvOut with + | true, Some(pats, _), TcPatLinearEnv(tpenvR, namesR, takenNamesR) -> + match pats with + | pat :: _ -> + let extra = collectBoundIdTextsFromPat [] pat |> Set.ofList + TcPatLinearEnv(tpenvR, namesR, Set.union takenNamesR extra) + | _ -> patEnvOut + | _ -> patEnvOut + + let bindCurriedGroup (synSimplePats: SynSimplePats) : string list * TcPatLinearEnv = + let g = cenv.g + let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv + match synSimplePats with + | SynSimplePats.SimplePats ([], _, m) -> + // Unit (): synthesize a hidden name and unify with unit + let id = ident("unitVar" + string takenNames.Count, m) + UnifyTypes cenv env m ty g.unit_ty + let vFlags = TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, true) + let _, namesR, takenNamesR = TcPatBindingName cenv env id ty false None None vFlags (names, takenNames) + [ id.idText ], TcPatLinearEnv(tpenv, namesR, takenNamesR) + | SynSimplePats.SimplePats ([sp], _, _) -> + // Single parameter: no tuple splitting, check directly + let v, patEnv' = TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv sp [] + [ v ], patEnv' + | SynSimplePats.SimplePats (ps, _, m) -> + // Multiple parameters: treat a domain type as a ref-tuple and map each simple pat + let ptys = UnifyRefTupleType env.eContextInfo cenv env.DisplayEnv m ty ps + let namesOut, patEnvR = + (patEnv, List.zip ptys ps) + ||> List.mapFold (fun penv (pty, sp) -> TcSimplePat optionalArgsOK checkConstraints cenv pty env penv sp []) + namesOut, patEnvR + + // 1) validate optional-arg ordering ValidateOptArgOrder synSimplePats - match synSimplePats with - | SynSimplePats.SimplePats ([],_, m) -> - // Unit "()" patterns in argument position become SynSimplePats.SimplePats([], _) in the - // syntactic translation when building bindings. This is done because the - // use of "()" has special significance for arity analysis and argument counting. - // - // Here we give a name to the single argument implied by those patterns. - // This is a little awkward since it would be nice if this was - // uniform with the process where we give names to other (more complex) - // patterns used in argument position, e.g. "let f (D(x)) = ..." - let id = ident("unitVar" + string takenNames.Count, m) - UnifyTypes cenv env m ty g.unit_ty - let vFlags = TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, true) - let _, namesR, takenNamesR = TcPatBindingName cenv env id ty false None None vFlags (names, takenNames) - let patEnvR = TcPatLinearEnv(tpenv, namesR, takenNamesR) - [id.idText], patEnvR + // 2) bind the current curried group + let namesOut, patEnvOut = bindCurriedGroup synSimplePats - | SynSimplePats.SimplePats (pats = [synSimplePat]) -> - let v, patEnv = TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv synSimplePat [] - [v], patEnv + // 3) post-augment takenNames for later groups (using the original first-group pattern) + let patEnvOut = augmentTakenNamesFromFirstGroup isFirst parsedData patEnvOut - | SynSimplePats.SimplePats (ps, _, m) -> - let ptys = UnifyRefTupleType env.eContextInfo cenv env.DisplayEnv m ty ps - let ps', patEnvR = (patEnv, List.zip ptys ps) ||> List.mapFold (fun patEnv (ty, pat) -> TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnv pat []) - ps', patEnvR + namesOut, patEnvOut and TcSimplePatsOfUnknownType (cenv: cenv) optionalArgsOK checkConstraints env tpenv (pat: SynPat) = let g = cenv.g let argTy = NewInferenceType g let patEnv = TcPatLinearEnv (tpenv, NameMap.empty, Set.empty) let spats, _ = SimplePatsOfPat cenv.synArgNameGenerator pat - let names, patEnv = TcSimplePats cenv optionalArgsOK checkConstraints argTy env patEnv spats + let names, patEnv = TcSimplePats cenv optionalArgsOK checkConstraints argTy env patEnv spats None false names, patEnv, spats and TcPatBindingName cenv env id ty isMemberThis vis1 valReprInfo (vFlags: TcPatValFlags) (names, takenNames: Set) = diff --git a/src/Compiler/Checking/CheckPatterns.fsi b/src/Compiler/Checking/CheckPatterns.fsi index da797b35a88..2569ad382a1 100644 --- a/src/Compiler/Checking/CheckPatterns.fsi +++ b/src/Compiler/Checking/CheckPatterns.fsi @@ -39,4 +39,6 @@ val TcSimplePats: env: TcEnv -> patEnv: TcPatLinearEnv -> synSimplePats: SynSimplePats -> + parsedData: (SynPat list * SynExpr) option -> + isFirst: bool -> string list * TcPatLinearEnv diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 9abf2b2eaa1..d37bbb2b619 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -6484,10 +6484,10 @@ and TcExprILAssembly (cenv: cenv) overallTy env tpenv (ilInstrs, synTyArgs, synA and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpenv e = let g = cenv.g match e with - | SynExpr.Lambda (isMember, isSubsequent, synSimplePats, bodyExpr, _parsedData, m, _trivia) when isMember || isFirst || isSubsequent -> + | SynExpr.Lambda (isMember, isSubsequent, synSimplePats, bodyExpr, parsedData, m, _trivia) when isMember || isFirst || isSubsequent -> let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy.Commit let vs, (TcPatLinearEnv (tpenv, names, takenNames)) = - cenv.TcSimplePats cenv isMember CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, takenNames)) synSimplePats + cenv.TcSimplePats cenv isMember CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, takenNames)) synSimplePats parsedData isFirst let envinner, _, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names let byrefs = vspecMap |> Map.map (fun _ v -> isByrefTy g v.Type, v) @@ -11296,41 +11296,7 @@ and TcNonRecursiveBinding declKind cenv env tpenv ty binding = | _ -> () | _ -> () - // Report duplicate bound names across curried argument patterns in non-recursive bindings - let reportDuplicateAcrossArgs (declPattern: SynPat) = - let rec collect acc (p: SynPat) = - match p with - | SynPat.FromParseError(p, _) - | SynPat.Paren(p, _) -> collect acc p - | SynPat.Tuple(_, ps, _, _) - | SynPat.ArrayOrList(_, ps, _) -> List.fold collect acc ps - | SynPat.As(lhs, rhs, _) -> - let acc = collect acc lhs - collect acc rhs - | SynPat.Named(SynIdent(id, _), _, _, _) -> id :: acc - | SynPat.LongIdent(argPats = SynArgPats.Pats ps) -> List.fold collect acc ps - | SynPat.Or(p1, p2, _, _) -> collect (collect acc p1) p2 - | SynPat.Ands(pats, _) -> List.fold collect acc pats - | SynPat.Record(fieldPats = fields) -> - (acc, fields) - ||> List.fold (fun acc (NamePatPairField(_, _, _, pat, _)) -> collect acc pat) - | SynPat.ListCons(lhsPat = l; rhsPat = r) -> collect (collect acc l) r - | SynPat.OptionalVal(id, _) -> id :: acc - | _ -> acc - match declPattern with - | SynPat.LongIdent(argPats = SynArgPats.Pats argPats) -> - let seen = System.Collections.Generic.HashSet() - for pat in argPats do - let names = collect [] pat - for id in List.rev names do - if not (System.String.IsNullOrEmpty id.idText) then - if not (seen.Add id.idText) then - errorR (VarBoundTwice id) - () - | _ -> () - match binding with - | SynBinding(headPat = pat) -> reportDuplicateAcrossArgs pat let binding = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env binding let explicitTyparInfo, tpenv = TcNonrecBindingTyparDecls cenv env tpenv binding @@ -11779,7 +11745,7 @@ and ApplyTypesFromArgumentPatterns (cenv: cenv, env, optionalArgsOK, ty, m, tpen let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m ty // We apply the type information from the patterns by type checking the // "simple" patterns against 'domainTyR'. They get re-typechecked later. - ignore (cenv.TcSimplePats cenv optionalArgsOK CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) pushedPat) + ignore (cenv.TcSimplePats cenv optionalArgsOK CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) pushedPat None false) ApplyTypesFromArgumentPatterns (cenv, env, optionalArgsOK, resultTy, m, tpenv, NormalizedBindingRhs (morePushedPats, retInfoOpt, e), memberFlagsOpt) /// Check if the type annotations and inferred type information in a value give a diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs index cb0d9f0a387..e783d9db000 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs @@ -61,4 +61,80 @@ let (++) e1 e1 = if e1 then e1 else false |> shouldFail |> withDiagnostics [ (Error 38, Line 2, Col 13, Line 2, Col 15, "'e1' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times with nested parens and as pattern`` () = + Fsx """ +let f ((a, b as c)) c = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 21, Line 2, Col 22, "'c' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times with nested parens tuple`` () = + Fsx """ +let g ((a, b)) a = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 16, Line 2, Col 17, "'a' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported in 'as' pattern in match case`` () = + Fsx """ +let h x = + match x with + | (a, b as c), c -> 0 +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 4, Col 20, Line 4, Col 21, "'c' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported in 'as' pattern in nested match case`` () = + Fsx """ +let h x = + match x with + | ((a, b as c), d), c -> 0 +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 4, Col 25, Line 4, Col 26, "'c' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported in 'as' pattern in nested match case 2`` () = + Fsx """ +let h x = + match x with + | ((a, b as c), d), c, d -> 0 +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 4, Col 25, Line 4, Col 26, "'c' is bound twice in this pattern") + (Error 38, Line 4, Col 28, Line 4, Col 29, "'d' is bound twice in this pattern") + ] + + [] + let ``Name is bound multiple times is reported in 'as' pattern in nested match case 3`` () = + Fsx """ +let h x = + match x with + | ((a, b as c), d as e), c, e -> 0 +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 4, Col 30, Line 4, Col 31, "'c' is bound twice in this pattern") + (Error 38, Line 4, Col 33, Line 4, Col 34, "'e' is bound twice in this pattern") ] \ No newline at end of file From 6375cd8e255526a85c413db6dc35d11b331f1a0a Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 10 Oct 2025 16:50:42 +0100 Subject: [PATCH 3/8] More tests --- .../NameIsBoundMultipleTimesTests.fs | 26 ++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs index e783d9db000..64b0fad9a3b 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs @@ -137,4 +137,28 @@ let h x = |> withDiagnostics [ (Error 38, Line 4, Col 30, Line 4, Col 31, "'c' is bound twice in this pattern") (Error 38, Line 4, Col 33, Line 4, Col 34, "'e' is bound twice in this pattern") - ] \ No newline at end of file + ] + + [] + let ``unitVar as user identifier in tuple binding does not clash with synthesized unit parameter name`` () = + Fsx """ +let (unitVar, ()) = 1, () +""" + |> typecheck + |> shouldSucceed + + [] + let ``unitVar as user identifier in function parameters does not clash with synthesized unit parameter name`` () = + Fsx """ +let f unitVar () = () +""" + |> typecheck + |> shouldSucceed + + [] + let ``unitVar as user identifier in function tuple parameter does not clash with synthesized unit parameter name`` () = + Fsx """ +let f (unitVar, ()) = () +""" + |> typecheck + |> shouldSucceed From 3a1028b06c838b13336847b9c438baff00fadb49 Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 10 Oct 2025 17:12:19 +0100 Subject: [PATCH 4/8] Another one --- .../NameIsBoundMultipleTimesTests.fs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs index 64b0fad9a3b..028b0954d73 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs @@ -162,3 +162,18 @@ let f (unitVar, ()) = () """ |> typecheck |> shouldSucceed + + [] + let ``Name is bound multiple times is reported for combined snippet f1,f2,f3``() = + Fsx """ +let f1 a a = () +let f2 (a, b as c) c = () +let f3 (a, b as c) a = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 10, Line 2, Col 11, "'a' is bound twice in this pattern"); + (Error 38, Line 3, Col 20, Line 3, Col 21, "'c' is bound twice in this pattern"); + (Error 38, Line 4, Col 20, Line 4, Col 21, "'a' is bound twice in this pattern") + ] From e6ea704da38b1e31d7eff981bdd389c86355e17c Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 10 Oct 2025 19:28:58 +0100 Subject: [PATCH 5/8] one more test and put back the unitVar explanation --- src/Compiler/Checking/CheckPatterns.fs | 9 ++++++- .../NameIsBoundMultipleTimesTests.fs | 24 ++++++++++++++++++- 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index c8beea08bca..8d5017e8d7c 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -181,7 +181,14 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv match synSimplePats with | SynSimplePats.SimplePats ([], _, m) -> - // Unit (): synthesize a hidden name and unify with unit + // Unit "()" patterns in argument position become SynSimplePats.SimplePats([], _) in the + // syntactic translation when building bindings. This is done because the + // use of "()" has special significance for arity analysis and argument counting. + // + // Here we give a name to the single argument implied by those patterns. + // This is a little awkward since it would be nice if this was + // uniform with the process where we give names to other (more complex) + // patterns used in argument position, e.g. "let f (D(x)) = ..." let id = ident("unitVar" + string takenNames.Count, m) UnifyTypes cenv env m ty g.unit_ty let vFlags = TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, true) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs index 028b0954d73..4f95fb87d21 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs @@ -164,7 +164,7 @@ let f (unitVar, ()) = () |> shouldSucceed [] - let ``Name is bound multiple times is reported for combined snippet f1,f2,f3``() = + let ``Name is bound multiple times is reported for combined bindings``() = Fsx """ let f1 a a = () let f2 (a, b as c) c = () @@ -177,3 +177,25 @@ let f3 (a, b as c) a = () (Error 38, Line 3, Col 20, Line 3, Col 21, "'c' is bound twice in this pattern"); (Error 38, Line 4, Col 20, Line 4, Col 21, "'a' is bound twice in this pattern") ] + + [] + let ``Name is bound multiple times is reported for combined bindings unitVar``() = + Fsx """ +let f1 unitVar unitVar = () +let f2 (unitVar, b as c) c = () +let f3 (a, unitVar as c) a = () +let f4 (a, b as c) unitVar = () +let f5 (unitVar, b as c) unitVar = () +let f6 (a, unitVar as c) unitVar = () +let f7 (a, b as unitVar) unitVar = () +""" + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 16, Line 2, Col 23, "'unitVar' is bound twice in this pattern") + (Error 38, Line 3, Col 26, Line 3, Col 27, "'c' is bound twice in this pattern") + (Error 38, Line 4, Col 26, Line 4, Col 27, "'a' is bound twice in this pattern") + (Error 38, Line 6, Col 26, Line 6, Col 33, "'unitVar' is bound twice in this pattern") + (Error 38, Line 7, Col 26, Line 7, Col 33, "'unitVar' is bound twice in this pattern") + (Error 38, Line 8, Col 26, Line 8, Col 33, "'unitVar' is bound twice in this pattern") + ] From 75b5f07d0ff41df3d06e8ed9e3f73782b948aacd Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Fri, 10 Oct 2025 19:32:44 +0100 Subject: [PATCH 6/8] release notes --- docs/release-notes/.FSharp.Compiler.Service/11.0.0.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md index 2cde88c0d94..0469b0575f6 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md @@ -2,6 +2,7 @@ * Scripts: Fix resolving the dotnet host path when an SDK directory is specified. ([PR #18960](https://github.com/dotnet/fsharp/pull/18960)) * Fix excessive StackGuard thread jumping ([PR #18971](https://github.com/dotnet/fsharp/pull/18971)) +* Fix name is bound multiple times is not reported in 'as' pattern ([PR #18984](https://github.com/dotnet/fsharp/pull/18984)) ### Added From 5488c00c882379901d476b8867edfe9841852d02 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Sat, 11 Oct 2025 07:42:46 +0100 Subject: [PATCH 7/8] last one --- .../NameIsBoundMultipleTimesTests.fs | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs index 4f95fb87d21..fe8887737c3 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/NameIsBoundMultipleTimesTests.fs @@ -199,3 +199,48 @@ let f7 (a, b as unitVar) unitVar = () (Error 38, Line 7, Col 26, Line 7, Col 33, "'unitVar' is bound twice in this pattern") (Error 38, Line 8, Col 26, Line 8, Col 33, "'unitVar' is bound twice in this pattern") ] + + [] + let ``Name is bound multiple times in lambdas with 'as' across groups; unitVar vs () not conflated`` () = + Fsx """ +let bad1 = fun (a, () as unitVar) unitVar -> () +let bad2 = fun a ((() as unitVar)) unitVar -> () + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 38, Line 2, Col 35, Line 2, Col 42, "'unitVar' is bound twice in this pattern") + (Error 38, Line 3, Col 36, Line 3, Col 43, "'unitVar' is bound twice in this pattern") + ] + + [] + let ``'as' across groups and unitVar vs () do not clash`` () = + Fsx """ +let f1 unitVar () = () +let f2 () unitVar = () +let f4 (unitVar, ()) a = () +let f5 ((), unitVar) = () +let f6 (unitVar, ()) () = () +let f7 (unitVar, b) () = () +let f8 (a, (unitVar as ())) () = () +let f9 (a, () as unitVar) () = () +let f10 (a, (() as unitVar)) () = () +""" + |> typecheck + |> shouldSucceed + + [] + let ``unitVar vs () do not clash in lambdas and matches`` () = + Fsx """ +let l1 = fun unitVar () -> () +let l2 = fun () unitVar -> () +let l3 = fun (unitVar, ()) -> () +let l4 = fun ((), unitVar) -> () +let l5 = fun (unitVar, b) () -> () +let structLam = fun struct (unitVar, ()) -> () +let okMatch x = + match x with + | (unitVar, ()) -> () + """ + |> typecheck + |> shouldSucceed \ No newline at end of file From 78b2192a62b33d0cec3614c83fe2d49a269767f7 Mon Sep 17 00:00:00 2001 From: edgargonzalez Date: Tue, 14 Oct 2025 12:26:22 +0200 Subject: [PATCH 8/8] Simplify signature and add comments --- src/Compiler/Checking/CheckBasics.fs | 2 +- src/Compiler/Checking/CheckBasics.fsi | 8 ++++---- src/Compiler/Checking/CheckPatterns.fs | 12 ++++++------ src/Compiler/Checking/CheckPatterns.fsi | 3 +-- .../Checking/Expressions/CheckExpressions.fs | 9 +++++++-- 5 files changed, 19 insertions(+), 15 deletions(-) diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index 2b39efe436c..835fd27bcaf 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -319,7 +319,7 @@ type TcFileState = TcPat: WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv // forward call - TcSimplePats: TcFileState -> bool -> CheckConstraints -> TType -> TcEnv -> TcPatLinearEnv -> SynSimplePats -> (SynPat list * SynExpr) option -> bool -> string list * TcPatLinearEnv + TcSimplePats: TcFileState -> bool -> CheckConstraints -> TType -> TcEnv -> TcPatLinearEnv -> SynSimplePats -> SynPat list * bool -> string list * TcPatLinearEnv // forward call TcSequenceExpressionEntry: TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 32f0f93720f..c396283c071 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/src/Compiler/Checking/CheckBasics.fsi @@ -295,8 +295,9 @@ type TcFileState = -> TcEnv -> TcPatLinearEnv -> SynSimplePats - -> (SynPat list * SynExpr) option - -> bool + // SynPat list: Represents parsed patterns, + // bool: Indicates if this is the first pattern in a sequence of patterns + -> SynPat list * bool -> string list * TcPatLinearEnv // forward call @@ -347,8 +348,7 @@ type TcFileState = -> TcEnv -> TcPatLinearEnv -> SynSimplePats - -> (SynPat list * SynExpr) option - -> bool + -> SynPat list * bool -> string list * TcPatLinearEnv) * tcSequenceExpressionEntry: (TcFileState -> TcEnv -> OverallTy -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv) * diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 8d5017e8d7c..eb61edf7eeb 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -146,7 +146,7 @@ and ValidateOptArgOrder (synSimplePats: SynSimplePats) = /// Bind the patterns used in the argument position for a function, method or lambda. -and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synSimplePats (parsedData: (SynPat list * SynExpr) option) (isFirst: bool) = +and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synSimplePats (parsedPatterns: SynPat list * bool) = let rec collectBoundIdTextsFromPat (acc: string list) (p: SynPat) : string list = match p with @@ -166,9 +166,9 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS | SynPat.ListCons(lhsPat = l; rhsPat = r) -> collectBoundIdTextsFromPat (collectBoundIdTextsFromPat acc l) r | _ -> acc - let augmentTakenNamesFromFirstGroup (isFirst: bool) (parsedData: (SynPat list * SynExpr) option) (patEnvOut: TcPatLinearEnv) : TcPatLinearEnv = - match isFirst, parsedData, patEnvOut with - | true, Some(pats, _), TcPatLinearEnv(tpenvR, namesR, takenNamesR) -> + let augmentTakenNamesFromFirstGroup (parsedData: SynPat list * bool) (patEnvOut: TcPatLinearEnv) : TcPatLinearEnv = + match parsedData, patEnvOut with + | (pats ,true), TcPatLinearEnv(tpenvR, namesR, takenNamesR) -> match pats with | pat :: _ -> let extra = collectBoundIdTextsFromPat [] pat |> Set.ofList @@ -213,7 +213,7 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS let namesOut, patEnvOut = bindCurriedGroup synSimplePats // 3) post-augment takenNames for later groups (using the original first-group pattern) - let patEnvOut = augmentTakenNamesFromFirstGroup isFirst parsedData patEnvOut + let patEnvOut = augmentTakenNamesFromFirstGroup parsedPatterns patEnvOut namesOut, patEnvOut @@ -222,7 +222,7 @@ and TcSimplePatsOfUnknownType (cenv: cenv) optionalArgsOK checkConstraints env t let argTy = NewInferenceType g let patEnv = TcPatLinearEnv (tpenv, NameMap.empty, Set.empty) let spats, _ = SimplePatsOfPat cenv.synArgNameGenerator pat - let names, patEnv = TcSimplePats cenv optionalArgsOK checkConstraints argTy env patEnv spats None false + let names, patEnv = TcSimplePats cenv optionalArgsOK checkConstraints argTy env patEnv spats ([], false) names, patEnv, spats and TcPatBindingName cenv env id ty isMemberThis vis1 valReprInfo (vFlags: TcPatValFlags) (names, takenNames: Set) = diff --git a/src/Compiler/Checking/CheckPatterns.fsi b/src/Compiler/Checking/CheckPatterns.fsi index 2569ad382a1..412044eda1e 100644 --- a/src/Compiler/Checking/CheckPatterns.fsi +++ b/src/Compiler/Checking/CheckPatterns.fsi @@ -39,6 +39,5 @@ val TcSimplePats: env: TcEnv -> patEnv: TcPatLinearEnv -> synSimplePats: SynSimplePats -> - parsedData: (SynPat list * SynExpr) option -> - isFirst: bool -> + parsedPatterns: SynPat list * bool -> string list * TcPatLinearEnv diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index d37bbb2b619..92391651740 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -6486,8 +6486,13 @@ and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpe match e with | SynExpr.Lambda (isMember, isSubsequent, synSimplePats, bodyExpr, parsedData, m, _trivia) when isMember || isFirst || isSubsequent -> let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy.Commit + let parsedPatterns = + parsedData + |> Option.map fst + |> Option.defaultValue [] + let vs, (TcPatLinearEnv (tpenv, names, takenNames)) = - cenv.TcSimplePats cenv isMember CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, takenNames)) synSimplePats parsedData isFirst + cenv.TcSimplePats cenv isMember CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, takenNames)) synSimplePats (parsedPatterns, isFirst) let envinner, _, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names let byrefs = vspecMap |> Map.map (fun _ v -> isByrefTy g v.Type, v) @@ -11745,7 +11750,7 @@ and ApplyTypesFromArgumentPatterns (cenv: cenv, env, optionalArgsOK, ty, m, tpen let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m ty // We apply the type information from the patterns by type checking the // "simple" patterns against 'domainTyR'. They get re-typechecked later. - ignore (cenv.TcSimplePats cenv optionalArgsOK CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) pushedPat None false) + ignore (cenv.TcSimplePats cenv optionalArgsOK CheckCxs domainTy env (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) pushedPat ([], false)) ApplyTypesFromArgumentPatterns (cenv, env, optionalArgsOK, resultTy, m, tpenv, NormalizedBindingRhs (morePushedPats, retInfoOpt, e), memberFlagsOpt) /// Check if the type annotations and inferred type information in a value give a