Skip to content

Commit

Permalink
Show warning when Record is accessed without type but RequireQualifie…
Browse files Browse the repository at this point in the history
…dAccess was set - relates to dotnet#95
  • Loading branch information
forki committed Jan 27, 2015
1 parent 742c133 commit 5200780
Show file tree
Hide file tree
Showing 6 changed files with 41 additions and 15 deletions.
3 changes: 2 additions & 1 deletion src/fsharp/FSComp.txt
Original file line number Diff line number Diff line change
Expand Up @@ -1022,7 +1022,8 @@ 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.""
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."
1135,nrRecordTypeNeedsQualifiedAccess,"The record type for the record field '%s' was defined with the RequireQualifiedAccessAttribute. Include the name of the record type ('%s') in the name you are using."
# -----------------------------------------------------------------------------
# ilwrite.fs errors
# -----------------------------------------------------------------------------
Expand Down
17 changes: 11 additions & 6 deletions src/fsharp/nameres.fs
Original file line number Diff line number Diff line change
Expand Up @@ -221,6 +221,9 @@ let valRefHash (vref: ValRef) =
| None -> 0
| Some v -> LanguagePrimitives.PhysicalHash v

/// Represents a record field resolution and the information if the usage is deprecated.
type FieldResolution = FieldResolution of RecdFieldRef * bool

/// Information about an extension member held in the name resolution environment
type ExtensionMember =

Expand Down Expand Up @@ -2144,7 +2147,8 @@ let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:Re
let modulScopedFieldNames =
match TryFindTypeWithRecdField modref id with
| Some tycon when IsEntityAccessible ncenv.amap m ad (modref.MkNestedTyconRef tycon) ->
success(modref.MkNestedRecdFieldRef tycon id, rest)
let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs
success(FieldResolution(modref.MkNestedRecdFieldRef tycon id,showDeprecated), rest)
| _ -> error
// search for type-qualified names, e.g. { Microsoft.FSharp.Core.Ref.contents = 1 }
let tyconSearch =
Expand All @@ -2154,7 +2158,7 @@ let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:Re
let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref))
let tyconSearch = ResolveLongIdentInTyconRefs ncenv nenv LookupKind.RecdField (depth+1) m ad rest typeNameResInfo id.idRange tcrefs
// choose only fields
let tyconSearch = tyconSearch |?> List.choose (function (_,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(rfref,rest) | _ -> None)
let tyconSearch = tyconSearch |?> List.choose (function (_,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(FieldResolution(rfref,false),rest) | _ -> None)
tyconSearch
| _ ->
NoResultsOrUsefulErrors
Expand All @@ -2181,15 +2185,16 @@ let ResolveField (ncenv:NameResolver) nenv ad typ (mp,id:Ident) =
| [] ->
if isAppTy g typ then
match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText,m,typ) with
| Some (RecdFieldInfo(_,rfref)) -> [rfref]
| Some (RecdFieldInfo(_,rfref)) -> [FieldResolution(rfref,false)]
| None -> error(Error(FSComp.SR.nrTypeDoesNotContainSuchField((NicePrint.minimalStringOfType nenv.eDisplayEnv typ), id.idText),m))
else
let frefs =
try Map.find id.idText nenv.eFieldLabels
with :? KeyNotFoundException -> error (UndefinedName(0,FSComp.SR.undefinedNameRecordLabel,id,NameMap.domainL nenv.eFieldLabels))
// Eliminate duplicates arising from multiple 'open'
let frefs = frefs |> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef)
frefs
frefs
|> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef)
|> List.map (fun x -> FieldResolution(x,false))

| _ ->
let lid = (mp@[id])
Expand All @@ -2201,7 +2206,7 @@ let ResolveField (ncenv:NameResolver) nenv ad typ (mp,id:Ident) =
let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref))
let tyconSearch = ResolveLongIdentInTyconRefs ncenv nenv LookupKind.RecdField 1 m ad rest typeNameResInfo tn.idRange tcrefs
// choose only fields
let tyconSearch = tyconSearch |?> List.choose (function (_,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(rfref,rest) | _ -> None)
let tyconSearch = tyconSearch |?> List.choose (function (_,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(FieldResolution(rfref,false),rest) | _ -> None)
tyconSearch
| _ -> NoResultsOrUsefulErrors
let modulSearch ad =
Expand Down
4 changes: 3 additions & 1 deletion src/fsharp/nameres.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,8 @@ type Item =
| UnqualifiedType of TyconRef list
member DisplayName : TcGlobals -> string

/// Represents a record field resolution and the information if the usage is deprecated.
type FieldResolution = FieldResolution of RecdFieldRef * bool

/// Information about an extension member held in the name resolution environment
[<Sealed>]
Expand Down Expand Up @@ -263,7 +265,7 @@ val internal ResolveTypeLongIdentInTyconRef : TcResultsSink -> NameResol
val internal ResolveTypeLongIdent : TcResultsSink -> NameResolver -> ItemOccurence -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> TypeNameResolutionStaticArgsInfo -> PermitDirectReferenceToGeneratedType -> ResultOrException<TyconRef>

/// Resolve a long identifier to a field
val internal ResolveField : NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> RecdFieldRef list
val internal ResolveField : NameResolver -> NameResolutionEnv -> AccessorDomain -> TType -> Ident list * Ident -> FieldResolution list

/// Resolve a long identifier occurring in an expression position
val internal ResolveExprLongIdent : TcResultsSink -> NameResolver -> range -> AccessorDomain -> NameResolutionEnv -> TypeNameResolutionInfo -> Ident list -> Item * Ident list
Expand Down
13 changes: 8 additions & 5 deletions src/fsharp/tc.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1828,7 +1828,7 @@ let BuildFieldMap cenv env isPartial ty flds m =
let frefSet = ResolveField cenv.nameResolver env.eNameResEnv ad ty fld
fld,frefSet, fldExpr)
let relevantTypeSets =
frefSets |> List.map (fun (_,frefSet,_) -> frefSet |> List.choose (fun rfref -> Some rfref.TyconRef))
frefSets |> List.map (fun (_,frefSet,_) -> frefSet |> List.choose (fun (FieldResolution(rfref,_)) -> Some rfref.TyconRef))

let tcref =
match List.fold (ListSet.intersect (tyconRefEq cenv.g)) (List.head relevantTypeSets) (List.tail relevantTypeSets) with
Expand All @@ -1840,13 +1840,13 @@ let BuildFieldMap cenv env isPartial ty flds m =
// We're going to get an error of some kind below.
// Just choose one field ref and let the error come later
let (_,frefSet1,_) = List.head frefSets
let fref1 = List.head frefSet1
let (FieldResolution(fref1,_))= List.head frefSet1
fref1.TyconRef

let fldsmap,rfldsList =
((Map.empty,[]), frefSets) ||> List.fold (fun (fs,rfldsList) (fld,frefs,fldExpr) ->
match frefs |> List.filter (fun fref2 -> tyconRefEq cenv.g tcref fref2.TyconRef) with
| [fref2] ->
match frefs |> List.filter (fun (FieldResolution(fref2,_)) -> tyconRefEq cenv.g tcref fref2.TyconRef) with
| [FieldResolution(fref2,showDeprecated)] ->

// Record the precise resolution of the field for intellisense
let item = FreshenRecdFieldRef cenv.nameResolver m fref2
Expand All @@ -1856,9 +1856,12 @@ let BuildFieldMap cenv env isPartial ty flds m =
CheckFSharpAttributes cenv.g fref2.PropertyAttribs m |> CommitOperationResult
if Map.containsKey fref2.FieldName fs then
errorR (Error(FSComp.SR.tcFieldAppearsTwiceInRecord(fref2.FieldName),m))
if showDeprecated then
warning(Deprecated(FSComp.SR.nrRecordTypeNeedsQualifiedAccess(fref2.FieldName,fref2.Tycon.DisplayName) |> snd,m))

if not (tyconRefEq cenv.g tcref fref2.TyconRef) then
let (_,frefSet1,_) = List.head frefSets
let fref1 = List.head frefSet1
let (FieldResolution(fref1,_)) = List.head frefSet1
errorR (FieldsFromDifferentTypes(env.DisplayEnv,fref1,fref2,m))
(fs,rfldsList)
else (Map.add fref2.FieldName fldExpr fs,
Expand Down
4 changes: 3 additions & 1 deletion tests/fsharp/typecheck/sigs/neg90.bsl
Original file line number Diff line number Diff line change
Expand Up @@ -5,4 +5,6 @@ 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.'
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."
neg90.fs(28,9,28,41): typecheck error FS0035: This construct is deprecated: The record type for the record field 'Field1' was defined with the RequireQualifiedAccessAttribute. Include the name of the record type ('Record1') in the name you are using.'
15 changes: 14 additions & 1 deletion tests/fsharp/typecheck/sigs/neg90.fs
Original file line number Diff line number Diff line change
Expand Up @@ -13,4 +13,17 @@ module First =
[<RequireQualifiedAccess>]
type DU = Member of int

let _ = First.Member(0)
let _ = First.Member(0) // compiles, but should not
let _ = First.DU.Member(0) // correct

// See https://github.com/Microsoft/visualfsharp/issues/95 - part 2
module ModuleWithRecord =
[<RequireQualifiedAccess>]
type Record1 = { Field1 : int }

let _ = { ModuleWithRecord.Record1.Field1 = 42 } // correct

open ModuleWithRecord
let _ = { Record1.Field1 = 42 } // correct
let _ = { ModuleWithRecord.Field1 = 42 } // compiles, but should not
let _ = { ModuleWithRecord.Record1.Field1 = 42 } // correct

0 comments on commit 5200780

Please sign in to comment.