Notifier-Subscription-List robustness

Src/Myc.Core.Notifier.pas

@@ -24,7 +24,6 @@ type
             end;
 
     strict private
-        FFirst: NativeUInt; // Stores the first receiver if no list is allocated, or acts as a combined lock and state field.
         // Bit 0: Lock state (0 = locked, 1 = unlocked).
         // Bit 1: Finalized state (0 = not finalized, 1 = finalized).
         // Other bits (if not 0 and bit 0 is 1) can be a direct interface pointer if FList is nil.
@@ -37,7 +36,7 @@ type
         procedure Create; // Initializes the notification list, preparing it for use.
         procedure Destroy; // Cleans up all resources, including unadvising all receivers. Assumes no concurrent access.
         function Advise(const Receiver: T): TTag; // Registers a receiver interface and returns an opaque tag for later unsubscription.
-        procedure Unadvise(Tag: TTag); // Unregisters a specific receiver using the tag obtained from Advise.
+        procedure Unadvise(Tag: TTag);
         procedure UnadviseAll; // Unregisters all currently advised receivers.
         procedure Lock; inline; // Acquires an exclusive lock for thread-safe operations on the list.
         procedure Release; inline; // Releases the previously acquired exclusive lock.
@@ -51,8 +50,7 @@ implementation
 
 procedure TMycNotifyList<T>.Create;
 begin
-    FFirst := 1;
-    FList := nil;
+    NativeUInt(FList) := 1;
 end;
 
 procedure TMycNotifyList<T>.Destroy;
@@ -60,7 +58,7 @@ begin
     // Because refcounting is thread-safe, this will always be entered once after all references
     // to Self are dropped. No locking needed!
     //    Assert(not IsLocked);
-    FFirst := FFirst and not 3;
+    NativeUInt(FList) := NativeUInt(FList) and not 1;
     UnadviseAll;
 end;
 
@@ -70,11 +68,8 @@ var
 begin
     Assert(IsLocked);
 
-    if FFirst = 0 then
-    begin
-        IInterface(FFirst) := Receiver;
-        exit(PPointer(@Receiver)^);
-    end;
+    if not Assigned(Receiver) then
+        exit( nil );
 
     Item := AllocItem;
     Item.Receiver := Receiver;
@@ -90,13 +85,8 @@ end;
 
 procedure TMycNotifyList<T>.Lock;
 begin
-    repeat
-        if FFirst and 1 = 0 then
-        begin
-            YieldProcessor;
-            continue;
-        end;
-    until TInterlocked.BitTestAndClear(PNativeUint(@FFirst)^, 0);
+    while not TInterlocked.BitTestAndClear(NativeUint(FList), 0) do
+        YieldProcessor;
 
     Assert(IsLocked, 'Locking failed');
 end;
@@ -113,33 +103,77 @@ end;
 
 function TMycNotifyList<T>.IsLocked: Boolean;
 begin
-    Result := FFirst and 1 = 0;
+    Result := NativeUInt(FList) and 1 = 0;
 end;
 
 procedure TMycNotifyList<T>.Notify(Func: TPredicate<T>);
 var
-    Item, P: PItem;
+    Item: PItem;
+    Last: PItem;
+    tmp: PItem;
 begin
     Assert(IsLocked);
 
-    if FFirst <> 0 then
-        if not Func(IInterface(FFirst)) then
-            IInterface(FFirst) := nil;
-
+    tmp := nil;
+    Last := nil;
     Item := FList;
-    while Item <> nil do
+    while (Item <> nil) and Assigned(Item.Receiver) do
     begin
-        P := Item.Next;
         if not Func(Item.Receiver) then
-            Unadvise(TTag(Item));
-        Item := P;
+        begin
+            // Receiver wants no more notifications, detach it
+            if Item = FList then
+                FList := Item.Next;
+
+            if Item.Prev <> nil then
+                Item.Prev.Next := Item.Next;
+            if Item.Next <> nil then
+                Item.Next.Prev := Item.Prev;
+
+            // release the receiver
+            Item.Receiver := nil;
+
+            // and save the list item in a tmp list for later use
+            var nxt := Item.Next;
+            Item.Next := tmp;
+            tmp := Item;
+            Item := nxt;
+        end
+        else
+        begin
+            Last := Item;
+            Item := Last.Next;
+        end;
+    end;
+
+    // Append all detached items at end of the list. We can't simply free them, because the subscription is owned by the client.
+    while tmp <> nil do
+    begin
+        Item := tmp;
+        tmp := Item.Next;
+
+        if Last = nil then
+        begin
+            Item.Prev := nil;
+            Item.Next := FList;
+            FList := Item;
+        end
+        else
+        begin
+            Item.Prev := Last;
+            Item.Next := Last.Next;
+            if Item.Prev <> nil then
+                Item.Prev.Next := Item;
+        end;
+        if Item.Next <> nil then
+            Item.Next.Prev := Item;
     end;
 end;
 
 procedure TMycNotifyList<T>.Release;
 begin
     Assert(IsLocked);
-    TInterlocked.Exchange(Pointer(FFirst), Pointer(FFirst or 1));
+    TInterlocked.Exchange(NativeUint(FList), NativeUint(FList) or 1);
 end;
 
 procedure TMycNotifyList<T>.Unadvise(Tag: TTag);
@@ -148,11 +182,19 @@ var
 begin
     Assert(IsLocked);
 
-    if NativeUInt(Tag) = FFirst then
-    begin
-        IInterface(FFirst) := nil;
+    if (Tag = nil) or (FList = nil) then
         exit;
+
+    {$ifdef DEBUG}
+    Item := FList;
+    while Item<>nil do
+    begin
+        if Item = Tag then
+            break;
+        Item := Item.Next;
     end;
+    Assert( Item <> nil, 'Receiver not advised' );
+    {$endif}
 
     if FList = nil then
         exit;
@@ -175,8 +217,6 @@ end;
 procedure TMycNotifyList<T>.UnadviseAll;
 begin
     Assert(IsLocked);
-
-    IInterface(FFirst) := nil;
     while FList <> nil do
         Unadvise(TTag(FList));
 end;

Src/Myc.Core.Signals.pas

@@ -32,7 +32,6 @@ type
     strict private
         FSubscribers: TMycNotifyList<TSignal.ISubscriber>;
         function GetSignal: TSignal;
-        function GetIsSet: Boolean;
     public
         constructor Create;
         destructor Destroy; override;
@@ -197,11 +196,6 @@ begin
     inherited;
 end;
 
-function TMycEvent.GetIsSet: Boolean;
-begin
-    Result := true;
-end;
-
 function TMycEvent.GetSignal: TSignal;
 begin
     Result := Self;

Src/Myc.Signals.pas

@@ -223,6 +223,7 @@ begin
     if Assigned(FSignal) then
     begin
         FSignal.Unsubscribe(FTag);
+        FTag := nil;
         FSignal := TSignal.Null;
     end;
     FTag := nil;