packages feed

fb-util-0.1.0.1: tests/RWVarTest.hs

{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

module RWVarTest (main) where

import Test.HUnit
import TestRunner

import Facebook.Init
import Util.RWVar
import Util.HUnit

readTest :: Test
readTest = TestLabel "readTest" $ TestCase $ do
  var <- newRWVar expected
  withReadRWVar var $ \v ->
    assertEqual "got expected back" expected v
  where
    expected = 'a'

writeTest :: Test
writeTest = TestLabel "writeTest" $ TestCase $ do
  var <- newRWVar initial
  withWriteRWVar var $ \v -> do
    assertEqual "got initial" initial v
    return (update, ())
  withReadRWVar var $ \v ->
    assertEqual "got updated value" update v
  where
    initial :: Int
    initial = 42
    update = 1337

readReadTest :: Test
readReadTest = TestLabel "nestedReads" $ TestCase $ do
  var <- newRWVar val
  withReadRWVar var $ \x -> do
    assertEqual "first got value" val x
    withReadRWVar var $ \y ->
      assertEqual "second got value" val y
  where
    val = 'a'

readWriteDeadlockTest :: Test
readWriteDeadlockTest = TestLabel "read then write deadlocks" $ TestCase $ do
  var <- newRWVar 'a'
  assertThrow "deadlocks" $
    withReadRWVar var $ \_ ->
      withWriteRWVar var $ \a -> return (a, ())

writeReadDeadlockTest :: Test
writeReadDeadlockTest = TestLabel "write then read deadlocks" $ TestCase $ do
  var <- newRWVar 'a'
  assertThrow "deadlocks" $
    withWriteRWVar var $ \a -> do
      _ <- withReadRWVar var return
      return (a, ())

writeWriteDeadlockTest :: Test
writeWriteDeadlockTest = TestLabel "write then write deadlocks" $ TestCase $ do
  var <- newRWVar 'a'
  assertThrow "deadlocks" $
    withWriteRWVar var $ \x -> do
      _ <- withWriteRWVar var $ \y -> return (y, ())
      return (x, ())


main :: IO ()
main = withFacebookUnitTest $
  testRunner $ TestList
   [ readTest
   , writeTest
   , readReadTest
   , readWriteDeadlockTest
   , writeReadDeadlockTest
   , writeWriteDeadlockTest
   ]