[svn:parrot] r45765 - trunk/tools/dev
fperrad at svn.parrot.org
fperrad at svn.parrot.org
Sat Apr 17 19:45:03 UTC 2010
Author: fperrad
Date: Sat Apr 17 19:45:03 2010
New Revision: 45765
URL: https://trac.parrot.org/parrot/changeset/45765
Log:
[tapir] add options --reverse, --shuffle
Modified:
trunk/tools/dev/tapir.pir
Modified: trunk/tools/dev/tapir.pir
==============================================================================
--- trunk/tools/dev/tapir.pir Sat Apr 17 18:34:39 2010 (r45764)
+++ trunk/tools/dev/tapir.pir Sat Apr 17 19:45:03 2010 (r45765)
@@ -37,9 +37,11 @@
Boolean options:
-v, --verbose Print all test lines.
+ -s, --shuffle Run the tests in random order.
-f, --failures Show failed tests.
-o, --comments Show comments.
--ignore-exit Ignore exit status from test scripts.
+ --reverse Run the tests in reverse order.
-q, --quiet Suppress some test output while running tests.
-Q, --QUIET Only print summary results.
--directives Only show results with TODO or SKIP directives.
@@ -71,6 +73,8 @@
push getopts, 'comments|o'
push getopts, 'directives'
push getopts, 'ignore-exit'
+ push getopts, 'reverse'
+ push getopts, 'shuffle|s'
push getopts, 'version|V'
push getopts, 'help|h'
opts = getopts.'get_options'(argv)
@@ -92,11 +96,91 @@
harness.'archive'($S0)
L2:
harness.'process_args'(opts)
- aggregate = harness.'runtests'(files)
+ $P0 = _get_tests(opts, files)
+ aggregate = harness.'runtests'($P0)
$I0 = aggregate.'has_errors'()
exit $I0
.end
+.sub '_get_tests' :anon
+ .param pmc opts
+ .param pmc files
+ .local int nb
+ nb = elements files
+ # currently, FixedStringArray hasn't the method sort.
+ # see TT #1356
+ $P0 = new 'FixedPMCArray'
+ set $P0, nb
+ $I0 = 0
+ $P1 = iter files
+ L1:
+ unless $P1 goto L2
+ $S0 = shift $P1
+ $P2 = split "\\", $S0
+ $S0 = join "/", $P2
+ $P2 = box $S0
+ $P0[$I0] = $P2
+ inc $I0
+ goto L1
+ L2:
+ $I0 = exists opts['shuffle']
+ unless $I0 goto L3
+ $P0 = _shuffle($P0)
+ goto L4
+ L3:
+ $P0.'sort'()
+ $I0 = exists opts['reverse']
+ unless $I0 goto L4
+ $P0 = _reverse($P0)
+ L4:
+ .return ($P0)
+.end
+
+.sub '_reverse' :anon
+ .param pmc array
+ .local int nb
+ nb = elements array
+ $P0 = new 'FixedPMCArray'
+ set $P0, nb
+ $I0 = 0
+ $I1 = nb - 1
+ L1:
+ unless $I0 < nb goto L2
+ $P1 = array[$I0]
+ $P0[$I1] = $P1
+ inc $I0
+ dec $I1
+ goto L1
+ L2:
+ .return ($P0)
+.end
+
+.sub '_shuffle' :anon
+ .param pmc array
+ load_bytecode 'Math/Rand.pbc'
+ .local pmc rand
+ rand = get_global [ 'Math'; 'Rand' ], 'rand'
+ .local pmc srand
+ srand = get_global [ 'Math'; 'Rand' ], 'srand'
+ $I0 = time
+ srand($I0)
+ .local int i, j
+ i = elements array
+ L1:
+ unless i > 0 goto L2
+ $I0 = rand()
+ j = $I0 % i
+ dec i
+ $P1 = array[i]
+ $P2 = array[j]
+ array[i] = $P2
+ array[j] = $P1
+ goto L1
+ L2:
+ .return (array)
+.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
More information about the parrot-commits
mailing list