Testing.icl 3.48 KB
Newer Older
1
implementation module iTasks.Extensions.Development.Testing
2
import iTasks
3
import System.Time
4 5 6

import Testing.TestEvents 
import iTasks.Util.Testing 
7
import iTasks.Extensions.Development.Tools
8
import Text, Data.Tuple, Data.Error, System.FilePath, System.OS
9 10 11

TESTS_PATH :== "../Tests/TestPrograms"

12
//:: CompileError = CompileError !Int
13 14 15 16 17
derive class iTask EndEventType
derive gEditor FailReason, FailedAssertion, CounterExample, Relation
derive gText FailReason, FailedAssertion, CounterExample, Relation
derive gDefault FailReason, FailedAssertion, CounterExample, Relation
derive gEq FailReason, FailedAssertion, CounterExample, Relation
18

19
compileTestModule :: FilePath -> Task EndEventType
20 21 22 23 24 25 26
compileTestModule path
	= 	traceValue path >>| get cpmExecutable
	>>- \cpm ->runWithOutput cpm ["project", base, "create"] (Just baseDir)
	>>- \_   ->runWithOutput cpm ["project", prj, "target", "iTasks"] (Just baseDir)
	>>- \_   ->runWithOutput cpm ["project", prj, "exec", base +++ ".exe"] (Just baseDir)
	>>- \_   ->runWithOutput cpm ["project", prj, "set", "-h", "200M", "-s", "2M", "-dynamics"] (Just baseDir)
	>>- \_   ->runWithOutput cpm [prj] (Just baseDir) //Build the test
27
		@ \(c,o) -> if (passed c o) Passed (Failed Nothing)
28
where
29 30
    //Cpm still returns exitcode 0 on failure, so we have to check the output
	passed 0 o = let lines = split OS_NEWLINE (join "" o) in not (any isErrorLine lines) 
31 32
	passed _ _ = False

33 34
 	isErrorLine l = startsWith "Error" l || startsWith "Type error" l || startsWith "Parse error" l

35
	baseDir = takeDirectory path
36 37
	base = takeFileName (dropExtension path)
	prj = takeFileName (addExtension base "prj")
38

39
//Copy-paste.. should be in library
40
runTestModule :: FilePath -> Task EndEventType
41 42 43
runTestModule path
	= compileTestModule path
	>>- \res -> case res of
44
		Passed = runWithOutput exe [] Nothing @ (parseSuiteResult o appSnd (join "")) //Run the test
45
	    _      = return res
46 47 48 49
where
	baseDir = takeDirectory path
	base = dropExtension path
	exe = addExtension base "exe"
50

51
	parseSuiteResult :: (Int,String) -> EndEventType //QUICK AND DIRTY PARSER
52
	parseSuiteResult (ecode,output)
53 54 55 56
		# lines = split "\n" output
		| length lines < 2 = fallback ecode output
		# suiteName = trim ((split ":" (lines !! 0)) !! 1)
		# results = [parseRes resLines \\ resLines <- splitLines (drop 3 lines) | length resLines >= 2]
57 58
		= Passed 
		//= {SuiteResult|suiteName=suiteName,testResults=results}
59 60 61 62 63 64 65 66 67 68 69 70
	where
		splitLines lines = split` lines [[]]
		where
			split` ["":lines] acc = split` lines [[]:acc]
			split` [l:lines] [h:acc] = split` lines [[l:h]:acc]
			split` [] acc = reverse (map reverse acc)

		parseRes [nameLine,resultLine:descLines]
			# name = trim ((split ":" nameLine) !! 1)
			# result = case resultLine of
				"Result: Passed" = Passed
				"Result: Skipped" = Skipped
71 72
				//_ = Failed (if (descLines =: []) Nothing (Just (join "\n" descLines)))
				_ = Failed (if (descLines =: []) Nothing (Just Crashed))
73 74 75 76
			= (name,result)
		parseRes _ = ("oops",Failed Nothing)

		//If we can't parse the output, We'll treat it as a single simple test executable
77 78
		fallback 0 _ = Passed //{SuiteResult|suiteName="Unknown",testResults=[("executable",Passed)]}
		fallback _ output = Failed Nothing//{SuiteResult|suiteName="Unknown",testResults=[("executable",Failed (Just output))]}
79

80 81 82 83
runWithOutput :: FilePath [String] (Maybe FilePath) -> Task (Int,[String])
runWithOutput prog args dir = withShared ([], []) \out->withShared [] \stdin->
	externalProcess {tv_sec=0,tv_nsec=100000000} prog args dir Nothing stdin out
	>>- \c->get out @ tuple c o fst