Skip to content

Commit

Permalink
Ad-hoc fix for ref readonly parameters (#16232)
Browse files Browse the repository at this point in the history
* Test should fail

* Threat ref readonly as inref

* Fixed condition in test
  • Loading branch information
vzarytovskii authored Nov 7, 2023
1 parent c2031c2 commit 24ef671
Show file tree
Hide file tree
Showing 4 changed files with 70 additions and 8 deletions.
10 changes: 7 additions & 3 deletions src/Compiler/Checking/TypeHierarchy.fs
Original file line number Diff line number Diff line change
Expand Up @@ -355,8 +355,13 @@ let ImportILTypeFromMetadata amap m scoref tinst minst ilTy =
/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type.
let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilTy getCattrs =
let ty = RescopeAndImportILType scoref amap m (tinst@minst) ilTy
// If the type is a byref and one of attributes from a return or parameter has IsReadOnly, then it's a inref.
if isByrefTy amap.g ty && TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ()) then
// If the type is a byref and one of attributes from a return or parameter has
// - a `IsReadOnlyAttribute` - it's an inref
// - a `RequiresLocationAttribute` (in which case it's a `ref readonly`) which we treat as inref,
// latter is an ad-hoc fix for https://github.com/dotnet/runtime/issues/94317.
if isByrefTy amap.g ty
&& (TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ())
|| TryFindILAttribute amap.g.attrib_RequiresLocationAttribute (getCattrs ())) then
mkInByrefTy amap.g (destByrefTy amap.g ty)
else
ty
Expand Down Expand Up @@ -428,4 +433,3 @@ let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsori
let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming
(tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig))
renaming, tptys

1 change: 1 addition & 0 deletions src/Compiler/TypedTree/TcGlobals.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1423,6 +1423,7 @@ type TcGlobals(
member val attrib_ParamArrayAttribute = findSysAttrib "System.ParamArrayAttribute"
member val attrib_IDispatchConstantAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute"
member val attrib_IUnknownConstantAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute"
member val attrib_RequiresLocationAttribute = findSysAttrib "System.Runtime.CompilerServices.RequiresLocationAttribute"

// We use 'findSysAttrib' here because lookup on attribute is done by name comparison, and can proceed
// even if the type is not found in a system assembly.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@
<ItemGroup>
<Compile Include="..\service\FsUnit.fs">
<Link>FsUnit.fs</Link>
</Compile>
</Compile>
<Compile Include="Conformance\BasicGrammarElements\AccessibilityAnnotations\Basic\Basic.fs" />
<Compile Include="Conformance\BasicGrammarElements\AccessibilityAnnotations\OnOverridesAndIFaceImpl\OnOverridesAndIFaceImpl.fs" />
<Compile Include="Conformance\BasicGrammarElements\AccessibilityAnnotations\OnTypeMembers\OnTypeMembers.fs" />
Expand Down Expand Up @@ -112,7 +112,7 @@
<Compile Include="Conformance\Types\RecordTypes\AnonymousRecords.fs" />
<Compile Include="Conformance\Types\RecordTypes\RecordTypes.fs" />
<Compile Include="Conformance\Types\StructTypes\StructTypes.fs" />
<Compile Include="Conformance\Types\StructTypes\StructActivePatterns.fs" />
<Compile Include="Conformance\Types\StructTypes\StructActivePatterns.fs" />
<Compile Include="Conformance\Types\TypeConstraints\CheckingSyntacticTypes\CheckingSyntacticTypes.fs" />
<Compile Include="Conformance\Types\TypeConstraints\LogicalPropertiesOfTypes\LogicalPropertiesOfTypes.fs" />
<Compile Include="Conformance\Types\TypeConstraints\IWSAMsAndSRTPs\IWSAMsAndSRTPsTests.fs" />
Expand Down Expand Up @@ -176,7 +176,7 @@
<Compile Include="ErrorMessages\DontSuggestTests.fs" />
<Compile Include="ErrorMessages\ElseBranchHasWrongTypeTests.fs" />
<Compile Include="ErrorMessages\InvalidLiteralTests.fs" />
<Compile Include="ErrorMessages\InvalidNumericLiteralTests.fs" />
<Compile Include="ErrorMessages\InvalidNumericLiteralTests.fs" />
<Compile Include="ErrorMessages\MissingElseBranch.fs" />
<Compile Include="ErrorMessages\MissingExpressionTests.fs" />
<Compile Include="ErrorMessages\ModuleTests.fs" />
Expand All @@ -192,7 +192,7 @@
<Compile Include="ErrorMessages\Repro1548.fs" />
<Compile Include="ErrorMessages\WarnIfDiscardedInList.fs" />
<Compile Include="ErrorMessages\UnionCasePatternMatchingErrors.fs" />
<Compile Include="ErrorMessages\InterfaceImplInAugmentationsTests.fs" />
<Compile Include="ErrorMessages\InterfaceImplInAugmentationsTests.fs" />
<Compile Include="ErrorMessages\ExtendedDiagnosticDataTests.fs" />
<Compile Include="Language\IndexerSetterParamArray.fs" />
<Compile Include="Language\MultiDimensionalArrayTests.fs" />
Expand Down Expand Up @@ -226,6 +226,7 @@
<Compile Include="Interop\RequiredAndInitOnlyProperties.fs" />
<Compile Include="Interop\StaticsInInterfaces.fs" />
<Compile Include="Interop\VisibilityTests.fs" />
<Compile Include="Interop\ByrefTests.fs" />
<Compile Include="Scripting\Interactive.fs" />
<Compile Include="TypeChecks\SeqTypeCheckTests.fs" />
<Compile Include="TypeChecks\CheckDeclarationsTests.fs" />
Expand Down Expand Up @@ -324,5 +325,5 @@
<ItemGroup Condition="'$(FSHARPCORE_USE_PACKAGE)' == 'true'">
<PackageReference Include="FSharp.Core" Version="$(FSharpCoreShippedPackageVersionValue)" />
</ItemGroup>

</Project>
56 changes: 56 additions & 0 deletions tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,56 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

namespace Interop

open FSharp.Test
open FSharp.Test.Compiler

module ``Byref interop verification tests`` =

[<FactForNETCOREAPP>]
let ``Test that ref readonly is treated as inref`` () =

FSharp """
module ByrefTest
open System.Runtime.CompilerServices
type MyRecord = { Value : int } with
member this.SetValue(v: int) = (Unsafe.AsRef<int> &this.Value) <- v
let check mr =
if mr.Value <> 1 then
failwith "Value should be 1"
mr.SetValue(42)
if mr.Value <> 42 then
failwith $"Value should be 42, but is {mr.Value}"
0
[<EntryPoint>]
let main _ =
let mr = { Value = 1 }
check mr
"""
|> asExe
|> compileAndRun
|> shouldSucceed

[<FactForNETCOREAPP>]
let ``Test that ref readonly is treated as inref for ROS .ctor`` () =
FSharp """
module Foo
open System
[<EntryPoint>]
let main _ =
let mutable bt: int = 42
let ros = ReadOnlySpan<int>(&bt)
if ros.Length <> 1 || ros[0] <> 42 then
failwith "Unexpected result"
0
"""
|> asExe
|> compileAndRun
|> shouldSucceed

0 comments on commit 24ef671

Please sign in to comment.