fix 12761 (#13865) (#14323)

Co-authored-by: Don Syme <[email protected]>

src/Compiler/CodeGen/IlxGen.fs

@@ -6709,7 +6709,13 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN
         NestedTypeRefForCompLoc eenvouter.cloc cloName
 
     // Collect the free variables of the closure
-    let cloFreeVarResults = freeInExpr (CollectTyparsAndLocalsWithStackGuard()) expr
+    let cloFreeVarResults =
+        let opts = CollectTyparsAndLocalsWithStackGuard()
+        let opts =
+            match eenvouter.tyenv.TemplateReplacement with
+            | None -> opts
+            | Some (tcref, _, typars, _) -> opts.WithTemplateReplacement(tyconRefEq g tcref, typars)
+        freeInExpr opts expr
 
     // Partition the free variables when some can be accessed from places besides the immediate environment
     // Also filter out the current value being bound, if any, as it is available from the "this"

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -2133,7 +2133,10 @@ type FreeVarOptions =
       includeRecdFields: bool
       includeUnionCases: bool
       includeLocals: bool
+      templateReplacement: ((TyconRef -> bool) * Typars) option
       stackGuard: StackGuard option }
+
+    member this.WithTemplateReplacement(f, typars) = { this with templateReplacement = Some (f, typars) }
 
 let CollectAllNoCaching = 
     { canCache = false
@@ -2144,6 +2147,7 @@ let CollectAllNoCaching =
       includeUnionCases = true
       includeTypars = true
       includeLocals = true
+      templateReplacement = None
       stackGuard = None}
 
 let CollectTyparsNoCaching = 
@@ -2155,6 +2159,7 @@ let CollectTyparsNoCaching =
       includeRecdFields = false
       includeUnionCases = false
       includeLocals = false
+      templateReplacement = None
       stackGuard = None }
 
 let CollectLocalsNoCaching = 
@@ -2166,6 +2171,7 @@ let CollectLocalsNoCaching =
       includeRecdFields = false 
       includeUnionCases = false
       includeLocals = true
+      templateReplacement = None
       stackGuard = None }
 
 let CollectTyparsAndLocalsNoCaching = 
@@ -2177,6 +2183,7 @@ let CollectTyparsAndLocalsNoCaching =
       includeUnionCases = false
       includeTypars = true
       includeLocals = true
+      templateReplacement = None
       stackGuard = None }
 
 let CollectAll =
@@ -2188,6 +2195,7 @@ let CollectAll =
       includeUnionCases = true
       includeTypars = true
       includeLocals = true
+      templateReplacement = None
       stackGuard = None }
 
 let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll
@@ -2199,6 +2207,7 @@ let CollectTyparsAndLocalsImpl stackGuardOpt = // CollectAll
       includeLocalTyconReprs = false
       includeRecdFields = false
       includeUnionCases = false
+      templateReplacement = None
       stackGuard = stackGuardOpt }
 
 
@@ -2219,12 +2228,18 @@ let accFreeLocalTycon opts x acc =
     if Zset.contains x acc.FreeTycons then acc else 
     { acc with FreeTycons = Zset.add x acc.FreeTycons } 
 
-let accFreeTycon opts (tcref: TyconRef) acc = 
+let rec accFreeTycon opts (tcref: TyconRef) acc = 
+    let acc =
+        match opts.templateReplacement with
+        | Some (isTemplateTyconRef, cloFreeTyvars) when isTemplateTyconRef tcref ->
+            let cloInst = List.map mkTyparTy cloFreeTyvars
+            accFreeInTypes opts cloInst acc
+        | _ -> acc
     if not opts.includeLocalTycons then acc
     elif tcref.IsLocalRef then accFreeLocalTycon opts tcref.ResolvedTarget acc
     else acc
 
-let rec boundTypars opts tps acc = 
+and boundTypars opts tps acc = 
     // Bound type vars form a recursively-referential set due to constraints, e.g. A: I<B>, B: I<A> 
     // So collect up free vars in all constraints first, then bind all variables 
     let acc = List.foldBack (fun (tp: Typar) acc -> accFreeInTyparConstraints opts tp.Constraints acc) tps acc

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -796,7 +796,12 @@ val emptyFreeLocals: FreeLocals
 
 val unionFreeLocals: FreeLocals -> FreeLocals -> FreeLocals
 
-type FreeVarOptions
+/// Represents the options to activate when collecting free variables
+[<Sealed>]
+type FreeVarOptions =
+    /// During backend code generation of state machines, register a template replacement for struct types.
+    /// This may introduce new free variables related to the instantiation of the struct type.
+    member WithTemplateReplacement: (TyconRef -> bool) * Typars -> FreeVarOptions
 
 val CollectLocalsNoCaching: FreeVarOptions
 

tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs

@@ -1259,6 +1259,75 @@ type BasicsNotInParallel() =
                     require ran "never ran")
             taskOuter.Wait()
 
+    [<Fact; >]
+    member _.testGenericBackgroundTasks() =
+        printfn "Running testBackgroundTask..."
+        for i in 1 .. 5 do 
+            let mutable ran = false
+            let mutable posted = false
+            let oldSyncContext = SynchronizationContext.Current
+            let syncContext = { new SynchronizationContext()  with member _.Post(d,state) = posted <- true; d.Invoke(state) }
+            try 
+                SynchronizationContext.SetSynchronizationContext syncContext
+                let f (result: 'T ref) (x: 'T) =
+                    backgroundTask {
+                        require (System.Threading.Thread.CurrentThread.IsThreadPoolThread) "expect to be on background thread"
+                        ran <- true
+                        result.Value <- x
+                    }
+                let t = f (ref "") "hello"
+                t.Wait()
+                let t2 = f (ref 1) 1
+                t2.Wait()
+                require ran "never ran"
+                require (not posted) "did not expect post to sync context"
+            finally
+                SynchronizationContext.SetSynchronizationContext oldSyncContext
+
+
+/// https://github.com/dotnet/fsharp/issues/12761
+module Test12761A =
+
+    type Dto = {
+        DtoValue : string
+        Key : string
+    }
+
+    type MyGenericType<'Key,'Value> = {
+        Value : 'Value
+        Key : 'Key
+    }
+
+    type ProblematicType<'Key, 'Value, 'Dto, 'E>( fromDto : 'Dto -> Result<MyGenericType<'Key,'Value>,'E> ) =
+        let myTask = 
+            backgroundTask {
+                    let dto =  """{"DtoValue":"1","Key":"key1"}""" |> box |> unbox<'Dto>
+                return fromDto dto |> printfn "%A"
+            }
+        member __.ContainsKey = fun (key: 'Key) -> true
+
+
+    type MyType = MyGenericType<string,int>
+
+    module MyType =
+        let fromDto (dto: Dto)  =
+            try
+                {
+                    Value = int dto.DtoValue
+                    Key = dto.Key
+                } 
+                |> Ok
+            with | e -> Error e
+
+
+/// https://github.com/dotnet/fsharp/issues/12761
+module Test12761B =
+    let TestFunction<'Dto>() =
+            backgroundTask {
+                let dto = Unchecked.defaultof<'Dto>
+                System.Console.WriteLine(dto)
+            }
+
 type Issue12184() =
     member this.TaskMethod() =
         task {