Add a compiler warning for lower case literals in patterns

    Add unit tests

    dotnet/fsharp#666

Author: dungpa

src/fsharp/FSComp.txt

@@ -1344,3 +1344,4 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS
 3187,checkNotSufficientlyGenericBecauseOfScope,"Type inference caused the type variable %s to escape its scope. Consider adding an explicit type parameter declaration or adjusting your code to be less generic."
 3188,checkNotSufficientlyGenericBecauseOfScopeAnon,"Type inference caused an inference type variable to escape its scope. Consider adding type annotations to make your code less generic."
 3189,checkRaiseFamilyFunctionArgumentCount,"Redundant arguments are being ignored in function '%s'. Expected %d but got %d arguments."
+3190,checkLowercaseLiteralBindingInPattern,"Lowercase literal '%s' is being shadowed by a new pattern with the same name. Only uppercase and module-prefixed literals can be used as named patterns."

src/fsharp/NameResolution.fs

@@ -606,7 +606,10 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g:TcGlobals)
         ePatItems = ePatItems
         eIndexedExtensionMembers = eIndexedExtensionMembers 
         eUnindexedExtensionMembers = eUnindexedExtensionMembers }
-    
+
+let TryFindPatternByName name {ePatItems = patternMap} =
+    NameMap.tryFind name patternMap
+
 /// Add a set of type definitions to the name resolution environment 
 let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap m  root nenv tcrefs = 
     let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m) nenv tcrefs

src/fsharp/NameResolution.fsi

@@ -101,6 +101,9 @@ type FullyQualifiedFlag =
 [<RequireQualifiedAccess>]
 type BulkAdd = Yes | No
 
+/// Lookup patterns in name resolution environment
+val internal TryFindPatternByName : string -> NameResolutionEnv -> Item option
+
 /// Add extra items to the environment for Visual Studio, e.g. static members 
 val internal AddFakeNamedValRefToNameEnv : string -> NameResolutionEnv -> ValRef -> NameResolutionEnv
 

src/fsharp/TypeChecker.fs

@@ -4691,7 +4691,7 @@ and TcSimplePatsOfUnknownType cenv optArgsOK checkCxs env tpenv spats =
     let argty = NewInferenceType ()
     TcSimplePats cenv optArgsOK checkCxs argty env (tpenv,NameMap.empty,Set.empty) spats
 
-and TcPatBindingName _cenv _env id ty isMemberThis vis1 topValData (inlineFlag,declaredTypars,argAttribs,isMutable,vis2,compgen) (names,takenNames:Set<string>) = 
+and TcPatBindingName _cenv env id ty isMemberThis vis1 topValData (inlineFlag,declaredTypars,argAttribs,isMutable,vis2,compgen) (names,takenNames:Set<string>) = 
     let vis = if isSome vis1 then vis1 else vis2
     if takenNames.Contains id.idText then errorR (VarBoundTwice id)
     let baseOrThis = if isMemberThis then MemberThisVal else NormalVal
@@ -4700,7 +4700,14 @@ and TcPatBindingName _cenv _env id ty isMemberThis vis1 topValData (inlineFlag,d
     (fun (TcPatPhase2Input values) -> 
         let (vspec,typeScheme) = 
             match values.TryFind id.idText with
-            | Some x -> x
+            | Some value ->
+                let name = id.idText
+                if not (String.IsNullOrEmpty name) && Char.IsLower(name.[0]) then
+                    match TryFindPatternByName name env.eNameResEnv with
+                    | Some (Item.Value vref) when vref.LiteralValue.IsSome ->
+                        warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern(id.idText),id.idRange))
+                    | Some _ | None -> ()
+                value
             | None -> error(Error(FSComp.SR.tcNameNotBoundInPattern(id.idText),id.idRange))
         PBind(vspec,typeScheme)),
     names,takenNames

tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralIgnored.fs

@@ -0,0 +1,13 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(10,5-10,14)" id="FS3190">Lowercase literal 'lowerCase' is being shadowed by a new pattern with the same name\. Only uppercase and module-prefixed literals can be used as named patterns\.$</Expects>
+module M
+
+let [<Literal>] lowerCase = "lowerCase"
+let [<Literal>] UpperCase = "UpperCase"
+
+let f = function
+  | UpperCase -> "UpperCase"
+  | lowerCase -> "LowerCase"
+
+f "A" |> ignore
+

tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralNotIgnored.fs

@@ -0,0 +1,15 @@
+// #Regression #Diagnostics 
+//<Expects status="warning" span="(13,7-13,8)" id="FS0026">This rule will never be matched$</Expects>
+module M0
+
+module m1 =
+  let [<Literal>] lowerCase = "lowerCase"
+  let [<Literal>] UpperCase = "UpperCase"
+
+module M2 =
+  let f = function
+    | m1.lowerCase -> "LowerCase"
+    | lowerCase2 -> "LowerCase2"
+    | _ -> "Don't know"
+
+printfn "%A" (M2.f "B")

tests/fsharpqa/Source/Diagnostics/General/env.lst

@@ -125,4 +125,7 @@ ReqPP	SOURCE=W_WebExtensionsNotInPowerPack01.fs SCFLAGS="--test:ErrorRanges -r:F
 	SOURCE=W_RaiseRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_RaiseRedundantArgs.fs
 	SOURCE=W_InvalidArgRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_InvalidArgRedundantArgs.fs
 	SOURCE=W_NullArgRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_NullArgRedundantArgs.fs
-	SOURCE=W_InvalidOpRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_InvalidOpRedundantArgs.fs
+	SOURCE=W_InvalidOpRedundantArgs.fs  SCFLAGS="--test:ErrorRanges -a"	# W_InvalidOpRedundantArgs.fs
+
+        SOURCE=W_LowercaseLiteralIgnored.fs  SCFLAGS="--test:ErrorRanges"	# W_LowercaseLiteralIgnored.fs
+	SOURCE=W_LowercaseLiteralNotIgnored.fs  SCFLAGS="--test:ErrorRanges"	# W_LowercaseLiteralNotIgnored.fs