{-|
    Module      :  Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Run
    Description :  (testing) running all polynomial tests in a batch
    Copyright   :  (c) 2007-2008 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable
    
    Support for running all polynomial tests in a batch.
-}
module Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Run
where

import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Generate
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Reduce
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Ring
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Bounds
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Enclosure
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Division
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Elementary
import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Compose
--import Data.Number.ER.RnToRm.UnitDom.ChebyshevBase.Polynom.Tests.Integration

import qualified Data.Number.ER.RnToRm.UnitDom.Base as UFB
import qualified Data.Number.ER.Real.Base as B
import Data.Number.ER.Real.Approx.Interval
import Data.Number.ER.Real.Arithmetic.Elementary
import Data.Number.ER.Real.DomainBox (VariableID(..), DomainBox, DomainBoxMappable, DomainIntBox)

import Data.Number.ER.Real.DefaultRepr
import Data.Number.ER.Misc

import Test.QuickCheck
import Test.QuickCheck.Batch

import System.IO
import System.Directory
import qualified System.FilePath as FP
import Data.Time.Clock
import Data.Time.Calendar

initArith = B.initialiseBaseArithmetic (0::BM)

runPolynomTests =
    do
    (UTCTime (ModifiedJulianDay days) secs) <- getCurrentTime
    let folder = "tests-" ++ (show days) ++ "-" ++ (show $ floor $ toRational secs)
    createDirectory folder
--    mkRunTests "poly tests" chplTestOptions (chplTests folder)
    mkRunTests "poly tests" chplTestOptions (enclTests folder)
    
instance Show TestResult
    where
    show result =
        case result of
            TestOk msg ntest stamps ->
                msg ++ " " ++ show ntest ++ " " -- ++ show stamps
            TestExausted msg ntest stamps ->
                msg ++ " " ++ show ntest ++ " " -- ++ show stamps
            TestAborted exception ->
                "aborted: " ++ show exception
            TestFailed args ntest ->
                "failed after " ++ show ntest ++ " tests" 
                ++ "\n args = " ++ show args
                    
mkRunTests testsetName options tests =
    do
    initArith
    mapM (mkRunTest $ length tests) $ zip [1..] tests
    return ()
    where
    mkRunTest testCount (n, (testName, test)) =
        do
        putStr testDescr
        result <- test options
        putStrLn $ "  result: " ++ show result
--        runTests testDescr options [test]
        hFlush stdout
        where
        testDescr = 
            "(" ++ show n ++ "/" ++ show testCount ++ ") " ++ testsetName ++ ": " ++ testName ++ "\n" 

chplTestOptions = 
    TestOptions
      { 
--        no_of_tests = 10
--        no_of_tests = 50
        no_of_tests = 100
--        no_of_tests = 200
      , 
        length_of_tests = 240 * 3600 -- ie 4h time limit
      ,
        debug_tests = False 
      }

chplTests folder =
    [
        ("reduce term count", run prop_chplReduceTermCount_consistent),
        ("reduce degree", run prop_chplReduceDegree_consistent),
        ("add two polys", run prop_chplAdd_consistent),
        ("add const to poly", run prop_chplAddConst_consistent),
        ("mult two polys", run prop_chplMult_consistent),
        ("scale poly", run prop_chplScale_consistent),
        ("bounds of poly", run prop_chplBounds_consistent),
        ("max of two polys", run prop_chplMax_consistent),
        ("min of two polys", run prop_chplMin_consistent)
    ]
enclTests folder =
    [
        ("add thick encls", run $ prop_enclAdd_ThickEncls_consistent $ addFolder "enclAdd_Thick"),
        ("mult paral encls", run $ prop_enclMultiply_ParalEncls_consistent $ addFolder "enclMultiply_Paral"),
        ("mult thick encls", run $ prop_enclMultiply_ThickEncls_consistent $ addFolder "enclMultiply_Thick"),
        ("scale paral encl", run $ prop_enclScale_ParalEncl_consistent $ addFolder "enclScale_Paral"),
        ("scale thick encl", run $ prop_enclScale_ThickEncl_consistent $ addFolder "enclScale_Thick"),
        ("recip paral encl", run $ prop_enclRecip_ParalEncl_consistent $ addFolder "enclRecip_Paral"),
        ("recip thick encl", run $ prop_enclRecip_ThickEncl_consistent $ addFolder "enclRecip_Thick"),
        ("compose thin encl", run $ prop_enclCompose_ThinEncl_consistent $ addFolder "enclCompose_Thin"),
        ("compose paral encl", run $ prop_enclCompose_ParalEncl_consistent $ addFolder "enclCompose_Paral"),
        ("compose thick encl", run $ prop_enclCompose_ThickEncl_consistent $ addFolder "enclCompose_Thick"),
        ("exp thin encl", run $ prop_enclExp_ThinEncl_consistent $ addFolder "enclExp_Thin"),
        ("exp paral encl", run $ prop_enclExp_ParalEncl_consistent $ addFolder "enclExp_Paral"),
        ("exp thick encl", run $ prop_enclExp_ThickEncl_consistent $ addFolder "enclExp_Thick"),
        ("sine thin encl", run $ prop_enclSine_ThinEncl_consistent $ addFolder "enclSine_Thin"),
        ("sine paral encl", run $ prop_enclSine_ParalEncl_consistent $ addFolder "enclSine_Paral"),
        ("sine thick encl", run $ prop_enclSine_ThickEncl_consistent $ addFolder "enclSine_Thick"),
        ("cosine thin encl", run $ prop_enclCosine_ThinEncl_consistent $ addFolder "enclCosine_Thin"),
        ("cosine paral encl", run $ prop_enclCosine_ParalEncl_consistent $ addFolder "enclCosine_Paral"),
        ("cosine thick encl", run $ prop_enclCosine_ThickEncl_consistent $ addFolder "enclCosine_Thick"),
        ("atan thin encl", run $ prop_enclAtan_ThinEncl_consistent $ addFolder "enclAtan_Thin"),
        ("atan paral encl", run $ prop_enclAtan_ParalEncl_consistent $ addFolder "enclAtan_Paral"),
        ("atan thick encl", run $ prop_enclAtan_ThickEncl_consistent $ addFolder "enclAtan_Thick")
    ]
    where
    addFolder name = FP.combine folder name
     

-- failed tests:

--failed1 = 
--    -- identified 19 Feb 9:33
--    -- fixed 19 Feb 16:50
--     prop_enclCompose_ThickEncl_consistent "a"
--        (Deg20Size20 4 18, 0,
--         PSize30 ((0,112), polynomials200ishSize30 !! 112),
--         (PSize30 ((0,57), polynomials200ishSize30 !! 57),
--          PSize30 ((0,18), polynomials200ishSize30 !! 18)
--         )         
--        )

failed2 = 
    -- identified 19 Feb 18:59 -- this one makes the automatic test abort with <<loop>>
    -- but runs ok when executed individually
    prop_enclMultiply_ParalEncls_consistent "a"
        (Deg20Size20 5 11,
         (SmallRatio 680377 535300, PSize30 ((1,1018), polynomials1200ishSize30 !! 1018)),
         (SmallRatio (-157647) 491208, PSize30 ((1,465), polynomials1200ishSize30 !! 465))
        )