From 9549f875a62ae6b20e4b7ba69da9052db939db09 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 16 Feb 2026 16:14:26 +0100 Subject: [PATCH 1/2] Fix runtime crashes: TypeLoadException, InvalidProgramException, stack corruption Fix 6 codegen bugs that cause hard crashes or invalid IL: - #11132: voidptr delegate TypeLoadException - #13447: tail. + localloc stack corruption - #14492: inline constraints TypeLoadException in Release - #14508: nativeptr in interfaces TypeLoadException - #18319: literal upcast missing box instruction - #18956: decimal literal InvalidProgramException in Debug Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../.FSharp.Compiler.Service/10.0.300.md | 6 + src/Compiler/AbstractIL/il.fs | 9 + src/Compiler/AbstractIL/il.fsi | 1 + src/Compiler/CodeGen/EraseClosures.fs | 36 +- src/Compiler/CodeGen/IlxGen.fs | 159 +++++++-- .../CodeGenRegressions_Crashes.fs | 327 ++++++++++++++++++ .../StaticOptimizations/String_Enum.fs.il.bsl | 1 - .../TestFunction03.fs.OptimizeOff.il.bsl | 11 - ...estFunction03.fs.OptimizeOn.il.release.bsl | 1 - .../TestFunction03b.fs.OptimizeOff.il.bsl | 11 - ...stFunction03b.fs.OptimizeOn.il.release.bsl | 1 - .../TestFunction03c.fs.OptimizeOff.il.bsl | 13 +- ...stFunction03c.fs.OptimizeOn.il.release.bsl | 1 - ...nalSignatureOff.OptimizeOff.il.netcore.bsl | 1 - ...rnalSignatureOff.OptimizeOn.il.netcore.bsl | 1 - ...rnalSignatureOn.OptimizeOff.il.netcore.bsl | 1 - ...ernalSignatureOn.OptimizeOn.il.netcore.bsl | 1 - .../FSharp.Compiler.ComponentTests.fsproj | 1 + 18 files changed, 513 insertions(+), 69 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs 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..b7c5bd1b465 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,12 @@ * 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 TypeLoadException when creating delegate with voidptr parameter. (Issue [#11132](https://github.com/dotnet/fsharp/issues/11132), [PR #19338](https://github.com/dotnet/fsharp/pull/19338)) +* Suppress tail calls when localloc (NativePtr.stackalloc) is used. (Issue [#13447](https://github.com/dotnet/fsharp/issues/13447), [PR #19338](https://github.com/dotnet/fsharp/pull/19338)) +* Fix TypeLoadException in Release builds with inline constraints. (Issue [#14492](https://github.com/dotnet/fsharp/issues/14492), [PR #19338](https://github.com/dotnet/fsharp/pull/19338)) +* Fix nativeptr in interfaces leads to TypeLoadException. (Issue [#14508](https://github.com/dotnet/fsharp/issues/14508), [PR #19338](https://github.com/dotnet/fsharp/pull/19338)) +* Fix box instruction for literal upcasts. (Issue [#18319](https://github.com/dotnet/fsharp/issues/18319), [PR #19338](https://github.com/dotnet/fsharp/pull/19338)) +* Fix Decimal Literal causes InvalidProgramException in Debug builds. (Issue [#18956](https://github.com/dotnet/fsharp/issues/18956), [PR #19338](https://github.com/dotnet/fsharp/pull/19338)) ### Added * FSharpType: add ImportILType ([PR #19300](https://github.com/dotnet/fsharp/pull/19300)) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 5d7848f246e..52a4efb6510 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -3333,6 +3333,15 @@ let mkILSimpleTypar nm = MetadataIndex = NoMetadataIdx } +let stripILGenericParamConstraints (gp: ILGenericParameterDef) = + { gp with + Constraints = [] + HasReferenceTypeConstraint = false + HasNotNullableValueTypeConstraint = false + HasDefaultConstructorConstraint = false + HasAllowsRefStruct = false + } + let genericParamOfGenericActual (_ga: ILType) = mkILSimpleTypar "T" let mkILFormalTypars (x: ILGenericArgsList) = List.map genericParamOfGenericActual x diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 3d6f88bb6ca..29febf2b457 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -2066,6 +2066,7 @@ val internal mkILFormalNamedTy: ILBoxity -> ILTypeRef -> ILGenericParameterDef l val internal mkILFormalTypars: ILType list -> ILGenericParameterDefs val internal mkILFormalGenericArgs: int -> ILGenericParameterDefs -> ILGenericArgsList val internal mkILSimpleTypar: string -> ILGenericParameterDef +val internal stripILGenericParamConstraints: ILGenericParameterDef -> ILGenericParameterDef /// Make custom attributes. val internal mkILCustomAttribMethRef: diff --git a/src/Compiler/CodeGen/EraseClosures.fs b/src/Compiler/CodeGen/EraseClosures.fs index 6585fa1d661..532185d8090 100644 --- a/src/Compiler/CodeGen/EraseClosures.fs +++ b/src/Compiler/CodeGen/EraseClosures.fs @@ -152,7 +152,19 @@ let newIlxPubCloEnv (ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFi let mkILTyFuncTy cenv = cenv.mkILTyFuncTy +let inline private (|IsVoidPtr|_|) ty = + match ty with + | ILType.Ptr ILType.Void -> true + | _ -> false + +let private fixVoidPtrForGenericArg (ilg: ILGlobals) ty = + match ty with + | IsVoidPtr -> ilg.typ_IntPtr + | _ -> ty + let mkILFuncTy cenv dty rty = + let dty = fixVoidPtrForGenericArg cenv.ilg dty + let rty = fixVoidPtrForGenericArg cenv.ilg rty mkILBoxedTy cenv.tref_Func[0] [ dty; rty ] let mkILCurriedFuncTy cenv dtys rty = @@ -167,6 +179,8 @@ let typ_Func cenv (dtys: ILType list) rty = else mkFuncTypeRef cenv.ilg.fsharpCoreAssemblyScopeRef n + let dtys = dtys |> List.map (fixVoidPtrForGenericArg cenv.ilg) + let rty = fixVoidPtrForGenericArg cenv.ilg rty mkILBoxedTy tref (dtys @ [ rty ]) let rec mkTyOfApps cenv apps = @@ -189,6 +203,8 @@ let mkMethSpecForMultiApp cenv (argTys: ILType list, retTy) = let n = argTys.Length let formalArgTys = List.mapi (fun i _ -> ILType.TypeVar(uint16 i)) argTys let formalRetTy = ILType.TypeVar(uint16 n) + let argTys = argTys |> List.map (fixVoidPtrForGenericArg cenv.ilg) + let retTy = fixVoidPtrForGenericArg cenv.ilg retTy let inst = argTys @ [ retTy ] if n = 1 then @@ -545,12 +561,14 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let convil = convILMethodBody (Some nowCloSpec, boxReturnTy) clo.cloCode.Value + let specializeGenParams = addedGenParams |> List.map stripILGenericParamConstraints + let nowApplyMethDef = mkILGenericVirtualMethod ( "Specialize", ILCallingConv.Instance, ILMemberAccess.Public, - addedGenParams (* method is generic over added ILGenericParameterDefs *) , + specializeGenParams, [], mkILReturn cenv.ilg.typ_Object, MethodBody.IL(notlazy convil) @@ -676,7 +694,17 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = else // CASE 2b - Build an Invoke method - let nowEnvParentClass = typ_Func cenv (typesOfILParams nowParams) nowReturnTy + let fixedNowParams = + nowParams + |> List.map (fun (p: ILParameter) -> + { p with + Type = fixVoidPtrForGenericArg cenv.ilg p.Type + }) + + let fixedNowReturnTy = fixVoidPtrForGenericArg cenv.ilg nowReturnTy + + let nowEnvParentClass = + typ_Func cenv (typesOfILParams fixedNowParams) fixedNowReturnTy let cloTypeDef = let convil = convILMethodBody (Some nowCloSpec, None) clo.cloCode.Value @@ -685,8 +713,8 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = mkILNonGenericVirtualInstanceMethod ( "Invoke", ILMemberAccess.Public, - nowParams, - mkILReturn nowReturnTy, + fixedNowParams, + mkILReturn fixedNowReturnTy, MethodBody.IL(notlazy convil) ) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 1e2f26b011e..de08f443c55 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1394,6 +1394,28 @@ let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) = let IsValRefIsDllImport g (vref: ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute +/// Check if a type contains nativeptr with a type parameter from the given set. +/// Used to detect interface implementations that need 'native int' return type. +let hasNativePtrWithTypar (g: TcGlobals) (typars: Typar list) ty = + let rec check ty = + let ty = stripTyEqns g ty + + match ty with + | TType_app(tcref, tinst, _) when tyconRefEq g g.nativeptr_tcr tcref -> + tinst + |> List.exists (fun t -> + match stripTyEqns g t with + | TType_var(tp, _) -> typars |> List.exists (fun tp2 -> tp.Stamp = tp2.Stamp) + | _ -> false) + | TType_app(_, tinst, _) -> tinst |> List.exists check + | TType_fun(d, r, _) -> check d || check r + | TType_tuple(_, tys) -> tys |> List.exists check + | TType_anon(_, tys) -> tys |> List.exists check + | TType_forall(_, t) -> check t + | _ -> false + + check ty + /// Determine how a top level value is represented, when it is being represented /// as a method. let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = @@ -1421,7 +1443,34 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = let ilActualRetTy = let ilRetTy = GenReturnType cenv m tyenvUnderTypars returnTy - if isCtor || cctor then ILType.Void else ilRetTy + + if isCtor || cctor then + ILType.Void + // When implementing an interface slot with nativeptr<'T> where 'T is an interface + // type parameter and the interface type args are concrete, the interface method + // returns 'native int'. The method def must also return 'native int' to match. + elif memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + match + memberInfo.ImplementedSlotSigs + |> List.tryPick (fun (TSlotSig(_, ty, sctps, _, _, sRetTy)) -> + let interfaceTypeArgs = argsOfAppTy g ty + + if + not sctps.IsEmpty + && (freeInTypes CollectTypars interfaceTypeArgs).FreeTypars.IsEmpty + && sRetTy |> Option.exists (hasNativePtrWithTypar g sctps) + then + Some(sctps, sRetTy) + else + None) + with + | Some(sctps, sRetTy) -> + // Generate return type using the slot's type params so nativeptr<'T> → native int + let slotEnv = TypeReprEnv.Empty.ForTypars sctps + GenReturnType cenv m slotEnv sRetTy + | None -> ilRetTy + else + ilRetTy let ilTy = GenType cenv m tyenvUnderTypars (mkWoNullAppTy parentTcref (List.map mkTyparTy ctps)) @@ -2508,6 +2557,8 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs let mutable hasDebugPoints = false let mutable anyDocument = None // we collect an arbitrary document in order to emit the header FeeFee if needed + let mutable hasStackAllocatedLocals = false + let codeLabelToPC: Dictionary = Dictionary<_, _>(10) let codeLabelToCodeLabel: Dictionary = @@ -2566,11 +2617,19 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs member cgbuf.EmitInstr(pops, pushes, i) = cgbuf.DoPops pops cgbuf.DoPushes pushes + + if i = I_localloc then + hasStackAllocatedLocals <- true + codebuf.Add i member cgbuf.EmitInstrs(pops, pushes, is) = cgbuf.DoPops pops cgbuf.DoPushes pushes + + if is |> List.exists (fun i -> i = I_localloc) then + hasStackAllocatedLocals <- true + is |> List.iter codebuf.Add member private _.EnsureNopBetweenDebugPoints() = @@ -2703,6 +2762,8 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs member _.HasPinnedLocals() = locals |> Seq.exists (fun (_, _, isFixed, _) -> isFixed) + member _.HasStackAllocatedLocals() = hasStackAllocatedLocals + member _.Close() = let instrs = codebuf.ToArray() @@ -3320,32 +3381,50 @@ and GenConstant cenv cgbuf eenv (c, m, ty) sequel = match TryEliminateDesugaredConstants g m c with | Some e -> GenExpr cenv cgbuf eenv e Continue | None -> - let emitInt64Constant i = + let needsBoxingToTargetTy = + (match ilTy with + | ILType.Value _ -> false + | _ -> true) + + // Wraps an emitter: calls it, then boxes if target type is not a value type (e.g. literal upcast to obj). + let inline emitAndBoxIfNeeded emitter uty arg = + emitter uty arg + + if needsBoxingToTargetTy then + CG.EmitInstr cgbuf (pop 1) (Push [ ilTy ]) (I_box uty) + + let emitInt64Constant uty i = // see https://github.com/dotnet/fsharp/pull/3620 // and https://github.com/dotnet/fsharp/issue/8683 // and https://github.com/dotnet/roslyn/blob/98f12bb/src/Compilers/Core/Portable/CodeGen/ILBuilderEmit.cs#L679 if i >= int64 Int32.MinValue && i <= int64 Int32.MaxValue then - CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ mkLdcInt32 (int32 i); AI_conv DT_I8 ] + CG.EmitInstrs cgbuf (pop 0) (Push [ uty ]) [ mkLdcInt32 (int32 i); AI_conv DT_I8 ] elif i >= int64 UInt32.MinValue && i <= int64 UInt32.MaxValue then - CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ mkLdcInt32 (int32 i); AI_conv DT_U8 ] + CG.EmitInstrs cgbuf (pop 0) (Push [ uty ]) [ mkLdcInt32 (int32 i); AI_conv DT_U8 ] else - CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (iLdcInt64 i) + CG.EmitInstr cgbuf (pop 0) (Push [ uty ]) (iLdcInt64 i) + + let emitConst uty instr = + CG.EmitInstr cgbuf (pop 0) (Push [ uty ]) instr + + let emitConstI uty instrs = + CG.EmitInstrs cgbuf (pop 0) (Push [ uty ]) instrs match c with - | Const.Bool b -> CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Bool ]) (mkLdcInt32 (if b then 1 else 0)) - | Const.SByte i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i)) - | Const.Int16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i)) - | Const.Int32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 i) - | Const.Int64 i -> emitInt64Constant i - | Const.IntPtr i -> CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ iLdcInt64 i; AI_conv DT_I ] - | Const.Byte i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i)) - | Const.UInt16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i)) - | Const.UInt32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int32 i)) - | Const.UInt64 i -> emitInt64Constant (int64 i) - | Const.UIntPtr i -> CG.EmitInstrs cgbuf (pop 0) (Push [ ilTy ]) [ iLdcInt64 (int64 i); AI_conv DT_U ] - | Const.Double f -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (AI_ldc(DT_R8, ILConst.R8 f)) - | Const.Single f -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (AI_ldc(DT_R4, ILConst.R4 f)) - | Const.Char c -> CG.EmitInstr cgbuf (pop 0) (Push [ ilTy ]) (mkLdcInt32 (int c)) + | Const.Bool b -> emitAndBoxIfNeeded emitConst g.ilg.typ_Bool (mkLdcInt32 (if b then 1 else 0)) + | Const.SByte i -> emitAndBoxIfNeeded emitConst g.ilg.typ_SByte (mkLdcInt32 (int32 i)) + | Const.Int16 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_Int16 (mkLdcInt32 (int32 i)) + | Const.Int32 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_Int32 (mkLdcInt32 i) + | Const.Int64 i -> emitAndBoxIfNeeded emitInt64Constant g.ilg.typ_Int64 i + | Const.IntPtr i -> emitAndBoxIfNeeded emitConstI g.ilg.typ_IntPtr [ iLdcInt64 i; AI_conv DT_I ] + | Const.Byte i -> emitAndBoxIfNeeded emitConst g.ilg.typ_Byte (mkLdcInt32 (int32 i)) + | Const.UInt16 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_UInt16 (mkLdcInt32 (int32 i)) + | Const.UInt32 i -> emitAndBoxIfNeeded emitConst g.ilg.typ_UInt32 (mkLdcInt32 (int32 i)) + | Const.UInt64 i -> emitAndBoxIfNeeded emitInt64Constant g.ilg.typ_UInt64 (int64 i) + | Const.UIntPtr i -> emitAndBoxIfNeeded emitConstI g.ilg.typ_UIntPtr [ iLdcInt64 (int64 i); AI_conv DT_U ] + | Const.Double f -> emitAndBoxIfNeeded emitConst g.ilg.typ_Double (AI_ldc(DT_R8, ILConst.R8 f)) + | Const.Single f -> emitAndBoxIfNeeded emitConst g.ilg.typ_Single (AI_ldc(DT_R4, ILConst.R4 f)) + | Const.Char c -> emitAndBoxIfNeeded emitConst g.ilg.typ_Char (mkLdcInt32 (int c)) | Const.String s -> GenString cenv cgbuf s | Const.Unit -> GenUnit cenv eenv m cgbuf | Const.Zero -> GenDefaultValue cenv cgbuf eenv (ty, m) @@ -4509,6 +4588,7 @@ and CanTailcall // Can't tailcall with a .NET 2.0 generic constrained call since it involves a byref // Can't tailcall when there are pinned locals since the stack frame must remain alive let hasPinnedLocals = cgbuf.HasPinnedLocals() + let hasStackAllocatedLocals = cgbuf.HasStackAllocatedLocals() if not hasStructObjArg @@ -4519,6 +4599,7 @@ and CanTailcall && not isSelfInit && not makesNoCriticalTailcalls && not hasPinnedLocals + && not hasStackAllocatedLocals && // We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return. @@ -5840,6 +5921,8 @@ and GenFormalReturnType m cenv eenvFormal returnTy : ILReturn = and instSlotParam inst (TSlotParam(nm, ty, inFlag, fl2, fl3, attrs)) = TSlotParam(nm, instType inst ty, inFlag, fl2, fl3, attrs) +and containsNativePtrWithTypar (g: TcGlobals) (typars: Typar list) ty = hasNativePtrWithTypar g typars ty + and GenActualSlotsig m cenv @@ -5848,14 +5931,44 @@ and GenActualSlotsig methTyparsOfOverridingMethod (methodParams: Val list) = + let g = cenv.g let ilSlotParams = List.concat ilSlotParams + let interfaceTypeArgs = argsOfAppTy g ty + let instForSlotSig = - mkTyparInst (ctps @ mtps) (argsOfAppTy cenv.g ty @ generalizeTypars methTyparsOfOverridingMethod) + mkTyparInst (ctps @ mtps) (interfaceTypeArgs @ generalizeTypars methTyparsOfOverridingMethod) + + let interfaceTypeArgsAreConcrete = + not ctps.IsEmpty + && (freeInTypes CollectTypars interfaceTypeArgs).FreeTypars.IsEmpty + + let slotHasNativePtrWithCtps = + interfaceTypeArgsAreConcrete + && (ilSlotParams + |> List.exists (fun (TSlotParam(_, ty, _, _, _, _)) -> containsNativePtrWithTypar g ctps ty) + || ilSlotRetTy |> Option.exists (containsNativePtrWithTypar g ctps)) + + let eenvForSlotGen = + if slotHasNativePtrWithCtps then + EnvForTypars ctps eenv + else + eenv + + // When the slot has nativeptr with concrete interface type args, don't substitute + // the class type params (ctps) - only substitute method type params (mtps). + // This keeps nativeptr<'T> unsubstituted so it generates 'native int' in IL, + // matching the interface method's signature. Without this, nativeptr<'T> would be + // substituted to nativeptr which generates 'T*', causing a TypeLoadException. + let instForSlotSigGen = + if slotHasNativePtrWithCtps then + mkTyparInst mtps (generalizeTypars methTyparsOfOverridingMethod) + else + instForSlotSig let ilParams = ilSlotParams - |> List.map (instSlotParam instForSlotSig >> GenSlotParam m cenv eenv) + |> List.map (instSlotParam instForSlotSigGen >> GenSlotParam m cenv eenvForSlotGen) // Use the better names if available let ilParams = @@ -5866,7 +5979,7 @@ and GenActualSlotsig ilParams let ilRetTy = - GenReturnType cenv m eenv.tyenv (Option.map (instType instForSlotSig) ilSlotRetTy) + GenReturnType cenv m eenvForSlotGen.tyenv (Option.map (instType instForSlotSigGen) ilSlotRetTy) let iLRet = mkILReturn ilRetTy @@ -5874,7 +5987,7 @@ and GenActualSlotsig match ilSlotRetTy with | None -> iLRet | Some t -> - match GenAdditionalAttributesForTy cenv.g t with + match GenAdditionalAttributesForTy g t with | [] -> iLRet | attrs -> iLRet.WithCustomAttrs(mkILCustomAttrs attrs) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs new file mode 100644 index 00000000000..6a20d871776 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs @@ -0,0 +1,327 @@ +// 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_Crashes = + + 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/18956 + [] + let ``Issue_18956_DecimalConstantInvalidProgram`` () = + let source = """ +module A = + [] + let B = 42m + +[] +let main args = + printfn "%M" A.B + 0 +""" + FSharp source + |> asExe + |> withDebug + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/18319 + [] + let ``Issue_18319_LiteralUpcastMissingBox`` () = + let source = """ +module Test + +[] +let badobj: System.ValueType = 1 + +[] +let main _ = + System.Console.WriteLine(badobj) + 0 +""" + FSharp source + |> asExe + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/18319 + // Second case from issue: literal upcast used as default parameter value + [] + let ``Issue_18319_LiteralUpcastDefaultParam`` () = + let source = """ +module Test + +open System.Runtime.InteropServices + +[] +let lit: System.ValueType = 1 + +type C() = + static member M([] param: System.ValueType) = + System.Console.WriteLine(param) + +[] +let main _ = + C.M() + C.M(42) + 0 +""" + FSharp source + |> asExe + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/14508 + [] + let ``Issue_14508_NativeptrInInterfaces_CompileOnly`` () = + let source = """ +module Test + +open Microsoft.FSharp.NativeInterop + +type IFoo<'T when 'T : unmanaged> = + abstract member Pointer : nativeptr<'T> + +type Broken() = + member x.Pointer : nativeptr = Unchecked.defaultof<_> + interface IFoo with + member x.Pointer = x.Pointer + +type Working<'T when 'T : unmanaged>() = + member x.Pointer : nativeptr<'T> = Unchecked.defaultof<_> + interface IFoo<'T> with + member x.Pointer = x.Pointer +""" + FSharp source + |> asLibrary + |> compile + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/14508 + [] + let ``Issue_14508_NativeptrInInterfaces_RuntimeWorking`` () = + let source = """ +open Microsoft.FSharp.NativeInterop + +type IFoo<'T when 'T : unmanaged> = + abstract member Pointer : nativeptr<'T> + +type Working<'T when 'T : unmanaged>() = + member x.Pointer : nativeptr<'T> = Unchecked.defaultof<_> + interface IFoo<'T> with + member x.Pointer = x.Pointer + +printfn "Working type loaded successfully" +""" + FSharp source + |> asExe + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/14508 + [] + let ``Issue_14508_NativeptrInInterfaces_RuntimeBroken`` () = + let source = """ +open Microsoft.FSharp.NativeInterop + +type IFoo<'T when 'T : unmanaged> = + abstract member Pointer : nativeptr<'T> + +type Broken() = + member x.Pointer : nativeptr = Unchecked.defaultof<_> + interface IFoo with + member x.Pointer = x.Pointer + +let b = Broken() +let p = (b :> IFoo).Pointer +printfn "Broken type loaded and Pointer accessed: %A" p +""" + FSharp source + |> asExe + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/14492 + [] + let ``Issue_14492_ReleaseConfigError`` () = + let source = """ +module Test + +#nowarn "3370" + +let inline refEquals<'a when 'a : not struct> (a : 'a) (b : 'a) = obj.ReferenceEquals (a, b) + +let inline tee f x = + f x + x + +let memoizeLatestRef (f: 'a -> 'b) = + let cell = ref None + let f' (x: 'a) = + match !cell with + | Some (x', value) when refEquals x' x -> value + | _ -> f x |> tee (fun y -> cell := Some (x, y)) + f' + +module BugInReleaseConfig = + let test f x = + printfn "%s" (f x) + + let f: string -> string = memoizeLatestRef id + + let run () = test f "ok" + +[] +let main _ = + BugInReleaseConfig.run () + 0 +""" + FSharp source + |> asExe + |> withOptimize + |> compile + |> shouldSucceed + |> run + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/13447 + [] + let ``Issue_13447_TailInstructionCorruption`` () = + let source = """ +module Test +open System +open Microsoft.FSharp.NativeInterop + +#nowarn "9" // Uses of this construct may result in the generation of unverifiable .NET IL code + +[] +type MyResult<'T, 'E> = + | Ok of value: 'T + | Error of error: 'E + +let useStackAlloc () : MyResult = + let ptr = NativePtr.stackalloc 100 + let span = Span(NativePtr.toVoidPtr ptr, 100) + span.[0] <- 42uy + Ok (int span.[0]) + +let test () = + match useStackAlloc () with + | Ok v -> v + | Error _ -> -1 +""" + let actualIL = + FSharp source + |> asLibrary + |> withOptimize + |> compile + |> shouldSucceed + |> getActualIL + + let useStackAllocIdx = actualIL.IndexOf("useStackAlloc") + Assert.True(useStackAllocIdx >= 0, "useStackAlloc method not found in IL") + let methodEnd = actualIL.IndexOf("\n } ", useStackAllocIdx) + let methodIL = if methodEnd > 0 then actualIL.Substring(useStackAllocIdx, methodEnd - useStackAllocIdx) else actualIL.Substring(useStackAllocIdx) + Assert.DoesNotContain("tail.", methodIL) + + // https://github.com/dotnet/fsharp/issues/11132 + [] + let ``Issue_11132_VoidptrDelegate`` () = + let source = """ +module Test +#nowarn "9" + +open System + +type MyDelegate = delegate of voidptr -> unit + +let method (ptr: voidptr) = () + +let getDelegate (m: voidptr -> unit) : MyDelegate = MyDelegate(m) + +let test() = + let d = getDelegate method + d.Invoke(IntPtr.Zero.ToPointer()) + +do test() +""" + FSharp source + |> asExe + |> withOptimize + |> compileAndRun + |> shouldSucceed + |> ignore + + // https://github.com/dotnet/fsharp/issues/14492 + // Variant: cross-assembly inlining with constrained generics triggers Specialize closure + [] + let ``Issue_14492_CrossAssemblyInline`` () = + let lib = FSharp """ +module Lib + +let inline refEquals<'a when 'a : not struct> (a : 'a) (b : 'a) = obj.ReferenceEquals (a, b) + +let inline tee f x = + f x + x +""" |> withOptimize + |> asLibrary + + let app = FSharp """ +module App + +open Lib + +let memoizeLatestRef (f: 'a -> 'b) = + let cell = ref None + let f' (x: 'a) = + match cell.Value with + | Some (x', value) when refEquals x' x -> value + | _ -> f x |> tee (fun y -> cell.Value <- Some (x, y)) + f' + +module Test = + let f: string -> string = memoizeLatestRef id + let run () = printfn "%s" (f "ok") + +[] +let main _ = Test.run(); 0 +""" + app + |> withOptimize + |> asExe + |> withReferences [lib] + |> compileAndRun + |> shouldSucceed + |> ignore + diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/StaticOptimizations/String_Enum.fs.il.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/StaticOptimizations/String_Enum.fs.il.bsl index 740505ce6a7..1af36573396 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/StaticOptimizations/String_Enum.fs.il.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/StaticOptimizations/String_Enum.fs.il.bsl @@ -540,4 +540,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOff.il.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOff.il.bsl index dd6e6ab1b40..9de983bbfa2 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOff.il.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOff.il.bsl @@ -16,16 +16,6 @@ .hash algorithm 0x00008004 .ver 0:0:0:0 -} -.mresource public FSharpSignatureCompressedData.assembly -{ - - -} -.mresource public FSharpOptimizationCompressedData.assembly -{ - - } .module assembly.exe @@ -112,4 +102,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOn.il.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOn.il.release.bsl index d360b2a91eb..aa576cc3d13 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOn.il.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03.fs.OptimizeOn.il.release.bsl @@ -123,4 +123,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOff.il.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOff.il.bsl index 6b0f2cd2642..15905929f58 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOff.il.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOff.il.bsl @@ -16,16 +16,6 @@ .hash algorithm 0x00008004 .ver 0:0:0:0 -} -.mresource public FSharpSignatureCompressedData.assembly -{ - - -} -.mresource public FSharpOptimizationCompressedData.assembly -{ - - } .module assembly.exe @@ -126,4 +116,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOn.il.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOn.il.release.bsl index 0a3ae50e3e0..05caaf30094 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOn.il.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03b.fs.OptimizeOn.il.release.bsl @@ -130,4 +130,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOff.il.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOff.il.bsl index 0eeedf099d9..f67fcf38d92 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOff.il.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOff.il.bsl @@ -8,7 +8,7 @@ .assembly extern netstandard { .publickeytoken = (CC 7B 13 FF CD 2D DD 51 ) - .ver 2:0:0:0 + .ver 2:1:0:0 } .assembly assembly { @@ -21,16 +21,6 @@ .hash algorithm 0x00008004 .ver 0:0:0:0 -} -.mresource public FSharpSignatureCompressedData.assembly -{ - - -} -.mresource public FSharpOptimizationCompressedData.assembly -{ - - } .module assembly.exe @@ -145,4 +135,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOn.il.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOn.il.release.bsl index ad3903afb89..3dbb67a8837 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOn.il.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction03c.fs.OptimizeOn.il.release.bsl @@ -141,4 +141,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOff.il.netcore.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOff.il.netcore.bsl index 0a339bb2ae3..1ce1ae80199 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOff.il.netcore.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOff.il.netcore.bsl @@ -324,4 +324,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOn.il.netcore.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOn.il.netcore.bsl index a73fda88e58..ddec5b43dee 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOn.il.netcore.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOff.OptimizeOn.il.netcore.bsl @@ -306,4 +306,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOff.il.netcore.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOff.il.netcore.bsl index 0a339bb2ae3..1ce1ae80199 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOff.il.netcore.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOff.il.netcore.bsl @@ -324,4 +324,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOn.il.netcore.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOn.il.netcore.bsl index a73fda88e58..ddec5b43dee 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOn.il.netcore.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/TestFunction22h.fs.RealInternalSignatureOn.OptimizeOn.il.netcore.bsl @@ -306,4 +306,3 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index fd02dace6e1..fe5b3f19077 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -280,6 +280,7 @@ + From 02db613317a8c0c8ee594a64938a9431bf5b3ddd Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 26 Feb 2026 15:12:51 +0100 Subject: [PATCH 2/2] Fix EmittedIL tests failing on net472 Desktop configuration Mark Issue_13447_TailInstructionCorruption and Issue_11132_VoidptrDelegate tests with FactForNETCOREAPP to skip on net472 Desktop test runs. - Issue_13447 uses Span which is not available on net472 - Issue_11132 uses voidptr in closure generic args which requires netcore runtime support Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../CodeGenRegressions/CodeGenRegressions_Crashes.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs index 6a20d871776..7dd573b9b9d 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/CodeGenRegressions/CodeGenRegressions_Crashes.fs @@ -215,7 +215,7 @@ let main _ = |> ignore // https://github.com/dotnet/fsharp/issues/13447 - [] + [] let ``Issue_13447_TailInstructionCorruption`` () = let source = """ module Test @@ -255,7 +255,7 @@ let test () = Assert.DoesNotContain("tail.", methodIL) // https://github.com/dotnet/fsharp/issues/11132 - [] + [] let ``Issue_11132_VoidptrDelegate`` () = let source = """ module Test