diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index da89cec27a2..4207e092109 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -1,4 +1,6 @@ ### Fixed +* Fix outref parameter compiled as byref. (Issue [#13468](https://github.com/dotnet/fsharp/issues/13468), [PR #19340](https://github.com/dotnet/fsharp/pull/19340)) +* Fix static abstract interface members with byref params. (Issue [#18135](https://github.com/dotnet/fsharp/issues/18135), [PR #19340](https://github.com/dotnet/fsharp/pull/19340)) ### Added diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 40254a11965..388072f0c16 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -446,16 +446,24 @@ type MethodDefKey(ilg:ILGlobals, tidx: int, garity: int, nm: string, retTy: ILTy override _.Equals(obj: obj) = match obj with | :? MethodDefKey as y -> - let compareILTypes o1 o2 = + let rec compareILTypes o1 o2 = match o1, o2 with - | ILType.Value v1, ILType.Value v2 -> v1.EqualsWithPrimaryScopeRef(ilg.primaryAssemblyScopeRef, v2 :> obj ) + | ILType.Value v1, ILType.Value v2 -> v1.EqualsWithPrimaryScopeRef(ilg.primaryAssemblyScopeRef, v2 :> obj) + | ILType.Boxed v1, ILType.Boxed v2 -> v1.EqualsWithPrimaryScopeRef(ilg.primaryAssemblyScopeRef, v2 :> obj) + | ILType.Byref t1, ILType.Byref t2 -> compareILTypes t1 t2 + | ILType.Ptr t1, ILType.Ptr t2 -> compareILTypes t1 t2 + | ILType.Array(sh1, t1), ILType.Array(sh2, t2) -> sh1 = sh2 && compareILTypes t1 t2 + | ILType.Modified(req1, tref1, t1), ILType.Modified(req2, tref2, t2) -> + req1 = req2 + && tref1.EqualsWithPrimaryScopeRef(ilg.primaryAssemblyScopeRef, tref2 :> obj) + && compareILTypes t1 t2 | _ -> o1 = o2 tidx = y.TypeIdx && garity = y.GenericArity && nm = y.Name && - // note: these next two use structural equality on AbstractIL ILType values - retTy = y.ReturnType && List.lengthsEqAndForall2 compareILTypes argTys y.ArgTypes && + // note: these next two use scope-aware equality on AbstractIL ILType values + compareILTypes retTy y.ReturnType && List.lengthsEqAndForall2 compareILTypes argTys y.ArgTypes && isStatic = y.IsStatic | _ -> false diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 290bba23e4d..24df3fae425 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -605,6 +605,10 @@ let voidCheck m g permits ty = [] type DuFieldCoordinates = { CaseIdx: int; FieldIdx: int } +/// Flags propagated from interface slot signatures to parameter metadata. +[] +type SlotParamFlags = { IsIn: bool; IsOut: bool } + /// Structure for maintaining field reuse across struct unions type UnionFieldReuseMap = MultiMap @@ -1496,7 +1500,12 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = mspec, mspecW, ctps, mtps, curriedArgInfos, paramInfos, retInfo, witnessInfos, methodArgTys, returnTy else let methodArgTys, paramInfos = List.unzip flatArgInfos - let ilMethodArgTys = GenParamTypes cenv m tyenvUnderTypars false methodArgTys + + let isSlotSig = + memberInfo.MemberFlags.IsDispatchSlot + || memberInfo.MemberFlags.IsOverrideOrExplicitImpl + + let ilMethodArgTys = GenParamTypes cenv m tyenvUnderTypars isSlotSig methodArgTys let ilMethodInst = GenTypeArgs cenv m tyenvUnderTypars (List.map mkTyparTy mtps) let mspec = @@ -3498,7 +3507,6 @@ and GenLinearExpr cenv cgbuf eenv expr sequel preSteps (contf: FakeUnit -> FakeU if preSteps && GenExprPreSteps cenv cgbuf eenv expr sequel then contf Fake else - // This case implemented here to get a guaranteed tailcall // Make sure we generate the debug point outside the scope of the variable let startMark, endMark as scopeMarks = StartDelayedLocalScope "let" cgbuf @@ -8992,6 +9000,7 @@ and GenParams (argInfos: ArgReprInfo list) methArgTys (implValsOpt: Val list option) + (slotSigParamFlags: SlotParamFlags list option) = let g = cenv.g let ilWitnessParams = GenWitnessParams cenv eenv m witnessInfos @@ -9010,11 +9019,18 @@ and GenParams | _ -> List.map (fun x -> x, None) ilArgTysAndInfos let ilParams, _ = - (Set.empty, List.zip methArgTys ilArgTysAndInfoAndVals) - ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> + ((Set.empty, 0), List.zip methArgTys ilArgTysAndInfoAndVals) + ||> List.mapFold (fun (takenNames, paramIdx) (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> let inFlag, outFlag, optionalFlag, defaultParamValue, Marshal, attribs = GenParamAttribs cenv methodArgTy topArgInfo.Attribs + let inFlag, outFlag = + match slotSigParamFlags with + | Some flags when paramIdx < flags.Length -> + let slotFlags = flags[paramIdx] + (inFlag || slotFlags.IsIn, outFlag || slotFlags.IsOut) + | _ -> (inFlag, outFlag) + let idOpt = match topArgInfo.Name with | Some v -> Some v @@ -9053,7 +9069,7 @@ and GenParams MetadataIndex = NoMetadataIdx } - param, takenNames) + param, (takenNames, paramIdx + 1)) ilWitnessParams @ ilParams @@ -9406,8 +9422,18 @@ and GenMethodForBinding let ilTypars = GenGenericParams cenv eenvUnderMethLambdaTypars methLambdaTypars + let slotSigParamFlags = + match v.ImplementedSlotSigs with + | slotsig :: _ -> + let slotParams = slotsig.FormalParams |> List.concat + + slotParams + |> List.map (fun (TSlotParam(_, _, inFlag, outFlag, _, _)) -> { IsIn = inFlag; IsOut = outFlag }) + |> Some + | [] -> None + let ilParams = - GenParams cenv eenvUnderMethTypeTypars m mspec witnessInfos paramInfos argTys (Some nonUnitNonSelfMethodVars) + GenParams cenv eenvUnderMethTypeTypars m mspec witnessInfos paramInfos argTys (Some nonUnitNonSelfMethodVars) slotSigParamFlags let ilReturn = GenReturnInfo cenv eenvUnderMethTypeTypars (Some returnTy) mspec.FormalReturnType retInfo @@ -10737,7 +10763,7 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) = let ilReturn = GenReturnInfo cenv eenvForMeth returnTy mspec.FormalReturnType retInfo - let ilParams = GenParams cenv eenvForMeth m mspec [] argInfos methArgTys None + let ilParams = GenParams cenv eenvForMeth m mspec [] argInfos methArgTys None None let compileAsInstance = ValRefIsCompiledAsInstanceMember g vref diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Signatures.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Signatures.fs new file mode 100644 index 00000000000..f404e80efc6 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Signatures.fs @@ -0,0 +1,107 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace EmittedIL + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler +open FSharp.Test.Utilities + +module CodeGenRegressions_Signatures = + + let private getActualIL (result: CompilationResult) = + match result with + | CompilationResult.Success s -> + match s.OutputPath with + | Some p -> + let (_, _, actualIL) = ILChecker.verifyILAndReturnActual [] p [ "// dummy" ] + actualIL + | None -> failwith "No output path" + | _ -> failwith "Compilation failed" + + // https://github.com/dotnet/fsharp/issues/18135 + [] + let ``Issue_18135_StaticAbstractByrefParams`` () = + let source = """ +module Test + +#nowarn "3535" + +[] +type I = + static abstract Foo: int inref -> int + +type T = + interface I with + static member Foo i = i + +let f<'T when 'T :> I>() = + let x = 123 + printfn "%d" ('T.Foo &x) + +[] +let main _ = + f() + 0 +""" + FSharp source + |> asExe + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/13468 + [] + let ``Issue_13468_OutrefAsByref_IL`` () = + let csCode = "namespace CSharpLib { public interface IOutTest { void TryGet(string k, out int v); } }" + let csLib = CSharp csCode |> withName "CSharpLib" + let fsCode = "module Test\nopen CSharpLib\ntype MyImpl() =\n interface IOutTest with\n member this.TryGet(k, v) = v <- 42" + let actualIL = + FSharp fsCode + |> withReferences [csLib] + |> asLibrary + |> compile + |> shouldSucceed + |> getActualIL + Assert.Contains("[out]", actualIL) + + // https://github.com/dotnet/fsharp/issues/13468 + [] + let ``Issue_13468_OutrefAsByref_Runtime`` () = + let csCode = """ +namespace CSharpLib { + public interface IOutTest { bool TryGet(string k, out int v); } + public static class OutTestHelper { + public static string Run(IOutTest impl) { + int v; + bool ok = impl.TryGet("key", out v); + return ok ? v.ToString() : "fail"; + } + } +}""" + let csLib = CSharp csCode |> withName "CSharpLib" + let fsCode = """ +module Test +open CSharpLib +type MyImpl() = + interface IOutTest with + member this.TryGet(k, v) = v <- 42; true + +[] +let main _ = + let result = OutTestHelper.Run(MyImpl()) + if result <> "42" then failwithf "Expected 42, got %s" result + printfn "Success: %s" result + 0 +""" + FSharp fsCode + |> withReferences [csLib] + |> asExe + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 41848cbf2f0..f4502feb413 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -280,6 +280,7 @@ +