MultiQueue.hs

-- | Cross-queue scheduling: waits, events, hand-offs and reclamation.
module Spec.MultiQueue (tests) where

import Fragr

import Control.Exception (try)
import Control.Monad (void)
import Data.Foldable (find, for_)
import Data.IORef (modifyIORef', newIORef, readIORef)
import Data.Maybe (fromJust, isJust)
import Data.Text (Text)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))

import Fragr qualified as FG
import Utils

tests :: TestTree
tests =
  testGroup
    "multi-queue"
    [ crossQueueHandoff
    , watermarkDedup
    , droppedWaitCoversMigrate
    , nonAdjacentEventPair
    , adjacentNeedsNoEvent
    , writeAfterForeignRead
    , crossQueueRenameFlags
    , recycleAwaitsTimelines
    , recycleAwaitsRefcount
    , culledContributeNothing
    , perQueueCommandLogs
    , finalizeFollowsProducerQueue
    , finalizeFollowsBareCreator
    , executingQueuesAreLive
    , queuedWithoutRecycleImport
    , queuedWithoutRecycleTransient
    , familyFanOut
    , siblingGuardWithinFamily
    , sharedSkipsSiblingGuard
    , twoFamiliesRejected
    , markSharedExemptsFanOut
    , sharedImportByContract
    , queueOutsidePartition
    , sameFamilyStillPairs
    , mixedFamilyFanOutRejected
    , sameQueueSharesAcquire
    , renameCarriesNoTransferBack
    , foreignImportDerivesNothing
    , ownedImportBoundaryPair
    , ownedImportAtHome
    , ownedImportForeignRename
    , ownedImportUnused
    ]

crossQueueHandoff :: TestTree
crossQueueHandoff = testCase "graphics produces, compute (other queue) consumes: one cross-queue wait, release/acquire" do
  g <- FG.newFrameGraph @Device @Device
  gbuf <-
    FG.addPass
      g
      "Graphics"
      ( do
          h <- FG.create @Image "gbuf" (img "gbuf")
          FG.write h
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Compute"
      ( do
          FG.setQueue (QueueId 1)
          FG.read gbuf
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compile g
  s <- FG.snapshot g
  let
    graphics = syncOf s "Graphics"
    compute = syncOf s "Compute"
  compute.waits @?= [Wait{queue = QueueId 0, value = 1, covers = [Access{handle = gbuf, flags = Nothing}]}]
  compute.acquires @?= [Transfer{handle = gbuf, peer = QueueId 0, flags = Nothing}]
  graphics.releases @?= [Transfer{handle = gbuf, peer = QueueId 1, flags = Nothing}]
  graphics.signal @?= 1
  dev <- runQueued g
  l0 <- queueLog dev (QueueId 0)
  l1 <- queueLog dev (QueueId 1)
  assertBool "release recorded on q0" (("release " <> tshow gbuf <> " to q1") `elem` l0)
  assertBool "acquire recorded on q1" (("acquire " <> tshow gbuf <> " from q0") `elem` l1)
  assertBool "wait recorded on q1" ("wait q0>=1" `elem` l1)

watermarkDedup :: TestTree
watermarkDedup = testCase "watermark dedup: the later consumer inherits the earlier wait" do
  g <- FG.newFrameGraph @Device @Device
  r1 <- FG.addPass g "A1" (FG.create @Image "r1" (img "r1") >>= FG.write) \_data -> pure ()
  r2 <- FG.addPass g "A2" (FG.create @Image "r2" (img "r2") >>= FG.write) \_data -> pure ()
  _ <-
    FG.addPass
      g
      "C1"
      ( do
          FG.setQueue (QueueId 1)
          FG.read r1
          FG.read r2
          FG.setSideEffect
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "C2"
      ( do
          FG.setQueue (QueueId 1)
          FG.read r1
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compile g
  s <- FG.snapshot g
  -- C1 waits only on the later value (2), covering both edges' reads.
  (syncOf s "C1").waits @?= [Wait{queue = QueueId 0, value = 2, covers = [Access{handle = r1, flags = Nothing}, Access{handle = r2, flags = Nothing}]}]
  -- C2's need (q0 >= 1) is already implied by C1's earlier wait.
  (syncOf s "C2").waits @?= []

droppedWaitCoversMigrate :: TestTree
droppedWaitCoversMigrate = testCase "a dropped wait's covers migrate to the kept wait" do
  g <- FG.newFrameGraph @Device @Device
  r1 <- FG.addPass g "A1" (FG.create @Image "r1" (img "r1") >>= FG.write) \_data -> pure ()
  r2 <- FG.addPass g "A2" (FG.create @Image "r2" (img "r2") >>= FG.write) \_data -> pure ()
  -- C1's wait (value 2) sets the watermark; C2's (value 1) is dropped,
  -- but its differently-flagged access must still scope the kept wait.
  _ <-
    FG.addPass
      g
      "C1"
      ( do
          FG.setQueue (QueueId 1)
          FG.readWith r2 ColorAttachment
          FG.setSideEffect
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "C2"
      ( do
          FG.setQueue (QueueId 1)
          FG.readWith r1 ShaderRead
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compile g
  s <- FG.snapshot g
  (syncOf s "C1").waits
    @?= [ Wait
            { queue = QueueId 0
            , value = 2
            , covers = [Access{handle = r1, flags = Just ShaderRead}, Access{handle = r2, flags = Just ColorAttachment}]
            }
        ]
  (syncOf s "C2").waits @?= []

nonAdjacentEventPair :: TestTree
nonAdjacentEventPair = testCase "same-queue non-adjacent dependency emits an event pair" do
  g <- FG.newFrameGraph @Device @Device
  r <- FG.addPass g "Producer" (FG.create @Image "r" (img "r") >>= FG.write) \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Middle"
      ( do
          h <- FG.create @Image "m" (img "m")
          FG.write_ h
          FG.setSideEffect
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Consumer"
      ( do
          FG.read r
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compile g
  s <- FG.snapshot g
  (syncOf s "Producer").signalEvents @?= [SyncEvent{event = EventId 0, covers = [Access{handle = r, flags = Nothing}]}]
  (syncOf s "Consumer").waitEvents @?= [SyncEvent{event = EventId 0, covers = [Access{handle = r, flags = Nothing}]}]
  (syncOf s "Middle").signalEvents @?= []
  (syncOf s "Middle").waitEvents @?= []

adjacentNeedsNoEvent :: TestTree
adjacentNeedsNoEvent = testCase "adjacent same-queue dependency needs no event" do
  g <- FG.newFrameGraph @Device @Device
  r <- FG.addPass g "Producer" (FG.create @Image "r" (img "r") >>= FG.write) \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Consumer"
      ( do
          FG.read r
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compile g
  s <- FG.snapshot g
  (syncOf s "Producer").signalEvents @?= []
  (syncOf s "Consumer").waitEvents @?= []

writeAfterForeignRead :: TestTree
writeAfterForeignRead = testCase "a renaming writer waits for foreign-queue readers (write-after-read)" do
  g <- FG.newFrameGraph @Device @Device
  r <- FG.addPass g "Producer" (FG.create @Image "r" (img "r") >>= FG.write) \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Reader"
      ( do
          FG.setQueue (QueueId 1)
          FG.read r
          FG.setSideEffect
      )
      \_data -> pure ()
  r' <-
    FG.addPass
      g
      "Overwrite"
      ( do
          r' <- FG.write r
          FG.setSideEffect
          pure r'
      )
      \_data -> pure ()
  FG.compile g
  s <- FG.snapshot g
  -- Reader holds position 1 on queue 1; Overwrite must not run before
  -- it, even though no data flows from Reader to Overwrite. The wait
  -- covers the renaming write the anti-edge protects.
  (syncOf s "Overwrite").waits @?= [Wait{queue = QueueId 1, value = 1, covers = [Access{handle = r', flags = Nothing}]}]

crossQueueRenameFlags :: TestTree
crossQueueRenameFlags = testCase "a cross-queue rename's transfer carries the renaming write's access" do
  g <- FG.newFrameGraph @Device @Device
  r <-
    FG.addPass
      g
      "Producer"
      (FG.create @Image "r" (img "r") >>= (`FG.writeWith` ColorAttachment))
      \_data -> runHere "Producer"
  r' <-
    FG.addPass
      g
      "Rename"
      ( do
          FG.setQueue (QueueId 1)
          r' <- FG.writeWith r General
          FG.setSideEffect
          pure r'
      )
      \_data -> runHere "Rename"
  FG.compile g
  s <- FG.snapshot g
  -- The rename consumes r through its implicit flagless read; the
  -- transfer carries the renaming write's access instead — so the
  -- release / acquire hooks fire, with the target state.
  (syncOf s "Producer").releases @?= [Transfer{handle = r', peer = QueueId 1, flags = Just General}]
  (syncOf s "Rename").acquires @?= [Transfer{handle = r', peer = QueueId 0, flags = Just General}]
  dev <- runQueued g
  l0 <- queueLog dev (QueueId 0)
  l1 <- queueLog dev (QueueId 1)
  assertBool "release hook fires with the write's flags" ("release-hook r ->general" `elem` l0)
  assertBool "acquire hook fires with the write's flags" ("acquire-hook r ->general" `elem` l1)

recycleAwaitsTimelines :: TestTree
recycleAwaitsTimelines = testCase "recycle queue reclaims only once every timeline is past the requirements" do
  rq <- FG.newRecycleQueue
  destroyed <- newIORef ([] :: [Int])
  item <- FG.mkRetireItem 7 [(QueueId 0, 2), (QueueId 1, 3)] (modifyIORef' destroyed (7 :))
  FG.retireItem rq item
  c1 <- FG.collect rq [(QueueId 0, 2), (QueueId 1, 2)] -- q1 short
  c1 @?= []
  readIORef destroyed >>= (@?= [])
  c2 <- FG.collect rq [(QueueId 0, 5), (QueueId 1, 3)] -- both met
  c2 @?= [7]
  readIORef destroyed >>= (@?= [7])

recycleAwaitsRefcount :: TestTree
recycleAwaitsRefcount = testCase "an in-use refcount holds a resource past satisfied timelines" do
  rq <- FG.newRecycleQueue
  destroyed <- newIORef (0 :: Int)
  item <- FG.mkRetireItem 1 [(QueueId 0, 1)] (modifyIORef' destroyed (+ 1))
  FG.acquireItem item
  FG.retireItem rq item
  c1 <- FG.collect rq [(QueueId 0, 1)] -- timelines met, but a ref is held
  c1 @?= []
  readIORef destroyed >>= (@?= 0)
  FG.releaseItem item
  c2 <- FG.collect rq [(QueueId 0, 1)]
  c2 @?= [1]
  readIORef destroyed >>= (@?= 1)

culledContributeNothing :: TestTree
culledContributeNothing = testCase "culled passes contribute nothing to the schedule" do
  g <- FG.newFrameGraph @Device @Device
  _ <-
    FG.addPass
      g
      "Live"
      ( do
          h <- FG.create @Image "r" (img "r")
          FG.write_ h
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.addPass_ g "Dead" (FG.create @Image "s" (img "s") >>= FG.write_) (pure ())
  FG.compile g
  s <- FG.snapshot g
  [live] <- pure (filter (\p -> p.name == "Live") s.passes)
  [dead] <- pure (filter (\p -> p.name == "Dead") s.passes)
  assertBool "the live pass has a schedule" (isJust live.sync)
  dead.sync @?= Nothing
  -- Only the live resource (entry 0) shows up in the retire requirements.
  map (.entryId) s.retires @?= [0]

perQueueCommandLogs :: TestTree
perQueueCommandLogs = testCase "a multi-queue frame records the expected per-queue command logs" do
  g <- FG.newFrameGraph @Device @Device
  FG.addPreExec g \dev -> logHere dev "flush"
  FG.addPostExec g \dev -> logHere dev "post-flush"
  gbuf <-
    FG.addPass
      g
      "Graphics"
      ( do
          h <- FG.create @Image "gbuf" (img "gbuf")
          FG.writeWith h ColorAttachment
      )
      \_data -> runHere "Graphics"
  lit <-
    FG.addPass
      g
      "Compute"
      ( do
          FG.setQueue (QueueId 1)
          FG.readWith gbuf ShaderRead
          h <- FG.create @Image "lit" (img "lit")
          FG.writeWith h General
      )
      \_data -> runHere "Compute"
  _ <-
    FG.addPass
      g
      "Present"
      ( do
          FG.readWith lit ShaderRead
          FG.setSideEffect
      )
      \_data -> runHere "Present"
  FG.compile g
  FG.executingQueues g >>= (@?= [QueueId 0, QueueId 1])
  s <- FG.snapshot g
  -- The schedule carries the consuming access's flags on waits and
  -- transfers, so drivers can derive wait scopes and target states.
  (syncOf s "Compute").waits @?= [Wait{queue = QueueId 0, value = 1, covers = [Access{handle = gbuf, flags = Just ShaderRead}]}]
  (syncOf s "Graphics").releases @?= [Transfer{handle = gbuf, peer = QueueId 1, flags = Just ShaderRead}]
  (syncOf s "Present").acquires @?= [Transfer{handle = lit, peer = QueueId 1, flags = Just ShaderRead}]
  dev <- runQueued g
  l0 <- queueLog dev (QueueId 0)
  l1 <- queueLog dev (QueueId 1)
  l0
    @?= [ "create gbuf"
        , "barrier gbuf undefined->color-attachment"
        , "flush"
        , "run Graphics"
        , "release-hook gbuf ->shader-read"
        , "post-flush"
        , "release " <> tshow gbuf <> " to q1"
        , "signal 1"
        , "wait q1>=1"
        , "acquire " <> tshow lit <> " from q1"
        , "acquire-hook lit ->shader-read"
        , "barrier lit general->shader-read"
        , "flush"
        , "run Present"
        , "post-flush"
        , "signal 2"
        , "destroy lit"
        ]
  l1
    @?= [ "wait q0>=1"
        , "acquire " <> tshow gbuf <> " from q0"
        , "create lit"
        , "acquire-hook gbuf ->shader-read"
        , "barrier gbuf color-attachment->shader-read"
        , "barrier lit undefined->general"
        , "flush"
        , "run Compute"
        , "release-hook lit ->shader-read"
        , "post-flush"
        , "release " <> tshow lit <> " to q0"
        , "signal 1"
        , "destroy gbuf"
        ]

finalizeFollowsProducerQueue :: TestTree
finalizeFollowsProducerQueue = testCase "finalize places its pass on the producer's queue" do
  g <- FG.newFrameGraph @Device @Device
  r <-
    FG.addPass
      g
      "Compute"
      ( do
          FG.setQueue (QueueId 1)
          FG.create @Image "r" (img "r") >>= FG.write
      )
      \_data -> pure ()
  FG.finalize g r General
  FG.compile g
  FG.executingQueues g >>= (@?= [QueueId 1])
  s <- FG.snapshot g
  let fin = syncOf s "finalize r"
  fin.queue @?= QueueId 1
  -- Same queue, adjacent: the helper manufactures no cross-queue
  -- wait, transfer or event.
  fin.waits @?= []
  fin.acquires @?= []

finalizeFollowsBareCreator :: TestTree
finalizeFollowsBareCreator = testCase "finalize follows a creator that never writes" do
  g <- FG.newFrameGraph @Device @Device
  r <-
    FG.addPass
      g
      "Author"
      do
        FG.setQueue (QueueId 1)
        FG.create @Image "r" (img "r")
      \_data -> pure ()
  FG.finalize g r General
  FG.compile g
  FG.executingQueues g >>= (@?= [QueueId 1])
  s <- FG.snapshot g
  (syncOf s "finalize r").queue @?= QueueId 1

executingQueuesAreLive :: TestTree
executingQueuesAreLive = testCase "executingQueues lists only queues with surviving passes" do
  g <- FG.newFrameGraph @Device @Device
  assertFatal $ FG.executingQueues g
  _ <-
    FG.addPass
      g
      "Live"
      ( do
          FG.setQueue (QueueId 1)
          h <- FG.create @Image "r" (img "r")
          FG.write_ h
          FG.setSideEffect
      )
      \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Dead"
      ( do
          FG.setQueue (QueueId 2)
          FG.create @Image "s" (img "s") >>= FG.write
      )
      \_data -> pure ()
  FG.compile g
  FG.executingQueues g >>= (@?= [QueueId 1])

queuedWithoutRecycleImport :: TestTree
queuedWithoutRecycleImport = testCase "executeQueued without a recycle queue drives an import-only graph" do
  g <- FG.newFrameGraph @Device @Device
  swapImg <- Image <$> newIORef "undefined" <*> pure False
  h <- FG.importResource g "swap" (img "swap") swapImg
  _ <-
    FG.addPass
      g
      "Blit"
      (FG.writeWith h General)
      \_data -> runHere "Blit"
  FG.compile g
  dev <- newDevice
  FG.executeQueued g (mkBackend dev) Nothing dev dev
  assertHandoffsDrained dev
  l0 <- queueLog dev (QueueId 0)
  l0 @?= ["barrier swap undefined->general", "run Blit", "signal 1"]

queuedWithoutRecycleTransient :: TestTree
queuedWithoutRecycleTransient = testCase "executeQueued without a recycle queue refuses a transient to reclaim" do
  g <- FG.newFrameGraph @Device @Device
  _ <-
    FG.addPass
      g
      "P"
      ( do
          h <- FG.create @Image "t" (img "t")
          FG.write_ h
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compile g
  dev <- newDevice
  assertFatal $ FG.executeQueued g (mkBackend dev) Nothing dev dev

familyFanOut :: TestTree
familyFanOut = testCase "family fan-out: one transfer, acquired by the family's first consumer" do
  (g, gbuf) <- fanOutGraph
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1), (QueueId 2, FamilyId 1)] g
  s <- FG.snapshot g
  (syncOf s "Graphics").releases @?= [Transfer{handle = gbuf, peer = QueueId 1, flags = Nothing}]
  (syncOf s "C1").acquires @?= [Transfer{handle = gbuf, peer = QueueId 0, flags = Nothing}]
  (syncOf s "C2").acquires @?= []
  -- The sibling waits on the producer /and/ on the primary's acquiring
  -- pass — the acquire barrier lives on the primary's queue.
  (syncOf s "C2").waits
    @?= [ Wait{queue = QueueId 0, value = 1, covers = [Access{handle = gbuf, flags = Nothing}]}
        , Wait{queue = QueueId 1, value = 1, covers = [Access{handle = gbuf, flags = Nothing}]}
        ]
  dev <- runQueued g
  l1 <- queueLog dev (QueueId 1)
  l2 <- queueLog dev (QueueId 2)
  assertBool "the primary acquires" (("acquire " <> tshow gbuf <> " from q0") `elem` l1)
  assertBool "the sibling does not" (("acquire " <> tshow gbuf <> " from q0") `notElem` l2)
  assertBool "the sibling waits on the acquirer" ("wait q1>=1" `elem` l2)

siblingGuardWithinFamily :: TestTree
siblingGuardWithinFamily = testCase "the sibling guard melts within the producer's own family" do
  -- Consumers of the producer's family need no acquire barrier: the
  -- hand-off transitions producer-side, so the data-edge wait on the
  -- producer already orders the sibling.
  g <- FG.newFrameGraph @Device @Device
  gbuf <- FG.addPass g "Graphics" (FG.create @Image "gbuf" (img "gbuf") >>= FG.write) \_data -> pure ()
  for_ [(1 :: Int, "C1"), (2, "C2")] \(q, n) ->
    FG.addPass
      g
      n
      ( do
          FG.setQueue (QueueId q)
          FG.read gbuf
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 0), (QueueId 2, FamilyId 0)] g
  s <- FG.snapshot g
  (syncOf s "C2").waits @?= [Wait{queue = QueueId 0, value = 1, covers = [Access{handle = gbuf, flags = Nothing}]}]
  void (runQueued g)

sharedSkipsSiblingGuard :: TestTree
sharedSkipsSiblingGuard = testCase "a shared resource skips the sibling guard" do
  -- CONCURRENT: the release transitions producer-side and the acquire
  -- melts, so the sibling's wait on the producer covers everything.
  (g, gbuf) <- fanOutGraph
  FG.markShared g gbuf
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1), (QueueId 2, FamilyId 1)] g
  s <- FG.snapshot g
  (syncOf s "C2").waits @?= [Wait{queue = QueueId 0, value = 1, covers = [Access{handle = gbuf, flags = Nothing}]}]
  void (runQueued g)

twoFamiliesRejected :: TestTree
twoFamiliesRejected = testCase "released to two families is rejected" do
  (g, _) <- fanOutGraph
  expectTwoFamilies [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1), (QueueId 2, FamilyId 2)] [("C1", FamilyId 1), ("C2", FamilyId 2)] g

markSharedExemptsFanOut :: TestTree
markSharedExemptsFanOut = testCase "markShared exempts a two-family fan-out from single ownership" do
  (g, gbuf) <- fanOutGraph
  FG.markShared g gbuf
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1), (QueueId 2, FamilyId 2)] g
  s <- FG.snapshot g
  (syncOf s "Graphics").releases
    @?= [ Transfer{handle = gbuf, peer = QueueId 1, flags = Nothing}
        , Transfer{handle = gbuf, peer = QueueId 2, flags = Nothing}
        ]
  (syncOf s "C1").acquires @?= [Transfer{handle = gbuf, peer = QueueId 0, flags = Nothing}]
  (syncOf s "C2").acquires @?= [Transfer{handle = gbuf, peer = QueueId 0, flags = Nothing}]

sharedImportByContract :: TestTree
sharedImportByContract = testCase "a shared import is exempt through the contract (isShared)" do
  g <- FG.newFrameGraph @Device @Device
  obj <- Image <$> newIORef "undefined" <*> pure True
  h0 <- FG.importScratch g "gbuf" (img "gbuf") obj
  gbuf <- FG.addPass g "Graphics" (FG.write h0) \_data -> pure ()
  for_ [(1 :: Int, "C1"), (2, "C2")] \(q, n) ->
    FG.addPass
      g
      n
      ( do
          FG.setQueue (QueueId q)
          FG.read gbuf
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1), (QueueId 2, FamilyId 2)] g
  s <- FG.snapshot g
  (syncOf s "Graphics").releases
    @?= [ Transfer{handle = gbuf, peer = QueueId 1, flags = Nothing}
        , Transfer{handle = gbuf, peer = QueueId 2, flags = Nothing}
        ]

queueOutsidePartition :: TestTree
queueOutsidePartition = testCase "a queue outside the partition keeps its per-queue transfer" do
  (g, gbuf) <- fanOutGraph
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1)] g
  s <- FG.snapshot g
  (syncOf s "Graphics").releases
    @?= [ Transfer{handle = gbuf, peer = QueueId 1, flags = Nothing}
        , Transfer{handle = gbuf, peer = QueueId 2, flags = Nothing}
        ]
  (syncOf s "C2").acquires @?= [Transfer{handle = gbuf, peer = QueueId 0, flags = Nothing}]

sameFamilyStillPairs :: TestTree
sameFamilyStillPairs = testCase "a same-family consumer still gets the transfer pair (backends melt it)" do
  g <- FG.newFrameGraph @Device @Device
  gbuf <- FG.addPass g "Graphics" (FG.create @Image "gbuf" (img "gbuf") >>= FG.write) \_data -> pure ()
  _ <-
    FG.addPass
      g
      "C1"
      ( do
          FG.setQueue (QueueId 1)
          FG.read gbuf
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 0)] g
  s <- FG.snapshot g
  (syncOf s "Graphics").releases @?= [Transfer{handle = gbuf, peer = QueueId 1, flags = Nothing}]
  (syncOf s "C1").acquires @?= [Transfer{handle = gbuf, peer = QueueId 0, flags = Nothing}]

mixedFamilyFanOutRejected :: TestTree
mixedFamilyFanOutRejected = testCase "a fan-out mixing the producer's own family with a foreign one is rejected" do
  -- C1 shares the producer's family, C2 does not. Ownership must move
  -- to C2's family while C1 still reads on the source family — an order
  -- the release (recorded producer-side) cannot express, so this is a
  -- two-family violation like any other; markShared is the way out.
  (g, _) <- fanOutGraph
  expectTwoFamilies [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 0), (QueueId 2, FamilyId 1)] [("C1", FamilyId 0), ("C2", FamilyId 1)] g

sameQueueSharesAcquire :: TestTree
sameQueueSharesAcquire = testCase "same-queue consumers share one acquire" do
  -- The partition-less path groups per (version, queue) like the
  -- family path groups per family: one release must be consumed by
  -- exactly one acquire, on the first-registered consumer.
  g <- FG.newFrameGraph @Device @Device
  gbuf <- FG.addPass g "Graphics" (FG.create @Image "gbuf" (img "gbuf") >>= FG.write) \_data -> pure ()
  for_ [("C1" :: Text), "C2"] \n ->
    FG.addPass
      g
      n
      ( do
          FG.setQueue (QueueId 1)
          FG.read gbuf
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compile g
  s <- FG.snapshot g
  (syncOf s "Graphics").releases @?= [Transfer{handle = gbuf, peer = QueueId 1, flags = Nothing}]
  (syncOf s "C1").acquires @?= [Transfer{handle = gbuf, peer = QueueId 0, flags = Nothing}]
  (syncOf s "C2").acquires @?= []
  void (runQueued g)

renameCarriesNoTransferBack :: TestTree
renameCarriesNoTransferBack = testCase "a rename after a foreign read carries no transfer back" do
  -- The reader's hand-off pair is the read edge's; the write-after-read
  -- anti-edge carries no payload and the rename's data edge is
  -- same-queue, so ownership is never handed back — safe only because
  -- the overwrite is a write (backends acquire by discarding; a partial
  -- cross-family rewrite is Q3's territory).
  g <- FG.newFrameGraph @Device @Device
  r <- FG.addPass g "Producer" (FG.create @Image "r" (img "r") >>= FG.write) \_data -> pure ()
  _ <-
    FG.addPass
      g
      "Reader"
      ( do
          FG.setQueue (QueueId 1)
          FG.read r
          FG.setSideEffect
      )
      \_data -> pure ()
  r' <-
    FG.addPass
      g
      "Overwrite"
      ( do
          r' <- FG.write r
          FG.setSideEffect
          pure r'
      )
      \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1)] g
  s <- FG.snapshot g
  (syncOf s "Producer").releases @?= [Transfer{handle = r, peer = QueueId 1, flags = Nothing}]
  (syncOf s "Reader").acquires @?= [Transfer{handle = r, peer = QueueId 0, flags = Nothing}]
  (syncOf s "Overwrite").acquires @?= []
  (syncOf s "Overwrite").releases @?= []
  (syncOf s "Overwrite").waits @?= [Wait{queue = QueueId 1, value = 1, covers = [Access{handle = r', flags = Nothing}]}]
  void (runQueued g)

foreignImportDerivesNothing :: TestTree
foreignImportDerivesNothing = testCase "an import first touched by a foreign queue derives no transfer" do
  -- No producer edge this frame, so nothing arms a hand-off: a plain
  -- EXCLUSIVE import cannot migrate families across frames (the
  -- backend guards the read fatally) — declare the owner with
  -- importOwned instead.
  g <- FG.newFrameGraph @Device @Device
  obj <- Image <$> newIORef "undefined" <*> pure False
  h <- FG.importResource g "ext" (img "ext") obj
  _ <-
    FG.addPass
      g
      "Foreign"
      ( do
          FG.setQueue (QueueId 1)
          FG.read h
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1)] g
  s <- FG.snapshot g
  (syncOf s "Foreign").waits @?= []
  (syncOf s "Foreign").acquires @?= []

ownedImportBoundaryPair :: TestTree
ownedImportBoundaryPair = testCase "an owned import hands its first foreign touch a boundary pair" do
  -- The synthetic producer stands in for last frame's work on the
  -- owning queue: the release records there, the consumer acquires
  -- under its own flags and waits on the synthetic pass's signal.
  (g, h) <- ownedImport (QueueId 0)
  _ <-
    FG.addPass
      g
      "Foreign"
      ( do
          FG.setQueue (QueueId 1)
          FG.readWith h ShaderRead
          FG.setSideEffect
      )
      \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1)] g
  s <- FG.snapshot g
  (syncOf s "import ext").releases @?= [Transfer{handle = h, peer = QueueId 1, flags = Just ShaderRead}]
  (syncOf s "Foreign").acquires @?= [Transfer{handle = h, peer = QueueId 0, flags = Just ShaderRead}]
  (syncOf s "Foreign").waits @?= [Wait{queue = QueueId 0, value = 1, covers = [Access{handle = h, flags = Just ShaderRead}]}]
  dev <- runQueued g
  l0 <- queueLog dev (QueueId 0)
  assertBool "the release records on the owner" (("release " <> tshow h <> " to q1") `elem` l0)
  assertBool "the release hook fires there" ("release-hook ext ->shader-read" `elem` l0)

ownedImportAtHome :: TestTree
ownedImportAtHome = testCase "an owned import first touched at home derives no transfer" do
  (g, h) <- ownedImport (QueueId 0)
  _ <- FG.addPass g "Consumer" (FG.readWith h ShaderRead >> FG.setSideEffect) \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1)] g
  s <- FG.snapshot g
  (syncOf s "import ext").releases @?= []
  (syncOf s "Consumer").waits @?= []
  (syncOf s "Consumer").acquires @?= []
  void (runQueued g)

ownedImportForeignRename :: TestTree
ownedImportForeignRename = testCase "a foreign rename of an owned import carries the write's flags" do
  -- The rename consumes the synthetic version through its implicit
  -- flagless read; the pair rides the renaming write's access. The
  -- writer also proves the observed flip: no setSideEffect, yet it
  -- survives culling.
  (g, h) <- ownedImport (QueueId 0)
  h' <-
    FG.addPass
      g
      "Overwrite"
      ( do
          FG.setQueue (QueueId 1)
          FG.writeWith h ColorAttachment
      )
      \_data -> pure ()
  FG.compileWith [(QueueId 0, FamilyId 0), (QueueId 1, FamilyId 1)] g
  s <- FG.snapshot g
  -- The pair names the renaming write's access — the new version's
  -- handle, like any rename-consumed transfer.
  (syncOf s "import ext").releases @?= [Transfer{handle = h', peer = QueueId 1, flags = Just ColorAttachment}]
  (syncOf s "Overwrite").acquires @?= [Transfer{handle = h', peer = QueueId 0, flags = Just ColorAttachment}]
  void (runQueued g)

ownedImportUnused :: TestTree
ownedImportUnused = testCase "an unused owned import culls its synthetic pass" do
  (g, _) <- ownedImport (QueueId 0)
  FG.compile g
  s <- FG.snapshot g
  (fromJust (find (\p -> p.name == "import ext") s.passes)).sync @?= Nothing
  dev <- runQueued g
  queueLog dev (QueueId 0) >>= (@?= [])

-- | An image persisted from "last frame" (general layout), owned by the queue.
ownedImport :: QueueId -> IO (FrameGraph Device Device, Handle Image)
ownedImport owner = do
  g <- FG.newFrameGraph @Device @Device
  obj <- Image <$> newIORef "general" <*> pure False
  h <- FG.importOwned g "ext" (img "ext") obj owner
  pure (g, h)

-- | One producer on queue 0, consumers on queues 1 and 2.
fanOutGraph :: IO (FrameGraph Device Device, Handle Image)
fanOutGraph = do
  g <- FG.newFrameGraph @Device @Device
  gbuf <- FG.addPass g "Graphics" (FG.create @Image "gbuf" (img "gbuf") >>= FG.write) \_data -> pure ()
  for_ [(1 :: Int, "C1"), (2, "C2")] \(q, n) ->
    FG.addPass
      g
      n
      ( do
          FG.setQueue (QueueId q)
          FG.read gbuf
          FG.setSideEffect
      )
      \_data -> pure ()
  pure (g, gbuf)

-- | Compiling under the partition must reject @gbuf@ with these consumers.
expectTwoFamilies :: [(QueueId, FamilyId)] -> [(Text, FamilyId)] -> FrameGraph Device Device -> IO ()
expectTwoFamilies partition consumers g =
  try @FragrError (FG.compileWith partition g) >>= \case
    Left (ReleasedToTwoFamilies res cs) -> do
      res @?= "gbuf"
      cs @?= consumers
    Left e -> assertFailure ("unexpected error: " <> show e)
    Right () -> assertFailure "expected ReleasedToTwoFamilies"