diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 72de74d869a..5d6a480a3f0 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -845,7 +845,6 @@ let AtMostOneResult m res = match res with | Exception err -> raze err | Result [] -> raze (Error(FSComp.SR.nrInvalidModuleExprType(),m)) - | Result [res] -> success res | Result (res :: _) -> success res //------------------------------------------------------------------------- @@ -1976,25 +1975,31 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN | Some vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> success(resInfo,Item.Value (mkNestedValRef modref vspec),rest) | _-> - match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> - let ucref = mkUnionCaseRef (modref.NestedTyconRef 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,showDeprecated),rest) - | _ -> match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> - - // Something in a type? + // Something in a discriminated union without RequireQualifiedAccess attribute? + let unionSearch,hasRequireQualifiedAccessAttribute = + match TryFindTypeWithUnionCase modref id with + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText + let ucinfo = FreshenUnionCaseRef ncenv m ucref + let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + success [resInfo,Item.UnionCase(ucinfo,hasRequireQualifiedAccessAttribute),rest],hasRequireQualifiedAccessAttribute + | _ -> NoResultsOrUsefulErrors,false + + match unionSearch with + | Result (res :: _) when not hasRequireQualifiedAccessAttribute -> success res + | _ -> + + // Something in a type? let tyconSearch = let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, (if isNil rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), modref) let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) if not (isNil rest) then let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs,TypeNameResolutionStaticArgsInfo.Indefinite), PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) - ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Expr (depth+1) m ad rest typeNameResInfo id.idRange tcrefs + ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Expr (depth+1) m ad rest typeNameResInfo id.idRange tcrefs // Check if we've got some explicit type arguments else let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) @@ -2012,7 +2017,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN match tyconSearch with | Result (res :: _) -> success res - | _ -> + | _ -> // Something in a sub-namespace or sub-module let moduleSearch = @@ -2027,7 +2032,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN else NoResultsOrUsefulErrors - match tyconSearch +++ moduleSearch with + match tyconSearch +++ moduleSearch +++ unionSearch with | Result [] -> let predictedPossibleTypes = modref.ModuleOrNamespaceType.AllEntities diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion.fs new file mode 100644 index 00000000000..45222ba64f3 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion.fs @@ -0,0 +1,11 @@ +// #Conformance #TypeInference #Attributes +// Verify the RequireQualifiedAccess attribute works on unions + +module A = + [] + type U = | C + + type C() = + static member M() = () + +let x = A.C.M() \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs new file mode 100644 index 00000000000..6ee304d50c0 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion2.fs @@ -0,0 +1,19 @@ +// #Conformance #TypeInference #Attributes + +module Module = + type R = { a: int } with static member New = { a = 1 } + type Choice = | R of R +open Module + +let record1 = R.New +let choice1 v = + match v with + | R r -> r + +let newChoice = R { a = 1} + +let choice2 v = + match v with + | Module.R r -> r + +let newChoice2 = Module.R { a = 1} \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs new file mode 100644 index 00000000000..2fb35c7087f --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA.fs @@ -0,0 +1,10 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions without RQA + +module A = + type U = | C + + type C() = + static member M() = () + +let x:A.U = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs new file mode 100644 index 00000000000..d26a6024967 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnRecordVsUnion_NoRQA2.fs @@ -0,0 +1,10 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions without RQA + +module A = + type U = | C + + type C() = + static member M() = () + +let x = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName.fs new file mode 100644 index 00000000000..eee2b7cdb5c --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName.fs @@ -0,0 +1,9 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions where type name is case name + +module A = + type C = + | B + | C + +let x = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName2.fs b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName2.fs new file mode 100644 index 00000000000..7148ad9bea2 --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/OnUnionWithCaseOfSameName2.fs @@ -0,0 +1,10 @@ +// #Conformance #TypeInference #Attributes +// Verify the access works on unions where type name is case name + +module A = + [] + type C = + | B + | C + +let x = A.C \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst index 53cdac9eb37..dadbaeb4e55 100644 --- a/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst +++ b/tests/fsharpqa/Source/Conformance/InferenceProcedures/NameResolution/RequireQualifiedAccess/env.lst @@ -1,5 +1,12 @@ SOURCE=OnRecord.fs # OnRecord.fs SOURCE=E_OnRecord.fs # E_OnRecord.fs + SOURCE=OnRecordVsUnion.fs # OnRecordVsUnion.fs + SOURCE=OnRecordVsUnion2.fs # OnRecordVsUnion2.fs SOURCE=OnDiscriminatedUnion.fs # OnDiscriminatedUnion.fs SOURCE=E_OnDiscriminatedUnion.fs # E_OnDiscriminatedUnion.fs + + SOURCE=OnRecordVsUnion_NoRQA.fs # OnRecordVsUnion_NoRQA.fs + SOURCE=OnRecordVsUnion_NoRQA2.fs # OnRecordVsUnion_NoRQA2.fs + SOURCE=OnUnionWithCaseOfSameName.fs # OnUnionWithCaseOfSameName.fs + SOURCE=OnUnionWithCaseOfSameName2.fs # OnUnionWithCaseOfSameName2.fs \ No newline at end of file