Make Event's AddHandler/RemoveHandler atomic (dotnet#11326)

src/fsharp/FSharp.Core/event.fs

@@ -10,6 +10,19 @@ namespace Microsoft.FSharp.Control
     open Microsoft.FSharp.Control
     open System.Reflection
     open System.Diagnostics
+
+    module private Atomic =
+        open System.Threading
+
+        let inline setWith (thunk: 'a -> 'a) (value: byref<'a>) =
+            let mutable exchanged = false
+            let mutable oldValue = value
+            while not exchanged do
+                let comparand = oldValue
+                let newValue = thunk comparand
+                oldValue <- Interlocked.CompareExchange(&value, newValue, comparand)
+                if obj.ReferenceEquals(comparand, oldValue) then
+                    exchanged <- true
 
     [<CompiledName("FSharpDelegateEvent`1")>]
     type DelegateEvent<'Delegate when 'Delegate :> System.Delegate>() = 
@@ -21,9 +34,9 @@ namespace Microsoft.FSharp.Control
         member x.Publish = 
             { new IDelegateEvent<'Delegate> with 
                 member x.AddHandler(d) =
-                    multicast <- System.Delegate.Combine(multicast, d)
-                member x.RemoveHandler(d) = 
-                    multicast <- System.Delegate.Remove(multicast, d) }
+                    Atomic.setWith (fun value -> System.Delegate.Combine(value, d)) &multicast
+                member x.RemoveHandler(d) =
+                    Atomic.setWith (fun value -> System.Delegate.Remove(value, d)) &multicast }
 
     type EventDelegee<'Args>(observer: System.IObserver<'Args>) =
         static let makeTuple = 
@@ -54,7 +67,7 @@ namespace Microsoft.FSharp.Control
     type EventWrapper<'Delegate,'Args> = delegate of 'Delegate * obj * 'Args -> unit
 
     [<CompiledName("FSharpEvent`2")>]
-    type Event<'Delegate, 'Args when 'Delegate : delegate<'Args, unit> and 'Delegate :> System.Delegate>() =  
+    type Event<'Delegate, 'Args when 'Delegate : delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct>() =  
 
         let mutable multicast : 'Delegate = Unchecked.defaultof<_>     
 
@@ -85,6 +98,8 @@ namespace Microsoft.FSharp.Control
                 mi                
 
         member x.Trigger(sender:obj,args: 'Args) = 
+            // Copy multicast value into local variable to avoid changing during member call. 
+            let multicast = multicast
             match box multicast with 
             | null -> () 
             | _ -> 
@@ -102,9 +117,9 @@ namespace Microsoft.FSharp.Control
                   member x.ToString() = "<published event>"
               interface IEvent<'Delegate,'Args> with 
                 member e.AddHandler(d) =
-                    multicast <- System.Delegate.Combine(multicast, d) :?> 'Delegate 
+                    Atomic.setWith (fun value -> System.Delegate.Combine(value, d) :?> 'Delegate) &multicast
                 member e.RemoveHandler(d) = 
-                    multicast <- System.Delegate.Remove(multicast, d)  :?> 'Delegate 
+                    Atomic.setWith (fun value -> System.Delegate.Remove(value, d) :?> 'Delegate) &multicast
               interface System.IObservable<'Args> with 
                 member e.Subscribe(observer) = 
                    let obj = new EventDelegee<'Args>(observer)
@@ -128,9 +143,9 @@ namespace Microsoft.FSharp.Control
                   member x.ToString() = "<published event>"
               interface IEvent<'T> with 
                 member e.AddHandler(d) =
-                    x.multicast <- (System.Delegate.Combine(x.multicast, d) :?> Handler<'T>)
+                    Atomic.setWith (fun value -> System.Delegate.Combine(value, d) :?> Handler<'T>) &x.multicast
                 member e.RemoveHandler(d) = 
-                    x.multicast <- (System.Delegate.Remove(x.multicast, d) :?> Handler<'T>)
+                    Atomic.setWith (fun value -> System.Delegate.Remove(value, d) :?> Handler<'T>) &x.multicast
               interface System.IObservable<'T> with 
                 member e.Subscribe(observer) = 
                    let h = new Handler<_>(fun sender args -> observer.OnNext(args))

src/fsharp/FSharp.Core/event.fsi

@@ -26,7 +26,7 @@ namespace Microsoft.FSharp.Control
     ///
     /// <category index="3">Events and Observables</category>
     [<CompiledName("FSharpEvent`2")>]
-    type Event<'Delegate,'Args when 'Delegate : delegate<'Args,unit> and 'Delegate :> System.Delegate > = 
+    type Event<'Delegate,'Args when 'Delegate : delegate<'Args,unit> and 'Delegate :> System.Delegate and 'Delegate : not struct> = 
         /// <summary>Creates an event object suitable for delegate types following the standard .NET Framework convention of a first 'sender' argument.</summary>
         /// <returns>The created event.</returns>
         new : unit -> Event<'Delegate,'Args>

tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj

@@ -74,6 +74,7 @@
     <Compile Include="FSharp.Core\Microsoft.FSharp.Core\PrintfTests.fs" />
     <Compile Include="FSharp.Core\Microsoft.FSharp.Core\ResultTests.fs" />
     <Compile Include="FSharp.Core\Microsoft.FSharp.Core\ExtraTopLevelOperatorsTests.fs" />
+    <Compile Include="FSharp.Core\Microsoft.FSharp.Control\EventTypes.fs" />
     <Compile Include="FSharp.Core\Microsoft.FSharp.Control\LazyType.fs" />
     <Compile Include="FSharp.Core\Microsoft.FSharp.Control\Cancellation.fs" />
     <Compile Include="FSharp.Core\Microsoft.FSharp.Control\AsyncType.fs" />

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

@@ -0,0 +1,77 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+// Various tests for the:
+// Microsoft.FSharp.Control event types
+
+namespace FSharp.Core.UnitTests.Control
+
+open System
+open System.Reflection
+open Xunit
+
+module private EventTypes =
+    type MultiArgDelegate = delegate of obj * obj[] -> unit
+
+    let getListeners event =
+        let eventType = event.GetType()
+        let multicastField = 
+            eventType
+                .GetField("multicast", BindingFlags.NonPublic ||| BindingFlags.Instance)
+                .GetValue event 
+                :?> System.Delegate
+
+        if not (isNull multicastField) then
+            let multicastType = typeof<System.MulticastDelegate>
+            let listeners = 
+                multicastType
+                    .GetMethod("GetInvocationList")
+                    .Invoke(multicastField, [||]) 
+                    :?> System.Delegate []
+            Some listeners              
+        else
+            None
+
+type EventTypes() =
+
+    [<Literal>]
+    let RunsCount = 100
+
+    let runAddRemoveHandlers (event: IDelegateEvent<_>) handlerInitializer =
+        seq {
+            for _ in 1 .. RunsCount do
+                async {
+                    let h = handlerInitializer()
+                    event.AddHandler(h)
+                    event.RemoveHandler(h)
+                }
+        } |> Async.Parallel |> Async.RunSynchronously |> ignore
+
+    [<Fact>]
+    member this.``Adding/removing handlers to published Event<'T> is thread-safe``() = 
+        let event = new Event<int>()  
+        let listenersBefore = EventTypes.getListeners event
+        runAddRemoveHandlers (event.Publish) (fun _ -> new Handler<_>(fun sender args -> ()))
+        let listenersAfter = EventTypes.getListeners event
+
+        Assert.True(listenersBefore.IsNone)
+        Assert.True(listenersAfter.IsNone)
+
+    [<Fact>]
+    member this.``Adding/removing handlers to published DelegateEvent is thread-safe``() = 
+        let event = new DelegateEvent<_>()  
+        let listenersBefore = EventTypes.getListeners event
+        runAddRemoveHandlers (event.Publish) (fun _ -> EventTypes.MultiArgDelegate(fun sender args -> ()))
+        let listenersAfter = EventTypes.getListeners event
+
+        Assert.True(listenersBefore.IsNone)
+        Assert.True(listenersAfter.IsNone)
+
+    [<Fact>]
+    member this.``Adding/removing handlers to published Event<'D,'A> is thread-safe``() = 
+        let event = new Event<_, _>()  
+        let listenersBefore = EventTypes.getListeners event
+        runAddRemoveHandlers (event.Publish) (fun _ -> EventTypes.MultiArgDelegate(fun sender args -> ()))
+        let listenersAfter = EventTypes.getListeners event
+
+        Assert.True(listenersBefore.IsNone)
+        Assert.True(listenersAfter.IsNone)