Warn on uppercase identifiers in patterns. (#15816)

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

@@ -27,6 +27,7 @@
 * Better ranges for CE `use` error reporting. ([PR #17811](https://github.com/dotnet/fsharp/pull/17811))
 * Better ranges for `inherit` error reporting. ([PR #17879](https://github.com/dotnet/fsharp/pull/17879))
 * Better ranges for `inherit` `struct` error reporting. ([PR #17886](https://github.com/dotnet/fsharp/pull/17886))
+* Warn on uppercase identifiers in patterns. ([PR #15816](https://github.com/dotnet/fsharp/pull/15816))
 * Better ranges for `inherit` objects error reporting. ([PR #17893](https://github.com/dotnet/fsharp/pull/17893))
 * Better ranges for #nowarn error reporting; bring back #nowarn warnings for --langVersion:80; add warnings under feature flag ([PR #17871](https://github.com/dotnet/fsharp/pull/17871))
 

docs/release-notes/.FSharp.Core/9.0.200.md

@@ -6,4 +6,4 @@
 
 ### Changed
 
-### Breaking Changes
+### Breaking Changes

docs/release-notes/.Language/preview.md

@@ -5,5 +5,6 @@
 * Added type conversions cache, only enabled for compiler runs ([PR#17668](https://github.com/dotnet/fsharp/pull/17668))
 
 ### Fixed
+* Warn on uppercase identifiers in patterns. ([PR #15816](https://github.com/dotnet/fsharp/pull/15816))
 
 ### Changed

src/Compiler/Checking/CheckPatterns.fs

@@ -58,10 +58,12 @@ let UnifyRefTupleType contextInfo (cenv: cenv) denv m ty ps =
     AddCxTypeEqualsType contextInfo denv cenv.css m ty (TType_tuple (tupInfoRef, ptys))
     ptys
 
-let rec TryAdjustHiddenVarNameToCompGenName cenv env (id: Ident) altNameRefCellOpt =
+let rec TryAdjustHiddenVarNameToCompGenName (cenv: cenv) env (id: Ident) altNameRefCellOpt =
     match altNameRefCellOpt with
     | Some ({contents = SynSimplePatAlternativeIdInfo.Undecided altId } as altNameRefCell) ->
-        match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false id.idRange env.eAccessRights env.eNameResEnv TypeNameResolutionInfo.Default [id] ExtraDotAfterIdentifier.No with
+        let supportsWarnOnUpperIdentifiersInPatterns = cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns)
+        let warnOnUpperFlag = if supportsWarnOnUpperIdentifiersInPatterns then WarnOnUpperVariablePatterns else AllIdsOK
+        match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver warnOnUpperFlag false id.idRange env.eAccessRights env.eNameResEnv TypeNameResolutionInfo.Default [id] ExtraDotAfterIdentifier.No with
         | Item.NewDef _ ->
             // The name is not in scope as a pattern identifier (e.g. union case), so do not use the alternate ID
             None
@@ -356,6 +358,12 @@ and TcPatNamedAs warnOnUpper cenv env valReprInfo vFlags patEnv ty synInnerPat i
 
 and TcPatUnnamedAs warnOnUpper cenv env vFlags patEnv ty pat1 pat2 m =
     let pats = [pat1; pat2]
+    let warnOnUpper =
+        if cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns) then
+            AllIdsOK
+        else
+            warnOnUpper
+
     let patsR, patEnvR = TcPatterns warnOnUpper cenv env vFlags patEnv (List.map (fun _ -> ty) pats) pats
     let phase2 values = TPat_conjs(List.map (fun f -> f values) patsR, m)
     phase2, patEnvR
@@ -441,7 +449,7 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m =
         else List.foldBack (mkConsListPat g argTy) argsR (mkNilListPat g m argTy)
     phase2, acc
 
-and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
+and TcRecordPat warnOnUpper (cenv: cenv) env vFlags patEnv ty fieldPats m =
     let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, fieldPat)
     match BuildFieldMap cenv env false ty fieldPats m with
     | None -> (fun _ -> TPat_error m), patEnv
@@ -458,7 +466,13 @@ and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
     let fieldPats, patEnvR =
         (patEnv, ftys) ||> List.mapFold (fun s (ty, fsp) ->
             match fldsmap.TryGetValue fsp.rfield_id.idText with
-            | true, v -> TcPat warnOnUpper cenv env None vFlags s ty v
+            | true, v ->
+                let warnOnUpper =
+                    if cenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns) then
+                        AllIdsOK
+                    else
+                        warnOnUpper
+                TcPat warnOnUpper cenv env None vFlags s ty v
             | _ -> (fun _ -> TPat_wild m), s)
 
     let phase2 values =

src/Compiler/Checking/Expressions/CheckComputationExpressions.fs

@@ -982,7 +982,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv firstSourcePat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv firstSourcePat None TcTrueMatchClause.No
 
                         vspecs, envinner)
 
@@ -991,7 +991,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv secondSourcePat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv secondSourcePat None TcTrueMatchClause.No
 
                         vspecs, envinner)
 
@@ -1002,7 +1002,7 @@ let rec TryTranslateComputationExpression
                             use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                             let _, _, vspecs, envinner, _ =
-                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat3 None
+                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat3 None TcTrueMatchClause.No
 
                             vspecs, envinner)
                     | None -> varSpace
@@ -1231,7 +1231,7 @@ let rec TryTranslateComputationExpression
                     use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                     let _, _, vspecs, envinner, _ =
-                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None
+                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
 
                     vspecs, envinner)
 
@@ -1789,7 +1789,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
 
                         vspecs, envinner
                     | _ ->
@@ -1873,7 +1873,7 @@ let rec TryTranslateComputationExpression
                     use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                     let _, _, vspecs, envinner, _ =
-                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None
+                        TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv pat None TcTrueMatchClause.No
 
                     vspecs, envinner)
 
@@ -2066,7 +2066,7 @@ let rec TryTranslateComputationExpression
                         use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                         let _, _, vspecs, envinner, _ =
-                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None
+                            TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No
 
                         vspecs, envinner)
 
@@ -2111,7 +2111,7 @@ let rec TryTranslateComputationExpression
                             use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                             let _, _, vspecs, envinner, _ =
-                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None
+                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No
 
                             vspecs, envinner)
 
@@ -2239,7 +2239,7 @@ let rec TryTranslateComputationExpression
                             use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink
 
                             let _, _, vspecs, envinner, _ =
-                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None
+                                TcMatchPattern cenv (NewInferenceType cenv.g) env ceenv.tpenv consumePat None TcTrueMatchClause.No
 
                             vspecs, envinner)
 

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -1017,6 +1017,12 @@ type TcCanFail =
     | IgnoreMemberResoutionError
     | IgnoreAllErrors
     | ReportAllErrors
+
+[<RequireQualifiedAccess>]
+[<Struct>]
+type TcTrueMatchClause =
+    | Yes
+    | No
 
 let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC m =
     let g = cenv.g
@@ -2516,8 +2522,12 @@ module BindingNormalization =
                 match memberFlagsOpt with
                 | None ->
                     let extraDot = if synLongId.ThereIsAnExtraDotAtTheEnd then ExtraDotAfterIdentifier.Yes else ExtraDotAfterIdentifier.No
-
-                    match ResolvePatternLongIdent cenv.tcSink nameResolver AllIdsOK true m ad env.NameEnv TypeNameResolutionInfo.Default longId extraDot with
+                    let warnOnUpper =
+                        if not args.IsEmpty then
+                            WarnOnUpperUnionCaseLabel
+                        else AllIdsOK  
+
+                    match ResolvePatternLongIdent cenv.tcSink nameResolver warnOnUpper true m ad env.NameEnv TypeNameResolutionInfo.Default longId extraDot with
                     | Item.NewDef id ->
                         if id.idText = opNameCons then
                             NormalizedBindingPat(pat, rhsExpr, valSynData, typars)
@@ -6423,10 +6433,8 @@ 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, _, m, _) 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
 
@@ -8072,7 +8080,7 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s
 
     let pat, _, vspecs, envinner, tpenv =
         let env = { env with eIsControlFlow = false }
-        TcMatchPattern cenv enumElemTy env tpenv synPat None
+        TcMatchPattern cenv enumElemTy env tpenv synPat None TcTrueMatchClause.No
 
     let elemVar, pat =
         // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to
@@ -10602,10 +10610,15 @@ and TcAndPatternCompileMatchClauses mExpr mMatch actionOnFailure cenv inputExprO
     let matchVal, expr = CompilePatternForMatchClauses cenv env mExpr mMatch true actionOnFailure inputExprOpt inputTy resultTy.Commit clauses
     matchVal, expr, tpenv
 
-and TcMatchPattern cenv inputTy env tpenv (synPat: SynPat) (synWhenExprOpt: SynExpr option) =
+and TcMatchPattern (cenv: cenv) inputTy env tpenv (synPat: SynPat) (synWhenExprOpt: SynExpr option) (tcTrueMatchClause: TcTrueMatchClause) =
     let g = cenv.g
     let m = synPat.Range
-    let patf', (TcPatLinearEnv (tpenv, names, _)) = cenv.TcPat WarnOnUpperCase cenv env None (TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, false)) (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) inputTy synPat
+    let warnOnUpperFlag =
+        match tcTrueMatchClause with
+        | TcTrueMatchClause.Yes -> WarnOnUpperUnionCaseLabel
+        | TcTrueMatchClause.No -> WarnOnUpperVariablePatterns
+
+    let patf', (TcPatLinearEnv (tpenv, names, _)) = cenv.TcPat warnOnUpperFlag cenv env None (TcPatValFlags (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, false)) (TcPatLinearEnv (tpenv, Map.empty, Set.empty)) inputTy synPat
     let envinner, values, vspecMap = MakeAndPublishSimpleValsForMergedScope cenv env m names
 
     let whenExprOpt, tpenv =
@@ -10626,9 +10639,15 @@ and TcMatchClauses cenv inputTy (resultTy: OverallTy) env tpenv clauses =
     resultList,tpEnv
 
 and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchClause =
-    let (SynMatchClause(synPat, synWhenExprOpt, synResultExpr, patm, spTgt, _)) = synMatchClause
+    let (SynMatchClause(synPat, synWhenExprOpt, synResultExpr, patm, spTgt, trivia)) = synMatchClause
 
-    let pat, whenExprOpt, vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv synPat synWhenExprOpt
+    let isTrueMatchClause =
+        if synMatchClause.IsTrueMatchClause then
+            TcTrueMatchClause.Yes
+        else
+            TcTrueMatchClause.No
+
+    let pat, whenExprOpt, vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv synPat synWhenExprOpt isTrueMatchClause
 
     let resultEnv =
         if isFirst then envinner

src/Compiler/Checking/Expressions/CheckExpressions.fsi

@@ -351,6 +351,13 @@ type TcCanFail =
     | IgnoreAllErrors
     | ReportAllErrors
 
+/// Represents a pattern  that is used in a true match clause e.g. | pat -> expr
+[<RequireQualifiedAccess>]
+[<Struct>]
+type TcTrueMatchClause =
+    | Yes
+    | No
+
 /// Represents a recursive binding after it has been both checked and generalized, but
 /// before initialization recursion has been rewritten
 type PreInitializationGraphEliminationBinding =
@@ -703,6 +710,7 @@ val TcMatchPattern:
     tpenv: UnscopedTyparEnv ->
     synPat: SynPat ->
     synWhenExprOpt: SynExpr option ->
+    tcTrueMatchClause: TcTrueMatchClause ->
         Pattern * Expr option * Val list * TcEnv * UnscopedTyparEnv
 
 [<return: Struct>]

src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs

@@ -59,7 +59,7 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
                 ConvertArbitraryExprToEnumerable cenv arbitraryTy env pseudoEnumExpr
 
             let patR, _, vspecs, envinner, tpenv =
-                TcMatchPattern cenv enumElemTy env tpenv pat None
+                TcMatchPattern cenv enumElemTy env tpenv pat None TcTrueMatchClause.No
 
             let innerExpr, tpenv =
                 let envinner = { envinner with eIsControlFlow = true }
@@ -241,7 +241,7 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
             let inputExprTy = NewInferenceType g
 
             let pat', _, vspecs, envinner, tpenv =
-                TcMatchPattern cenv bindPatTy env tpenv pat None
+                TcMatchPattern cenv bindPatTy env tpenv pat None TcTrueMatchClause.No
 
             UnifyTypes cenv env m inputExprTy bindPatTy
 
@@ -270,9 +270,15 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
 
             let tclauses, tpenv =
                 (tpenv, clauses)
-                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, _)) ->
+                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, trivia) as clause) ->
+                    let isTrueMatchClause =
+                        if clause.IsTrueMatchClause then
+                            TcTrueMatchClause.Yes
+                        else
+                            TcTrueMatchClause.No
+
                     let patR, condR, vspecs, envinner, tpenv =
-                        TcMatchPattern cenv inputTy env tpenv pat cond
+                        TcMatchPattern cenv inputTy env tpenv pat cond isTrueMatchClause
 
                     let envinner =
                         match sp with
@@ -313,9 +319,15 @@ let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallT
             // Compile the pattern twice, once as a filter with all succeeding targets returning "1", and once as a proper catch block.
             let clauses, tpenv =
                 (tpenv, withList)
-                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, m, sp, _)) ->
+                ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, m, sp, trivia) as clause) ->
+                    let isTrueMatchClause =
+                        if clause.IsTrueMatchClause then
+                            TcTrueMatchClause.Yes
+                        else
+                            TcTrueMatchClause.No
+
                     let patR, condR, vspecs, envinner, tpenv =
-                        TcMatchPattern cenv g.exn_ty env tpenv pat cond
+                        TcMatchPattern cenv g.exn_ty env tpenv pat cond isTrueMatchClause
 
                     let envinner =
                         match sp with

src/Compiler/Checking/NameResolution.fs

@@ -3369,7 +3369,10 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv nu
 exception UpperCaseIdentifierInPattern of range
 
 /// Indicates if a warning should be given for the use of upper-case identifiers in patterns
-type WarnOnUpperFlag = WarnOnUpperCase | AllIdsOK
+type WarnOnUpperFlag =
+    | WarnOnUpperUnionCaseLabel
+    | WarnOnUpperVariablePatterns
+    | AllIdsOK
 
 // Long ID in a pattern
 let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified warnOnUpper newDef m ad nenv numTyArgsOpt (id: Ident) (rest: Ident list) extraDotAtTheEnd =
@@ -3389,13 +3392,21 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa
             | true, res when not newDef -> ResolveUnqualifiedItem ncenv nenv m res
             | _ ->
                 // Single identifiers in patterns - variable bindings
-                if
-                    not newDef
-                    && warnOnUpper = WarnOnUpperCase
-                    && id.idText.Length >= 3
-                    && System.Char.ToLowerInvariant id.idText[0] <> id.idText[0]
+                let supportsDontWarnOnUppercaseIdentifiers = ncenv.g.langVersion.SupportsFeature(LanguageFeature.DontWarnOnUppercaseIdentifiersInBindingPatterns)
+                let isUpperCaseIdentifier = (not newDef && System.Char.ToLowerInvariant id.idText[0] <> id.idText[0])
+                if (supportsDontWarnOnUppercaseIdentifiers && isUpperCaseIdentifier)
                 then
-                    warning(UpperCaseIdentifierInPattern m)
+                    match warnOnUpper with
+                    | WarnOnUpperUnionCaseLabel -> warning(UpperCaseIdentifierInPattern m)
+                    | WarnOnUpperVariablePatterns
+                    | AllIdsOK -> ()
+                else
+                    // HACK: This is an historical hack that seems to related the use country and language codes, which are very common in codebases
+                    if isUpperCaseIdentifier && id.idText.Length >= 3 then
+                        match warnOnUpper with
+                        | WarnOnUpperUnionCaseLabel
+                        | WarnOnUpperVariablePatterns ->  warning(UpperCaseIdentifierInPattern m)
+                        | AllIdsOK -> ()
 
                 // If there's an extra dot, we check whether the single identifier is a union, module or namespace and report it to the sink for the sake of tooling
                 match extraDotAtTheEnd with

src/Compiler/Checking/NameResolution.fsi

@@ -565,7 +565,8 @@ type LookupKind =
 
 /// Indicates if a warning should be given for the use of upper-case identifiers in patterns
 type WarnOnUpperFlag =
-    | WarnOnUpperCase
+    | WarnOnUpperUnionCaseLabel
+    | WarnOnUpperVariablePatterns
     | AllIdsOK
 
 /// Indicates whether we permit a direct reference to a type generator. Only set when resolving the