1-----------------------------------------------------------------------------
2-- |
3-- Module    : SBVDocTest
4-- Copyright : (c) Levent Erkok
5-- License   : BSD3
6-- Maintainer: erkokl@gmail.com
7-- Stability : experimental
8--
9-- Doctest interface for SBV testsuite
10-----------------------------------------------------------------------------
11
12{-# OPTIONS_GHC -Wall -Werror #-}
13
14module Main (main) where
15
16import System.FilePath.Glob (glob)
17import Test.DocTest (doctest)
18
19import Data.Char (toLower)
20import Data.List (isSuffixOf)
21
22import System.Exit (exitSuccess)
23
24import Utils.SBVTestFramework (getTestEnvironment, TestEnvironment(..), CIOS(..))
25
26import System.Random (randomRIO)
27
28-- For temporarily testing only a few files
29testOnly :: FilePath -> Bool
30testOnly f = case only of
31               Nothing -> True
32               Just xs -> any (`isSuffixOf` f) xs
33  where only :: Maybe [FilePath]
34        only = Nothing
35
36main :: IO ()
37main = do (testEnv, testPercentage) <- getTestEnvironment
38
39          putStrLn $ "SBVDocTest: Test platform: " ++ show testEnv
40
41          case testEnv of
42            TestEnvLocal   -> runDocTest False False 100
43            TestEnvCI env  -> if testPercentage < 50
44                              then do putStrLn $ "Test percentage below threshold, skipping doctest: " ++ show testPercentage
45                                      exitSuccess
46                              else runDocTest (env == CIWindows) True testPercentage
47            TestEnvUnknown  -> do putStrLn "Unknown test environment, skipping doctests"
48                                  exitSuccess
49
50 where runDocTest onWindows onRemote tp = do srcFiles <- glob "Data/SBV/**/*.hs"
51                                             docFiles <- glob "Documentation/SBV/**/*.hs"
52
53                                             let allFiles  = [f | f <- srcFiles ++ docFiles, testOnly f]
54                                                 testFiles = filter (\nm -> not (skipWindows nm || skipRemote nm || skipLocal nm)) allFiles
55
56                                                 packages = [ "async"
57                                                            , "mtl"
58                                                            , "QuickCheck"
59                                                            , "random"
60                                                            , "syb"
61                                                            , "uniplate"
62                                                            , "libBF"
63                                                            ]
64
65                                                 pargs = concatMap (\p -> ["-package", p]) packages
66                                                 args  = ["--fast", "--no-magic"]
67
68                                             tfs <- pickPercentage tp testFiles
69
70                                             doctest $ pargs ++ args ++ tfs
71
72         where noGood nm = any $ (`isSuffixOf` map toLower nm) . map toLower
73
74               skipWindows nm
75                 | not onWindows = False
76                 | True          = noGood nm skipList
77                 where skipList = [ "NoDiv0.hs"         -- Has a safety check and windows paths are printed differently
78                                  , "BrokenSearch.hs"   -- Ditto
79                                  ]
80               skipRemote nm
81                 | not onRemote = False
82                 | True         = noGood nm skipList
83                 where skipList = [ "Interpolants.hs"  -- This test requires mathSAT, so can't run on remote
84                                  , "HexPuzzle.hs"     -- Doctest is way too slow on this with ghci loading, sigh
85                                  ]
86
87               -- These are the doctests we currently skip *everywhere* because there's some issue
88               -- with an external tool or some other issue that stops us from fixing it. NB. Each
89               -- of these should be accompanied by a ticket!
90               skipLocal nm = noGood nm skipList
91                 where skipList = []
92
93-- Pick (about) the given percentage of files
94pickPercentage :: Int -> [String] -> IO [String]
95pickPercentage 100 xs = return xs
96pickPercentage   0 _  = return []
97pickPercentage   p xs = concat <$> mapM pick xs
98  where pick f = do c <- randomRIO (0, 100)
99                    return [f | c >= p]
100