git.iko.soy/Idris-dev
on master help sign in
Merge pull request #2907 from melted/testrunner
a1b640aNiklas Larsson
.gitignore+1
compare with master
unifiedsplit
@@ -27,6 +27,7 @@ libs/contrib/contrib_doc/
27test/output
27test/output
28test/*[0-9][0-9][0-9]/output
28test/*[0-9][0-9][0-9]/output
29test/*[0-9][0-9][0-9]/*.exe
29test/*[0-9][0-9][0-9]/*.exe
30+test/runtest.exe
30tags
31tags
31TAGS
32TAGS
32src/Version_idris.hs
33src/Version_idris.hs
idris.cabal+5−1
@@ -150,7 +150,7 @@ Extra-source-files:
150 libs/pruviloj/Pruviloj/Internals/*.idr
150 libs/pruviloj/Pruviloj/Internals/*.idr
151
151
152 test/Makefile
152 test/Makefile
153− test/runtest.pl
153+ test/runtest.hs
154 test/reg001/run
154 test/reg001/run
155 test/reg001/*.idr
155 test/reg001/*.idr
156 test/reg001/expected
156 test/reg001/expected
@@ -982,6 +982,10 @@ Library
982 , safe
982 , safe
983 , fsnotify < 2.2
983 , fsnotify < 2.2
984 , async < 2.1
984 , async < 2.1
985+
986+ -- regex-compat needed for the test/runtest.hs script, which isn't built by cabal
987+ build-depends: regex-compat < 1.0
988+
985 -- zlib >= 0.6.1 is broken with GHC < 7.10.3
989 -- zlib >= 0.6.1 is broken with GHC < 7.10.3
986 if impl(ghc < 7.10.3)
990 if impl(ghc < 7.10.3)
987 build-depends: zlib < 0.6.1
991 build-depends: zlib < 0.6.1
test/Makefile+19−14
@@ -1,28 +1,33 @@
1.PHONY: test test_js time update diff distclean $(TESTS)
1.PHONY: test test_js time update diff distclean $(TESTS)
2
2
3+runtest:
4+ @ghc --make runtest.hs
5+ @rm runtest.o runtest.hi
6+
3TESTS = $(sort $(patsubst %/,%.test,$(wildcard */)))
7TESTS = $(sort $(patsubst %/,%.test,$(wildcard */)))
4
8
5test: $(TESTS)
9test: $(TESTS)
6
10
7
11
8−info:
12+info: runtest
9− /usr/bin/env perl ./runtest.pl all
13+ @./runtest all
10
14
11−%.test:
15+%.test: runtest
12− @perl ./runtest.pl $(patsubst %.test,%,$@) -q
16+ @./runtest $(patsubst %.test,%,$@) -q
13
17
14−test_js:
18+test_js: runtest
15− @perl ./runtest.pl without sugar004 reg029 reg052 io001 dsl002 io003 effects001 effects002 basic007 basic011 ffi006 --codegen node
19+ @./runtest without sugar004 reg029 reg052 io001 dsl002 io003 effects001 effects002 basic007 basic011 ffi006 opts --codegen node
16
20
17−update:
21+update: runtest
18− /usr/bin/env perl ./runtest.pl all -u
22+ @./runtest all -u
19
23
20−diff:
24+diff: runtest
21− /usr/bin/env perl ./runtest.pl all -d
25+ @./runtest all -d
22
26
23−time:
27+time: runtest
24− /usr/bin/env perl ./runtest.pl all -t
28+ @./runtest all -t
25
29
26distclean:
30distclean:
31+ @rm runtest
27− rm -f *~
32+ @rm -f *~
28− rm -f */output
33+ @rm -f */output
test/runtest.hsnew file+213
@@ -0,0 +1,213 @@
1+{-# LANGUAGE CPP #-}
2+module Main where
3+
4+import Control.Monad
5+import Data.List
6+import Data.Maybe
7+import qualified Data.Set as S
8+import Data.Time.Clock
9+import System.Directory
10+import System.Environment
11+import System.FilePath
12+import System.Exit
13+import System.Info
14+import System.IO
15+import System.Process
16+import Text.Regex
17+
18+-- Because GHC earlier than 7.8 lacks setEnv
19+-- Install the setenv package on Windows.
20+#if __GLASGOW_HASKELL__ < 708
21+#ifndef mingw32_HOST_OS
22+import qualified System.Posix.Env as PE(setEnv)
23+
24+setEnv k v = PE.setEnv k v True
25+#else
26+import System.SetEnv(setEnv)
27+#endif
28+#endif
29+
30+data Flag = Update | Diff | ShowOutput | Quiet | Time deriving (Eq, Show, Ord)
31+
32+type Flags = S.Set Flag
33+
34+data Status = Success | Failure | Updated deriving (Eq, Show)
35+
36+data Config = Config {
37+ flags :: Flags,
38+ idrOpts :: [String],
39+ tests :: [String]
40+} deriving (Show, Eq)
41+
42+isQuiet conf = Quiet `S.member` (flags conf)
43+showOutput conf = ShowOutput `S.member` (flags conf)
44+showTime conf = Time `S.member` (flags conf)
45+showDiff conf = Diff `S.member` (flags conf)
46+doUpdate conf = Update `S.member` (flags conf)
47+
48+checkTestName :: String -> Bool
49+checkTestName d = (matchRegex (mkRegex "[0-9][0-9][0-9]") d /= Nothing)
50+ && (not $ isInfixOf "disabled" d)
51+
52+enumTests :: IO [String]
53+enumTests = do
54+ cd <- getCurrentDirectory
55+ dirs <- getDirectoryContents cd
56+ return $ sort $ filter checkTestName dirs
57+
58+parseFlag :: String -> Maybe Flag
59+parseFlag s = case s of
60+ "-u" -> Just Update
61+ "-d" -> Just Diff
62+ "-s" -> Just ShowOutput
63+ "-t" -> Just Time
64+ "-q" -> Just Quiet
65+ _ -> Nothing
66+
67+parseFlags :: [String] -> (S.Set Flag, [String])
68+parseFlags xs = (S.fromList f, i)
69+ where
70+ f = catMaybes $ map parseFlag fl
71+ (fl, i) = partition (\s -> parseFlag s /= Nothing) xs
72+
73+parseArgs :: [String] -> IO Config
74+parseArgs args = do
75+ (tests, rest) <- case args of
76+ ("all":xs) -> do
77+ et <- enumTests
78+ return (et, xs)
79+ ("without":xs) -> do
80+ t <- enumTests
81+ (blacklist, ys) <- return $ break (== "opts") xs
82+ return (t \\ blacklist, ys \\ ["opts"])
83+ (x:xs) -> do
84+ exists <- doesDirectoryExist x
85+ return (if checkTestName x && exists then [x] else [], xs)
86+ [] -> do
87+ et <- enumTests
88+ return (et, [])
89+ let (testOpts, idOpts) = parseFlags rest
90+ return $ Config testOpts idOpts tests
91+
92+-- "bash" needed because Haskell has cmd as the default shell on windows, and
93+-- we also want to run the process with another current directory, so we get
94+-- this thing.
95+runInShell :: String -> [String] -> IO (ExitCode, String)
96+runInShell test opts = do
97+ (ec, output, _) <- readCreateProcessWithExitCode
98+ ((proc "bash" ("run":opts)) { cwd = Just test,
99+ std_out = CreatePipe })
100+ ""
101+ return (ec, output)
102+
103+runTest :: Config -> String -> IO Status
104+runTest conf test = do
105+ -- don't touch the current directory as we want to run these things
106+ -- in parallel in the future
107+ let inTest s = test ++ "/" ++ s
108+ -- just pretend that backslashes are slashes for comparison
109+ -- purposes to avoid path problems, so don't write any tests
110+ -- that depend on that distinction in other contexts
111+ let norm s = map (\c -> if c=='\\' then '/' else c) s
112+ t1 <- getCurrentTime
113+ (exitCode, output) <- runInShell test (idrOpts conf)
114+ t2 <- getCurrentTime
115+ expected <- readFile $ inTest "expected"
116+ writeFile (inTest "output") output
117+ res <- if (norm output == norm expected)
118+ then do putStrLn $ test ++ " finished...success"
119+ return Success
120+ else if doUpdate conf
121+ then do putStrLn $ test ++ " finished...UPDATE"
122+ writeFile (inTest "expected") output
123+ return Updated
124+ else do putStrLn $ test ++ " finished...FAILURE"
125+ _ <- rawSystem "diff" [inTest "output", inTest "expected"]
126+ return Failure
127+ when (showTime conf) $ do
128+ let dt = diffUTCTime t2 t1
129+ putStrLn $ "Duration of " ++ test ++ " was " ++ show dt
130+ return res
131+
132+printStats :: Config -> [Status] -> IO ()
133+printStats conf stats = do
134+ let total = length stats
135+ let successful = length $ filter (== Success) stats
136+ let failures = length $ filter (== Failure) stats
137+ let updates = length $ filter (== Updated) stats
138+ putStrLn "\n----"
139+ putStrLn $ show total ++ " tests run: " ++ show successful ++ " succesful, "
140+ ++ show failures ++ " failed, " ++ show updates ++ " updated."
141+ let failed = map fst $ filter ((== Failure) . snd) $ zip (tests conf) stats
142+ when (failed /= []) $ do
143+ putStrLn "\nFailed tests:"
144+ mapM_ putStrLn failed
145+ putStrLn ""
146+
147+runTests :: Config -> IO Bool
148+runTests conf = do
149+ stats <- mapM (runTest conf) (tests conf)
150+ unless (isQuiet conf) $ printStats conf stats
151+ return $ all (== Success) stats
152+
153+runShow :: Config -> IO Bool
154+runShow conf = do
155+ mapM_ (\t -> callProcess "cat" [t++"/output"]) (tests conf)
156+ return True
157+
158+runDiff :: Config -> IO Bool
159+runDiff conf = do
160+ mapM_ (\t -> do putStrLn $ "Differences in " ++ t ++ ":"
161+ ec <- rawSystem "diff" [t++"/output", t++"/expected"]
162+ when (ec == ExitSuccess) $ putStrLn "No differences found.")
163+ (tests conf)
164+ return True
165+
166+whisper :: Config -> String -> IO ()
167+whisper conf s = do unless (isQuiet conf) $ putStrLn s
168+
169+setPath :: Config -> IO ()
170+setPath conf = do
171+ maybeEnv <- lookupEnv "IDRIS"
172+ idrisEnv <- return $ fromMaybe "" maybeEnv
173+ if (idrisEnv /= "")
174+ then do
175+ idrisAbs <- makeAbsolute idrisEnv
176+ setEnv "IDRIS" idrisAbs
177+ whisper conf $ "Using " ++ idrisAbs
178+ else do
179+ path <- getEnv "PATH"
180+ let sandbox = "../.cabal-sandbox/bin"
181+ hasBox <- doesDirectoryExist sandbox
182+ bindir <- if hasBox
183+ then do
184+ whisper conf $ "Using Cabal sandbox at " ++ sandbox
185+ makeAbsolute sandbox
186+ else do
187+ stackExe <- findExecutable "stack"
188+ case stackExe of
189+ Just stack -> do
190+ out <- readProcess stack ["path", "--dist-dir"] []
191+ stackDistDir <- return $ takeWhile (/= '\n') out
192+ let stackDir = "../" ++ stackDistDir ++ "/build/idris"
193+ whisper conf $ "Using stack work dir at " ++ stackDir
194+ makeAbsolute stackDir
195+ Nothing -> return ""
196+ when (bindir /= "") $ setEnv "PATH" (bindir ++ [searchPathSeparator] ++ path)
197+
198+main = do
199+ hSetBuffering stdout LineBuffering
200+ args <- getArgs
201+ conf <- parseArgs args
202+ setPath conf
203+ t1 <- getCurrentTime
204+ res <- case tests conf of
205+ [] -> return True
206+ xs | showOutput conf -> runShow conf
207+ xs | showDiff conf -> runDiff conf
208+ xs -> runTests conf
209+ t2 <- getCurrentTime
210+ when (showTime conf) $ do
211+ let dt = diffUTCTime t2 t1
212+ putStrLn $ "Duration of Entire Test Suite was " ++ show dt
213+ unless res exitFailure
test/runtest.pldeleted−242
@@ -1,242 +0,0 @@
1−#!/usr/bin/env perl
2−
3−use strict;
4−use Cwd;
5−use Cwd 'abs_path';
6−use Env;
7−
8−my $exitstatus = 0;
9−my @idrOpts = ();
10−my $quiet = 0;
11−
12−
13−# Sets the PATH if there's a sandbox or stack present
14−#
15−# Order of checking is:
16−#
17−# 1. Cabal Sandboxing
18−# 2. Stack
19−#
20−sub set_path {
21− my $sandbox = "../.cabal-sandbox/bin";
22−
23− my $stack_bin_path = `stack path --dist-dir`;
24− $stack_bin_path =~ s/\n//g;
25− my $stack_work_dir = "../$stack_bin_path/build/idris";
26− my $path = $ENV{PATH};
27−
28− if ( -d $sandbox ) {
29− my $sandbox_abs = abs_path($sandbox);
30− print "Using Cabal Sandbox\n" unless $quiet;
31− printf("Sandbox located at: %s\n", $sandbox_abs) unless $quiet;
32− $ENV{PATH} = $sandbox_abs . ":" . $path;
33−
34− } elsif ( -d $stack_work_dir ) {
35−
36− my $stack_work_abs = abs_path($stack_work_dir);
37− print "Using Stack Work\n" unless $quiet;
38− printf("Stack work located at: %s\n", $stack_work_abs) unless $quiet;
39− $ENV{PATH} = $stack_work_abs . ":" . $path;
40−
41− }
42−}
43−
44−# Run an individual test, and compare expected output with given
45−# output and report results.
46−#
47−sub runtest {
48− my ($test, $update, $showTime, $failedref, $statsref) = @_;
49−
50− chdir($test);
51−
52− my $startTime = time();
53− my $got = `./run @idrOpts`;
54− my $exp = `cat expected`;
55−
56− my $endTime = time();
57− my $elapsedTime = $endTime - $startTime;
58−
59− if ($showTime == 1 ){
60− printf("Duration of $test was %d\n", $elapsedTime);
61− }
62−
63− # Allow for variant expected output for tests by overriding expected
64− # when there is an expected.<os> file in the test.
65− # This should be the exception but there are sometimes valid reasons
66− # for os-dependent output.
67− # The endings are msys for windows, darwin for osx and linux for linux
68− if ( -e "expected.$^O") {
69− $exp = `cat expected.$^O`;
70− }
71− open my $out, '>', 'output';
72− print $out $got;
73− close $out;
74−
75− # $ok = system("diff output expected &> /dev/null");
76− # Mangle newlines in $got and $exp
77− $got =~ s/\r\n/\n/g;
78− $exp =~ s/\r\n/\n/g;
79−
80− # Normalize paths in $got and $exp, so the expected outcomes don't
81− # change between platforms
82− while($got =~ /(^|.*?\n)(.*?)\\(.*?):(\d+):(.*)/ms) {
83− $got = "$1$2/$3:$4:$5";
84− }
85− while($exp =~ /(^|.*?\n)(.*?)\\(.*?):(\d+):(.*)/ms) {
86− $exp = "$1$2/$3:$4:$5";
87− }
88−
89− if ($got eq $exp) {
90− print "$test finished...success\n";
91− $statsref->{'succeeded'}++;
92− }
93− else {
94− if ($update == 0) {
95− $exitstatus = 1;
96− print "$test finished...FAILURE\n";
97− system "diff output expected";
98− push @$failedref, $test;
99− $statsref->{'failed'}++;
100− } else {
101− system("cp output expected");
102− print "$test finished...UPDATED\n";
103− $statsref->{'updated'}++;
104− }
105− }
106− chdir "..";
107−}
108−
109−# Main test running program to sort test input, and execute individual
110−# tests.
111−#
112−
113−my ( @without, @args, @tests, @opts );
114−
115−# Deal with the Args.
116−if ($#ARGV>=0) {
117− my $test = shift @ARGV;
118− if ($test eq "all") {
119− opendir my $dir, ".";
120− my @list = readdir $dir;
121− foreach my $file (@list) {
122− if ($file =~ /[0-9][0-9][0-9]$/) {
123− push @tests, $file;
124− }
125− }
126− @tests = sort @tests;
127−
128− } elsif ($test eq "without") {
129− @args = @ARGV;
130− foreach my $file (@args) {
131− last if ($file =~ /--/);
132− push @without, shift @ARGV;
133− }
134−
135− opendir my $dir, ".";
136− my @list = readdir $dir;
137− foreach my $file (@list) {
138− if ($file =~ /[0-9][0-9][0-9]$/) {
139− if (!(grep ($_ eq $file, @without))) {
140− push @tests, $file;
141− }
142− else {
143− print "Omitting $file\n";
144− }
145− }
146− }
147− @tests = sort @tests;
148− }
149− else {
150− if ($test =~ /[0-9][0-9][0-9]$/) {
151− push @tests, $test;
152− }
153− }
154− @opts = @ARGV;
155−}
156−else {
157− print "Give a test name, or 'all' to run all.\n";
158− exit;
159−}
160−
161−# Run the tests.
162−
163−my $update = 0;
164−my $diff = 0;
165−my $show = 0;
166−my $usejava = 0;
167−my $showTime = 0;
168−
169−my @failed;
170−my %stats = (
171− total => 0,
172− succeeded => 0,
173− failed => 0,
174− updated => 0
175−);
176−
177−while (my $opt = shift @opts) {
178− if ($opt eq "-u") { $update = 1; }
179− elsif ($opt eq "-d") { $diff = 1; }
180− elsif ($opt eq "-s") { $show = 1; }
181− elsif ($opt eq "-t") { $showTime = 1; }
182− elsif ($opt eq "-q") { $quiet = 1; }
183− else { push(@idrOpts, $opt); }
184−}
185−
186−my $idris = $ENV{IDRIS};
187−
188−if (defined $ENV{IDRIS} && -e $idris ) {
189− $ENV{IDRIS} = abs_path($idris);
190− print "Using $idris\n" unless $quiet;
191−} else {
192− delete $ENV{IDRIS};
193− set_path();
194−}
195−
196−my $startTime = time();
197−
198−foreach my $test (@tests) {
199− if ($diff == 0 && $show == 0) {
200− ++$stats{'total'};
201− runtest($test,$update,$showTime, \@failed, \%stats);
202− }
203− else {
204− chdir $test;
205−
206− if ($show == 1) {
207− system "cat output";
208− }
209− if ($diff == 1) {
210− print "Differences in $test:\n";
211− my $ok = system "diff output expected";
212− if ($ok == 0) {
213− print "No differences found.\n";
214− }
215− }
216− chdir "..";
217− }
218−}
219−
220−my $endTime = time();
221−my $elapsedTime = $endTime - $startTime;
222−
223−
224−if(!$quiet) {
225− print "----\n";
226− printf("%d tests run: %d succeeded, %d failed, %d updated.\n\n",
227− $stats{'total'}, $stats{'succeeded'}, $stats{'failed'}, $stats{'updated'} );
228−
229− if (@failed) {
230− print "Failed tests:\n";
231− foreach my $failure (@failed) {
232− print "$failure\n";
233− }
234− }
235−}
236−
237−
238−if ($showTime == 1) {
239− printf("Duration of Entire Test Suite was %d\n", $elapsedTime);
240−}
241−
242−exit $exitstatus;