summaryrefslogtreecommitdiff
path: root/Omni/Task/RaceTest.hs
blob: d4780fda4853abcd16e44f2f5bf524cfa6db3592 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Omni.Task.RaceTest where

import Alpha
import Omni.Task.Core
import qualified Omni.Test as Test
import System.Directory (doesFileExist, removeFile)
import System.Environment (setEnv)
import Control.Concurrent.Async (mapConcurrently)
import qualified Data.Text as T
import Data.List (nub)

test :: Test.Tree
test = Test.group "Omni.Task.Race" [raceTest]

raceTest :: Test.Tree
raceTest =
  Test.unit "concurrent child creation (race condition)" <| do
    -- Set up test mode
    setEnv "TASK_TEST_MODE" "1"
    setEnv "TASK_DB_PATH" ".tasks/race-test.jsonl"
    
    -- Clean up test database
    let testFile = ".tasks/race-test.jsonl"
    exists <- doesFileExist testFile
    when exists <| removeFile testFile
    initTaskDb
    
    -- Create a parent epic
    parent <- createTask "Parent Epic" Epic Nothing Nothing P2 []
    let parentId = taskId parent
    
    -- Create multiple children concurrently
    -- We'll create 10 children in parallel
    let childCount = 10
        indices = [1..childCount]
    
    -- Run concurrent creations
    children <- mapConcurrently
      (\i -> createTask ("Child " <> tshow i) WorkTask (Just parentId) Nothing P2 [])
      indices
    
    -- Check for duplicates in generated IDs
    let ids = map taskId children
        uniqueIds = nub ids
    
    -- If there was a race condition, we'd have fewer unique IDs than children
    length uniqueIds Test.@?= length children
    length uniqueIds Test.@?= childCount
    
    -- Verify IDs follow the pattern parentId.N
    for_ ids <| \tid -> do
        (parentId `T.isPrefixOf` tid) Test.@?= True