fb-util-0.1.0.1: tests/ConcurrentTest.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.
-}

{-# OPTIONS_GHC -Wno-name-shadowing #-}
module ConcurrentTest where

import Control.Exception
import Data.IORef

import Test.HUnit
import TestRunner

import Util.Concurrent

cacheSuccessTest :: Test
cacheSuccessTest = TestLabel "cacheSuccess" $ TestCase $ do
  c <- cacheSuccess (return (3::Int))
  r <- c
  assertEqual "cacheSuccess ok" r 3
  r <- c
  assertEqual "cacheSuccess ok2" r 3
  x <- newIORef (0::Int)
  c <- cacheSuccess (modifyIORef x (+1) >> readIORef x)
  r <- c
  assertEqual "cacheSuccess ok3" r 1
  r <- c
  assertEqual "cacheSuccess ok4" r 1
  x <- newIORef (0::Int)
  c <- cacheSuccess $ do
    modifyIORef x (+1); z <- readIORef x; throwIO $ ErrorCall $ show z
  r <- try c :: IO (Either ErrorCall ())
  assertEqual "cacheSuccess fail1" r (Left (ErrorCall "1"))
  r <- try c :: IO (Either ErrorCall ())
  assertEqual "cacheSuccess fail2" r (Left (ErrorCall "2"))

main :: IO ()
main = testRunner $ TestList
  [ cacheSuccessTest
  ]