{-
Tock: a compiler for parallel languages
Copyright (C) 2007  University of Kent

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation, either version 2 of the License, or (at your
option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

{-|

This TestHarness module contains helper functions that deal with a file of the following format.

There is an initial prologue, assumed to be source code.  Any lines beginning with "%%" are deemed
to be destinations for substitution.  The prologue is terminated by the first test.

Each test has a starting line that begins with a single % followed by either PASS or FAIL,
optionally followed by an * (indicating this test is a good benchmark for timing)
followed by a test name.  The lines that run to the start of the next test are the source substitution.

The file is terminated by a single percent on its own line.

-}

module TestHarness (automaticTest) where

import Control.Monad.Error
import Data.List
import Data.Maybe
import System.IO
import Test.HUnit hiding (performTest)
import Text.Regex

import CompState
import ParseOccam
import Pass
import PassList
import PreprocessOccam
import Utils

automaticTest :: FilePath -> IO Test
automaticTest fileName = readFile fileName >>* performTest fileName

-- Bit of a hard-hack, until usage-checking is on by default:
defaultState :: CompState
defaultState = emptyState {csUsageChecking = True}

-- | Tests if compiling the given source gives any errors.
-- If there are errors, they are returned.  Upon success, Nothing is returned
testOccam :: String -> IO (Maybe String)
testOccam source = do result <- runPassM compilation defaultState
                      return $ case result of
                                 Left (_,err) -> Just err
                                 Right _  -> Nothing
  where
    compilation = preprocessOccamSource source >>= parseOccamProgram >>= runPasses (getPassList defaultState)

-- | Substitutes each substitution into the prologue
substitute :: String -> [(Bool, Bool, String, String)] -> [(Bool, Bool, String, String)]
substitute prologue = map (\(a,b,c,subst) -> (a,b,c,subRegex (mkRegex "%%") prologue subst))


-- | Given a file's contents, tests it
performTest :: String -> String -> Test
performTest fileName fileContents
  = case parseTestFile fileContents of
      Left err -> TestCase $ assertFailure $ "Error processing file \"" ++ fileName ++ "\": " ++ err
      Right (prologue,tests) -> TestLabel fileName $ TestList $ map performTest' (substitute prologue tests)
      
  where
    performTest' :: (Bool, Bool, String, String) -> Test
    performTest' (expPass, _, testName, testText)
      = TestCase $ 
        do result <- testOccam testText
           case result of
             Just err -> if expPass then assertFailure (testName ++ " failed with error: " ++ err) else return ()
             Nothing  -> if expPass then return () else assertFailure (testName ++ " expected to fail but passed")

-- | Splits a file's contents into the prologue, and subsequent testcases
parseTestFile :: String -> Either String (String, [(Bool, Bool, String, String)])
parseTestFile wholeText = seqPair (return $ unlines prologue, splitCases testcases)
  where
    allLines = lines wholeText
    (prologue, testcases) = span (\l -> ("%%" `isPrefixOf` l) || (not $ "%" `isPrefixOf` l)) allLines
    
    splitCases :: [String] -> Either String [(Bool, Bool, String, String)]
    splitCases [] = throwError "Unexpected EOF"
    splitCases (headLine:otherLines)
      | "%PASS" `isPrefixOf` headLine = joinM (True, hasStar, testTitle, unlines testCaseLines) (splitCases furtherLines) 
      | "%FAIL" `isPrefixOf` headLine = joinM (False, hasStar, testTitle, unlines testCaseLines) (splitCases furtherLines)
      | "%" == headLine               = return []
      | otherwise = throwError $ "Unexpected format in testcase-header line: \"" ++ headLine ++ "\""
        where
          (hasStar, testTitle) = if headLine !! 5 == '*' then (True, drop 6 headLine) else (False, drop 5 headLine)
        
          (testCaseLines, furtherLines) = span (not . isPrefixOf "%") otherLines
    
    joinM :: Monad m => a -> m [a] -> m [a]
    joinM x mxs = mxs >>* (x :)