    {-# LANGUAGE LambdaCase #-}

    -- | @futhark test@
    module Futhark.CLI.Test (main) where

    import Control.Applicative.Lift (Errors, Lift (..), failure, runErrors)
    import Control.Concurrent
    import Control.Concurrent.Async
    import Control.Exception
    import Control.Monad
    import Control.Monad.Except (ExceptT (..), MonadError, runExceptT, withExceptT)
    import Control.Monad.Except qualified as E
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Control.Monad.Trans.Class (lift)
    import Data.ByteString qualified as SBS
    import Data.ByteString.Lazy qualified as LBS
    import Data.List (delete, partition)
    import Data.Map.Strict qualified as M
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Data.Text.IO qualified as T
    import Data.Time.Clock.System (SystemTime (..), getSystemTime)
    import Futhark.Analysis.Metrics.Type
    import Futhark.Server
    import Futhark.Test
    import Futhark.Util (atMostChars, fancyTerminal, showText)
    import Futhark.Util.Options
    import Futhark.Util.Pretty (annotate, bgColor, bold, hardline, pretty, putDoc, vsep)
    import Futhark.Util.Table
    import System.Console.ANSI (clearFromCursorToScreenEnd, clearLine, cursorUpLine)
    import System.Console.Terminal.Size qualified as Terminal
    import System.Environment
    import System.Exit
    import System.FilePath
    import System.IO
    import System.Process.ByteString (readProcessWithExitCode)
    import Text.Regex.TDFA

    --- Test execution

    -- The use of [T.Text] here is somewhat kludgy. We use it to track how
    -- many errors have occurred during testing of a single program (which
    -- may have multiple entry points). This should really not be done at
    -- the monadic level - a test failing should be handled explicitly.
    type TestM = ExceptT [T.Text] IO

    -- Taken from transformers-0.5.5.0.
    eitherToErrors :: Either e a -> Errors e a
    eitherToErrors :: forall e a. Either e a -> Errors e a
    eitherToErrors = (e -> Errors e a) -> (a -> Errors e a) -> Either e a -> Errors e a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either e -> Errors e a
    forall e a. e -> Errors e a
    failure a -> Errors e a
    forall (f :: * -> *) a. a -> Lift f a
    Pure

    throwError :: (MonadError [e] m) => e -> m a
    throwError :: forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError e
    e = [e] -> m a
    forall a. [e] -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError [e
    e]

    runTestM :: TestM () -> IO TestResult
    runTestM :: TestM () -> IO TestResult
    runTestM = (Either [Text] () -> TestResult)
    -> IO (Either [Text] ()) -> IO TestResult
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([Text] -> TestResult)
    -> (() -> TestResult) -> Either [Text] () -> TestResult
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either [Text] -> TestResult
    Failure ((() -> TestResult) -> Either [Text] () -> TestResult)
    -> (() -> TestResult) -> Either [Text] () -> TestResult
    forall a b. (a -> b) -> a -> b
    $ TestResult -> () -> TestResult
    forall a b. a -> b -> a
    const TestResult
    Success) (IO (Either [Text] ()) -> IO TestResult)
    -> (TestM () -> IO (Either [Text] ())) -> TestM () -> IO TestResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestM () -> IO (Either [Text] ())
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT

    liftExcept :: ExceptT T.Text IO a -> TestM a
    liftExcept :: forall a. ExceptT Text IO a -> TestM a
    liftExcept = (Text -> ExceptT [Text] IO a)
    -> (a -> ExceptT [Text] IO a)
    -> Either Text a
    -> ExceptT [Text] IO a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([Text] -> ExceptT [Text] IO a
    forall a. [Text] -> ExceptT [Text] IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError ([Text] -> ExceptT [Text] IO a)
    -> (Text -> [Text]) -> Text -> ExceptT [Text] IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure) a -> ExceptT [Text] IO a
    forall a. a -> ExceptT [Text] IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either Text a -> ExceptT [Text] IO a)
    -> (ExceptT Text IO a -> ExceptT [Text] IO (Either Text a))
    -> ExceptT Text IO a
    -> ExceptT [Text] IO a
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< IO (Either Text a) -> ExceptT [Text] IO (Either Text a)
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either Text a) -> ExceptT [Text] IO (Either Text a))
    -> (ExceptT Text IO a -> IO (Either Text a))
    -> ExceptT Text IO a
    -> ExceptT [Text] IO (Either Text a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExceptT Text IO a -> IO (Either Text a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT

    context :: T.Text -> TestM a -> TestM a
    context :: forall a. Text -> TestM a -> TestM a
    context Text
    s = ([Text] -> [Text]) -> ExceptT [Text] IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) e e' a.
    Functor m =>
    (e -> e') -> ExceptT e m a -> ExceptT e' m a
    withExceptT (([Text] -> [Text]) -> ExceptT [Text] IO a -> ExceptT [Text] IO a)
    -> ([Text] -> [Text]) -> ExceptT [Text] IO a -> ExceptT [Text] IO a
    forall a b. (a -> b) -> a -> b
    $
      \case
        [] -> []
        (Text
    e : [Text]
    es') -> (Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ":\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    e) Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    es'

    context1 :: (Monad m) => T.Text -> ExceptT T.Text m a -> ExceptT T.Text m a
    context1 :: forall (m :: * -> *) a.
    Monad m =>
    Text -> ExceptT Text m a -> ExceptT Text m a
    context1 Text
    s = (Text -> Text) -> ExceptT Text m a -> ExceptT Text m a
    forall (m :: * -> *) e e' a.
    Functor m =>
    (e -> e') -> ExceptT e m a -> ExceptT e' m a
    withExceptT ((Text -> Text) -> ExceptT Text m a -> ExceptT Text m a)
    -> (Text -> Text) -> ExceptT Text m a -> ExceptT Text m a
    forall a b. (a -> b) -> a -> b
    $ \Text
    e -> Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ":\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    e

    accErrors :: [TestM a] -> TestM [a]
    accErrors :: forall a. [TestM a] -> TestM [a]
    accErrors [TestM a]
    tests = do
      [Either [Text] a]
    eithers <- IO [Either [Text] a] -> ExceptT [Text] IO [Either [Text] a]
    forall (m :: * -> *) a. Monad m => m a -> ExceptT [Text] m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO [Either [Text] a] -> ExceptT [Text] IO [Either [Text] a])
    -> IO [Either [Text] a] -> ExceptT [Text] IO [Either [Text] a]
    forall a b. (a -> b) -> a -> b
    $ (TestM a -> IO (Either [Text] a))
    -> [TestM a] -> IO [Either [Text] a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TestM a -> IO (Either [Text] a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT [TestM a]
    tests
      let errors :: Lift (Constant [Text]) [a]
    errors = (Either [Text] a -> Lift (Constant [Text]) a)
    -> [Either [Text] a] -> Lift (Constant [Text]) [a]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Either [Text] a -> Lift (Constant [Text]) a
    forall e a. Either e a -> Errors e a
    eitherToErrors [Either [Text] a]
    eithers
      IO (Either [Text] [a]) -> TestM [a]
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either [Text] [a]) -> TestM [a])
    -> IO (Either [Text] [a]) -> TestM [a]
    forall a b. (a -> b) -> a -> b
    $ Either [Text] [a] -> IO (Either [Text] [a])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either [Text] [a] -> IO (Either [Text] [a]))
    -> Either [Text] [a] -> IO (Either [Text] [a])
    forall a b. (a -> b) -> a -> b
    $ Lift (Constant [Text]) [a] -> Either [Text] [a]
    forall e a. Errors e a -> Either e a
    runErrors Lift (Constant [Text]) [a]
    errors

    accErrors_ :: [TestM a] -> TestM ()
    accErrors_ :: forall a. [TestM a] -> TestM ()
    accErrors_ = ExceptT [Text] IO [a] -> TestM ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ExceptT [Text] IO [a] -> TestM ())
    -> ([TestM a] -> ExceptT [Text] IO [a]) -> [TestM a] -> TestM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TestM a] -> ExceptT [Text] IO [a]
    forall a. [TestM a] -> TestM [a]
    accErrors

    data TestResult
      = Success
      | Failure [T.Text]
      deriving (TestResult -> TestResult -> Bool
    (TestResult -> TestResult -> Bool)
    -> (TestResult -> TestResult -> Bool) -> Eq TestResult
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TestResult -> TestResult -> Bool
    == :: TestResult -> TestResult -> Bool
    $c/= :: TestResult -> TestResult -> Bool
    /= :: TestResult -> TestResult -> Bool
    Eq, Int -> TestResult -> ShowS
    [TestResult] -> ShowS
    TestResult -> String
    (Int -> TestResult -> ShowS)
    -> (TestResult -> String)
    -> ([TestResult] -> ShowS)
    -> Show TestResult
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TestResult -> ShowS
    showsPrec :: Int -> TestResult -> ShowS
    $cshow :: TestResult -> String
    show :: TestResult -> String
    $cshowList :: [TestResult] -> ShowS
    showList :: [TestResult] -> ShowS
    Show)

    pureTestResults :: IO [TestResult] -> TestM ()
    pureTestResults :: IO [TestResult] -> TestM ()
    pureTestResults IO [TestResult]
    m = do
      [[Text]]
    errs <- (TestResult -> [[Text]] -> [[Text]])
    -> [[Text]] -> [TestResult] -> [[Text]]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr TestResult -> [[Text]] -> [[Text]]
    collectErrors [[Text]]
    forall a. Monoid a => a
    mempty ([TestResult] -> [[Text]])
    -> ExceptT [Text] IO [TestResult] -> ExceptT [Text] IO [[Text]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [TestResult] -> ExceptT [Text] IO [TestResult]
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO [TestResult]
    m
      Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([[Text]] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Text]]
    errs) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ [Text] -> TestM ()
    forall a. [Text] -> ExceptT [Text] IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError ([Text] -> TestM ()) -> [Text] -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ [[Text]] -> [Text]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Text]]
    errs
      where
        collectErrors :: TestResult -> [[Text]] -> [[Text]]
    collectErrors TestResult
    Success [[Text]]
    errs = [[Text]]
    errs
        collectErrors (Failure [Text]
    err) [[Text]]
    errs = [Text]
    err [Text] -> [[Text]] -> [[Text]]
    forall a. a -> [a] -> [a]
    : [[Text]]
    errs

    -- | The longest we are willing to wait for a test, in microseconds.
    timeout :: Int
    timeout :: Int
    timeout = Int
    5 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    60 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1000000

    withProgramServer :: FilePath -> FilePath -> [String] -> (Server -> IO [TestResult]) -> TestM ()
    withProgramServer :: String
    -> String -> [String] -> (Server -> IO [TestResult]) -> TestM ()
    withProgramServer String
    program String
    runner [String]
    extra_options Server -> IO [TestResult]
    f = do
      -- Explicitly prefixing the current directory is necessary for
      -- readProcessWithExitCode to find the binary when binOutputf has
      -- no path component.
      let binOutputf :: String
    binOutputf = ShowS
    dropExtension String
    program
          binpath :: String
    binpath = String
    "." String -> ShowS
    </> String
    binOutputf

          (String
    to_run, [String]
    to_run_args)
            | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    runner = (String
    binpath, [String]
    extra_options)
            | Bool
    otherwise = (String
    runner, String
    binpath String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    extra_options)

          prog_ctx :: Text
    prog_ctx =
            Text
    "Running " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack ([String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String
    binpath String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    extra_options)

      Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    prog_ctx (TestM () -> TestM ())
    -> (IO [TestResult] -> TestM ()) -> IO [TestResult] -> TestM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO [TestResult] -> TestM ()
    pureTestResults (IO [TestResult] -> TestM ())
    -> (IO [TestResult] -> IO [TestResult])
    -> IO [TestResult]
    -> TestM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO [TestResult] -> IO [TestResult]
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [TestResult] -> TestM ()) -> IO [TestResult] -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
        ServerCfg -> (Server -> IO [TestResult]) -> IO [TestResult]
    forall a. ServerCfg -> (Server -> IO a) -> IO a
    withServer (String -> [String] -> ServerCfg
    futharkServerCfg String
    to_run [String]
    to_run_args) ((Server -> IO [TestResult]) -> IO [TestResult])
    -> (Server -> IO [TestResult]) -> IO [TestResult]
    forall a b. (a -> b) -> a -> b
    $ \Server
    server ->
          IO () -> IO [TestResult] -> IO (Either () [TestResult])
    forall a b. IO a -> IO b -> IO (Either a b)
    race (Int -> IO ()
    threadDelay Int
    timeout) (Server -> IO [TestResult]
    f Server
    server) IO (Either () [TestResult])
    -> (Either () [TestResult] -> IO [TestResult]) -> IO [TestResult]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Left ()
    _ -> do
              Server -> IO ()
    abortServer Server
    server
              String -> IO [TestResult]
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> IO [TestResult]) -> String -> IO [TestResult]
    forall a b. (a -> b) -> a -> b
    $ String
    "test timeout after " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show Int
    timeout String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " microseconds"
            Right [TestResult]
    r -> [TestResult] -> IO [TestResult]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [TestResult]
    r

    data TestMode
      = -- | Only type check.
        TypeCheck
      | -- | Only compile (do not run).
        Compile
      | -- | Only internalise (do not run).
        Internalise
      | -- | Test compiled code.
        Compiled
      | -- | Test interpreted code.
        Interpreted
      | -- | Perform structure tests.
        Structure
      deriving (TestMode -> TestMode -> Bool
    (TestMode -> TestMode -> Bool)
    -> (TestMode -> TestMode -> Bool) -> Eq TestMode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TestMode -> TestMode -> Bool
    == :: TestMode -> TestMode -> Bool
    $c/= :: TestMode -> TestMode -> Bool
    /= :: TestMode -> TestMode -> Bool
    Eq, Int -> TestMode -> ShowS
    [TestMode] -> ShowS
    TestMode -> String
    (Int -> TestMode -> ShowS)
    -> (TestMode -> String) -> ([TestMode] -> ShowS) -> Show TestMode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TestMode -> ShowS
    showsPrec :: Int -> TestMode -> ShowS
    $cshow :: TestMode -> String
    show :: TestMode -> String
    $cshowList :: [TestMode] -> ShowS
    showList :: [TestMode] -> ShowS
    Show)

    data TestCase = TestCase
      { TestCase -> TestMode
    _testCaseMode :: TestMode,
        TestCase -> String
    testCaseProgram :: FilePath,
        TestCase -> ProgramTest
    testCaseTest :: ProgramTest,
        TestCase -> ProgConfig
    _testCasePrograms :: ProgConfig
      }
      deriving (Int -> TestCase -> ShowS
    [TestCase] -> ShowS
    TestCase -> String
    (Int -> TestCase -> ShowS)
    -> (TestCase -> String) -> ([TestCase] -> ShowS) -> Show TestCase
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TestCase -> ShowS
    showsPrec :: Int -> TestCase -> ShowS
    $cshow :: TestCase -> String
    show :: TestCase -> String
    $cshowList :: [TestCase] -> ShowS
    showList :: [TestCase] -> ShowS
    Show)

    instance Eq TestCase where
      TestCase
    x == :: TestCase -> TestCase -> Bool
    == TestCase
    y = TestCase -> String
    testCaseProgram TestCase
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestCase -> String
    testCaseProgram TestCase
    y

    instance Ord TestCase where
      TestCase
    x compare :: TestCase -> TestCase -> Ordering
    `compare` TestCase
    y = TestCase -> String
    testCaseProgram TestCase
    x String -> String -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` TestCase -> String
    testCaseProgram TestCase
    y

    data RunResult
      = ErrorResult T.Text
      | SuccessResult [Value]

    progNotFound :: T.Text -> T.Text
    progNotFound :: Text -> Text
    progNotFound Text
    s = Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ": command not found"

    optimisedProgramMetrics :: ProgConfig -> StructurePipeline -> FilePath -> TestM AstMetrics
    optimisedProgramMetrics :: ProgConfig -> StructurePipeline -> String -> TestM AstMetrics
    optimisedProgramMetrics ProgConfig
    programs StructurePipeline
    pipeline String
    program =
      case StructurePipeline
    pipeline of
        StructurePipeline
    SOACSPipeline ->
          [String] -> TestM AstMetrics
    forall {m :: * -> *} {b}.
    (MonadIO m, Read b, MonadError [Text] m) =>
    [String] -> m b
    check [String
    "-s"]
        StructurePipeline
    GpuPipeline ->
          [String] -> TestM AstMetrics
    forall {m :: * -> *} {b}.
    (MonadIO m, Read b, MonadError [Text] m) =>
    [String] -> m b
    check [String
    "--gpu"]
        StructurePipeline
    MCPipeline ->
          [String] -> TestM AstMetrics
    forall {m :: * -> *} {b}.
    (MonadIO m, Read b, MonadError [Text] m) =>
    [String] -> m b
    check [String
    "--mc"]
        StructurePipeline
    SeqMemPipeline ->
          [String] -> TestM AstMetrics
    forall {m :: * -> *} {b}.
    (MonadIO m, Read b, MonadError [Text] m) =>
    [String] -> m b
    check [String
    "--seq-mem"]
        StructurePipeline
    GpuMemPipeline ->
          [String] -> TestM AstMetrics
    forall {m :: * -> *} {b}.
    (MonadIO m, Read b, MonadError [Text] m) =>
    [String] -> m b
    check [String
    "--gpu-mem"]
        StructurePipeline
    MCMemPipeline ->
          [String] -> TestM AstMetrics
    forall {m :: * -> *} {b}.
    (MonadIO m, Read b, MonadError [Text] m) =>
    [String] -> m b
    check [String
    "--mc-mem"]
        StructurePipeline
    NoPipeline ->
          [String] -> TestM AstMetrics
    forall {m :: * -> *} {b}.
    (MonadIO m, Read b, MonadError [Text] m) =>
    [String] -> m b
    check []
      where
        check :: [String] -> m b
    check [String]
    opt = do
          String
    futhark <- IO String -> m String
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> m String) -> IO String -> m String
    forall a b. (a -> b) -> a -> b
    $ IO String -> (String -> IO String) -> Maybe String -> IO String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO String
    getExecutablePath String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe String -> IO String) -> Maybe String -> IO String
    forall a b. (a -> b) -> a -> b
    $ ProgConfig -> Maybe String
    configFuthark ProgConfig
    programs
          let opts :: [String]
    opts = [String
    "dev"] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    opt [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "--metrics", String
    program]
          (ExitCode
    code, ByteString
    output, ByteString
    err) <- IO (ExitCode, ByteString, ByteString)
    -> m (ExitCode, ByteString, ByteString)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ExitCode, ByteString, ByteString)
     -> m (ExitCode, ByteString, ByteString))
    -> IO (ExitCode, ByteString, ByteString)
    -> m (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ String
    -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
    readProcessWithExitCode String
    futhark [String]
    opts ByteString
    ""
          let output' :: Text
    output' = ByteString -> Text
    T.decodeUtf8 ByteString
    output
          case ExitCode
    code of
            ExitCode
    ExitSuccess
              | [(b
    m, [])] <- ReadS b
    forall a. Read a => ReadS a
    reads ReadS b -> ReadS b
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    output' -> b -> m b
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure b
    m
              | Bool
    otherwise -> Text -> m b
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> m b) -> Text -> m b
    forall a b. (a -> b) -> a -> b
    $ Text
    "Could not read metrics output:\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    output'
            ExitFailure Int
    127 -> Text -> m b
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> m b) -> Text -> m b
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    progNotFound (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    futhark
            ExitFailure Int
    _ -> Text -> m b
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> m b) -> Text -> m b
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    err

    testMetrics :: ProgConfig -> FilePath -> StructureTest -> TestM ()
    testMetrics :: ProgConfig -> String -> StructureTest -> TestM ()
    testMetrics ProgConfig
    programs String
    program (StructureTest StructurePipeline
    pipeline (AstMetrics Map Text Int
    expected)) =
      Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    "Checking metrics" (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ do
        AstMetrics
    actual <- ProgConfig -> StructurePipeline -> String -> TestM AstMetrics
    optimisedProgramMetrics ProgConfig
    programs StructurePipeline
    pipeline String
    program
        [TestM ()] -> TestM ()
    forall a. [TestM a] -> TestM ()
    accErrors_ ([TestM ()] -> TestM ()) -> [TestM ()] -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ ((Text, Int) -> TestM ()) -> [(Text, Int)] -> [TestM ()]
    forall a b. (a -> b) -> [a] -> [b]
    map (AstMetrics -> (Text, Int) -> TestM ()
    forall {m :: * -> *}.
    MonadError [Text] m =>
    AstMetrics -> (Text, Int) -> m ()
    ok AstMetrics
    actual) ([(Text, Int)] -> [TestM ()]) -> [(Text, Int)] -> [TestM ()]
    forall a b. (a -> b) -> a -> b
    $ Map Text Int -> [(Text, Int)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Text Int
    expected
      where
        maybePipeline :: StructurePipeline -> T.Text
        maybePipeline :: StructurePipeline -> Text
    maybePipeline StructurePipeline
    SOACSPipeline = Text
    "(soacs) "
        maybePipeline StructurePipeline
    GpuPipeline = Text
    "(gpu) "
        maybePipeline StructurePipeline
    MCPipeline = Text
    "(mc) "
        maybePipeline StructurePipeline
    SeqMemPipeline = Text
    "(seq-mem) "
        maybePipeline StructurePipeline
    GpuMemPipeline = Text
    "(gpu-mem) "
        maybePipeline StructurePipeline
    MCMemPipeline = Text
    "(mc-mem) "
        maybePipeline StructurePipeline
    NoPipeline = Text
    " "

        ok :: AstMetrics -> (Text, Int) -> m ()
    ok (AstMetrics Map Text Int
    metrics) (Text
    name, Int
    expected_occurences) =
          case Text -> Map Text Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    name Map Text Int
    metrics of
            Maybe Int
    Nothing
              | Int
    expected_occurences Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 ->
                  Text -> m ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                    Text
    name
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> StructurePipeline -> Text
    maybePipeline StructurePipeline
    pipeline
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "should have occurred "
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    expected_occurences
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " times, but did not occur at all in optimised program."
            Just Int
    actual_occurences
              | Int
    expected_occurences Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    actual_occurences ->
                  Text -> m ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                    Text
    name
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> StructurePipeline -> Text
    maybePipeline StructurePipeline
    pipeline
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "should have occurred "
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    expected_occurences
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " times, but occurred "
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    actual_occurences
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " times."
            Maybe Int
    _ -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    testWarnings :: [WarningTest] -> SBS.ByteString -> TestM ()
    testWarnings :: [WarningTest] -> ByteString -> TestM ()
    testWarnings [WarningTest]
    warnings ByteString
    futerr = [TestM ()] -> TestM ()
    forall a. [TestM a] -> TestM ()
    accErrors_ ([TestM ()] -> TestM ()) -> [TestM ()] -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ (WarningTest -> TestM ()) -> [WarningTest] -> [TestM ()]
    forall a b. (a -> b) -> [a] -> [b]
    map WarningTest -> TestM ()
    forall {m :: * -> *}. MonadError [Text] m => WarningTest -> m ()
    testWarning [WarningTest]
    warnings
      where
        testWarning :: WarningTest -> m ()
    testWarning (ExpectedWarning Text
    regex_s Regex
    regex)
          | Bool -> Bool
    not (Regex -> String -> Bool
    forall regex source target.
    RegexContext regex source target =>
    regex -> source -> target
    match Regex
    regex (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    futerr) =
              Text -> m ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                Text
    "Expected warning:\n  "
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    regex_s
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\nGot warnings:\n  "
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Text
    T.decodeUtf8 ByteString
    futerr
          | Bool
    otherwise = () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    runInterpretedEntry :: FutharkExe -> FilePath -> InputOutputs -> TestM ()
    runInterpretedEntry :: FutharkExe -> String -> InputOutputs -> TestM ()
    runInterpretedEntry (FutharkExe String
    futhark) String
    program (InputOutputs Text
    entry [TestRun]
    run_cases) =
      let dir :: String
    dir = ShowS
    takeDirectory String
    program
          runInterpretedCase :: TestRun -> TestM ()
    runInterpretedCase run :: TestRun
    run@(TestRun [Text]
    _ Values
    inputValues ExpectedResult Success
    _ Int
    index Text
    _) =
            Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ((Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` TestRun -> [Text]
    runTags TestRun
    run) [Text
    "compiled", Text
    "script"]) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
              Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context (Text
    "Entry point: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    entry Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "; dataset: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> TestRun -> Text
    runDescription TestRun
    run) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ do
                Text
    input <- [Text] -> Text
    T.unlines ([Text] -> Text) -> ([Value] -> [Text]) -> [Value] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> Text) -> [Value] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Text
    valueText ([Value] -> Text)
    -> ExceptT [Text] IO [Value] -> ExceptT [Text] IO Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FutharkExe -> String -> Values -> ExceptT [Text] IO [Value]
    forall (m :: * -> *).
    (MonadFail m, MonadIO m) =>
    FutharkExe -> String -> Values -> m [Value]
    getValues (String -> FutharkExe
    FutharkExe String
    futhark) String
    dir Values
    inputValues
                ExpectedResult [Value]
    expectedResult' <- FutharkExe
    -> String
    -> Text
    -> TestRun
    -> ExceptT [Text] IO (ExpectedResult [Value])
    forall (m :: * -> *).
    (MonadFail m, MonadIO m) =>
    FutharkExe
    -> String -> Text -> TestRun -> m (ExpectedResult [Value])
    getExpectedResult (String -> FutharkExe
    FutharkExe String
    futhark) String
    program Text
    entry TestRun
    run
                (ExitCode
    code, ByteString
    output, ByteString
    err) <-
                  IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ExitCode, ByteString, ByteString)
     -> ExceptT [Text] IO (ExitCode, ByteString, ByteString))
    -> IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $
                    String
    -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
    readProcessWithExitCode String
    futhark [String
    "run", String
    "-e", Text -> String
    T.unpack Text
    entry, String
    program] (ByteString -> IO (ExitCode, ByteString, ByteString))
    -> ByteString -> IO (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $
                      Text -> ByteString
    T.encodeUtf8 Text
    input
                case ExitCode
    code of
                  ExitFailure Int
    127 ->
                    Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> TestM ()) -> Text -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    progNotFound (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    futhark
                  ExitCode
    _ ->
                    ExceptT Text IO () -> TestM ()
    forall a. ExceptT Text IO a -> TestM a
    liftExcept (ExceptT Text IO () -> TestM ()) -> ExceptT Text IO () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
                      Text
    -> Int
    -> String
    -> ExpectedResult [Value]
    -> RunResult
    -> ExceptT Text IO ()
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    Text
    -> Int -> String -> ExpectedResult [Value] -> RunResult -> m ()
    compareResult Text
    entry Int
    index String
    program ExpectedResult [Value]
    expectedResult'
                        (RunResult -> ExceptT Text IO ())
    -> ExceptT Text IO RunResult -> ExceptT Text IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String
    -> ExitCode
    -> ByteString
    -> ByteString
    -> ExceptT Text IO RunResult
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    String -> ExitCode -> ByteString -> ByteString -> m RunResult
    runResult String
    program ExitCode
    code ByteString
    output ByteString
    err
       in [TestM ()] -> TestM ()
    forall a. [TestM a] -> TestM ()
    accErrors_ ([TestM ()] -> TestM ()) -> [TestM ()] -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ (TestRun -> TestM ()) -> [TestRun] -> [TestM ()]
    forall a b. (a -> b) -> [a] -> [b]
    map TestRun -> TestM ()
    runInterpretedCase [TestRun]
    run_cases

    runTestCase :: TestCase -> TestM ()
    runTestCase :: TestCase -> TestM ()
    runTestCase (TestCase TestMode
    mode String
    program ProgramTest
    testcase ProgConfig
    progs) = do
      String
    futhark <- IO String -> ExceptT [Text] IO String
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> ExceptT [Text] IO String)
    -> IO String -> ExceptT [Text] IO String
    forall a b. (a -> b) -> a -> b
    $ IO String -> (String -> IO String) -> Maybe String -> IO String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO String
    getExecutablePath String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe String -> IO String) -> Maybe String -> IO String
    forall a b. (a -> b) -> a -> b
    $ ProgConfig -> Maybe String
    configFuthark ProgConfig
    progs
      let checkctx :: Text
    checkctx =
            [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat
              [ Text
    "Type-checking with '",
                String -> Text
    T.pack String
    futhark,
                Text
    " check ",
                String -> Text
    T.pack String
    program,
                Text
    "'"
              ]
      case ProgramTest -> TestAction
    testAction ProgramTest
    testcase of
        CompileTimeFailure ExpectedError
    expected_error ->
          Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (TestMode
    mode TestMode -> [TestMode] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [TestMode
    Structure, TestMode
    Internalise]) (TestM () -> TestM ())
    -> (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    checkctx (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ do
            (ExitCode
    code, ByteString
    _, ByteString
    err) <-
              IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ExitCode, ByteString, ByteString)
     -> ExceptT [Text] IO (ExitCode, ByteString, ByteString))
    -> IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ String
    -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
    readProcessWithExitCode String
    futhark [String
    "check", String
    program] ByteString
    ""
            case ExitCode
    code of
              ExitCode
    ExitSuccess -> Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError Text
    "Expected failure\n"
              ExitFailure Int
    127 -> Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> TestM ()) -> Text -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    progNotFound (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    futhark
              ExitFailure Int
    1 -> Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> TestM ()) -> Text -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    err
              ExitFailure Int
    _ -> ExceptT Text IO () -> TestM ()
    forall a. ExceptT Text IO a -> TestM a
    liftExcept (ExceptT Text IO () -> TestM ()) -> ExceptT Text IO () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ ExpectedError -> Text -> ExceptT Text IO ()
    forall (m :: * -> *).
    MonadError Text m =>
    ExpectedError -> Text -> m ()
    checkError ExpectedError
    expected_error (Text -> ExceptT Text IO ()) -> Text -> ExceptT Text IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    err
        RunCases {}
          | TestMode
    mode TestMode -> TestMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestMode
    TypeCheck -> do
              let options :: [String]
    options = [String
    "check", String
    program] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ProgConfig -> [String]
    configExtraCompilerOptions ProgConfig
    progs
              Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    checkctx (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ do
                (ExitCode
    code, ByteString
    _, ByteString
    err) <- IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ExitCode, ByteString, ByteString)
     -> ExceptT [Text] IO (ExitCode, ByteString, ByteString))
    -> IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ String
    -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
    readProcessWithExitCode String
    futhark [String]
    options ByteString
    ""
                case ExitCode
    code of
                  ExitCode
    ExitSuccess -> () -> TestM ()
    forall a. a -> ExceptT [Text] IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                  ExitFailure Int
    127 -> Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> TestM ()) -> Text -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    progNotFound (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    futhark
                  ExitFailure Int
    _ -> Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> TestM ()) -> Text -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    err
          | TestMode
    mode TestMode -> TestMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestMode
    Internalise -> do
              let options :: [String]
    options = [String
    "dev", String
    program] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ProgConfig -> [String]
    configExtraCompilerOptions ProgConfig
    progs
              Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    checkctx (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ do
                (ExitCode
    code, ByteString
    _, ByteString
    err) <- IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ExitCode, ByteString, ByteString)
     -> ExceptT [Text] IO (ExitCode, ByteString, ByteString))
    -> IO (ExitCode, ByteString, ByteString)
    -> ExceptT [Text] IO (ExitCode, ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ String
    -> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
    readProcessWithExitCode String
    futhark [String]
    options ByteString
    ""
                case ExitCode
    code of
                  ExitCode
    ExitSuccess -> () -> TestM ()
    forall a. a -> ExceptT [Text] IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                  ExitFailure Int
    127 -> Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> TestM ()) -> Text -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    progNotFound (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    futhark
                  ExitFailure Int
    _ -> Text -> TestM ()
    forall e (m :: * -> *) a. MonadError [e] m => e -> m a
    throwError (Text -> TestM ()) -> Text -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    err
        RunCases [InputOutputs]
    ios [StructureTest]
    structures [WarningTest]
    warnings -> do
          -- Compile up-front and reuse same executable for several entry points.
          let backend :: String
    backend = ProgConfig -> String
    configBackend ProgConfig
    progs
              extra_compiler_options :: [String]
    extra_compiler_options = ProgConfig -> [String]
    configExtraCompilerOptions ProgConfig
    progs

          Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TestMode
    mode TestMode -> [TestMode] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [TestMode
    Compiled, TestMode
    Interpreted]) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
            Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    "Generating reference outputs" (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
              -- We probably get the concurrency at the test program level,
              -- so force just one data set at a time here.
              (Text -> [Text]) -> ExceptT Text IO () -> TestM ()
    forall (m :: * -> *) e e' a.
    Functor m =>
    (e -> e') -> ExceptT e m a -> ExceptT e' m a
    withExceptT Text -> [Text]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExceptT Text IO () -> TestM ()) -> ExceptT Text IO () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
                Maybe Int
    -> FutharkExe
    -> String
    -> String
    -> [InputOutputs]
    -> ExceptT Text IO ()
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    Maybe Int
    -> FutharkExe -> String -> String -> [InputOutputs] -> m ()
    ensureReferenceOutput (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    1) (String -> FutharkExe
    FutharkExe String
    futhark) String
    "c" String
    program [InputOutputs]
    ios

          Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TestMode
    mode TestMode -> TestMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestMode
    Structure) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
            (StructureTest -> TestM ()) -> [StructureTest] -> TestM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (ProgConfig -> String -> StructureTest -> TestM ()
    testMetrics ProgConfig
    progs String
    program) [StructureTest]
    structures

          Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TestMode
    mode TestMode -> [TestMode] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [TestMode
    Compile, TestMode
    Compiled]) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
            Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context (Text
    "Compiling with --backend=" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack String
    backend) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ do
              [String]
    -> FutharkExe -> String -> String -> [WarningTest] -> TestM ()
    compileTestProgram [String]
    extra_compiler_options (String -> FutharkExe
    FutharkExe String
    futhark) String
    backend String
    program [WarningTest]
    warnings
              Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (TestMode
    mode TestMode -> TestMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestMode
    Compile) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ do
                ([String]
    tuning_opts, String
    _) <-
                  IO ([String], String) -> ExceptT [Text] IO ([String], String)
    forall a. IO a -> ExceptT [Text] IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ([String], String) -> ExceptT [Text] IO ([String], String))
    -> IO ([String], String) -> ExceptT [Text] IO ([String], String)
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> String -> IO ([String], String)
    forall (m :: * -> *).
    MonadIO m =>
    Maybe String -> String -> m ([String], String)
    determineTuning (ProgConfig -> Maybe String
    configTuning ProgConfig
    progs) String
    program
                let extra_options :: [String]
    extra_options =
                      Maybe String -> String -> [String]
    determineCache (ProgConfig -> Maybe String
    configCacheExt ProgConfig
    progs) String
    program
                        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    tuning_opts
                        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ProgConfig -> [String]
    configExtraOptions ProgConfig
    progs
                    runner :: String
    runner = ProgConfig -> String
    configRunner ProgConfig
    progs
                Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    "Running compiled program" (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
                  String
    -> String -> [String] -> (Server -> IO [TestResult]) -> TestM ()
    withProgramServer String
    program String
    runner [String]
    extra_options ((Server -> IO [TestResult]) -> TestM ())
    -> (Server -> IO [TestResult]) -> TestM ()
    forall a b. (a -> b) -> a -> b
    $ \Server
    server -> do
                    let run :: InputOutputs -> IO [TestResult]
    run = FutharkExe -> Server -> String -> InputOutputs -> IO [TestResult]
    runCompiledEntry (String -> FutharkExe
    FutharkExe String
    futhark) Server
    server String
    program
                    [[TestResult]] -> [TestResult]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[TestResult]] -> [TestResult])
    -> IO [[TestResult]] -> IO [TestResult]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (InputOutputs -> IO [TestResult])
    -> [InputOutputs] -> IO [[TestResult]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM InputOutputs -> IO [TestResult]
    run [InputOutputs]
    ios

          Bool -> TestM () -> TestM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TestMode
    mode TestMode -> TestMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestMode
    Interpreted) (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
            Text -> TestM () -> TestM ()
    forall a. Text -> TestM a -> TestM a
    context Text
    "Interpreting" (TestM () -> TestM ()) -> TestM () -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
              [TestM ()] -> TestM ()
    forall a. [TestM a] -> TestM ()
    accErrors_ ([TestM ()] -> TestM ()) -> [TestM ()] -> TestM ()
    forall a b. (a -> b) -> a -> b
    $
                (InputOutputs -> TestM ()) -> [InputOutputs] -> [TestM ()]
    forall a b. (a -> b) -> [a] -> [b]
    map (FutharkExe -> String -> InputOutputs -> TestM ()
    runInterpretedEntry (String -> FutharkExe
    FutharkExe String
    futhark) String
    program) [InputOutputs]
    ios

    liftCommand ::
      (MonadError T.Text m, MonadIO m) =>
      IO (Maybe CmdFailure) ->
      m ()
    liftCommand :: forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    liftCommand IO (Maybe CmdFailure)
    m = do
      Maybe CmdFailure
    r <- IO (Maybe CmdFailure) -> m (Maybe CmdFailure)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (Maybe CmdFailure)
    m
      case Maybe CmdFailure
    r of
        Just (CmdFailure [Text]
    _ [Text]
    err) -> Text -> m ()
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.unlines [Text]
    err
        Maybe CmdFailure
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    runCompiledEntry :: FutharkExe -> Server -> FilePath -> InputOutputs -> IO [TestResult]
    runCompiledEntry :: FutharkExe -> Server -> String -> InputOutputs -> IO [TestResult]
    runCompiledEntry FutharkExe
    futhark Server
    server String
    program (InputOutputs Text
    entry [TestRun]
    run_cases) = do
      Either CmdFailure [OutputType]
    output_types <- Server -> Text -> IO (Either CmdFailure [OutputType])
    cmdOutputs Server
    server Text
    entry
      Either CmdFailure [InputType]
    input_types <- Server -> Text -> IO (Either CmdFailure [InputType])
    cmdInputs Server
    server Text
    entry
      case (,) ([OutputType] -> [InputType] -> ([OutputType], [InputType]))
    -> Either CmdFailure [OutputType]
    -> Either CmdFailure ([InputType] -> ([OutputType], [InputType]))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Either CmdFailure [OutputType]
    output_types Either CmdFailure ([InputType] -> ([OutputType], [InputType]))
    -> Either CmdFailure [InputType]
    -> Either CmdFailure ([OutputType], [InputType])
    forall a b.
    Either CmdFailure (a -> b)
    -> Either CmdFailure a -> Either CmdFailure b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Either CmdFailure [InputType]
    input_types of
        Left (CmdFailure [Text]
    _ [Text]
    err) ->
          [TestResult] -> IO [TestResult]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [[Text] -> TestResult
    Failure [Text]
    err]
        Right ([OutputType]
    output_types', [InputType]
    input_types') -> do
          let outs :: [Text]
    outs = [Text
    "out" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    i | Int
    i <- [Int
    0 .. [OutputType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [OutputType]
    output_types' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]]
              ins :: [Text]
    ins = [Text
    "in" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    i | Int
    i <- [Int
    0 .. [InputType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [InputType]
    input_types' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]]
              onRes :: Either Text b -> TestResult
    onRes = (Text -> TestResult)
    -> (b -> TestResult) -> Either Text b -> TestResult
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([Text] -> TestResult
    Failure ([Text] -> TestResult) -> (Text -> [Text]) -> Text -> TestResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure) (TestResult -> b -> TestResult
    forall a b. a -> b -> a
    const TestResult
    Success)
          (TestRun -> IO TestResult) -> [TestRun] -> IO [TestResult]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((Either Text () -> TestResult)
    -> IO (Either Text ()) -> IO TestResult
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Either Text () -> TestResult
    forall {b}. Either Text b -> TestResult
    onRes (IO (Either Text ()) -> IO TestResult)
    -> (TestRun -> IO (Either Text ())) -> TestRun -> IO TestResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [InputType] -> [Text] -> [Text] -> TestRun -> IO (Either Text ())
    forall {m :: * -> *}.
    (MonadFail m, MonadIO m) =>
    [InputType] -> [Text] -> [Text] -> TestRun -> m (Either Text ())
    runCompiledCase [InputType]
    input_types' [Text]
    outs [Text]
    ins) [TestRun]
    run_cases
      where
        dir :: String
    dir = ShowS
    takeDirectory String
    program

        runCompiledCase :: [InputType] -> [Text] -> [Text] -> TestRun -> m (Either Text ())
    runCompiledCase [InputType]
    input_types [Text]
    outs [Text]
    ins TestRun
    run = ExceptT Text m () -> m (Either Text ())
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT Text m () -> m (Either Text ()))
    -> ExceptT Text m () -> m (Either Text ())
    forall a b. (a -> b) -> a -> b
    $ do
          let TestRun [Text]
    _ Values
    input_spec ExpectedResult Success
    _ Int
    index Text
    _ = TestRun
    run
              case_ctx :: Text
    case_ctx =
                Text
    "Entry point: "
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    entry
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "; dataset: "
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> TestRun -> Text
    runDescription TestRun
    run

          Text -> ExceptT Text m () -> ExceptT Text m ()
    forall (m :: * -> *) a.
    Monad m =>
    Text -> ExceptT Text m a -> ExceptT Text m a
    context1 Text
    case_ctx (ExceptT Text m () -> ExceptT Text m ())
    -> ExceptT Text m () -> ExceptT Text m ()
    forall a b. (a -> b) -> a -> b
    $ do
            ExpectedResult [Value]
    expected <- FutharkExe
    -> String
    -> Text
    -> TestRun
    -> ExceptT Text m (ExpectedResult [Value])
    forall (m :: * -> *).
    (MonadFail m, MonadIO m) =>
    FutharkExe
    -> String -> Text -> TestRun -> m (ExpectedResult [Value])
    getExpectedResult FutharkExe
    futhark String
    program Text
    entry TestRun
    run

            Server
    -> [(Text, Text)]
    -> FutharkExe
    -> String
    -> Values
    -> ExceptT Text m ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    Server -> [(Text, Text)] -> FutharkExe -> String -> Values -> m ()
    valuesAsVars Server
    server ([Text] -> [Text] -> [(Text, Text)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Text]
    ins ((InputType -> Text) -> [InputType] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map InputType -> Text
    inputType [InputType]
    input_types)) FutharkExe
    futhark String
    dir Values
    input_spec

            Either CmdFailure [Text]
    call_r <- IO (Either CmdFailure [Text])
    -> ExceptT Text m (Either CmdFailure [Text])
    forall a. IO a -> ExceptT Text m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either CmdFailure [Text])
     -> ExceptT Text m (Either CmdFailure [Text]))
    -> IO (Either CmdFailure [Text])
    -> ExceptT Text m (Either CmdFailure [Text])
    forall a b. (a -> b) -> a -> b
    $ Server -> Text -> [Text] -> [Text] -> IO (Either CmdFailure [Text])
    cmdCall Server
    server Text
    entry [Text]
    outs [Text]
    ins
            IO (Maybe CmdFailure) -> ExceptT Text m ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    liftCommand (IO (Maybe CmdFailure) -> ExceptT Text m ())
    -> IO (Maybe CmdFailure) -> ExceptT Text m ()
    forall a b. (a -> b) -> a -> b
    $ Server -> [Text] -> IO (Maybe CmdFailure)
    cmdFree Server
    server [Text]
    ins

            RunResult
    res <- case Either CmdFailure [Text]
    call_r of
              Left (CmdFailure [Text]
    _ [Text]
    err) ->
                RunResult -> ExceptT Text m RunResult
    forall a. a -> ExceptT Text m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (RunResult -> ExceptT Text m RunResult)
    -> RunResult -> ExceptT Text m RunResult
    forall a b. (a -> b) -> a -> b
    $ Text -> RunResult
    ErrorResult (Text -> RunResult) -> Text -> RunResult
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.unlines [Text]
    err
              Right [Text]
    _ ->
                [Value] -> RunResult
    SuccessResult
                  ([Value] -> RunResult)
    -> ExceptT Text m [Value] -> ExceptT Text m RunResult
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Server -> [Text] -> ExceptT Text m [Value]
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    Server -> [Text] -> m [Value]
    readResults Server
    server [Text]
    outs
                  ExceptT Text m RunResult
    -> ExceptT Text m () -> ExceptT Text m RunResult
    forall a b.
    ExceptT Text m a -> ExceptT Text m b -> ExceptT Text m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* IO (Maybe CmdFailure) -> ExceptT Text m ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    liftCommand (Server -> [Text] -> IO (Maybe CmdFailure)
    cmdFree Server
    server [Text]
    outs)

            Text
    -> Int
    -> String
    -> ExpectedResult [Value]
    -> RunResult
    -> ExceptT Text m ()
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    Text
    -> Int -> String -> ExpectedResult [Value] -> RunResult -> m ()
    compareResult Text
    entry Int
    index String
    program ExpectedResult [Value]
    expected RunResult
    res

    checkError :: (MonadError T.Text m) => ExpectedError -> T.Text -> m ()
    checkError :: forall (m :: * -> *).
    MonadError Text m =>
    ExpectedError -> Text -> m ()
    checkError (ThisError Text
    regex_s Regex
    regex) Text
    err
      | Bool -> Bool
    not (Regex -> String -> Bool
    forall regex source target.
    RegexContext regex source target =>
    regex -> source -> target
    match Regex
    regex (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    err) =
          Text -> m ()
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
            Text
    "Expected error:\n  "
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    regex_s
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\nGot error:\n"
              Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    T.unlines ((Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text
    "  " <>) (Text -> [Text]
    T.lines Text
    err))
    checkError ExpectedError
    _ Text
    _ =
      () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    runResult ::
      (MonadIO m, MonadError T.Text m) =>
      FilePath ->
      ExitCode ->
      SBS.ByteString ->
      SBS.ByteString ->
      m RunResult
    runResult :: forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    String -> ExitCode -> ByteString -> ByteString -> m RunResult
    runResult String
    program ExitCode
    ExitSuccess ByteString
    stdout_s ByteString
    _ =
      case String -> ByteString -> Either String [Value]
    valuesFromByteString String
    "stdout" (ByteString -> Either String [Value])
    -> ByteString -> Either String [Value]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    LBS.fromStrict ByteString
    stdout_s of
        Left String
    e -> do
          let actualf :: String
    actualf = String
    program String -> ShowS
    `addExtension` String
    "actual"
          IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString -> IO ()
    SBS.writeFile String
    actualf ByteString
    stdout_s
          Text -> m RunResult
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError (Text -> m RunResult) -> Text -> m RunResult
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    e Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n(See " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack String
    actualf Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ")"
        Right [Value]
    vs -> RunResult -> m RunResult
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (RunResult -> m RunResult) -> RunResult -> m RunResult
    forall a b. (a -> b) -> a -> b
    $ [Value] -> RunResult
    SuccessResult [Value]
    vs
    runResult String
    _ (ExitFailure Int
    _) ByteString
    _ ByteString
    stderr_s =
      RunResult -> m RunResult
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (RunResult -> m RunResult) -> RunResult -> m RunResult
    forall a b. (a -> b) -> a -> b
    $ Text -> RunResult
    ErrorResult (Text -> RunResult) -> Text -> RunResult
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    stderr_s

    compileTestProgram :: [String] -> FutharkExe -> String -> FilePath -> [WarningTest] -> TestM ()
    compileTestProgram :: [String]
    -> FutharkExe -> String -> String -> [WarningTest] -> TestM ()
    compileTestProgram [String]
    extra_options FutharkExe
    futhark String
    backend String
    program [WarningTest]
    warnings = do
      (ByteString
    _, ByteString
    futerr) <-
        (Text -> [Text])
    -> ExceptT Text IO (ByteString, ByteString)
    -> ExceptT [Text] IO (ByteString, ByteString)
    forall (m :: * -> *) e e' a.
    Functor m =>
    (e -> e') -> ExceptT e m a -> ExceptT e' m a
    withExceptT Text -> [Text]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExceptT Text IO (ByteString, ByteString)
     -> ExceptT [Text] IO (ByteString, ByteString))
    -> ExceptT Text IO (ByteString, ByteString)
    -> ExceptT [Text] IO (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $
          [String]
    -> FutharkExe
    -> String
    -> String
    -> ExceptT Text IO (ByteString, ByteString)
    forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    [String]
    -> FutharkExe -> String -> String -> m (ByteString, ByteString)
    compileProgram (String
    "--server" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    extra_options) FutharkExe
    futhark String
    backend String
    program
      [WarningTest] -> ByteString -> TestM ()
    testWarnings [WarningTest]
    warnings ByteString
    futerr

    compareResult ::
      (MonadIO m, MonadError T.Text m) =>
      T.Text ->
      Int ->
      FilePath ->
      ExpectedResult [Value] ->
      RunResult ->
      m ()
    compareResult :: forall (m :: * -> *).
    (MonadIO m, MonadError Text m) =>
    Text
    -> Int -> String -> ExpectedResult [Value] -> RunResult -> m ()
    compareResult Text
    _ Int
    _ String
    _ (Succeeds Maybe [Value]
    Nothing) SuccessResult {} =
      () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    compareResult Text
    entry Int
    index String
    program (Succeeds (Just [Value]
    expected_vs)) (SuccessResult [Value]
    actual_vs) =
      String -> [Value] -> [Value] -> m ()
    forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    String -> [Value] -> [Value] -> m ()
    checkResult
        (String
    program String -> ShowS
    <.> Text -> String
    T.unpack Text
    entry String -> ShowS
    <.> Int -> String
    forall a. Show a => a -> String
    show Int
    index)
        [Value]
    expected_vs
        [Value]
    actual_vs
    compareResult Text
    _ Int
    _ String
    _ (RunTimeFailure ExpectedError
    expectedError) (ErrorResult Text
    actualError) =
      ExpectedError -> Text -> m ()
    forall (m :: * -> *).
    MonadError Text m =>
    ExpectedError -> Text -> m ()
    checkError ExpectedError
    expectedError Text
    actualError
    compareResult Text
    _ Int
    _ String
    _ (Succeeds Maybe [Value]
    _) (ErrorResult Text
    err) =
      Text -> m ()
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Function failed with error:\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    err
    compareResult Text
    _ Int
    _ String
    _ (RunTimeFailure ExpectedError
    f) (SuccessResult [Value]
    _) =
      Text -> m ()
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    E.throwError (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Program succeeded, but expected failure:\n  " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ExpectedError -> Text
    forall a. Show a => a -> Text
    showText ExpectedError
    f

    ---
    --- Test manager
    ---

    data TestStatus = TestStatus
      { TestStatus -> [TestCase]
    testStatusRemain :: [TestCase],
        TestStatus -> [TestCase]
    testStatusRun :: [TestCase],
        TestStatus -> Int
    testStatusTotal :: Int,
        TestStatus -> Int
    testStatusFail :: Int,
        TestStatus -> Int
    testStatusPass :: Int,
        TestStatus -> Int
    testStatusRuns :: Int,
        TestStatus -> Int
    testStatusRunsRemain :: Int,
        TestStatus -> Int
    testStatusRunPass :: Int,
        TestStatus -> Int
    testStatusRunFail :: Int
      }

    catching :: IO TestResult -> IO TestResult
    catching :: IO TestResult -> IO TestResult
    catching IO TestResult
    m = IO TestResult
    m IO TestResult -> (SomeException -> IO TestResult) -> IO TestResult
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` SomeException -> IO TestResult
    save
      where
        save :: SomeException -> IO TestResult
        save :: SomeException -> IO TestResult
    save SomeException
    e = TestResult -> IO TestResult
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TestResult -> IO TestResult) -> TestResult -> IO TestResult
    forall a b. (a -> b) -> a -> b
    $ [Text] -> TestResult
    Failure [SomeException -> Text
    forall a. Show a => a -> Text
    showText SomeException
    e]

    doTest :: TestCase -> IO TestResult
    doTest :: TestCase -> IO TestResult
    doTest = IO TestResult -> IO TestResult
    catching (IO TestResult -> IO TestResult)
    -> (TestCase -> IO TestResult) -> TestCase -> IO TestResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestM () -> IO TestResult
    runTestM (TestM () -> IO TestResult)
    -> (TestCase -> TestM ()) -> TestCase -> IO TestResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestCase -> TestM ()
    runTestCase

    makeTestCase :: TestConfig -> TestMode -> (FilePath, ProgramTest) -> TestCase
    makeTestCase :: TestConfig -> TestMode -> (String, ProgramTest) -> TestCase
    makeTestCase TestConfig
    config TestMode
    mode (String
    file, ProgramTest
    spec) =
      TestConfig -> TestCase -> TestCase
    excludeCases TestConfig
    config (TestCase -> TestCase) -> TestCase -> TestCase
    forall a b. (a -> b) -> a -> b
    $ TestMode -> String -> ProgramTest -> ProgConfig -> TestCase
    TestCase TestMode
    mode String
    file ProgramTest
    spec (ProgConfig -> TestCase) -> ProgConfig -> TestCase
    forall a b. (a -> b) -> a -> b
    $ TestConfig -> ProgConfig
    configPrograms TestConfig
    config

    data ReportMsg
      = TestStarted TestCase
      | TestDone TestCase TestResult

    runTest :: MVar TestCase -> MVar ReportMsg -> IO ()
    runTest :: MVar TestCase -> MVar ReportMsg -> IO ()
    runTest MVar TestCase
    testmvar MVar ReportMsg
    resmvar = IO () -> IO ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      TestCase
    test <- MVar TestCase -> IO TestCase
    forall a. MVar a -> IO a
    takeMVar MVar TestCase
    testmvar
      MVar ReportMsg -> ReportMsg -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ReportMsg
    resmvar (ReportMsg -> IO ()) -> ReportMsg -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestCase -> ReportMsg
    TestStarted TestCase
    test
      TestResult
    res <- TestCase -> IO TestResult
    doTest TestCase
    test
      MVar ReportMsg -> ReportMsg -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ReportMsg
    resmvar (ReportMsg -> IO ()) -> ReportMsg -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TestCase -> TestResult -> ReportMsg
    TestDone TestCase
    test TestResult
    res

    excludedTest :: TestConfig -> TestCase -> Bool
    excludedTest :: TestConfig -> TestCase -> Bool
    excludedTest TestConfig
    config =
      (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` TestConfig -> [Text]
    configExclude TestConfig
    config) ([Text] -> Bool) -> (TestCase -> [Text]) -> TestCase -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgramTest -> [Text]
    testTags (ProgramTest -> [Text])
    -> (TestCase -> ProgramTest) -> TestCase -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestCase -> ProgramTest
    testCaseTest

    -- | Exclude those test cases that have tags we do not wish to run.
    excludeCases :: TestConfig -> TestCase -> TestCase
    excludeCases :: TestConfig -> TestCase -> TestCase
    excludeCases TestConfig
    config TestCase
    tcase =
      TestCase
    tcase {testCaseTest = onTest $ testCaseTest tcase}
      where
        onTest :: ProgramTest -> ProgramTest
    onTest (ProgramTest Text
    desc [Text]
    tags TestAction
    action) =
          Text -> [Text] -> TestAction -> ProgramTest
    ProgramTest Text
    desc [Text]
    tags (TestAction -> ProgramTest) -> TestAction -> ProgramTest
    forall a b. (a -> b) -> a -> b
    $ TestAction -> TestAction
    onAction TestAction
    action
        onAction :: TestAction -> TestAction
    onAction (RunCases [InputOutputs]
    ios [StructureTest]
    stest [WarningTest]
    wtest) =
          [InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
    RunCases ((InputOutputs -> InputOutputs) -> [InputOutputs] -> [InputOutputs]
    forall a b. (a -> b) -> [a] -> [b]
    map InputOutputs -> InputOutputs
    onIOs [InputOutputs]
    ios) [StructureTest]
    stest [WarningTest]
    wtest
        onAction TestAction
    action = TestAction
    action
        onIOs :: InputOutputs -> InputOutputs
    onIOs (InputOutputs Text
    entry [TestRun]
    runs) =
          Text -> [TestRun] -> InputOutputs
    InputOutputs Text
    entry ([TestRun] -> InputOutputs) -> [TestRun] -> InputOutputs
    forall a b. (a -> b) -> a -> b
    $ (TestRun -> Bool) -> [TestRun] -> [TestRun]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (TestRun -> Bool) -> TestRun -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Text -> Bool
    excluded ([Text] -> Bool) -> (TestRun -> [Text]) -> TestRun -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestRun -> [Text]
    runTags) [TestRun]
    runs
        excluded :: Text -> Bool
    excluded = (Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` TestConfig -> [Text]
    configExclude TestConfig
    config)

    putStatusTable :: TestStatus -> IO ()
    putStatusTable :: TestStatus -> IO ()
    putStatusTable TestStatus
    ts = Handle -> [[Entry]] -> Int -> IO ()
    hPutTable Handle
    stdout [[Entry]]
    rows Int
    1
      where
        rows :: [[Entry]]
    rows =
          [ [String -> AnsiStyle -> Entry
    mkEntry String
    "" AnsiStyle
    forall a. Monoid a => a
    mempty, Entry
    passed, Entry
    failed, String -> AnsiStyle -> Entry
    mkEntry String
    "remaining" AnsiStyle
    forall a. Monoid a => a
    mempty],
            (String -> Entry) -> [String] -> [Entry]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> AnsiStyle -> Entry
    `mkEntry` AnsiStyle
    forall a. Monoid a => a
    mempty) [String
    "programs", String
    passedProgs, String
    failedProgs, String
    remainProgs'],
            (String -> Entry) -> [String] -> [Entry]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> AnsiStyle -> Entry
    `mkEntry` AnsiStyle
    forall a. Monoid a => a
    mempty) [String
    "runs", String
    passedRuns, String
    failedRuns, String
    remainRuns']
          ]
        passed :: Entry
    passed = String -> AnsiStyle -> Entry
    mkEntry String
    "passed" (AnsiStyle -> Entry) -> AnsiStyle -> Entry
    forall a b. (a -> b) -> a -> b
    $ Color -> AnsiStyle
    color Color
    Green
        failed :: Entry
    failed = String -> AnsiStyle -> Entry
    mkEntry String
    "failed" (AnsiStyle -> Entry) -> AnsiStyle -> Entry
    forall a b. (a -> b) -> a -> b
    $ Color -> AnsiStyle
    color Color
    Red
        passedProgs :: String
    passedProgs = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> Int
    testStatusPass TestStatus
    ts
        failedProgs :: String
    failedProgs = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> Int
    testStatusFail TestStatus
    ts
        totalProgs :: String
    totalProgs = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> Int
    testStatusTotal TestStatus
    ts
        totalRuns :: String
    totalRuns = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> Int
    testStatusRuns TestStatus
    ts
        passedRuns :: String
    passedRuns = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> Int
    testStatusRunPass TestStatus
    ts
        failedRuns :: String
    failedRuns = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> Int
    testStatusRunFail TestStatus
    ts
        remainProgs :: String
    remainProgs = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> ([TestCase] -> Int) -> [TestCase] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TestCase] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([TestCase] -> String) -> [TestCase] -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> [TestCase]
    testStatusRemain TestStatus
    ts
        remainProgs' :: String
    remainProgs' = String
    remainProgs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    totalProgs
        remainRuns :: String
    remainRuns = Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> Int
    testStatusRunsRemain TestStatus
    ts
        remainRuns' :: String
    remainRuns' = String
    remainRuns String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "/" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    totalRuns

    tableLines :: Int
    tableLines :: Int
    tableLines = Int
    8

    spaceTable :: IO ()
    spaceTable :: IO ()
    spaceTable = String -> IO ()
    putStr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    tableLines Char
    '\n'

    reportTable :: TestStatus -> IO ()
    reportTable :: TestStatus -> IO ()
    reportTable TestStatus
    ts = do
      IO ()
    moveCursorToTableTop
      TestStatus -> IO ()
    putStatusTable TestStatus
    ts
      IO ()
    clearLine
      Int
    w <- Int -> (Window Int -> Int) -> Maybe (Window Int) -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    80 Window Int -> Int
    forall a. Window a -> a
    Terminal.width (Maybe (Window Int) -> Int) -> IO (Maybe (Window Int)) -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe (Window Int))
    forall n. Integral n => IO (Maybe (Window n))
    Terminal.size
      Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Text -> Text
    atMostChars (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Text -> Int
    T.length Text
    labelstr) Text
    running
      where
        running :: Text
    running = Text
    labelstr Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ([Text] -> Text
    T.unwords ([Text] -> Text) -> (TestStatus -> [Text]) -> TestStatus -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [Text]
    forall a. [a] -> [a]
    reverse ([Text] -> [Text])
    -> (TestStatus -> [Text]) -> TestStatus -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TestCase -> Text) -> [TestCase] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Text
    T.pack (String -> Text) -> (TestCase -> String) -> TestCase -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestCase -> String
    testCaseProgram) ([TestCase] -> [Text])
    -> (TestStatus -> [TestCase]) -> TestStatus -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestStatus -> [TestCase]
    testStatusRun) TestStatus
    ts
        labelstr :: Text
    labelstr = Text
    "Now testing: "

    reportLine :: MVar SystemTime -> TestStatus -> IO ()
    reportLine :: MVar SystemTime -> TestStatus -> IO ()
    reportLine MVar SystemTime
    time_mvar TestStatus
    ts =
      MVar SystemTime -> (SystemTime -> IO SystemTime) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar SystemTime
    time_mvar ((SystemTime -> IO SystemTime) -> IO ())
    -> (SystemTime -> IO SystemTime) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \SystemTime
    time -> do
        SystemTime
    time_now <- IO SystemTime
    getSystemTime
        if SystemTime -> Int64
    systemSeconds SystemTime
    time_now Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    - SystemTime -> Int64
    systemSeconds SystemTime
    time Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int64
    period
          then do
            Text -> IO ()
    T.putStrLn (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              Int -> Text
    forall a. Show a => a -> Text
    showText (TestStatus -> Int
    testStatusFail TestStatus
    ts)
                Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " failed, "
                Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText (TestStatus -> Int
    testStatusPass TestStatus
    ts)
                Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " passed, "
                Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showText Int
    num_remain
                Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " to go."
            SystemTime -> IO SystemTime
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SystemTime
    time_now
          else SystemTime -> IO SystemTime
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SystemTime
    time
      where
        num_remain :: Int
    num_remain = [TestCase] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([TestCase] -> Int) -> [TestCase] -> Int
    forall a b. (a -> b) -> a -> b
    $ TestStatus -> [TestCase]
    testStatusRemain TestStatus
    ts
        period :: Int64
    period = Int64
    60

    moveCursorToTableTop :: IO ()
    moveCursorToTableTop :: IO ()
    moveCursorToTableTop = Int -> IO ()
    cursorUpLine Int
    tableLines

    runTests :: TestConfig -> [FilePath] -> IO ()
    runTests :: TestConfig -> [String] -> IO ()
    runTests TestConfig
    config [String]
    paths = do
      -- We force line buffering to ensure that we produce running output.
      -- Otherwise, CI tools and the like may believe we are hung and kill
      -- us.
      Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    stdout BufferMode
    LineBuffering

      let mode :: TestMode
    mode = TestConfig -> TestMode
    configTestMode TestConfig
    config
      [TestCase]
    all_tests <-
        ((String, ProgramTest) -> TestCase)
    -> [(String, ProgramTest)] -> [TestCase]
    forall a b. (a -> b) -> [a] -> [b]
    map (TestConfig -> TestMode -> (String, ProgramTest) -> TestCase
    makeTestCase TestConfig
    config TestMode
    mode)
          ([(String, ProgramTest)] -> [TestCase])
    -> IO [(String, ProgramTest)] -> IO [TestCase]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String] -> IO [(String, ProgramTest)]
    testSpecsFromPathsOrDie [String]
    paths
      MVar TestCase
    testmvar <- IO (MVar TestCase)
    forall a. IO (MVar a)
    newEmptyMVar
      MVar ReportMsg
    reportmvar <- IO (MVar ReportMsg)
    forall a. IO (MVar a)
    newEmptyMVar
      Int
    concurrency <- IO Int -> (Int -> IO Int) -> Maybe Int -> IO Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO Int
    getNumCapabilities Int -> IO Int
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Int -> IO Int) -> Maybe Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ TestConfig -> Maybe Int
    configConcurrency TestConfig
    config
      Int -> IO ThreadId -> IO ()
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
    replicateM_ Int
    concurrency (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ MVar TestCase -> MVar ReportMsg -> IO ()
    runTest MVar TestCase
    testmvar MVar ReportMsg
    reportmvar

      let ([TestCase]
    excluded, [TestCase]
    included) = (TestCase -> Bool) -> [TestCase] -> ([TestCase], [TestCase])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (TestConfig -> TestCase -> Bool
    excludedTest TestConfig
    config) [TestCase]
    all_tests
      ThreadId
    _ <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ (TestCase -> IO ()) -> [TestCase] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (MVar TestCase -> TestCase -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar TestCase
    testmvar (TestCase -> IO ()) -> (TestCase -> TestCase) -> TestCase -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestConfig -> TestCase -> TestCase
    excludeCases TestConfig
    config) [TestCase]
    included

      MVar SystemTime
    time_mvar <- SystemTime -> IO (MVar SystemTime)
    forall a. a -> IO (MVar a)
    newMVar (SystemTime -> IO (MVar SystemTime))
    -> SystemTime -> IO (MVar SystemTime)
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Word32 -> SystemTime
    MkSystemTime Int64
    0 Word32
    0

      let fancy :: Bool
    fancy = Bool -> Bool
    not (TestConfig -> Bool
    configLineOutput TestConfig
    config) Bool -> Bool -> Bool
    && Bool
    fancyTerminal

          report :: TestStatus -> IO ()
    report
            | Bool
    fancy = TestStatus -> IO ()
    reportTable
            | Bool
    otherwise = MVar SystemTime -> TestStatus -> IO ()
    reportLine MVar SystemTime
    time_mvar
          clear :: IO ()
    clear
            | Bool
    fancy = IO ()
    clearFromCursorToScreenEnd
            | Bool
    otherwise = () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

          numTestCases :: TestCase -> Int
    numTestCases TestCase
    tc =
            case ProgramTest -> TestAction
    testAction (ProgramTest -> TestAction) -> ProgramTest -> TestAction
    forall a b. (a -> b) -> a -> b
    $ TestCase -> ProgramTest
    testCaseTest TestCase
    tc of
              CompileTimeFailure ExpectedError
    _ -> Int
    1
              RunCases [InputOutputs]
    ios [StructureTest]
    sts [WarningTest]
    wts ->
                [TestRun] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((InputOutputs -> [TestRun]) -> [InputOutputs] -> [TestRun]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap InputOutputs -> [TestRun]
    iosTestRuns [InputOutputs]
    ios)
                  Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [StructureTest] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [StructureTest]
    sts
                  Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [WarningTest] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [WarningTest]
    wts

          getResults :: TestStatus -> IO TestStatus
    getResults TestStatus
    ts
            | [TestCase] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TestStatus -> [TestCase]
    testStatusRemain TestStatus
    ts) = TestStatus -> IO ()
    report TestStatus
    ts IO () -> IO TestStatus -> IO TestStatus
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TestStatus -> IO TestStatus
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TestStatus
    ts
            | Bool
    otherwise = do
                TestStatus -> IO ()
    report TestStatus
    ts
                ReportMsg
    msg <- MVar ReportMsg -> IO ReportMsg
    forall a. MVar a -> IO a
    takeMVar MVar ReportMsg
    reportmvar
                case ReportMsg
    msg of
                  TestStarted TestCase
    test ->
                    TestStatus -> IO TestStatus
    getResults (TestStatus -> IO TestStatus) -> TestStatus -> IO TestStatus
    forall a b. (a -> b) -> a -> b
    $ TestStatus
    ts {testStatusRun = test : testStatusRun ts}
                  TestDone TestCase
    test TestResult
    res -> do
                    let ts' :: TestStatus
    ts' =
                          TestStatus
    ts
                            { testStatusRemain = test `delete` testStatusRemain ts,
                              testStatusRun = test `delete` testStatusRun ts,
                              testStatusRunsRemain =
                                testStatusRunsRemain ts - numTestCases test
                            }
                    case TestResult
    res of
                      TestResult
    Success -> do
                        let ts'' :: TestStatus
    ts'' =
                              TestStatus
    ts'
                                { testStatusRunPass =
                                    testStatusRunPass ts' + numTestCases test
                                }
                        TestStatus -> IO TestStatus
    getResults (TestStatus -> IO TestStatus) -> TestStatus -> IO TestStatus
    forall a b. (a -> b) -> a -> b
    $ TestStatus
    ts'' {testStatusPass = testStatusPass ts + 1}
                      Failure [Text]
    s -> do
                        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    fancy IO ()
    moveCursorToTableTop
                        IO ()
    clear
                        Doc AnsiStyle -> IO ()
    putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                          AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    annotate (AnsiStyle
    bold AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Color -> AnsiStyle
    bgColor Color
    Red) (String -> Doc AnsiStyle
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (TestCase -> String
    testCaseProgram TestCase
    test) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    ":")
                            Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline
                            Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> [Doc AnsiStyle] -> Doc AnsiStyle
    forall ann. [Doc ann] -> Doc ann
    vsep ((Text -> Doc AnsiStyle) -> [Text] -> [Doc AnsiStyle]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Doc AnsiStyle
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty [Text]
    s)
                            Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    hardline
                        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    fancy IO ()
    spaceTable
                        TestStatus -> IO TestStatus
    getResults (TestStatus -> IO TestStatus) -> TestStatus -> IO TestStatus
    forall a b. (a -> b) -> a -> b
    $
                          TestStatus
    ts'
                            { testStatusFail = testStatusFail ts' + 1,
                              testStatusRunPass =
                                testStatusRunPass ts'
                                  + max 0 (numTestCases test - length s),
                              testStatusRunFail =
                                testStatusRunFail ts'
                                  + min (numTestCases test) (length s)
                            }

      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    fancy IO ()
    spaceTable

      TestStatus
    ts <-
        TestStatus -> IO TestStatus
    getResults
          TestStatus
            { testStatusRemain :: [TestCase]
    testStatusRemain = [TestCase]
    included,
              testStatusRun :: [TestCase]
    testStatusRun = [],
              testStatusTotal :: Int
    testStatusTotal = [TestCase] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TestCase]
    included,
              testStatusFail :: Int
    testStatusFail = Int
    0,
              testStatusPass :: Int
    testStatusPass = Int
    0,
              testStatusRuns :: Int
    testStatusRuns = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (TestCase -> Int) -> [TestCase] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map TestCase -> Int
    numTestCases [TestCase]
    included,
              testStatusRunsRemain :: Int
    testStatusRunsRemain = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (TestCase -> Int) -> [TestCase] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map TestCase -> Int
    numTestCases [TestCase]
    included,
              testStatusRunPass :: Int
    testStatusRunPass = Int
    0,
              testStatusRunFail :: Int
    testStatusRunFail = Int
    0
            }

      -- Removes "Now testing" output.
      if Bool
    fancy
        then Int -> IO ()
    cursorUpLine Int
    1 IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    clearLine
        else String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show (TestStatus -> Int
    testStatusPass TestStatus
    ts) String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "/" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show (TestStatus -> Int
    testStatusTotal TestStatus
    ts) String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " passed."

      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([TestCase] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TestCase]
    excluded) (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Int -> String
    forall a. Show a => a -> String
    show ([TestCase] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TestCase]
    excluded) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " program(s) excluded."

      ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case TestStatus -> Int
    testStatusFail TestStatus
    ts of
        Int
    0 -> ExitCode
    ExitSuccess
        Int
    _ -> Int -> ExitCode
    ExitFailure Int
    1

    ---
    --- Configuration and command line parsing
    ---

    data TestConfig = TestConfig
      { TestConfig -> TestMode
    configTestMode :: TestMode,
        TestConfig -> ProgConfig
    configPrograms :: ProgConfig,
        TestConfig -> [Text]
    configExclude :: [T.Text],
        TestConfig -> Bool
    configLineOutput :: Bool,
        TestConfig -> Maybe Int
    configConcurrency :: Maybe Int
      }

    defaultConfig :: TestConfig
    defaultConfig :: TestConfig
    defaultConfig =
      TestConfig
        { configTestMode :: TestMode
    configTestMode = TestMode
    Compiled,
          configExclude :: [Text]
    configExclude = [Text
    "disable", Text
    "notest"],
          configPrograms :: ProgConfig
    configPrograms =
            ProgConfig
              { configBackend :: String
    configBackend = String
    "c",
                configFuthark :: Maybe String
    configFuthark = Maybe String
    forall a. Maybe a
    Nothing,
                configRunner :: String
    configRunner = String
    "",
                configExtraOptions :: [String]
    configExtraOptions = [],
                configExtraCompilerOptions :: [String]
    configExtraCompilerOptions = [],
                configTuning :: Maybe String
    configTuning = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "tuning",
                configCacheExt :: Maybe String
    configCacheExt = Maybe String
    forall a. Maybe a
    Nothing
              },
          configLineOutput :: Bool
    configLineOutput = Bool
    False,
          configConcurrency :: Maybe Int
    configConcurrency = Maybe Int
    forall a. Maybe a
    Nothing
        }

    data ProgConfig = ProgConfig
      { ProgConfig -> String
    configBackend :: String,
        ProgConfig -> Maybe String
    configFuthark :: Maybe FilePath,
        ProgConfig -> String
    configRunner :: FilePath,
        ProgConfig -> [String]
    configExtraCompilerOptions :: [String],
        ProgConfig -> Maybe String
    configTuning :: Maybe String,
        ProgConfig -> Maybe String
    configCacheExt :: Maybe String,
        -- | Extra options passed to the programs being run.
        ProgConfig -> [String]
    configExtraOptions :: [String]
      }
      deriving (Int -> ProgConfig -> ShowS
    [ProgConfig] -> ShowS
    ProgConfig -> String
    (Int -> ProgConfig -> ShowS)
    -> (ProgConfig -> String)
    -> ([ProgConfig] -> ShowS)
    -> Show ProgConfig
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ProgConfig -> ShowS
    showsPrec :: Int -> ProgConfig -> ShowS
    $cshow :: ProgConfig -> String
    show :: ProgConfig -> String
    $cshowList :: [ProgConfig] -> ShowS
    showList :: [ProgConfig] -> ShowS
    Show)

    changeProgConfig :: (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig :: (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ProgConfig -> ProgConfig
    f TestConfig
    config = TestConfig
    config {configPrograms = f $ configPrograms config}

    setBackend :: FilePath -> ProgConfig -> ProgConfig
    setBackend :: String -> ProgConfig -> ProgConfig
    setBackend String
    backend ProgConfig
    config =
      ProgConfig
    config {configBackend = backend}

    setFuthark :: FilePath -> ProgConfig -> ProgConfig
    setFuthark :: String -> ProgConfig -> ProgConfig
    setFuthark String
    futhark ProgConfig
    config =
      ProgConfig
    config {configFuthark = Just futhark}

    setRunner :: FilePath -> ProgConfig -> ProgConfig
    setRunner :: String -> ProgConfig -> ProgConfig
    setRunner String
    runner ProgConfig
    config =
      ProgConfig
    config {configRunner = runner}

    addCompilerOption :: String -> ProgConfig -> ProgConfig
    addCompilerOption :: String -> ProgConfig -> ProgConfig
    addCompilerOption String
    option ProgConfig
    config =
      ProgConfig
    config {configExtraCompilerOptions = configExtraCompilerOptions config ++ [option]}

    addOption :: String -> ProgConfig -> ProgConfig
    addOption :: String -> ProgConfig -> ProgConfig
    addOption String
    option ProgConfig
    config =
      ProgConfig
    config {configExtraOptions = configExtraOptions config ++ [option]}

    commandLineOptions :: [FunOptDescr TestConfig]
    commandLineOptions :: [FunOptDescr TestConfig]
    commandLineOptions =
      [ String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "t"
          [String
    "typecheck"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configTestMode = TypeCheck})
          String
    "Only perform type-checking",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "i"
          [String
    "interpreted"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configTestMode = Interpreted})
          String
    "Only interpret",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "c"
          [String
    "compiled"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configTestMode = Compiled})
          String
    "Only run compiled code (the default)",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "C"
          [String
    "compile"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configTestMode = Compile})
          String
    "Only compile, do not run.",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "s"
          [String
    "structure"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configTestMode = Structure})
          String
    "Perform structure tests.",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "I"
          [String
    "internalise"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configTestMode = Internalise})
          String
    "Only run the compiler frontend.",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "no-terminal", String
    "notty"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configLineOutput = True})
          String
    "Provide simpler line-based output.",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "backend"]
          ((String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg ((TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (String -> TestConfig -> TestConfig)
    -> String
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ((ProgConfig -> ProgConfig) -> TestConfig -> TestConfig)
    -> (String -> ProgConfig -> ProgConfig)
    -> String
    -> TestConfig
    -> TestConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ProgConfig -> ProgConfig
    setBackend) String
    "BACKEND")
          String
    "Backend used for compilation (defaults to 'c').",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "futhark"]
          ((String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg ((TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (String -> TestConfig -> TestConfig)
    -> String
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ((ProgConfig -> ProgConfig) -> TestConfig -> TestConfig)
    -> (String -> ProgConfig -> ProgConfig)
    -> String
    -> TestConfig
    -> TestConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ProgConfig -> ProgConfig
    setFuthark) String
    "PROGRAM")
          String
    "Program to run for subcommands (defaults to same binary as 'futhark test').",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "runner"]
          ((String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg ((TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (String -> TestConfig -> TestConfig)
    -> String
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ((ProgConfig -> ProgConfig) -> TestConfig -> TestConfig)
    -> (String -> ProgConfig -> ProgConfig)
    -> String
    -> TestConfig
    -> TestConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ProgConfig -> ProgConfig
    setRunner) String
    "PROGRAM")
          String
    "The program used to run the Futhark-generated programs (defaults to nothing).",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "exclude"]
          ( (String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg
              ( \String
    tag ->
                  (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config ->
                    TestConfig
    config {configExclude = T.pack tag : configExclude config}
              )
              String
    "TAG"
          )
          String
    "Exclude test programs that define this tag.",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          String
    "p"
          [String
    "pass-option"]
          ((String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg ((TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (String -> TestConfig -> TestConfig)
    -> String
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ((ProgConfig -> ProgConfig) -> TestConfig -> TestConfig)
    -> (String -> ProgConfig -> ProgConfig)
    -> String
    -> TestConfig
    -> TestConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ProgConfig -> ProgConfig
    addOption) String
    "OPT")
          String
    "Pass this option to programs being run.",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "pass-compiler-option"]
          ((String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg ((TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (String -> TestConfig -> TestConfig)
    -> String
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ((ProgConfig -> ProgConfig) -> TestConfig -> TestConfig)
    -> (String -> ProgConfig -> ProgConfig)
    -> String
    -> TestConfig
    -> TestConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ProgConfig -> ProgConfig
    addCompilerOption) String
    "OPT")
          String
    "Pass this option to the compiler (or typechecker if in -t mode).",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "no-tuning"]
          (Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. a -> ArgDescr a
    NoArg (Either (IO ()) (TestConfig -> TestConfig)
     -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig)))
    -> Either (IO ()) (TestConfig -> TestConfig)
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a b. (a -> b) -> a -> b
    $ (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ((ProgConfig -> ProgConfig) -> TestConfig -> TestConfig)
    -> (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    forall a b. (a -> b) -> a -> b
    $ \ProgConfig
    config -> ProgConfig
    config {configTuning = Nothing})
          String
    "Do not load tuning files.",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "cache-extension"]
          ( (String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg
              (\String
    s -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    changeProgConfig ((ProgConfig -> ProgConfig) -> TestConfig -> TestConfig)
    -> (ProgConfig -> ProgConfig) -> TestConfig -> TestConfig
    forall a b. (a -> b) -> a -> b
    $ \ProgConfig
    config -> ProgConfig
    config {configCacheExt = Just s})
              String
    "EXTENSION"
          )
          String
    "Use cache files with this extension (none by default).",
        String
    -> [String]
    -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    -> String
    -> FunOptDescr TestConfig
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option
          []
          [String
    "concurrency"]
          ( (String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> ArgDescr (Either (IO ()) (TestConfig -> TestConfig))
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg
              ( \String
    n ->
                  case ReadS Int
    forall a. Read a => ReadS a
    reads String
    n of
                    [(Int
    n', String
    "")]
                      | Int
    n' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 ->
                          (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. b -> Either a b
    Right ((TestConfig -> TestConfig)
     -> Either (IO ()) (TestConfig -> TestConfig))
    -> (TestConfig -> TestConfig)
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ \TestConfig
    config -> TestConfig
    config {configConcurrency = Just n'}
                    [(Int, String)]
    _ ->
                      IO () -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. a -> Either a b
    Left (IO () -> Either (IO ()) (TestConfig -> TestConfig))
    -> (String -> IO ())
    -> String
    -> Either (IO ()) (TestConfig -> TestConfig)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    optionsError (String -> Either (IO ()) (TestConfig -> TestConfig))
    -> String -> Either (IO ()) (TestConfig -> TestConfig)
    forall a b. (a -> b) -> a -> b
    $ String
    "'" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "' is not a positive integer."
              )
              String
    "NUM"
          )
          String
    "Number of tests to run concurrently."
      ]

    excludeBackend :: TestConfig -> TestConfig
    excludeBackend :: TestConfig -> TestConfig
    excludeBackend TestConfig
    config =
      TestConfig
    config
        { configExclude =
            "no_" <> T.pack (configBackend (configPrograms config))
              : configExclude config
        }

    -- | Run @futhark test@.
    main :: String -> [String] -> IO ()
    main :: String -> [String] -> IO ()
    main = TestConfig
    -> [FunOptDescr TestConfig]
    -> String
    -> ([String] -> TestConfig -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall cfg.
    cfg
    -> [FunOptDescr cfg]
    -> String
    -> ([String] -> cfg -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    mainWithOptions TestConfig
    defaultConfig [FunOptDescr TestConfig]
    commandLineOptions String
    "options... programs..." (([String] -> TestConfig -> Maybe (IO ()))
     -> String -> [String] -> IO ())
    -> ([String] -> TestConfig -> Maybe (IO ()))
    -> String
    -> [String]
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[String]
    progs TestConfig
    config ->
      case [String]
    progs of
        [] -> Maybe (IO ())
    forall a. Maybe a
    Nothing
        [String]
    _ -> IO () -> Maybe (IO ())
    forall a. a -> Maybe a
    Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
    forall a b. (a -> b) -> a -> b
    $ TestConfig -> [String] -> IO ()
    runTests (TestConfig -> TestConfig
    excludeBackend TestConfig
    config) [String]
    progs