From 24ef67194b4fa3366e2e87fc77a76c068ce78889 Mon Sep 17 00:00:00 2001
From: Vlad Zarytovskii <vzaritovsky@hotmail.com>
Date: Tue, 7 Nov 2023 13:37:44 +0100
Subject: [PATCH] Ad-hoc fix for `ref readonly` parameters (#16232)

* Test should fail

* Threat ref readonly as inref

* Fixed condition in test
---
 src/Compiler/Checking/TypeHierarchy.fs        | 10 +++-
 src/Compiler/TypedTree/TcGlobals.fs           |  1 +
 .../FSharp.Compiler.ComponentTests.fsproj     | 11 ++--
 .../Interop/ByrefTests.fs                     | 56 +++++++++++++++++++
 4 files changed, 70 insertions(+), 8 deletions(-)
 create mode 100644 tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs

diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs
index f6949c707d8..a778b516d99 100644
--- a/src/Compiler/Checking/TypeHierarchy.fs
+++ b/src/Compiler/Checking/TypeHierarchy.fs
@@ -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
@@ -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
-
diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs
index 01bd1a1283c..301096d092c 100755
--- a/src/Compiler/TypedTree/TcGlobals.fs
+++ b/src/Compiler/TypedTree/TcGlobals.fs
@@ -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.
diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
index 99fbfe55d88..50d81f50ee7 100644
--- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
+++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
@@ -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" />
@@ -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" />
@@ -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" />
@@ -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" />
@@ -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" />
@@ -324,5 +325,5 @@
   <ItemGroup Condition="'$(FSHARPCORE_USE_PACKAGE)' == 'true'">
     <PackageReference Include="FSharp.Core" Version="$(FSharpCoreShippedPackageVersionValue)" />
   </ItemGroup>
-	
+
 </Project>
diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs
new file mode 100644
index 00000000000..dca7589c903
--- /dev/null
+++ b/tests/FSharp.Compiler.ComponentTests/Interop/ByrefTests.fs
@@ -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
\ No newline at end of file