From 4421e296329e3032369040bce3bb4f708795d5e6 Mon Sep 17 00:00:00 2001 From: Anh-Dung Phan Date: Fri, 9 Oct 2015 00:15:24 -0700 Subject: [PATCH] Add a compiler warning for lower case literals in patterns Add unit tests https://github.com/Microsoft/visualfsharp/pull/666 --- src/fsharp/FSComp.txt | 1 + src/fsharp/NameResolution.fs | 5 ++++- src/fsharp/NameResolution.fsi | 3 +++ src/fsharp/TypeChecker.fs | 11 +++++++++-- .../General/W_LowercaseLiteralIgnored.fs | 13 +++++++++++++ .../General/W_LowercaseLiteralNotIgnored.fs | 15 +++++++++++++++ tests/fsharpqa/Source/Diagnostics/General/env.lst | 5 ++++- 7 files changed, 49 insertions(+), 4 deletions(-) create mode 100644 tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralIgnored.fs create mode 100644 tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralNotIgnored.fs diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 03a39be5b3d..9410e73984b 100644 --- a/src/fsharp/FSComp.txt +++ b/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." diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 8f0ddd0ecac..c930d6c691a 100644 --- a/src/fsharp/NameResolution.fs +++ b/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 diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index fadcd3f01e5..06fd5bb35d5 100644 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -101,6 +101,9 @@ type FullyQualifiedFlag = [] 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 diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 8619e556346..f4fa3fcf4d5 100644 --- a/src/fsharp/TypeChecker.fs +++ b/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) = +and TcPatBindingName _cenv env id ty isMemberThis vis1 topValData (inlineFlag,declaredTypars,argAttribs,isMutable,vis2,compgen) (names,takenNames:Set) = 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 diff --git a/tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralIgnored.fs b/tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralIgnored.fs new file mode 100644 index 00000000000..6959ae44400 --- /dev/null +++ b/tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralIgnored.fs @@ -0,0 +1,13 @@ +// #Regression #Diagnostics +//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\.$ +module M + +let [] lowerCase = "lowerCase" +let [] UpperCase = "UpperCase" + +let f = function + | UpperCase -> "UpperCase" + | lowerCase -> "LowerCase" + +f "A" |> ignore + diff --git a/tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralNotIgnored.fs b/tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralNotIgnored.fs new file mode 100644 index 00000000000..6e45e9cff04 --- /dev/null +++ b/tests/fsharpqa/Source/Diagnostics/General/W_LowercaseLiteralNotIgnored.fs @@ -0,0 +1,15 @@ +// #Regression #Diagnostics +//This rule will never be matched$ +module M0 + +module m1 = + let [] lowerCase = "lowerCase" + let [] UpperCase = "UpperCase" + +module M2 = + let f = function + | m1.lowerCase -> "LowerCase" + | lowerCase2 -> "LowerCase2" + | _ -> "Don't know" + +printfn "%A" (M2.f "B") diff --git a/tests/fsharpqa/Source/Diagnostics/General/env.lst b/tests/fsharpqa/Source/Diagnostics/General/env.lst index a7ced6841db..2f8d721c4e2 100644 --- a/tests/fsharpqa/Source/Diagnostics/General/env.lst +++ 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 \ No newline at end of file + 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