sandwich 0.3.0.0 → 0.3.0.1
raw patch · 5 files changed
+25/−10 lines, 5 files
Files
- CHANGELOG.md +4/−0
- sandwich.cabal +1/−1
- src/Test/Sandwich/Formatters/TerminalUI/CrossPlatform.hs +4/−1
- src/Test/Sandwich/Interpreters/StartTree.hs +1/−1
- src/Test/Sandwich/Waits.hs +15/−7
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog for sandwich +## 0.3.0.1++* Fix openFileExplorerFolderPortable on macOS+ ## 0.3.0.0 * Make createProcessWithLogging, readCreateProcessWithLogging etc. log with the callstack from the line where they're called (and not an internal line).
sandwich.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: sandwich-version: 0.3.0.0+version: 0.3.0.1 synopsis: Yet another test framework for Haskell description: Please see the <https://codedownio.github.io/sandwich documentation>. category: Testing
src/Test/Sandwich/Formatters/TerminalUI/CrossPlatform.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE QuasiQuotes #-} module Test.Sandwich.Formatters.TerminalUI.CrossPlatform ( openFileExplorerFolderPortable@@ -19,6 +18,10 @@ findExecutable "explorer.exe" >>= \case Just p -> void $ readCreateProcessWithExitCode (proc p [folder]) "" Nothing -> return ()+#elif darwin_HOST_OS+openFileExplorerFolderPortable :: String -> IO ()+openFileExplorerFolderPortable folder =+ void $ readCreateProcessWithExitCode (proc "open" [folder]) "" #else openFileExplorerFolderPortable :: String -> IO () openFileExplorerFolderPortable folder =
src/Test/Sandwich/Interpreters/StartTree.hs view
@@ -222,7 +222,7 @@ whenJust baseContextRunRoot $ \runRoot -> do let symlinkBaseName = case runTreeLoc of Nothing -> takeFileName dir- Just loc -> [i|#{srcLocFile loc}:#{srcLocStartLine loc}_#{takeFileName dir}|]+ Just loc -> [i|#{srcLocFile loc}_line#{srcLocStartLine loc}_#{takeFileName dir}|] let symlinkPath = errorsDir </> (nodeToFolderName symlinkBaseName 9999999 runTreeId) -- Delete the symlink if it's already present. This can happen when re-running
src/Test/Sandwich/Waits.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} @@ -22,13 +23,16 @@ import Data.Time import Data.Typeable import GHC.Stack-import System.Timeout (Timeout) import Test.Sandwich import UnliftIO.Exception import UnliftIO.Retry import UnliftIO.Timeout +#if MIN_VERSION_base(4,14,0)+import System.Timeout (Timeout)+#endif + -- | Keep trying an action up to a timeout while it fails with a 'FailureReason'. -- Use exponential backoff, with delays capped at 1 second. waitUntil :: forall m a. (HasCallStack, MonadUnliftIO m) => Double -> m a -> m a@@ -60,11 +64,15 @@ if | (diffUTCTime now startTime) > thresh -> return DontRetry | otherwise -> return ConsultPolicy + -- We can only catch the timeout for base >= 4.14.0.0, since before that the Timeout exception wasn't exported rethrowTimeoutExceptionWithCallStack :: (HasCallStack) => m a -> m a rethrowTimeoutExceptionWithCallStack = handleSyncOrAsync $ \(e@(SomeException inner)) ->- if | Just (_ :: Timeout) <- fromExceptionUnwrap e -> do- throwIO $ Reason (Just (popCallStack callStack)) "Timeout in waitUntil"- | Just (SyncExceptionWrapper (cast -> Just (SomeException (cast -> Just (SomeAsyncException (cast -> Just (_ :: Timeout))))))) <- cast inner -> do- throwIO $ Reason (Just (popCallStack callStack)) "Timeout in waitUntil"- | otherwise -> do- throwIO e+ if+#if !MIN_VERSION_base(4,13,0)+ | Just (_ :: Timeout) <- fromExceptionUnwrap e -> do+ throwIO $ Reason (Just (popCallStack callStack)) "Timeout in waitUntil"+ | Just (SyncExceptionWrapper (cast -> Just (SomeException (cast -> Just (SomeAsyncException (cast -> Just (_ :: Timeout))))))) <- cast inner -> do+ throwIO $ Reason (Just (popCallStack callStack)) "Timeout in waitUntil"+#endif+ | otherwise -> do+ throwIO e