=head1 NAME
Test::More - Parrot extension for testing modules
=head1 SYNOPSIS
# load this library
load_bytecode 'Test/More.pbc'
# get the testing functions
.local pmc exports, curr_namespace, test_namespace
curr_namespace = get_namespace
test_namespace = get_namespace [ 'Test'; 'More' ]
exports = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip skip_all isnt todo throws_like lives_ok dies_ok'
test_namespace.'export_to'(curr_namespace, exports)
# set a test plan
plan( 12 )
# run your tests
ok( 1 )
ok( 0, 'failing test with diagnostic' )
ok( 0, 'failing test with diagnostic', 'todo' => 'and a TODO comment' )
nok( 1, 'failing test with diagnostic', 'todo' => 'and a TODO comment' )
is( 100, 100 )
is( 200, 100, 'failing integer compare with diagnostic' )
is( 1.001, 1.001, 'passing float compare with diagnostic' )
is( 8.008, 4.004 )
is( 'foo', 'foo', 'passing string compare with diagnostic' )
is( 'foo', 'bar', 'failing string compare with diagnostic' )
is( some_pmc, another_pmc, 'pmc comparison uses "eq" op' )
is_null( some_pmc, 'pmc was null' )
diag( 'this may take a while' )
is_deeply( some_deep_pmc, another_deep_pmc, 'deep structure comparison' )
like( 'foo', 'f o**{2}', 'passing regex compare with diagnostic' )
skip(1, 'reason for skipping')
# old way
todo(0, 'this is a failed test', 'reason for todo')
# better way
is(0, 'FAIL', todo => 'failure reason')
$P0 = get_class "Squirrel"
$P0.new()
isa_ok($P0, "Squirrel", "new Squirrel")
=head1 DESCRIPTION
C<Test::More> is a pure-Parrot library for testing modules. It provides the
C<ok()>, C<is()>, C<isnt()>, C<is_deeply()>, and C<like()> comparison functions
for you. It also provides the C<plan()> and C<diag()> helper functions. It
uses C<Test::Builder>, a simple, single backend for multiple test modules
to use within your tests.
=head1 FUNCTIONS
This class defines the following functions:
=over 4
=cut
.namespace [ 'Test'; 'More' ]
.sub _initialize :load
load_bytecode 'Test/Builder.pbc'
.local pmc test
test = new [ 'Test'; 'Builder' ]
set_hll_global [ 'Test'; 'More' ], '_test', test
.end
=item C<plan( number_or_no_plan )>
Declares the number of tests you plan to run, either an integer greater than
zero or the string C<no_plan>. This will throw an exception if you have
already declared a plan or if you pass an invalid argument.
=cut
.sub plan
.param string tests
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'plan'( tests )
.end
=item C<done_testing( number_of_tests? )>
If you don't know how many tests you're going to run, you can issue
the plan when you're done running tests.
C<number_of_tests> is the same as plan(), it's the number of tests
you expected to run. You can omit this, in which case the number
of tests you ran doesn't matter, just the fact that your tests ran
to conclusion.
This is safer than and replaces the "no_plan" plan.
=cut
.sub done_testing
.param string tests :optional
.param int has_tests :opt_flag
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'done_testing'( tests )
.end
=item C<ok( passed, description )>
Records a test as pass or fail depending on the truth of the PMC C<passed>,
recording it with the optional test description in C<description>.
=cut
.sub ok
.param pmc passed
.param string description :optional
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
$I0 = istrue passed
if todo goto todo_l
test.'ok'( $I0, description )
goto done
todo_l:
test.'todo'( $I0, description, todo )
done:
.end
=item C<nok( passed, description )>
Records a test as pass or fail depending on the falsehood of the integer
C<passed>, recording it with the optional test description in C<description>.
=cut
.sub nok
.param pmc passed
.param string description :optional
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int reverse_passed
reverse_passed = isfalse passed
if todo goto todo_l
test.'ok'( reverse_passed, description )
goto done
todo_l:
test.'todo'( reverse_passed, description, todo )
done:
.end
=item C<is( left, right, description )>
Compares the parameters passed as C<left> and C<right>, passing if they are
equal and failing otherwise. This will report the results with the optional
test description in C<description>.
This is a multi-method, with separate implementations for int-int, float-float,
string-string, and PMC-PMC comparisons. The latter uses the C<eq> opcode for
comparison.
If there is a mismatch, the current implementation takes the type of C<left> as
the proper type for the comparison, converting any numeric arguments to floats.
Note that there is a hard-coded precision check to avoid certain rounding
errors.
=item C<is( left, right, description, precision )>
For C<Float> only, an optional 4th parameter is allowed, a numeric precision.
If specified, then the floats are only compared within the tolerance of the
precision: e.g.:
is(123.456, 123.457, 'close enough?', 1e-2)
will pass.
=cut
.sub one_or_both_null
.param pmc left
.param pmc right
.local int one
.local int both
$I0 = isnull left
$I1 = isnull right
or one, $I0, $I1
and both, $I0, $I1
.return (one, both)
.end
.sub is :multi(PMC, Integer)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto report
.local int l, r
l = left
r = right
pass = iseq l, r
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = 'null'
if null left goto r_str
l_string = left
r_str:
r_string = 'null'
if null right goto diag
r_string = right
diag:
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
#.sub is :multi(_, Float)
# .param num left
# .param num right
.sub is :multi(PMC, Float)
.param pmc left
.param pmc right
.param string description :optional
.param int have_desc :opt_flag
.param num precision :optional
.param int have_prec :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto report
.local num l, r
l = left
r = right
if have_prec goto check_precision
pass = iseq l, r
goto report
check_precision:
.local num diff
diff = l - r
diff = abs diff
pass = isle diff, precision
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = 'null'
if null left goto r_str
l_string = left
r_str:
r_string = 'null'
if null right goto diag
r_string = right
diag:
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
.sub is :multi(PMC, String)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto report
.local string l, r
l = left
r = right
pass = iseq l, r
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = 'null'
if null left goto r_str
l_string = left
r_str:
r_string = 'null'
if null right goto diag
r_string = right
diag:
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
.sub is :multi(PMC, PMC)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto result
.local int does_type
does_type = does right, 'String'
if does_type goto check_string
does_type = does right, 'Float'
if does_type goto check_float
does_type = does right, 'Integer'
if does_type goto check_integer
check_string:
pass = iseq left, right
goto result
check_float:
.local num ln, rn
ln = left
rn = right
pass = iseq ln, rn
goto result
check_integer:
.local int li, ri
li = left
ri = right
pass = iseq li, ri
goto result
result:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = 'null'
if null left goto r_str
l_string = left
r_str:
r_string = 'null'
if null right goto diag
r_string = right
diag:
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
=item C<isnt( left, right, description )>
Like C<is>, but succeeds if the arguments I<don't> match.
=cut
.sub isnt :multi(Integer, Integer)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto report
if left != right goto pass_it
goto report
pass_it:
pass = 1
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = left
r_string = right
r_string = 'not ' . r_string
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
.sub isnt :multi(Float, Float)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto report
ne left, right, pass_it
goto report
pass_it:
pass = 1
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = left
r_string = right
r_string = 'not ' . r_string
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
.sub isnt :multi(String, String)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto report
ne left, right, pass_it
goto report
pass_it:
pass = 1
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = left
r_string = right
r_string = 'not ' . r_string
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
.sub isnt :multi(PMC, PMC)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int pass
($I0, pass) = one_or_both_null(left, right)
if $I0 goto report
# this comparison may not work in general, but it's worth trying
pass = isne left, right
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
.local string diagnostic
.local string l_string
.local string r_string
l_string = left
r_string = right
r_string = 'not ' . r_string
diagnostic = _make_diagnostic( l_string, r_string )
test.'diag'( diagnostic )
done:
.end
=item C<diag( diagnostic, ... )>
Prints C<diagnostic> to the screen, without affecting test comparisons.
=cut
.sub diag
.param pmc args :slurpy
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.tailcall test.'diag'( args :flat )
.end
=item C<is_deeply( left, right, description )>
Compares the data structures passed as C<left> and C<right>. If data
structures are passed, C<is_deeply> does a deep comparison by walking each
structure. It passes if they are equal and fails otherwise. This will
report the results with the optional test description in C<description>.
This handles comparisons of array-like and hash-like structures.
=cut
.sub is_deeply :multi(PMC, PMC)
.param pmc left
.param pmc right
.param pmc description :optional
.param int have_desc :opt_flag
.param string todo :named("todo") :optional
.local int result
.local pmc diagnosis
diagnosis = new ['StringBuilder']
.local pmc position
position = new 'ResizablePMCArray'
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int does_flag
does_flag = does left, 'array'
if does_flag goto compare_array
does_flag = does left, 'hash'
if does_flag goto compare_hash
diagnosis = typeof left
diagnosis .= ' is not a nested data structure'
result = 0
goto report_result
compare_array:
result = compare_array( left, right, position )
goto report_result
compare_hash:
result = compare_hash( left, right, position )
goto report_result
report_result:
if todo goto todo_l
test.'ok'( result, description )
goto after_todo_l
todo_l:
test.'todo'( result, description, todo )
after_todo_l:
unless result goto report_diagnostic
.return( result )
report_diagnostic:
ne diagnosis, '', return_it
.local string left_value
.local string right_value
.local pmc left, right
right = pop position
left = pop position
check_right_null:
.local int rnull
rnull = isnull right
unless rnull goto set_right
right_value = 'nonexistent'
goto check_left_null
set_right:
right_value = right
check_left_null:
.local int lnull
lnull = isnull left
unless lnull goto set_left
left_value = 'undef'
goto create_diag
set_left:
left_value = left
create_diag:
.local string nested_path
nested_path = join '][', position
diagnosis = 'Mismatch'
unless nested_path goto show_expected
diagnosis .= ' at ['
diagnosis .= nested_path
diagnosis .= ']'
show_expected:
diagnosis .= ': expected '
diagnosis .= left_value
diagnosis .= ', received '
diagnosis .= right_value
return_it:
test.'diag'( diagnosis )
.return( result )
.end
.sub compare_array
.param pmc l_array
.param pmc r_array
.param pmc position
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int l_count
.local int r_count
l_count = l_array
r_count = r_array
if l_count == r_count goto compare_contents
.local pmc l_count_string
.local pmc r_count_string
l_count_string = new ['StringBuilder']
r_count_string = new ['StringBuilder']
$S0 = l_count
l_count_string = $S0
l_count_string .= ' element'
if l_count == 1 goto pluralization_done
l_count_string .= 's'
pluralization_done:
$S0 = r_count
r_count_string = $S0
push position, l_count_string
push position, r_count_string
.return( 0 )
compare_contents:
.local pmc l_iter
.local pmc r_iter
.local int count
l_iter = iter l_array
r_iter = iter r_array
l_iter = 0
r_iter = 0
count = 0
.local pmc l_elem
.local pmc r_elem
.local int elems_equal
iter_start:
unless l_iter goto iter_end
l_elem = shift l_iter
r_elem = shift r_iter
# MMD can't handle Nulls. So replace elems with Undef.
unless null l_elem goto check_right
l_elem = new 'Undef'
check_right:
unless null r_elem goto compare
r_elem = new 'Undef'
compare:
elems_equal = compare_elements( l_elem, r_elem, position )
unless elems_equal goto elems_not_equal
iter_next:
inc count
goto iter_start
elems_not_equal:
unshift position, count
.return( 0 )
iter_end:
.return( 1 )
.end
.sub compare_hash
.param pmc l_hash
.param pmc r_hash
.param pmc position
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int l_count
.local int r_count
l_count = l_hash
r_count = r_hash
if l_count == r_count goto compare_contents
.local pmc l_count_string
.local pmc r_count_string
l_count_string = new ['StringBuilder']
r_count_string = new ['StringBuilder']
$S0 = l_count
l_count_string = $S0
l_count_string .= ' element'
if l_count == 1 goto pluralization_done
l_count_string .= 's'
pluralization_done:
$S0 = r_count
r_count_string = $S0
push position, l_count_string
push position, r_count_string
.return( 0 )
compare_contents:
.local pmc l_iter
.local int count
l_iter = iter l_hash
l_iter = 0
count = 0
.local pmc key
.local pmc l_elem
.local pmc r_elem
.local int elems_equal
iter_start:
unless l_iter goto iter_end
key = shift l_iter
l_elem = l_hash[ key ]
r_elem = r_hash[ key ]
elems_equal = compare_elements( l_elem, r_elem, position )
unless elems_equal goto elems_not_equal
inc count
goto iter_start
elems_not_equal:
unshift position, key
.return( 0 )
iter_end:
.return( 1 )
.end
.sub compare_elements :multi(String, String, PMC)
.param pmc left
.param pmc right
.param pmc position
.local int equal
eq left, right, are_equal
are_not_equal:
push position, left
push position, right
.return( 0 )
are_equal:
.return( 1 )
.end
.sub compare_elements :multi(Integer, Integer, PMC)
.param pmc left
.param pmc right
.param pmc position
.local int equal
eq left, right, are_equal
are_not_equal:
push position, left
push position, right
.return( 0 )
are_equal:
.return( 1 )
.end
.sub compare_elements :multi(String, String, PMC)
.param pmc left
.param pmc right
.param pmc position
eq left, right, are_equal
are_not_equal:
push position, left
push position, right
.return( 0 )
are_equal:
.return( 1 )
.end
.sub compare_elements :multi(Integer, Integer, PMC)
.param pmc left
.param pmc right
.param pmc position
.local int equal
eq left, right, are_equal
are_not_equal:
push position, left
push position, right
.return( 0 )
are_equal:
.return( 1 )
.end
.sub compare_elements :multi(Array, Array, PMC)
.param pmc left
.param pmc right
.param pmc position
.local int equal
equal = compare_array( left, right, position )
.return( equal )
.end
.sub compare_elements :multi(Hash, Hash, PMC)
.param pmc left
.param pmc right
.param pmc position
.local int equal
equal = compare_hash( left, right, position )
.return( equal )
.end
.sub compare_elements :multi(Undef, Undef, PMC)
.param pmc left
.param pmc right
.param pmc position
.return( 1 )
.end
.sub compare_elements :multi(Undef, PMC, PMC)
.param pmc left
.param pmc right
.param pmc position
.local string l_undef
l_undef = '(undef)'
push position, l_undef
push position, right
.return( 0 )
.end
.sub compare_elements :multi(PMC, Undef, PMC)
.param pmc left
.param pmc right
.param pmc position
.local string r_undef
r_undef = '(undef)'
push position, left
push position, r_undef
.return( 0 )
.end
.sub compare_elements :multi(PMC, PMC, PMC)
.param pmc left
.param pmc right
.param pmc position
.local int does_flag
.local int equal
check_array:
does_flag = does left, 'array'
unless does_flag goto check_hash
equal = compare_array( left, right, position )
.return( equal )
check_hash:
does_flag = does left, 'hash'
if does_flag goto compare_hash
.return( 0 )
compare_hash:
equal = compare_hash( left, right, position )
.return( equal )
.end
=item C<is_null( pmc, description )>
Records a passing test if the PMC passed in is null, fails otherwise.
=cut
.sub is_null
.param pmc victim
.param string description :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local int passed
passed = isnull victim
test.'ok'( passed, description )
if passed goto done
.local string v_string
v_string = 'null'
if null victim goto diag
v_string = victim
diag:
.local string diagnostic
diagnostic = _make_diagnostic( v_string, 'null')
test.'diag'( diagnostic )
done:
.end
=item C<throws_type( invokable, type, description)>
Passes a test if calling the invokable throws an exception of the
expected type, fails a test otherwise.
If the invokable parameter is an invokable object, invoke it.
It it's a String, compile it as PIR code and invokes the result.
Otherwise, fail the test.
=cut
.sub throws_type
.param pmc invokable
.param int type
.param string description :optional
.local pmc test, ex
.local string msg, exmsg
.local int check, extype
get_hll_global test, [ 'Test'; 'More' ], '_test'
msg = ''
if null description goto setmsg
$I0 = length description
unless $I0 goto setmsg
msg = description
setmsg:
msg = concat msg, ': '
push_eh catch
check = does invokable, 'invokable'
if check goto invokeit
check = isa invokable, 'String'
unless check goto badinvoke
.local pmc compiler
.local string source
source = invokable
compiler = compreg 'PIR'
invokable = compiler(source)
goto invokeit
badinvoke:
die 'throws_type argument is not invokable'
invokeit:
invokable()
pop_eh
msg = concat msg, "expected to throw but doesn't"
ok(0, msg)
goto end
catch:
.get_results(ex)
extype = ex['type']
exmsg = ex['message']
finalize ex
pop_eh
msg = concat msg, "throws expected type"
exmsg = concat 'exception message is: "', exmsg
exmsg = concat exmsg, '"'
is(extype, type, msg)
diag(exmsg)
end:
.end
=item C<dies_ok( codestring, description )>
Takes PIR code in C<codestring> and an optional message in C<description>.
Passes a test if the PIR code throws any exception, fails a test otherwise.
=cut
.sub dies_ok
.param string target
.param string description :optional
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local pmc comp
.local pmc compfun
.local pmc compiler
compiler = compreg 'PIR'
.local pmc eh
eh = new 'ExceptionHandler'
set_label eh, handler # set handler label for exceptions
push_eh eh
compfun = compiler(target)
compfun() # eval the target code
pop_eh
# if it doesn't throw an exception fail
if todo goto todo_l
test.'ok'( 0, description )
goto after_todo_l
todo_l:
test.'todo'( 0, description, todo )
after_todo_l:
test.'diag'('no error thrown')
goto done
handler:
.local pmc ex
.local string error_msg
.local string diagnostic
.get_results (ex)
pop_eh
error_msg = ex
if todo goto todo_l2
test.'ok'( 1, description )
goto after_todo_l2
todo_l2:
test.'todo'( 1, description, todo )
after_todo_l2:
done:
.end
=item C<lives_ok( codestring, description )>
Takes PIR code in C<codestring> and an optional message in C<description>.
Passes a test if the PIR does not throw any exception, fails a test otherwise.
=cut
.sub lives_ok
.param string target
.param string description :optional
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local pmc comp
.local pmc compfun
.local pmc compiler
compiler = compreg 'PIR'
.local pmc eh
eh = new 'ExceptionHandler'
set_label eh, handler # set handler label for exceptions
push_eh eh
compfun = compiler(target)
compfun() # eval the target code
pop_eh
# if it doesn't throw an exception pass
if todo goto todo_l
test.'ok'( 1, description )
goto after_todo_l
todo_l:
test.'todo'( 1, description, todo )
after_todo_l:
goto done
handler:
.local pmc ex
.local string error_msg
.local string diagnostic
.get_results (ex)
pop_eh
error_msg = ex
if todo goto todo_l2
test.'ok'( 0, description )
goto after_todo_l2
todo_l2:
test.'todo'( 0, description, todo )
after_todo_l2:
test.'diag'(error_msg)
done:
.end
=item C<throws_like( codestring, pattern, description )>
Takes PIR code in C<codestring> and a PGE pattern to match in C<pattern>, as
well as an optional message in C<description>. Passes a test if the PIR throws
an exception that matches the pattern, fails the test otherwise.
=cut
.sub throws_like
.param string target
.param string pattern
.param string description :optional
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local pmc comp
.local pmc compfun
.local pmc compiler
compiler = compreg 'PIR'
.local pmc eh
eh = new 'ExceptionHandler'
set_label eh, handler # set handler label for exceptions
push_eh eh
compfun = compiler(target)
compfun() # eval the target code
pop_eh
# if it doesn't throw an exception, fail
if todo goto todo_l
test.'ok'( 0, description )
goto after_todo_l
todo_l:
test.'todo'( 0, description, todo )
after_todo_l:
test.'diag'('no error thrown')
goto done
handler:
.local pmc ex
.local string error_msg
.get_results (ex)
pop_eh
error_msg = ex
if todo goto todo_l2
like(error_msg, pattern, description)
goto after_todo_l2
todo_l2:
like(error_msg, pattern, description, 'todo' => todo)
after_todo_l2:
done:
.end
=item C<throws_substring( codestring, text, description )>
Takes PIR code in C<codestring> and a string to match in C<text>, as
well as an optional message in C<description>. Passes a test if the PIR throws
an exception that matches the pattern, fails the test otherwise.
=cut
.sub throws_substring
.param string target
.param string text
.param string description :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local pmc comp
.local pmc compfun
.local pmc compiler
compiler = compreg 'PIR'
.local pmc eh
eh = new 'ExceptionHandler'
set_label eh, handler # set handler label for exceptions
push_eh eh
compfun = compiler(target)
compfun() # eval the target code
pop_eh
# if it doesn't throw an exception, fail
test.'ok'( 0, description )
test.'diag'( 'no error thrown' )
goto done
handler:
.local pmc ex
.local string error_msg
.get_results (ex)
pop_eh
error_msg = ex
substring(error_msg, text, description)
done:
.end
=item C<substring( target, text, description )>
Similar to is, but using the index opcode to compare the string passed as
C<text> to the string passed as C<target>. It passes if C<text> is a substring
of C<target> and fails otherwise. This will report the results with the
optional test description in C<description>.
=cut
.sub substring
.param string target
.param string text
.param string description :optional
.local pmc test
.local pmc diagnostic
diagnostic = new ['StringBuilder']
get_hll_global test, [ 'Test'; 'More' ], '_test'
$I0 = index target, text
$I0 = isne $I0, -1
test.'ok'( $I0, description )
if $I0 goto done
diagnostic = "substring failed: '"
diagnostic .= target
diagnostic .= "' does not contain '"
diagnostic .= text
diagnostic .= "'"
test.'diag'(diagnostic)
done:
.end
=item C<like( target, pattern, description )>
Similar to is, but using the Parrot Grammar Engine to compare the string
passed as C<target> to the pattern passed as C<pattern>. It passes if the
pattern matches and fails otherwise. This will report the results with the
optional test description in C<description>.
=cut
.sub like
.param string target
.param string pattern
.param string description :optional
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local pmc p6rule_compile
load_bytecode "PGE.pbc"
load_bytecode "PGE/Dumper.pbc"
load_bytecode "PGE/Text.pbc"
load_bytecode "PGE/Util.pbc"
p6rule_compile = compreg "PGE::Perl6Regex"
.local pmc diagnostic
diagnostic = new ['StringBuilder']
.local int pass
pass = 0
match_pattern:
.local pmc rulesub
.local pmc match
.local pmc code
.local pmc exp
(rulesub, code, exp) = p6rule_compile(pattern)
if_null rulesub, rule_fail
match = rulesub(target)
unless match goto match_fail
match_success:
goto pass_it
match_fail:
diagnostic = "match failed: target '"
diagnostic .= target
diagnostic .= "' does not match pattern '"
diagnostic .= pattern
diagnostic .= "'"
goto report
rule_fail:
diagnostic = "rule error"
goto report
pass_it:
pass = 1
report:
if todo goto todo_l
test.'ok'( pass, description )
goto after_todo_l
todo_l:
test.'todo'( pass, description, todo )
after_todo_l:
if pass goto done
test.'diag'( diagnostic )
done:
.end
=item C<skip( how_many, why )>
Pass a number of tests, but with a comment that marks the test was
actually skipped. Arguments are optional.
=cut
.sub skip :multi(Integer, String)
.param int how_many
.param string description
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'skip'(how_many, description)
.end
.sub skip :multi(Integer)
.param int how_many
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'skip'(how_many)
.end
.sub skip :multi(String)
.param string description
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'skip'(1, description)
.end
.sub skip :multi()
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'skip'()
.end
=item C<skip_all( reason )>
=cut
.sub skip_all
.param string reason :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'skip_all'(reason)
.end
=item C<todo( passed, description, reason )>
Records a test as pass or fail (like C<ok>, but marks it as TODO so it always
appears as a success. This also records the optional C<description> of the test
and the C<reason> you have marked it as TODO.
=cut
.sub todo
.param pmc args :slurpy
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
test.'todo'( args :flat )
.end
=item C<isa_ok( object, class_name, object_name )>
Pass if the object C<isa> class of the given class name. The object
name passed in is not a full description, but a name to be included in
the description. The description is presented as "<object_name> isa
<class>".
Good input: "C<new MyObject>", "C<return from bar()>"
Bad input: "C<test that the return from Foo is correct type>"
=cut
.sub isa_ok
.param pmc thingy
.param pmc class_name
.param pmc object_name :optional
.param int got_name :opt_flag
.param string todo :named("todo") :optional
.local pmc test
get_hll_global test, [ 'Test'; 'More' ], '_test'
.local pmc description
.local pmc diagnostic
description = new ['StringBuilder']
diagnostic = new ['StringBuilder']
description = "The object"
unless got_name goto keep_default
description = object_name
keep_default:
$S0 = description
diagnostic = $S0
description .= " isa "
$S0 = class_name
description .= $S0
$I0 = isa thingy, class_name
if todo goto todo_l
test.'ok'($I0, description)
goto after_todo_l
todo_l:
test.'todo'( $I0, description, todo )
after_todo_l:
if $I0 goto out
diagnostic .= " isn't a "
$S1 = class_name
diagnostic .= $S1
diagnostic .= " it's a "
$S2 = typeof thingy
diagnostic .= $S2
test.'diag'(diagnostic)
out:
.end
.sub _make_diagnostic
.param string received
.param string expected
.local pmc diagnostic
diagnostic = new ['StringBuilder']
diagnostic = 'Have: '
diagnostic .= received
diagnostic .= "\nWant: "
diagnostic .= expected
$S0 = diagnostic
.return( $S0 )
.end
=back
=head1 AUTHOR
Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on
the Perl 6 port he wrote, based on the original Perl 5 version he wrote with
ideas from Michael G. Schwern. Please send patches, feedback, and suggestions
to the Perl 6 internals mailing list.
=head1 COPYRIGHT
Copyright (C) 2005-2009, Parrot Foundation.
=cut
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: