egison-3.9.0: test/Test.hs

module Main where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.IORef
import           Data.List

import           System.FilePath                (replaceDirectory, splitPath,
                                                 takeDirectory)
import           System.FilePath.Glob           (glob)
import           Test.Framework                 (defaultMain)
import           Test.Framework.Providers.HUnit (hUnitTestToTests)
import           Test.HUnit

import           Language.Egison
import           Language.Egison.Core
import           Language.Egison.Parser
import           Language.Egison.Primitives
import           Language.Egison.Types

main = do
  (sampleTestCases, unitTestCases) <- partition (isSubsequenceOf "answer" . show) <$> glob "test/**/*.egi"
  defaultMain $ hUnitTestToTests $ test $ map runUnitTestCase unitTestCases ++ map runSampleTestCase sampleTestCases

runUnitTestCase :: FilePath -> Test
runUnitTestCase file = TestLabel file . TestCase $ do
  env <- initialEnv defaultOption
  assertEgisonM $ do
    exprs <- loadFile file
    let (bindings, tests) = foldr collectDefsAndTests ([], []) exprs
    env' <- recursiveBind env bindings
    forM_ tests $ evalExprDeep env'
      where
        assertEgisonM :: EgisonM a -> Assertion
        assertEgisonM m = fromEgisonM m >>= assertString . either show (const "")

        collectDefsAndTests (Define name expr) (bindings, tests) =
          ((name, expr) : bindings, tests)
        collectDefsAndTests (Test expr) (bindings, tests) =
          (bindings, expr : tests)
        collectDefsAndTests _ r = r

runSampleTestCase :: FilePath -> Test
runSampleTestCase file = TestLabel file . TestCase $ do
  env <- initialEnv defaultOption
  let directory_path = takeDirectory file
  answers <- readFile file
  assertEgisonM (lines answers) $ do
    exprs <- loadFile (replaceDirectory file $ concat $ drop 2 $ splitPath directory_path)
    let (bindings, tests) = foldr collectDefsAndTests ([], []) exprs
    env' <- recursiveBind env bindings
    vals <- forM tests (evalExprDeep env')
    return $ zip tests vals
      where
        assertEgisonM :: [String] -> EgisonM [(EgisonExpr, EgisonValue)] -> Assertion
        assertEgisonM answers m = fromEgisonM m >>= assertString . either show (f answers)

        collectDefsAndTests (Define name expr) (bindings, tests) =
          ((name, expr) : bindings, tests)
        collectDefsAndTests (Test expr) (bindings, tests) =
          (bindings, expr : tests)
        collectDefsAndTests _ r = r

        f :: [String] -> [(EgisonExpr, EgisonValue)] -> String
        f answers ls = g answers ls 0
        g x y i = let (e, v) = unzip y in
                  if (x !! i) == show (v !! i)
                     then (if i < (length y - 1) then g x y (i + 1)
                                                 else "")
                     else "failed " ++ show (e !! i) ++ "\n expected: " ++ (x !! i) ++ "\n but found: " ++ show (v !! i)