fix

.github/workflows/build.yml

@@ -603,13 +603,11 @@ jobs:
         timeout-minutes: 120
         shell: bash
         run: |
-          scripts/ci/test-watchdog.sh 45 &
-          watchdog=$!
           i=1
           attempts=1
           ${{ (github.ref == 'refs/heads/stable' || startsWith(github.ref, 'refs/tags/v')) }} && attempts=3
           while [ "$i" -le "$attempts" ]; do
-            if ./simplex-chat-test +RTS -s -RTS; then
+            if ./simplex-chat-test; then
               break
             else
               echo "Attempt $i failed, retrying..."
@@ -617,7 +615,6 @@ jobs:
               sleep 1
             fi
           done
-          kill "$watchdog" || true
           if [ "$i" -gt "$attempts" ]; then
             echo "All "$attempts" attempts failed."
             exit 1
@@ -1127,13 +1124,11 @@ jobs:
         timeout-minutes: 120
         shell: bash
         run: |
-          scripts/ci/test-watchdog.sh 45 &
-          watchdog=$!
           i=1
           attempts=1
           ${{ (github.ref == 'refs/heads/stable' || startsWith(github.ref, 'refs/tags/v')) }} && attempts=3
           while [ "$i" -le "$attempts" ]; do
-            if cabal test --test-show-details=direct --test-options="+RTS -s -RTS" ${{ env.ghc_options }}; then
+            if cabal test --test-show-details=direct ${{ env.ghc_options }}; then
               break
             else
               echo "Attempt $i failed, retrying..."
@@ -1141,7 +1136,6 @@ jobs:
               sleep 1
             fi
           done
-          kill "$watchdog" || true
           if [ "$i" -gt "$attempts" ]; then
             echo "All "$attempts" attempts failed."
             exit 1

scripts/ci/test-watchdog.sh

@@ -1,32 +0,0 @@
-#!/bin/bash
-
-minutes=$1
-sleep $((minutes * 60))
-pid=$(pgrep -x simplex-chat-test | head -1)
-if [ -z "$pid" ]; then
-  exit 0
-fi
-
-children=$(pgrep -P "$pid")
-pids="$pid $children"
-for child in $children; do
-  pids="$pids $(pgrep -P "$child")"
-done
-
-echo "::group::simplex-chat-test is still running after $minutes minutes"
-for p in $pids; do
-  ps -o pid,ppid,stat,etime,command -p "$p"
-done
-for p in $pids; do
-  echo "=== stacks of $p"
-  if [ "$(uname)" = Darwin ]; then
-    sample "$p" 3 -file /dev/stdout
-  else
-    for task in /proc/"$p"/task/*; do
-      echo "--- thread ${task##*/} $(cat "$task"/comm) $(cat "$task"/wchan)"
-      sudo cat "$task"/stack
-    done
-  fi
-done
-echo "::endgroup::"
-kill "$pid"

tests/ChatTests/Groups.hs

@@ -28,7 +28,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Maybe (fromMaybe, isJust, maybeToList)
 import Data.Time (UTCTime, getCurrentTime)
 import Data.Int (Int64)
-import Data.List (intercalate, isInfixOf, isSuffixOf)
+import Data.List (intercalate, isInfixOf, isSubsequenceOf, isSuffixOf)
 import qualified Data.Map.Strict as M
 import qualified Data.Text as T
 import Simplex.Chat.Badges (FileSizeLimits (..))
@@ -6282,8 +6282,7 @@ testGroupHistory =
 
       cath ##> "/_get chat #1 count=100"
       r <- chat <$> getTermLine cath
-      let expected = [(0, "hello"), (0, "hey!")]
-      filter (`elem` expected) r `shouldContain` expected
+      r `shouldSatisfy` isSubsequenceOf [(0, "hello"), (0, "hey!")]
 
       -- message delivery works after sending history
       alice #> "#team 1"
@@ -6377,8 +6376,7 @@ testGroupHistoryPreferenceOff =
 
       cath ##> "/_get chat #1 count=100"
       r <- chat <$> getTermLine cath
-      let expected = [(0, "hello"), (0, "hey!")]
-      filter (`elem` expected) r `shouldContain` expected
+      r `shouldSatisfy` isSubsequenceOf [(0, "hello"), (0, "hey!")]
 
       alice ##> "/set history #team off"
       alice <## "updated group preferences:"
@@ -6643,11 +6641,11 @@ testGroupHistoryMultipleFiles =
 
       cath ##> "/_get chat #1 count=100"
       r <- chatF <$> getTermLine cath
-      let expected =
-            [ ((0, "hi alice"), Just $ tmpFile cath "testfile_bob_1"),
-              ((0, "hey bob"), Just $ tmpFile cath "testfile_alice_1")
-            ]
-      filter (`elem` expected) r `shouldContain` expected
+      r
+        `shouldSatisfy` isSubsequenceOf
+          [ ((0, "hi alice"), Just $ tmpFile cath "testfile_bob_1"),
+            ((0, "hey bob"), Just $ tmpFile cath "testfile_alice_1")
+          ]
 
 testGroupHistoryFileCancel :: HasCallStack => TestParams -> IO ()
 testGroupHistoryFileCancel =
@@ -6864,15 +6862,15 @@ testGroupHistoryQuotes =
 
       cath ##> "/_get chat #1 count=100"
       r <- chat' <$> getTermLine cath
-      let expected =
-            [ ((0, "ALICE"), Nothing),
-              ((0, "BOB"), Nothing),
-              ((0, "1"), Just (0, "ALICE")),
-              ((0, "2"), Just (0, "BOB")),
-              ((0, "3"), Just (0, "ALICE")),
-              ((0, "4"), Just (0, "BOB"))
-            ]
-      filter (`elem` expected) r `shouldContain` expected
+      r
+        `shouldSatisfy` isSubsequenceOf
+          [ ((0, "ALICE"), Nothing),
+            ((0, "BOB"), Nothing),
+            ((0, "1"), Just (0, "ALICE")),
+            ((0, "2"), Just (0, "BOB")),
+            ((0, "3"), Just (0, "ALICE")),
+            ((0, "4"), Just (0, "BOB"))
+          ]
 
 testGroupHistoryDeletedMessage :: HasCallStack => TestParams -> IO ()
 testGroupHistoryDeletedMessage =
@@ -6974,8 +6972,7 @@ testGroupHistoryDisappearingMessage =
 
       cath ##> "/_get chat #1 count=100"
       r1 <- chat <$> getTermLine cath
-      let expected1 = [(0, "1"), (0, "2"), (0, "3"), (0, "4")]
-      filter (`elem` expected1) r1 `shouldContain` expected1
+      r1 `shouldSatisfy` isSubsequenceOf [(0, "1"), (0, "2"), (0, "3"), (0, "4")]
 
       threadDelay 11000000
       concurrentlyN_
@@ -6995,8 +6992,7 @@ testGroupHistoryDisappearingMessage =
 
       cath ##> "/_get chat #1 count=100"
       r2 <- chat <$> getTermLine cath
-      let expected2 = [(0, "1"), (0, "4")]
-      filter (`elem` expected2) r2 `shouldContain` expected2
+      r2 `shouldSatisfy` isSubsequenceOf [(0, "1"), (0, "4")]
       r2 `shouldNotContain` [(0, "2")]
       r2 `shouldNotContain` [(0, "3")]
 
@@ -7107,8 +7103,7 @@ testGroupHistoryUnknownMember =
 
       dan ##> "/_get chat #1 count=100"
       r <- chat <$> getTermLine dan
-      let expected = [(0, "hi from alice"), (0, "hi from bob"), (0, "hi from cath")]
-      filter (`elem` expected) r `shouldContain` expected
+      r `shouldSatisfy` isSubsequenceOf [(0, "hi from alice"), (0, "hi from bob"), (0, "hi from cath")]
 
       dan ##> "/ms team"
       dan

tests/Test.hs

@@ -37,11 +37,6 @@ import Test.Hspec.Core.Spec (sequential)
 import UnliftIO.Temporary (withTempDirectory)
 import ValidNames
 import ViewTests
-#if MIN_VERSION_base(4,18,0)
-import Control.Concurrent (forkIO, threadDelay)
-import Control.Monad (forM_, void)
-import GHC.Conc.Sync (listThreads, threadLabel, threadStatus)
-#endif
 #if defined(dbPostgres)
 import Control.Exception (bracket_, finally)
 import PostgresSchemaDump
@@ -58,7 +53,6 @@ import WebRTCTests
 
 main :: IO ()
 main = do
-  dumpThreadsAfter 40
   setLogLevel LogError
 #if !defined(dbPostgres)
   chatQueryStats <- TM.emptyIO
@@ -147,17 +141,3 @@ main = do
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
-
-dumpThreadsAfter :: Int -> IO ()
-#if MIN_VERSION_base(4,18,0)
-dumpThreadsAfter minutes = void . forkIO $ do
-  threadDelay $ minutes * 60000000
-  ts <- listThreads
-  putStrLn $ "=== " <> show (length ts) <> " threads after " <> show minutes <> " minutes"
-  forM_ ts $ \t -> do
-    s <- threadStatus t
-    l <- threadLabel t
-    putStrLn $ show t <> " " <> show s <> " " <> maybe "" id l
-#else
-dumpThreadsAfter _ = pure ()
-#endif