Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix #557 - public type implements an internal interface that uses an internal type #1920

Merged
merged 4 commits into from
Dec 20, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions src/fsharp/TastOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -1431,6 +1431,7 @@ val DetectAndOptimizeForExpression : TcGlobals -> OptimizeForExpressionOptions -

val TryEliminateDesugaredConstants : TcGlobals -> range -> Const -> Expr option

val MemberIsExplicitImpl : TcGlobals -> ValMemberInfo -> bool
val ValIsExplicitImpl : TcGlobals -> Val -> bool
val ValRefIsExplicitImpl : TcGlobals -> ValRef -> bool

Expand Down
51 changes: 31 additions & 20 deletions src/fsharp/TypeChecker.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1305,7 +1305,7 @@ let CombineVisibilityAttribs vis1 vis2 m =
errorR(Error(FSComp.SR.tcMultipleVisibilityAttributes(),m))
if Option.isSome vis1 then vis1 else vis2

let ComputeAccessAndCompPath env declKindOpt m vis actualParent =
let ComputeAccessAndCompPath env declKindOpt m vis overrideVis actualParent =
let accessPath = env.eAccessPath
let accessModPermitted =
match declKindOpt with
Expand All @@ -1315,11 +1315,12 @@ let ComputeAccessAndCompPath env declKindOpt m vis actualParent =
if Option.isSome vis && not accessModPermitted then
errorR(Error(FSComp.SR.tcMultipleVisibilityAttributesWithLet(),m))
let vis =
match vis with
| None -> taccessPublic (* a module or member binding defaults to "public" *)
| Some SynAccess.Public -> taccessPublic
| Some SynAccess.Private -> taccessPrivate accessPath
| Some SynAccess.Internal -> taccessInternal
match overrideVis, vis with
| Some v,_ -> v
| _, None -> taccessPublic (* a module or member binding defaults to "public" *)
| _, Some SynAccess.Public -> taccessPublic
| _, Some SynAccess.Private -> taccessPrivate accessPath
| _, Some SynAccess.Internal -> taccessInternal

let vis =
match actualParent with
Expand Down Expand Up @@ -1358,18 +1359,28 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i
| _ -> false

let isExtrinsic = (declKind=ExtrinsicExtensionBinding)
let actualParent =
let actualParent, overrideVis =
// Use the parent of the member if it's available
// If it's an extrinsic extension member or not a member then use the containing module.
match memberInfoOpt with
| Some (ValMemberInfoTransient(memberInfo,_,_)) when not isExtrinsic ->
if memberInfo.ApparentParent.IsModuleOrNamespace then
errorR(InternalError(FSComp.SR.tcExpectModuleOrNamespaceParent(id.idText),m))

Parent(memberInfo.ApparentParent)
| _ -> altActualParent

let vis,_ = ComputeAccessAndCompPath env (Some declKind) id.idRange vis actualParent
// Members of interface implementations have the accessibility of the interface
// they are implementing.
let vis =
if Tastops.MemberIsExplicitImpl cenv.g memberInfo then
let slotSig = List.head memberInfo.ImplementedSlotSigs
match slotSig.ImplementedType with
| TType_app (tyconref,_) -> Some tyconref.Accessibility
| _ -> None
else
None
Parent(memberInfo.ApparentParent), vis
| _ -> altActualParent, None

let vis,_ = ComputeAccessAndCompPath env (Some declKind) id.idRange vis overrideVis actualParent

let inlineFlag =
if HasFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute attrs then
Expand Down Expand Up @@ -11571,7 +11582,7 @@ module TcRecdUnionAndEnumDeclarations = begin
| Parent tcref -> combineAccess vis tcref.TypeReprAccessibility

let MakeRecdFieldSpec _cenv env parent (isStatic,konst,ty',attrsForProperty,attrsForField,id,isMutable,vol,xmldoc,vis,m) =
let vis,_ = ComputeAccessAndCompPath env None m vis parent
let vis,_ = ComputeAccessAndCompPath env None m vis None parent
let vis = CombineReprAccess parent vis
NewRecdField isStatic konst id ty' isMutable vol attrsForProperty attrsForField xmldoc vis false

Expand Down Expand Up @@ -11649,7 +11660,7 @@ module TcRecdUnionAndEnumDeclarations = begin

let TcUnionCaseDecl cenv env parent thisTy tpenv (UnionCase (synAttrs,id,args,xmldoc,vis,m)) =
let attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs // the attributes of a union case decl get attached to the generated "static factory" method
let vis,_ = ComputeAccessAndCompPath env None m vis parent
let vis,_ = ComputeAccessAndCompPath env None m vis None parent
let vis = CombineReprAccess parent vis
let realUnionCaseName =
if id.idText = opNameCons then "Cons"
Expand Down Expand Up @@ -11699,7 +11710,7 @@ module TcRecdUnionAndEnumDeclarations = begin
| SynConst.UserNum _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(),m))
| _ ->
let v = TcConst cenv fieldTy m env v
let vis,_ = ComputeAccessAndCompPath env None m None parent
let vis,_ = ComputeAccessAndCompPath env None m None None parent
let vis = CombineReprAccess parent vis
if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(),id.idRange))
NewRecdField true (Some v) id thisTy false false [] attrs (xmldoc.ToXmlDoc()) vis false
Expand Down Expand Up @@ -13957,7 +13968,7 @@ module TcExceptionDeclarations =
let TcExnDefnCore_Phase1A cenv env parent (SynExceptionDefnRepr(synAttrs,UnionCase(_,id,_,_,_,_),_,doc,vis,m)) =
let attrs = TcAttributes cenv env AttributeTargets.ExnDecl synAttrs
if not (String.isUpper id.idText) then errorR(NotUpperCaseConstructor(m))
let vis,cpath = ComputeAccessAndCompPath env None m vis parent
let vis,cpath = ComputeAccessAndCompPath env None m vis None parent
let vis = TcRecdUnionAndEnumDeclarations.CombineReprAccess parent vis
CheckForDuplicateConcreteType env (id.idText + "Exception") id.idRange
CheckForDuplicateConcreteType env id.idText id.idRange
Expand Down Expand Up @@ -14199,7 +14210,7 @@ module EstablishTypeDefinitionCores =
let modKind = ComputeModuleOrNamespaceKind cenv.g true typeNames modAttrs id.idText
let modName = AdjustModuleName modKind id.idText

let vis,_ = ComputeAccessAndCompPath envInitial None id.idRange vis parent
let vis,_ = ComputeAccessAndCompPath envInitial None id.idRange vis None parent

CheckForDuplicateModule envInitial id.idText id.idRange
let id = ident (modName, id.idRange)
Expand Down Expand Up @@ -14228,7 +14239,7 @@ module EstablishTypeDefinitionCores =

// Augmentations of type definitions are allowed within the same file as long as no new type representation or abbreviation is given
CheckForDuplicateConcreteType env id.idText id.idRange
let vis,cpath = ComputeAccessAndCompPath env None id.idRange synVis parent
let vis,cpath = ComputeAccessAndCompPath env None id.idRange synVis None parent

// Establish the visibility of the representation, e.g.
// type R =
Expand All @@ -14245,7 +14256,7 @@ module EstablishTypeDefinitionCores =
| SynTypeDefnSimpleRepr.Enum _ -> None
| SynTypeDefnSimpleRepr.Exception _ -> None

let visOfRepr,_ = ComputeAccessAndCompPath env None id.idRange synVisOfRepr parent
let visOfRepr,_ = ComputeAccessAndCompPath env None id.idRange synVisOfRepr None parent
let visOfRepr = combineAccess vis visOfRepr
// If we supported nested types and modules then additions would be needed here
let lmtyp = notlazy (NewEmptyModuleOrNamespaceType ModuleOrType)
Expand Down Expand Up @@ -15951,7 +15962,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS
return! TcSignatureElementsMutRec cenv parent endm None env [modDecl]
else
let id = ComputeModuleName longPath
let vis,_ = ComputeAccessAndCompPath env None im vis parent
let vis,_ = ComputeAccessAndCompPath env None im vis None parent
let attribs = TcAttributes cenv env AttributeTargets.ModuleDecl attribs
CheckNamespaceModuleOrTypeName cenv.g id
let modKind = EstablishTypeDefinitionCores.ComputeModuleOrNamespaceKind cenv.g true typeNames attribs id.idText
Expand Down Expand Up @@ -16270,7 +16281,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem
let modName = EstablishTypeDefinitionCores.AdjustModuleName modKind id.idText
CheckForDuplicateConcreteType env modName im
CheckForDuplicateModule env id.idText id.idRange
let vis,_ = ComputeAccessAndCompPath env None id.idRange vis parent
let vis,_ = ComputeAccessAndCompPath env None id.idRange vis None parent

let endm = m.EndRange
let id = ident (modName, id.idRange)
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,84 @@

module Definitions =
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

should this be module internal?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That could be an additional test, but for the purpose of this fix I was trying to make things as clear as possible by keeping everything public except the interfaces/types themselves.


type private PrivateArg() = class end

type internal InternalArg() = class end

type PublicArg() = class end

type private IPrivateInterface =
abstract A : PublicArg -> InternalArg
abstract B : PublicArg -> PrivateArg
abstract C : InternalArg -> PrivateArg

type internal IInternalInterface =
abstract A : PublicArg -> InternalArg

type IPublicInterface =
abstract A : PublicArg -> PublicArg

// class accessibility should have no bearing on
// being able to implement any of these; as long
// as all the types are accessible at the implementation
// location the compiler need not complain.

// this already worked in F# 4.0
type private PrivateClass() =
interface IPrivateInterface with
member __.A _ = InternalArg()
member __.B _ = PrivateArg()
member __.C _ = PrivateArg()
interface IInternalInterface with
member __.A _ = InternalArg()
interface IPublicInterface with
member __.A _ = PublicArg()

// these two did no work in F# 4.0.
type internal InternalClass() =
interface IPrivateInterface with
member __.A _ = InternalArg()
member __.B _ = PrivateArg()
member __.C _ = PrivateArg()
interface IInternalInterface with
member __.A _ = InternalArg()
interface IPublicInterface with
member __.A _ = PublicArg()

type public PublicClass() =
interface IPrivateInterface with
member __.A _ = InternalArg()
member __.B _ = PrivateArg()
member __.C _ = PrivateArg()
interface IInternalInterface with
member __.A _ = InternalArg()
interface IPublicInterface with
member __.A _ = PublicArg()

let private privateValue = PrivateClass()
let private privateValueAsPrivateInterface = privateValue :> IPrivateInterface
let internal privateValueAsInternalInterface = privateValue :> IInternalInterface
let privateValueAsPublicInterface = privateValue :> IPublicInterface

let internal internalValue = InternalClass()
let private internalValueAsPrivateInterface = internalValue :> IPrivateInterface
let internal internalValueAsInternalInterface = internalValue :> IInternalInterface
let internalValueAsPublicInterface = internalValue :> IPublicInterface

let publicValue = PublicClass()
let private publicValueAsPrivateInterface = publicValue :> IPrivateInterface
let internal publicValueAsInternalInterface = publicValue :> IInternalInterface
let publicValueAsPublicInterface = publicValue :> IPublicInterface

module OtherModule =
open Definitions

// internal and public is all you can see here; private interface are not visible.

let internal internalValue = InternalClass()
let internal internalValueAsInternalInterface = internalValue :> IInternalInterface
let internalValueAsPublicInterface = internalValue :> IPublicInterface

let publicValue = PublicClass()
let internal publicValueAsInternalInterface = publicValue :> IInternalInterface
let publicValueAsPublicInterface = publicValue :> IPublicInterface
Original file line number Diff line number Diff line change
Expand Up @@ -19,4 +19,7 @@
SOURCE=E_ProtectedThingsInaccessible01.fs SCFLAGS="--test:ErrorRanges" # E_ProtectedThingsInaccessible01.fs

SOURCE=E_MoreAccessibleBaseClass01.fs # E_MoreAccessibleBaseClass01.fs
SOURCE=E_MoreAccessibleBaseClass02.fs # E_MoreAccessibleBaseClass02.fs
SOURCE=E_MoreAccessibleBaseClass02.fs # E_MoreAccessibleBaseClass02.fs

SOURCE=InterfaceImplementationVisibility.fs # InterfaceImplementationVisibility.fs

Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
SOURCE=GenericMethodsOnInterface01.fs # GenericMethodsOnInterface01.fs
SOURCE=GenericMethodsOnInterface02.fs # GenericMethodsOnInterface02.fs
SOURCE=ConcreteUnitOnInterface01.fs # ConcreteUnitOnInterface01.fs
SOURCE=ConcreteUnitOnInterface01.fs # ConcreteUnitOnInterface01.fs