Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Do not depend on unbounded-delays on 64-bit architecture #344

Merged
merged 1 commit into from
Aug 8, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 10 additions & 2 deletions core/Test/Tasty/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module Test.Tasty.Run
import qualified Data.IntMap as IntMap
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Int (Int64)
import Data.Maybe
import Data.Graph (SCC(..), stronglyConnComp)
import Data.Typeable
Expand All @@ -21,7 +22,6 @@ import Control.Monad.Trans.Reader (ReaderT(..), local, ask)
import Control.Monad.Trans.Writer (WriterT(..), execWriterT, mapWriterT, tell)
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.Timeout (timeout)
import Control.Concurrent.Async
import Control.Exception as E
import Control.Applicative
Expand All @@ -30,6 +30,12 @@ import Data.Monoid (First(..))
import GHC.Conc (labelThread)
import Prelude -- Silence AMP and FTP import warnings

#ifdef MIN_VERSION_unbounded_delays
import Control.Concurrent.Timeout (timeout)
#else
import System.Timeout (timeout)
#endif

import Test.Tasty.Core
import Test.Tasty.Parallel
import Test.Tasty.Patterns
Expand Down Expand Up @@ -171,7 +177,9 @@ executeTest action statusVar timeoutOpt inits fins = mask $ \restore -> do
, resultTime = fromIntegral t
, resultDetailsPrinter = noResultDetails
}
fromMaybe timeoutResult <$> timeout t a
-- If compiled with unbounded-delays then t' :: Integer, otherwise t' :: Int
let t' = fromInteger (min (max 0 t) (toInteger (maxBound :: Int64)))
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is the max 0 t necessary? Both System.Timeout.timeout and its unbounded-delays counterpart are fmap Just when the specified delay is less than zero.

That being said, it doesn't hurt to keep it there. :)

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

max 0 t is to prevent underflow. Imagine t = -(2^63+1) :: Integer: previously it meant no delay, but without max 0 t it would be cast to 2^63-1 :: Int, a huge timeout.

fromMaybe timeoutResult <$> timeout t' a

-- destroyResources should not be interrupted by an exception
-- Here's how we ensure this:
Expand Down
7 changes: 6 additions & 1 deletion core/tasty.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -70,8 +70,13 @@ library
transformers >= 0.5,
tagged >= 0.5,
optparse-applicative >= 0.14,
unbounded-delays >= 0.1,
ansi-terminal >= 0.9

-- No reason to depend on unbounded-delays on 64-bit architecture
if(!arch(x86_64) && !arch(aarch64))
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This looks brittle.
What are the possible values of arch? I couldn't even find the list in the cabal docs...
At least, checking it this way (with a whitelist) is conservative. But new architectures might easily fall under the radar.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Full list is here: https://hackage.haskell.org/package/Cabal-3.8.1.0/docs/src/Distribution.Simple.PreProcess.html#local-6989586621679281986

Potentially powerpc64, ia64 and s390x are also guaranteed to be 64-bit, but I decided to whitelist only architectures I have access to.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I suggest to open an issue to potentially extend the list of recognized architectures, and whoever has access to one of them and can do testing can attack it.

build-depends:
unbounded-delays >= 0.1

if(!impl(ghc >= 8.0))
build-depends: semigroups

Expand Down