content: {-
    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
    ]
  