Skip to content

Commit

Permalink
Show warning when DU is accessed without type but RequiredQualifiedAc…
Browse files Browse the repository at this point in the history
…cess was set - closes dotnet#95
  • Loading branch information
forki committed Jan 26, 2015
1 parent 11ede75 commit 129d9c6
Show file tree
Hide file tree
Showing 5 changed files with 38 additions and 31 deletions.
26 changes: 14 additions & 12 deletions src/fsharp/nameres.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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.
Expand Down Expand Up @@ -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


Expand Down Expand Up @@ -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) ->
Expand Down Expand Up @@ -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) ->
Expand Down Expand Up @@ -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) ->
Expand Down Expand Up @@ -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,false) -> IsUnionCaseUnseen ad g amap m x.UnionCaseRef
| Item.ExnCase x -> IsTyconUnseen ad g amap m x
| _ -> false

Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion src/fsharp/nameres.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
20 changes: 12 additions & 8 deletions src/fsharp/tc.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1876,7 +1876,11 @@ 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
let message = sprintf "The union type for union case '%s' was definded with the RequireQualifiedAccessAttribute. Include the name of the union type ('%s') in the name you are using.'" ucinfo.Name ucinfo.Tycon.DisplayName
warning(Deprecated(message,m))

let ucref = ucinfo.UnionCaseRef
CheckUnionCaseAttributes cenv.g ucref m |> CommitOperationResult
CheckUnionCaseAccessible cenv.amap m ad ucref |> ignore
Expand Down Expand Up @@ -4872,7 +4876,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))
Expand All @@ -4881,7 +4885,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)
Expand Down Expand Up @@ -7871,7 +7875,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
Expand Down Expand Up @@ -7927,7 +7931,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)
Expand Down Expand Up @@ -7956,7 +7960,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))
Expand Down Expand Up @@ -14021,9 +14025,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)

Expand Down
16 changes: 8 additions & 8 deletions src/fsharp/vs/ServiceDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)) ->
Expand Down Expand Up @@ -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()))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) ->
Expand Down Expand Up @@ -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 ->
Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/vs/service.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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 []
Expand Down

0 comments on commit 129d9c6

Please sign in to comment.