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>

Author: T-Gro

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))

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

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:

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)
                         )
 

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<ILCodeLabel, int> = Dictionary<_, _>(10)
 
     let codeLabelToCodeLabel: Dictionary<ILCodeLabel, ILCodeLabel> =
@@ -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<concrete> 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,15 +5979,15 @@ 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
 
     let ilRetWithAttrs =
         match ilSlotRetTy with
         | None -> iLRet
         | Some t ->
-            match GenAdditionalAttributesForTy cenv.g t with
+            match GenAdditionalAttributesForTy g t with
             | [] -> iLRet
             | attrs -> iLRet.WithCustomAttrs(mkILCustomAttrs attrs)