diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md index 8893e4d237d..4685dbfe8ce 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.300.md @@ -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)) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index d22f50cdc2f..719f23b944c 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -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 = @@ -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 @@ -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 @@ -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 @@ -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) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/Tuple.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/Tuple.fs index d7286f04e3b..79ad5cfbd95 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/Tuple.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/Tuple.fs @@ -25,6 +25,38 @@ module Tuple = |> typecheck |> shouldSucceed + [] + let ``Tuple - tuples02_fs - --test:ErrorRanges`` compilation = + compilation + |> asFs + |> withOptions ["--test:ErrorRanges"] + |> compileExeAndRun + |> shouldSucceed + + [] + 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." + ] + + [] + 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) [] let ``Tuple - W_IncompleteMatches01_fs - --test:ErrorRanges`` compilation = diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples02.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples02.fs new file mode 100644 index 00000000000..751f57bb97d --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples02.fs @@ -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 } \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples03.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples03.fs new file mode 100644 index 00000000000..402101fbc18 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples03.fs @@ -0,0 +1,6 @@ +namespace N + +type internal T = T + +module public M = + let t, t' = T, T diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples04.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples04.fs new file mode 100644 index 00000000000..d01d6b98592 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/PatternMatching/Tuple/tuples04.fs @@ -0,0 +1,6 @@ +namespace N + +type private T = T + +module internal M = + let t, t' = T, T