egison-5.0.0: test/Test.hs

module Main where

import           Control.Monad.IO.Class         (liftIO)
import           Control.Monad.Trans.Class      (lift)
import           System.Environment             (getArgs)
import           System.IO                      (hFlush, stdout)

import           Test.Framework                 (defaultMainWithArgs)
import           Test.Framework.Providers.HUnit (hUnitTestToTests)
import           Test.HUnit

import           Language.Egison
import           Language.Egison.AST            (TopExpr(..))
import           Language.Egison.MathOutput

main :: IO ()
main = do
  -- t <- evalRuntimeT defaultOption mathOutputTest
  args <- getArgs
  flip defaultMainWithArgs args . hUnitTestToTests . test $ 
    -- Skip mathOutputTest for now due to infinite loop
    map runTestCase testCases

testCases :: [FilePath]
testCases =
  [ "test/syntax.egi"
  , "test/primitive.egi"
  , "test/lib/core/assoc.egi"
  , "test/lib/core/base.egi"
  , "test/lib/core/collection.egi"
  , "test/lib/core/maybe.egi"
  , "test/lib/core/number.egi"
  , "test/lib/core/order.egi"
  , "test/lib/core/random.egi"
  , "test/lib/core/sort.egi"
  , "test/lib/core/string.egi"
  , "test/lib/math/algebra.egi"
  -- , "test/lib/math/analysis.egi"   -- Skipped due to infinite loop
  -- , "test/lib/math/arithmetic.egi"  -- Skipped due to infinite loop
  -- , "test/lib/math/tensor.egi"     -- Skipped due to infinite loop

--  , "sample/mahjong.egi" -- for testing pattern functions
  , "sample/primes.egi" -- for testing pattern matching with infinitely many results
  , "sample/sat/cdcl.egi" -- for testing a practical program using pattern matching
  , "sample/poker-hands.egi"
  , "sample/poker-hands-with-joker.egi"

  , "sample/math/geometry/riemann-curvature-tensor-of-S2.egi" -- for testing tensor index notation
  , "sample/math/geometry/riemann-curvature-tensor-of-T2.egi" -- for testing tensor index notation and math quote
  , "sample/math/geometry/curvature-form.egi" -- for testing differential form
  , "sample/math/number/17th-root-of-unity.egi" -- for testing rewriting of mathematical expressions
  , "sample/math/geometry/hodge-laplacian-polar.egi" -- for testing "..." in tensor indices
  ]

runTestCase :: FilePath -> Test
runTestCase file = TestLabel file . TestCase . assertEvalM $ do
  -- Print the test file name before starting
  liftIO $ do
    putStrLn $ "\n=== Testing: " ++ file ++ " ==="
    hFlush stdout
  env <- initialEnv
  -- Load core libraries and math normalization library
  let coreLibExprs = map Load coreLibraries
      mathLibExpr = [Load "lib/math/normalize.egi"]
      allLibExprs = coreLibExprs ++ mathLibExpr
  env' <- evalTopExprsNoPrint env allLibExprs
  -- Then load the test file
  exprs <- loadFile file
  evalTopExprsNoPrint env' exprs
  where
    assertEvalM :: EvalM a -> Assertion
    assertEvalM m = fromEvalM defaultOption m >>= assertString . either show (const "")

mathOutputTest :: RuntimeM Test
mathOutputTest = do
  envResult <- fromEvalT $ do
    env <- initialEnv
    -- Load core libraries and math normalization library
    let coreLibExprs = map Load coreLibraries
        mathLibExpr = [Load "lib/math/normalize.egi"]
        allLibExprs = coreLibExprs ++ mathLibExpr
    evalTopExprsNoPrint env allLibExprs
  env <- case envResult of
    Left err -> error $ "Failed to initialize environment: " ++ show err
    Right e -> return e
  latexTest <- mathOutputTestLatex env
  return $ TestList [latexTest]

mathOutputTestLatex :: Env -> RuntimeM Test
mathOutputTestLatex env = do
  TestLabel "math output: latex" . TestList <$>
    mapM (\(x, y, z) -> makeTest x y z)
      [ ("div", "x / y", "\\frac{x}{y}")
      ]
 where
   makeTest = makeMathOutputTest env "latex"

makeMathOutputTest :: Env -> String -> String -> String -> String -> RuntimeM Test
makeMathOutputTest env lang label expr expectedOutput = do
  res <- fromEvalT (runExpr env expr)
  case res of
    Left _    -> return . TestCase $ assertFailure "Failed to evaluate the expression"
    Right res -> return . TestCase $ assertEqual label ("#" ++ lang ++ "|" ++ expectedOutput ++ "|#") (prettyMath lang res)