diff --git a/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md index ca425fb63c4..5452b8742c5 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md @@ -21,6 +21,9 @@ * Fix FS3356 false positive for instance extension members with same name on different types, introduced by [#18821](https://github.com/dotnet/fsharp/pull/18821). ([PR #19260](https://github.com/dotnet/fsharp/pull/19260)) * Fix graph-based type checking incorrectly resolving dependencies when the same module name is defined across multiple files in the same namespace. ([PR #19280](https://github.com/dotnet/fsharp/pull/19280)) * F# Scripts: Fix default reference paths resolving when an SDK directory is specified. ([PR #19270](https://github.com/dotnet/fsharp/pull/19270)) +* 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)) +* Use constrained.callvirt for method calls on value types. (Issue [#18140](https://github.com/dotnet/fsharp/issues/18140), [PR #19340](https://github.com/dotnet/fsharp/pull/19340)) ### Added * FSharpType: add ImportILType ([PR #19300](https://github.com/dotnet/fsharp/pull/19300)) diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 40254a11965..cfa10ad46ac 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 + | ILType.Modified(_, _, t1), t2 -> compareILTypes t1 t2 + | t1, ILType.Modified(_, _, t2) -> 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 1e2f26b011e..bc726144dab 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 @@ -1491,7 +1495,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 = @@ -3491,7 +3500,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 @@ -5423,6 +5431,7 @@ and GenILCall (virt, valu, newobj, valUseFlags, isDllImport, ilMethRef: ILMethodRef, enclArgTys, methArgTys, argExprs, returnTys, m) sequel = + let g = cenv.g let hasByrefArg = ilMethRef.ArgTypes |> List.exists IsILTypeByref let isSuperInit = @@ -5445,6 +5454,24 @@ and GenILCall let makesNoCriticalTailcalls = (newobj || not virt) // Don't tailcall for 'newobj', or 'call' to IL code let hasStructObjArg = valu && ilMethRef.CallingConv.IsInstance + let ilEnclArgTys = GenTypeArgs cenv m eenv.tyenv enclArgTys + let ilMethArgTys = GenTypeArgs cenv m eenv.tyenv methArgTys + let ilReturnTys = GenTypes cenv m eenv.tyenv returnTys + let ilMethSpec = mkILMethSpec (ilMethRef, boxity, ilEnclArgTys, ilMethArgTys) + + let useICallVirt = + (virt || useCallVirt cenv boxity ilMethSpec isBaseCall) + && ilMethRef.CallingConv.IsInstance + + let ccallInfo = + ccallInfo + |> Option.orElseWith (fun () -> + match argExprs with + | objArgExpr :: _ when useICallVirt -> + let objArgTy = tyOfExpr g objArgExpr + if isStructTy g objArgTy then Some objArgTy else None + | _ -> None) + let tail = CanTailcall( hasStructObjArg, @@ -5459,15 +5486,6 @@ and GenILCall sequel ) - let ilEnclArgTys = GenTypeArgs cenv m eenv.tyenv enclArgTys - let ilMethArgTys = GenTypeArgs cenv m eenv.tyenv methArgTys - let ilReturnTys = GenTypes cenv m eenv.tyenv returnTys - let ilMethSpec = mkILMethSpec (ilMethRef, boxity, ilEnclArgTys, ilMethArgTys) - - let useICallVirt = - (virt || useCallVirt cenv boxity ilMethSpec isBaseCall) - && ilMethRef.CallingConv.IsInstance - // Load the 'this' pointer to pass to the superclass constructor. This argument is not // in the expression tree since it can't be treated like an ordinary value if isSuperInit then @@ -8975,6 +8993,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 @@ -8993,11 +9012,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 @@ -9036,7 +9062,7 @@ and GenParams MetadataIndex = NoMetadataIdx } - param, takenNames) + param, (takenNames, paramIdx + 1)) ilWitnessParams @ ilParams @@ -9389,8 +9415,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 @@ -10720,7 +10756,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..d36eb0c4d9c --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Signatures.fs @@ -0,0 +1,166 @@ +// 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/18140 + [] + let ``Issue_18140_CallvirtOnValueType`` () = + let source = """ +module Test + +[] +type MyRange = + val Value: int + new(v) = { Value = v } + +let comparer = + { new System.Collections.Generic.IEqualityComparer with + member _.Equals(x1, x2) = x1.Value = x2.Value + member _.GetHashCode o = o.GetHashCode() + } + +let test() = + let s = MyRange(42) + comparer.GetHashCode(s) +""" + let actualIL = + FSharp source + |> asLibrary + |> compile + |> shouldSucceed + |> getActualIL + + Assert.Contains("constrained.", actualIL) + + // https://github.com/dotnet/fsharp/issues/18140 + [] + let ``Issue_18140_CallvirtOnValueType_Runtime`` () = + let source = """ +[] +type MyRange = + val Value: int + new(v) = { Value = v } + +let comparer = + { new System.Collections.Generic.IEqualityComparer with + member _.Equals(x1, x2) = x1.Value = x2.Value + member _.GetHashCode o = o.GetHashCode() + } + +let s = MyRange(42) +let h = comparer.GetHashCode(s) +let eq = comparer.Equals(s, MyRange(42)) +if not eq then failwith "Expected equality" +printfn "Hash: %d, Equal: %b" h eq +""" + FSharp source + |> asExe + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // 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 fd02dace6e1..8f43773cd54 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -280,6 +280,7 @@ +