Show warning when DU is accessed without type but RequiredQualifiedAc…

…cess was set

fixes #95
closes #103

commit 8bc07748cd50a0436b39de6066e4c2aaf52d8be0
Author: latkin <latkin@microsoft.com>
Date:   Mon Jan 26 16:47:06 2015 -0800

    Fix typo in test baseline

commit 210baa88919d8bcd37db9fc1e0f9911acbc317e7
Author: latkin <latkin@microsoft.com>
Date:   Mon Jan 26 16:46:28 2015 -0800

    Fix improper unqualified DU accesses in project system

commit ef1fb6b
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Mon Jan 26 17:51:05 2015 +0100

    Put Deprecated message into FSComp.txt - relates to #95

commit fa5e972
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Mon Jan 26 16:03:38 2015 +0100

    Add test for DU which is accessed without type but RequiredQualifiedAccess was set - relates to #95

commit e8a652e
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Mon Jan 26 10:00:43 2015 +0100

    Fix a case where #95 is violated in the compiler itself

commit 7c9c968
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Sun Jan 25 20:10:05 2015 +0100

    Show warning when DU is accessed without type but RequiredQualifiedAccess was set - closes #95

src/fsharp/FSComp.txt

@@ -1022,6 +1022,7 @@ lexfltSeparatorTokensOfPatternMatchMisaligned,"The '|' tokens separating rules o
 1130,nrInvalidFieldLabel,"Invalid field label"
 1132,nrInvalidExpression,"Invalid expression '%s'"
 1133,nrNoConstructorsAvailableForType,"No constructors are available for the type '%s'"
+1134,nrUnionTypeNeedsQualifiedAccess,"The union type for union case '%s' was defined with the RequireQualifiedAccessAttribute. Include the name of the union type ('%s') in the name you are using.""
 # -----------------------------------------------------------------------------
 # ilwrite.fs errors
 # -----------------------------------------------------------------------------

src/fsharp/check.fs

@@ -1471,6 +1471,6 @@ let CheckTopImpl (g,amap,reportErrors,infoReader,internalsVisibleToPaths,viewCcu
 
     CheckModuleExpr cenv env mexpr;
     CheckAttribs cenv env extraAttribs;
-    if cenv.usesQuotations && QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat(cenv.g) = QuotationTranslator.FSharp_20_Plus then 
+    if cenv.usesQuotations && QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat(cenv.g) = QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus then 
         viewCcu.UsesFSharp20PlusQuotations <- true
     cenv.entryPointGiven

src/fsharp/nameres.fs

@@ -135,7 +135,7 @@ type Item =
     /// Represents the resolution of a name to an F# value or function.
     | Value of  ValRef
     /// Represents the resolution of a name to an F# union case.
-    | UnionCase of UnionCaseInfo
+    | UnionCase of UnionCaseInfo * bool
     /// Represents the resolution of a name to an F# active pattern result.
     | ActivePatternResult of ActivePatternInfo * TType * int  * range
     /// Represents the resolution of a name to an F# active pattern case within the body of an active pattern.
@@ -197,7 +197,7 @@ type Item =
         match d with
         | Item.Value v -> v.DisplayName
         | Item.ActivePatternCase apref -> apref.Name
-        | Item.UnionCase uinfo -> DecompileOpName uinfo.UnionCase.DisplayName
+        | Item.UnionCase(uinfo,_) -> DecompileOpName uinfo.UnionCase.DisplayName
         | Item.ExnCase tcref -> tcref.LogicalName
         | Item.RecdField rfinfo -> DecompileOpName rfinfo.RecdField.Name
         | Item.NewDef id -> id.idText
@@ -521,7 +521,7 @@ let AddRecdField (rfref:RecdFieldRef) tab = NameMultiMap.add rfref.FieldName rfr
 /// Add a set of union cases to the corresponding sub-table of the environment 
 let AddUnionCases1 (tab:Map<_,_>) (ucrefs:UnionCaseRef list)= 
     (tab, ucrefs) ||> List.fold (fun acc ucref -> 
-        let item = Item.UnionCase (GeneralizeUnionCaseRef ucref)
+        let item = Item.UnionCase(GeneralizeUnionCaseRef ucref,false)
         acc.Add (ucref.CaseName, item))
 
 /// Add a set of union cases to the corresponding sub-table of the environment 
@@ -530,13 +530,13 @@ let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_,_>) (ucrefs :Uni
     | BulkAdd.Yes -> 
         let items = 
             ucrefs |> Array.ofList |> Array.map (fun ucref -> 
-                let item = Item.UnionCase (GeneralizeUnionCaseRef ucref)
+                let item = Item.UnionCase(GeneralizeUnionCaseRef ucref,false)
                 KeyValuePair(ucref.CaseName,item))
         eUnqualifiedItems.AddAndMarkAsCollapsible items
 
     | BulkAdd.No -> 
         (eUnqualifiedItems,ucrefs) ||> List.fold (fun acc ucref -> 
-            let item = Item.UnionCase (GeneralizeUnionCaseRef ucref)
+            let item = Item.UnionCase(GeneralizeUnionCaseRef ucref,false)
             acc.Add (ucref.CaseName, item))
 
 /// Add any implied contents of a type definition to the environment.
@@ -754,7 +754,7 @@ let FreshenUnionCaseRef (ncenv: NameResolver) m (ucref:UnionCaseRef) =
 /// This must be called after fetching unqualified items that may need to be freshened
 let FreshenUnqualifiedItem (ncenv: NameResolver) m res = 
     match res with 
-    | Item.UnionCase (UnionCaseInfo(_,ucref)) -> Item.UnionCase (FreshenUnionCaseRef ncenv m ucref)
+    | Item.UnionCase(UnionCaseInfo(_,ucref),_) -> Item.UnionCase(FreshenUnionCaseRef ncenv m ucref,false)
     | _ -> res
 
 
@@ -1549,7 +1549,7 @@ let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo
            // Lookup: datatype constructors take precedence 
            match unionCaseSearch with 
            | Some ucase -> 
-               success(resInfo,Item.UnionCase(ucase),rest)
+               success(resInfo,Item.UnionCase(ucase,false),rest)
            | None -> 
                 match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm,ad) findFlag m typ with
                 | Some (PropertyItem psets) when (match lookupKind with LookupKind.Expr  -> true | _ -> false) -> 
@@ -1652,8 +1652,9 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN
         match  TryFindTypeWithUnionCase modref id with
         | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.MkNestedTyconRef tycon) -> 
             let ucref = mkUnionCaseRef (modref.MkNestedTyconRef tycon) id.idText 
+            let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs
             let ucinfo = FreshenUnionCaseRef ncenv m ucref
-            success (resInfo,Item.UnionCase ucinfo,rest)
+            success (resInfo,Item.UnionCase(ucinfo,showDeprecated),rest)
         | _ -> 
         match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with
         | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.MkNestedTyconRef excon) -> 
@@ -1854,8 +1855,9 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num
         | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.MkNestedTyconRef tycon) -> 
             let tcref = modref.MkNestedTyconRef tycon
             let ucref = mkUnionCaseRef tcref id.idText
+            let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs
             let ucinfo = FreshenUnionCaseRef ncenv m ucref
-            success (resInfo,Item.UnionCase ucinfo,rest)
+            success (resInfo,Item.UnionCase(ucinfo,showDeprecated),rest)
         | _ -> 
         match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with
         | Some exnc when IsEntityAccessible ncenv.amap m ad (modref.MkNestedTyconRef exnc) -> 
@@ -2411,7 +2413,7 @@ let IsUnionCaseUnseen ad g amap m (ucref:UnionCaseRef) =
 let ItemIsUnseen ad g amap m item = 
     match item with 
     | Item.Value x -> IsValUnseen ad  g m x
-    | Item.UnionCase x -> IsUnionCaseUnseen ad g amap m x.UnionCaseRef
+    | Item.UnionCase(x,_) -> IsUnionCaseUnseen ad g amap m x.UnionCaseRef
     | Item.ExnCase x -> IsTyconUnseen ad g amap m x
     | _ -> false
 
@@ -2466,7 +2468,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad st
             let tc,tinst = destAppTy g typ
             tc.UnionCasesAsRefList 
             |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not)
-            |> List.map (fun ucref ->  Item.UnionCase(UnionCaseInfo(tinst,ucref)))
+            |> List.map (fun ucref ->  Item.UnionCase(UnionCaseInfo(tinst,ucref),false))
         else []
 
     let einfos = 
@@ -2738,7 +2740,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is
        @ (UnionCaseRefsInModuleOrNamespace modref 
           |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not)
           |> List.map GeneralizeUnionCaseRef 
-          |> List.map Item.UnionCase)
+          |> List.map (fun x -> Item.UnionCase(x,false)))
 
          // Collect up the accessible active patterns in the module 
        @ (ActivePatternElemsOfModuleOrNamespace modref 

src/fsharp/nameres.fsi

@@ -38,7 +38,8 @@ type ArgumentContainer =
 type Item = 
   // These exist in the "eUnqualifiedItems" List.map in the type environment. 
   | Value of  ValRef
-  | UnionCase of UnionCaseInfo
+  // UnionCaseInfo and temporary flag which is used to show a "use case is deprecated" message
+  | UnionCase of UnionCaseInfo * bool 
   | ActivePatternResult of ActivePatternInfo * TType * int  * range
   | ActivePatternCase of ActivePatternElemRef 
   | ExnCase of TyconRef 

src/fsharp/tc.fs

@@ -1876,7 +1876,10 @@ let rec ApplyUnionCaseOrExn (makerForUnionCase,makerForExnTag) m cenv env overal
         let mkf = makerForExnTag(ecref)
         mkf,recdFieldTysOfExnDefRef ecref, [ for f in (recdFieldsOfExnDefRef ecref) -> f.Name ]
 
-    | Item.UnionCase ucinfo ->   
+    | Item.UnionCase(ucinfo,showDeprecated) ->   
+        if showDeprecated then
+            warning(Deprecated(FSComp.SR.nrUnionTypeNeedsQualifiedAccess(ucinfo.Name,ucinfo.Tycon.DisplayName) |> snd,m))
+
         let ucref = ucinfo.UnionCaseRef 
         CheckUnionCaseAttributes cenv.g ucref m  |> CommitOperationResult
         CheckUnionCaseAccessible cenv.amap m ad ucref |> ignore
@@ -4872,7 +4875,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat
                         | None -> 
                             let caseName = 
                                 match item with
-                                | Item.UnionCase uci -> uci.Name
+                                | Item.UnionCase(uci,_) -> uci.Name
                                 | Item.ExnCase tcref -> tcref.DisplayName
                                 | _ -> failwith "impossible"
                             error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(caseName, id.idText), id.idRange))
@@ -4881,7 +4884,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat
                             | null -> 
                                 result.[idx] <- pat
                                 let argContainerOpt = match item with
-                                                      | Item.UnionCase uci -> Some(ArgumentContainer.UnionCase(uci))
+                                                      | Item.UnionCase(uci,_) -> Some(ArgumentContainer.UnionCase(uci))
                                                       | Item.ExnCase tref -> Some(ArgumentContainer.Type(tref))
                                                       | _ -> None
                                 let argItem = Item.ArgName (id, (List.nth argtys idx), argContainerOpt)   
@@ -7871,7 +7874,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
                   let ucref = mkChoiceCaseRef cenv.g mItem aparity n
                   let _,_,tinst,_ = infoOfTyconRef mItem ucref.TyconRef
                   let ucinfo = UnionCaseInfo(tinst,ucref)
-                  ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy (Item.UnionCase ucinfo)
+                  ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy (Item.UnionCase(ucinfo,false))
           | _ -> 
               ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy item
         let nargtys = List.length argtys
@@ -7927,7 +7930,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
                             if box fittedArgs.[i] = null then
                                 fittedArgs.[i] <- arg
                                 let argContainerOpt = match item with
-                                                      | Item.UnionCase uci -> Some(ArgumentContainer.UnionCase(uci))
+                                                      | Item.UnionCase(uci,_) -> Some(ArgumentContainer.UnionCase(uci))
                                                       | Item.ExnCase tref -> Some(ArgumentContainer.Type(tref))
                                                       | _ -> None
                                 let argItem = Item.ArgName (id, (List.nth argtys i), argContainerOpt)   
@@ -7956,7 +7959,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
                             else
                                 let caseName = 
                                     match item with
-                                    | Item.UnionCase uci -> uci.Name
+                                    | Item.UnionCase(uci,_) -> uci.Name
                                     | Item.ExnCase tcref -> tcref.DisplayName
                                     | _ -> failwith "impossible"
                                 error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(caseName, id.idText),  id.idRange))
@@ -14021,9 +14024,9 @@ module EstablishTypeDefinitionCores = begin
                 // Constructors should be visible from IntelliSense, so add fake names for them 
                 for unionCase in unionCases do
                     let info = UnionCaseInfo(thisTyInst,mkUnionCaseRef thisTyconRef unionCase.Id.idText)
-                    let nenv' = AddFakeNameToNameEnv unionCase.Id.idText nenv (Item.UnionCase info) 
+                    let nenv' = AddFakeNameToNameEnv unionCase.Id.idText nenv (Item.UnionCase(info,false)) 
                     // Report to both - as in previous function
-                    let item = Item.UnionCase info
+                    let item = Item.UnionCase(info,false)
                     CallNameResolutionSink cenv.tcSink (unionCase.Range,nenv,item,item,ItemOccurence.Binding,envinner.DisplayEnv,ad)
                     CallEnvSink cenv.tcSink (unionCase.Id.idRange, nenv', ad)
 

src/fsharp/vs/ServiceDeclarations.fs

@@ -162,7 +162,7 @@ module internal ItemDescriptionsImpl =
     let rec rangeOfItem (g:TcGlobals) isDeclInfo d = 
         match d with
         | Item.Value vref  | Item.CustomBuilder (_,vref) -> Some (if isDeclInfo then vref.Range else vref.DefinitionRange)
-        | Item.UnionCase ucinfo        -> Some ucinfo.UnionCase.Range
+        | Item.UnionCase(ucinfo,_)     -> Some ucinfo.UnionCase.Range
         | Item.ActivePatternCase apref -> Some apref.ActivePatternVal.Range
         | Item.ExnCase tcref           -> Some tcref.Range
         | Item.RecdField rfinfo        -> Some rfinfo.RecdFieldRef.Range
@@ -192,7 +192,7 @@ module internal ItemDescriptionsImpl =
     let rec ccuOfItem g d = 
         match d with
         | Item.Value vref | Item.CustomBuilder (_,vref) -> ccuOfValRef vref 
-        | Item.UnionCase ucinfo                -> computeCcuOfTyconRef ucinfo.TyconRef
+        | Item.UnionCase(ucinfo,_)             -> computeCcuOfTyconRef ucinfo.TyconRef
         | Item.ActivePatternCase apref         -> ccuOfValRef apref.ActivePatternVal
         | Item.ExnCase tcref                   -> computeCcuOfTyconRef tcref
         | Item.RecdField rfinfo                -> computeCcuOfTyconRef rfinfo.RecdFieldRef.TyconRef
@@ -347,7 +347,7 @@ module internal ItemDescriptionsImpl =
                 | None -> XmlCommentNone
             else 
                 XmlCommentNone
-        | Item.UnionCase  ucinfo -> GetXmlDocSigOfUnionCaseInfo ucinfo
+        | Item.UnionCase (ucinfo,_) -> GetXmlDocSigOfUnionCaseInfo ucinfo
         | Item.ExnCase tcref -> GetXmlDocSigOfEntityRef infoReader m tcref 
         | Item.RecdField rfinfo -> GetXmlDocSigOfRecdFieldInfo rfinfo
         | Item.NewDef _ -> XmlCommentNone
@@ -511,7 +511,7 @@ module internal ItemDescriptionsImpl =
               | Wrap(Item.Value vref1 | Item.CustomBuilder (_,vref1)), Wrap(Item.Value vref2 | Item.CustomBuilder (_,vref2)) -> valRefEq g vref1 vref2
               | Wrap(Item.ActivePatternCase(APElemRef(_apinfo1, vref1, idx1))), Wrap(Item.ActivePatternCase(APElemRef(_apinfo2, vref2, idx2))) ->
                   idx1 = idx2 && valRefEq g vref1 vref2
-              | Wrap(Item.UnionCase(UnionCaseInfo(_, ur1))), Wrap(Item.UnionCase(UnionCaseInfo(_, ur2))) -> g.unionCaseRefEq ur1 ur2
+              | Wrap(Item.UnionCase(UnionCaseInfo(_, ur1),_)), Wrap(Item.UnionCase(UnionCaseInfo(_, ur2),_)) -> g.unionCaseRefEq ur1 ur2
               | Wrap(Item.RecdField(RecdFieldInfo(_, RFRef(tcref1, n1)))), Wrap(Item.RecdField(RecdFieldInfo(_, RFRef(tcref2, n2)))) -> 
                   (tyconRefEq g tcref1 tcref2) && (n1 = n2) // there is no direct function as in the previous case
               | Wrap(Item.Property(_, pi1s)), Wrap(Item.Property(_, pi2s)) -> 
@@ -542,7 +542,7 @@ module internal ItemDescriptionsImpl =
               | Wrap(Item.Value vref | Item.CustomBuilder (_,vref)) -> hash vref.LogicalName
               | Wrap(Item.ActivePatternCase(APElemRef(_apinfo, vref, idx))) -> hash (vref.LogicalName, idx)
               | Wrap(Item.ExnCase(tcref)) -> hash tcref.Stamp
-              | Wrap(Item.UnionCase(UnionCaseInfo(_, UCRef(tcref, n)))) -> hash(tcref.Stamp, n)
+              | Wrap(Item.UnionCase(UnionCaseInfo(_, UCRef(tcref, n)),_)) -> hash(tcref.Stamp, n)
               | Wrap(Item.RecdField(RecdFieldInfo(_, RFRef(tcref, n)))) -> hash(tcref.Stamp, n)
               | Wrap(Item.Event evt) -> evt.ComputeHashCode()
               | Wrap(Item.Property(_name, pis)) -> hash (pis |> List.map (fun pi -> pi.ComputeHashCode()))
@@ -611,7 +611,7 @@ module internal ItemDescriptionsImpl =
             DataTipElement(text, xml)
 
         // Union tags (constructors)
-        | Item.UnionCase ucinfo -> 
+        | Item.UnionCase(ucinfo,_) -> 
             let uc = ucinfo.UnionCase 
             let rty = generalizedTyconRef ucinfo.TyconRef
             let recd = uc.RecdFields 
@@ -886,7 +886,7 @@ module internal ItemDescriptionsImpl =
               bufferL os tpcsL
             else
               bufferL os (NicePrint.layoutPrettifiedTypeAndConstraints denv [] tau) 
-        | Item.UnionCase ucinfo -> 
+        | Item.UnionCase(ucinfo,_) -> 
             let rty = generalizedTyconRef ucinfo.TyconRef
             NicePrint.outputTy denv os rty
         | Item.ActivePatternCase(apref) -> 
@@ -970,7 +970,7 @@ module internal ItemDescriptionsImpl =
         | Item.Value vref | Item.CustomBuilder (_,vref) -> getKeywordForValRef vref
         | Item.ActivePatternCase apref -> apref.ActivePatternVal |> getKeywordForValRef
 
-        | Item.UnionCase ucinfo -> 
+        | Item.UnionCase(ucinfo,_) -> 
             (ucinfo.TyconRef |> ticksAndArgCountTextOfTyconRef)+"."+ucinfo.Name |> Some
 
         | Item.RecdField rfi -> 

src/fsharp/vs/service.fs

@@ -180,7 +180,7 @@ module internal Params =
                         |> List.map ParamNameAndType.FromArgInfo
                         |> List.map (fun (ParamNameAndType(nmOpt, pty)) -> ParamData(false, false, NotOptional, nmOpt, ReflectedArgInfo.None, pty))
                     ParamsOfParamDatas g denv paramDatas returnTy
-        | Item.UnionCase(ucr)   -> 
+        | Item.UnionCase(ucr,_)   -> 
             match ucr.UnionCase.RecdFields with
             | [f] -> [ParamOfUnionCaseField g denv NicePrint.isGeneratedUnionCaseField -1 f]
             | fs -> fs |> List.mapi (ParamOfUnionCaseField g denv NicePrint.isGeneratedUnionCaseField)
@@ -294,7 +294,7 @@ type MethodOverloads( name: string, unsortedMethods: Method[] ) =
                         if isFunction g rfinfo.FieldType then [item] else []
                     | Item.Value v -> 
                         if isFunction g v.Type then [item] else []
-                    | Item.UnionCase(ucr) -> 
+                    | Item.UnionCase(ucr,_) -> 
                         if not ucr.UnionCase.IsNullary then [item] else []
                     | Item.ExnCase(ecr) -> 
                         if recdFieldsOfExnDefRef ecr |> nonNil then [item] else []

tests/fsharp/typecheck/sigs/neg90.bsl

@@ -4,3 +4,5 @@ neg90.fs(4,9,4,12): typecheck error FS0001: A generic construct requires that th
 neg90.fs(7,22,7,25): typecheck error FS0039: The type 'foo' is not defined
 
 neg90.fs(7,22,7,25): typecheck error FS0039: The type 'foo' is not defined
+
+neg90.fs(16,9,16,21): typecheck error FS0035: This construct is deprecated: The union type for union case 'Member' was defined with the RequireQualifiedAccessAttribute. Include the name of the union type ('DU') in the name you are using.'

tests/fsharp/typecheck/sigs/neg90.fs

@@ -6,3 +6,11 @@ let _ = foo<Recd>()
 // See https://github.com/Microsoft/visualfsharp/issues/38
 type [<Measure>] N = foo // foo is undefined
 type M2 = float<N>
+
+
+// See https://github.com/Microsoft/visualfsharp/issues/95
+module First = 
+  [<RequireQualifiedAccess>]
+  type DU = Member of int
+
+let _ = First.Member(0)