Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
24 commits
Select commit Hold shift + click to select a range
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 docs/release-notes/.FSharp.Compiler.Service/9.0.300.md
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@
* Fix duplicate parse error reporting for GetBackgroundCheckResultsForFileInProject ([Issue #18379](https://github.com/dotnet/fsharp/issues/18379) [PR #18380](https://github.com/dotnet/fsharp/pull/18380))
* Fix MethodDefNotFound when compiling code invoking delegate with option parameter ([Issue #5171](https://github.com/dotnet/fsharp/issues/5171), [PR #18385](https://github.com/dotnet/fsharp/pull/18385))
* Fix #r nuget ..." downloads unneeded packages ([Issue #18231](https://github.com/dotnet/fsharp/issues/18231), [PR #18393](https://github.com/dotnet/fsharp/pull/18393))
* Skip accessibility checks for compiler-generated pattern inputs when used within the same module scope. ([Issue #4161](https://github.com/dotnet/fsharp/issues/4161), [PR #18426](https://github.com/dotnet/fsharp/pull/18426))
* Reenable β-reduction and subsequent reoptimization of immediately-invoked F#-defined generic delegates. ([PR #18401](https://github.com/dotnet/fsharp/pull/18401))
* Fixed [#18433](https://github.com/dotnet/fsharp/issues/18433), a rare case of an internal error in xml comment processing. ([PR #18436](https://github.com/dotnet/fsharp/pull/18436))

Expand Down
13 changes: 7 additions & 6 deletions src/Compiler/Checking/PostInferenceChecks.fs
Original file line number Diff line number Diff line change
Expand Up @@ -521,7 +521,7 @@ let AccessInternalsVisibleToAsInternal thisCompPath internalsVisibleToPaths acce
accessSubstPaths (thisCompPath, internalsVisibleToPath) access)


let CheckTypeForAccess (cenv: cenv) env objName valAcc m ty =
let CheckTypeForAccess (cenv: cenv) env objName valAcc accessedValIsCompilerGenerated m ty =
if cenv.reportErrors then

let visitType ty =
Expand All @@ -532,8 +532,9 @@ let CheckTypeForAccess (cenv: cenv) env objName valAcc m ty =
| ValueSome tcref ->
let thisCompPath = compPathOfCcu cenv.viewCcu
let tyconAcc = tcref.Accessibility |> AccessInternalsVisibleToAsInternal thisCompPath cenv.internalsVisibleToPaths
if isLessAccessible tyconAcc valAcc then
errorR(Error(FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, (objName())), m))
// Skip accessibility checks for compiler-generated pattern inputs
if not accessedValIsCompilerGenerated && isLessAccessible tyconAcc valAcc then
errorR(Error(FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, objName()), m))

CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty

Expand Down Expand Up @@ -2058,7 +2059,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin
// Check accessibility
if (v.IsMemberOrModuleBinding || v.IsMember) && not v.IsIncrClassGeneratedMember then
let access = AdjustAccess (IsHiddenVal env.sigToImplRemapInfo v) (fun () -> v.DeclaringEntity.CompilationPath) v.Accessibility
CheckTypeForAccess cenv env (fun () -> NicePrint.stringOfQualifiedValOrMember cenv.denv cenv.infoReader vref) access v.Range v.Type
CheckTypeForAccess cenv env (fun () -> NicePrint.stringOfQualifiedValOrMember cenv.denv cenv.infoReader vref) access vref.IsCompilerGenerated v.Range v.Type

if cenv.reportErrors then

Expand Down Expand Up @@ -2283,7 +2284,7 @@ let CheckRecdField isUnion cenv env (tycon: Tycon) (rfield: RecdField) =
IsHiddenTyconRepr env.sigToImplRemapInfo tycon ||
(not isUnion && IsHiddenRecdField env.sigToImplRemapInfo (tcref.MakeNestedRecdFieldRef rfield))
let access = AdjustAccess isHidden (fun () -> tycon.CompilationPath) rfield.Accessibility
CheckTypeForAccess cenv env (fun () -> rfield.LogicalName) access m fieldTy
CheckTypeForAccess cenv env (fun () -> rfield.LogicalName) access false m fieldTy

if isByrefLikeTyconRef g m tcref then
// Permit Span fields in IsByRefLike types
Expand Down Expand Up @@ -2551,7 +2552,7 @@ let CheckEntityDefn cenv env (tycon: Entity) =

// Access checks
let access = AdjustAccess (IsHiddenTycon env.sigToImplRemapInfo tycon) (fun () -> tycon.CompilationPath) tycon.Accessibility
let visitType ty = CheckTypeForAccess cenv env (fun () -> tycon.DisplayNameWithStaticParametersAndUnderscoreTypars) access tycon.Range ty
let visitType ty = CheckTypeForAccess cenv env (fun () -> tycon.DisplayNameWithStaticParametersAndUnderscoreTypars) access false tycon.Range ty

abstractSlotValsOfTycons [tycon] |> List.iter (typeOfVal >> visitType)

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,38 @@ module Tuple =
|> typecheck
|> shouldSucceed

[<Theory; Directory(__SOURCE_DIRECTORY__, Includes = [|"tuples02.fs"|])>]
let ``Tuple - tuples02_fs - --test:ErrorRanges`` compilation =
compilation
|> asFs
|> withOptions ["--test:ErrorRanges"]
|> compileExeAndRun
|> shouldSucceed

[<Theory; Directory(__SOURCE_DIRECTORY__, Includes = [|"tuples03.fs"|])>]
let ``Tuple - tuples03_fs - --test:ErrorRanges`` compilation =
compilation
|> asFs
|> withOptions ["--test:ErrorRanges"]
|> typecheck
|> shouldFail
|> withDiagnostics [
Error 410, Line 6, Col 12, Line 6, Col 14, "The type 'T' is less accessible than the value, member or type 'val t': T' it is used in."
Error 410, Line 6, Col 9, Line 6, Col 10, "The type 'T' is less accessible than the value, member or type 'val t: T' it is used in."
]

[<Theory; Directory(__SOURCE_DIRECTORY__, Includes = [|"tuples04.fs"|])>]
let ``Tuple - tuples04_fs - --test:ErrorRanges`` compilation =
compilation
|> asFs
|> withOptions ["--test:ErrorRanges"]
|> typecheck
|> shouldFail
|> withDiagnostics [
Error 410, Line 6, Col 12, Line 6, Col 14, "The type 'T' is less accessible than the value, member or type 'val internal t': T' it is used in."
Error 410, Line 6, Col 9, Line 6, Col 10, "The type 'T' is less accessible than the value, member or type 'val internal t: T' it is used in."
]

// This test was automatically generated (moved from FSharpQA suite - Conformance/PatternMatching/Tuple)
[<Theory; Directory(__SOURCE_DIRECTORY__, Includes = [|"W_IncompleteMatches01.fs"|])>]
let ``Tuple - W_IncompleteMatches01_fs - --test:ErrorRanges`` compilation =
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
module PM =
type PT =
abstract A : int
let a = { new PT with member __.A = 1 }
let b, c =
{ new PT with member __.A = 1 }
, { new PT with member __.A = 1 }

module private PM2 =
type PT =
abstract A : int
let a = { new PT with member __.A = 1 }
let b, c =
{ new PT with member __.A = 1 }
, { new PT with member __.A = 1 }
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
namespace N

type internal T = T

module public M =
let t, t' = T, T
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
namespace N

type private T = T

module internal M =
let t, t' = T, T