Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: nqp-p6
Fetching contributors…

Cannot retrieve contributors at this time

369 lines (272 sloc) 7.419 kB
#!./parrot
# Copyright (C) 2001-2010, Parrot Foundation.
=head1 NAME
t/pmc/capture.t - Test the Capture PMC
=head1 SYNOPSIS
% parrot t/pmc/capture.t
=head1 DESCRIPTION
Tests the C<Capture> PMC. Checks integer and key access using
a variety of keys and values.
=cut
.sub 'test' :main
.include 'test_more.pir'
test_new_capture()
empty_capture_tests()
basic_capture_tests()
test_defined_delete_exists()
test_hash_list()
test_get_integer()
test_get_number()
test_keyed_int_delegation()
test_list_delegation()
test_set_capture()
test_freeze_thaw()
"done_testing"()
.end
.sub 'test_new_capture'
.local pmc capt
capt = new ['Capture']
ok(1, 'new Capture')
.end
.sub 'empty_capture_tests'
.local pmc capt
capt = new ['Capture']
$I0 = elements capt
is($I0, 0, 'elements on empty Capture')
$N0 = capt[0]
is($N0, 0.0, 'get_number_keyed_int on empty Capture')
$I0 = capt[0]
is($I0, 0, 'get_integer_keyed_int on empty Capture')
$S0 = capt[0]
is($S0, '', 'get_string_keyed_int on empty Capture')
$N0 = capt['nothing']
is($N0, 0.0, 'get_number_keyed on empty Capture')
$S0 = capt
$S1 = 'get_string on empty Capture - ' . $S0
substring($S0, 'Capture[', $S1)
.end
.sub 'basic_capture_tests'
.local pmc capt
capt = new ['Capture']
capt[0] = 0
capt[1] = 1.5
capt[2] = 'two'
$P0 = new ['Integer']
$P0 = 3
capt[3] = $P0
push capt, 4
push capt, 5.5
push capt, 'six'
$P0 = new ['Integer']
$P0 = 7
push capt, $P0
unshift capt, 8
unshift capt, 9.5
unshift capt, 'ten'
$P0 = new ['Integer']
$P0 = 11
unshift capt, $P0
capt['alpha'] = 12
capt['beta'] = 13.5
capt['gamma'] = 'fourteen'
$P0 = new ['Integer']
$P0 = 15
capt['delta'] = $P0
$I0 = elements capt
is($I0, 12, 'elements')
$I0 = capt[11]
is($I0, 7, 'get_integer_keyed_int')
$P0 = capt[10]
is($P0, 'six', 'get_pmc_keyed_int')
$N0 = capt[9]
is($N0, 5.5, 'get_number_keyed_int')
$S0 = capt[8]
is($S0, '4', 'get_string_keyed_int')
$I0 = pop capt
is($I0, 7, 'pop an integer')
$P0 = pop capt
is($P0, 'six', 'pop a PMC')
$N0 = pop capt
is($N0, 5.5, 'pop a number')
$S0 = pop capt
is($S0, '4', 'pop a string')
$I0 = elements capt
is($I0, 8, 'elements after pop')
$I0 = shift capt
is($I0, 11, 'shift an integer')
$P0 = shift capt
is($P0, 'ten', 'shift a PMC')
$N0 = shift capt
is($N0, 9.5, 'shift a number')
$S0 = shift capt
is($S0, '8', 'shift a string')
$I0 = elements capt
is($I0, 4, 'elements after shift')
$P0 = pop capt
is($P0, 3, 'pop 1 out of 4')
$P0 = pop capt
is($P0, 'two', 'pop 2 out of 4')
$P0 = pop capt
is($P0, 1.5, 'pop 3 out of 4')
$P0 = pop capt
is($P0, 0, 'pop 4 out of 4')
$I0 = capt['delta']
is($I0, 15, 'get_integer_keyed_str')
$P0 = capt['gamma']
is($P0, 'fourteen', 'get_pmc_keyed_str')
$N0 = capt['beta']
is($N0, 13.5, 'get_number_keyed_str')
$S0 = capt['alpha']
is($S0, '12', 'get_string_keyed_str')
.end
.sub 'test_defined_delete_exists'
.local pmc capt
capt = new ['Capture']
$I0 = defined capt[2]
nok($I0, 'defined_i initially false')
$I1 = exists capt[2]
nok($I1, 'exists_i initially false')
$I0 = defined capt['alpha']
nok($I0, 'defined_s initially false')
$I1 = exists capt['alpha']
nok($I1, 'exists_s initially false')
capt[2] = 1
capt['alpha'] = 1
$P0 = new ['Undef']
capt['beta'] = $P0
$I0 = defined capt[2]
ok($I0, 'defined_i true after set')
$I1 = exists capt[2]
ok($I1, 'exists_i true after set')
$I0 = defined capt['alpha']
ok($I0, 'defined_s true after set')
$I1 = exists capt['alpha']
ok($I1, 'exists_s true after set')
$I0 = defined capt[1]
nok($I0, 'defined_i - no intermediate element created')
$I1 = exists capt[1]
nok($I1, 'exists_i - no intermediate element created')
$I0 = defined capt['beta']
nok($I0, 'defined_s checks for Undef values...')
$I1 = exists capt['beta']
ok($I1, 'but exists_s does not care')
delete capt[2]
delete capt['alpha']
$I0 = defined capt[2]
nok($I0, 'defined_i false after delete')
$I1 = exists capt[2]
nok($I1, 'exists_i false after delete')
$I0 = defined capt['alpha']
nok($I0, 'defined_s false after delete')
$I1 = exists capt['alpha']
nok($I1, 'exists_s false after delete')
.end
.sub 'test_hash_list'
.local pmc capt
capt = new ['Capture']
$P0 = capt.'list'()
$P1 = capt.'hash'()
isa_ok($P0, 'ResizablePMCArray', "capt.'list'")
isa_ok($P1, 'Hash', "capt.'hash'")
.end
.sub 'test_get_integer'
.local pmc capt
capt = new ['Capture']
push_eh test_get_integer_catch
$I0 = capt
nok(1, 'get_integer not implemented')
.return ()
test_get_integer_catch:
pop_eh
.local pmc exception
.local string message
.get_results (exception)
message = exception['message']
message = substr message, 0, 29
is(message, 'get_integer() not implemented', 'get_integer not implemented')
.return ()
.end
.sub 'test_get_number'
.local pmc capt
capt = new ['Capture']
push_eh test_get_number_catch
$N0 = capt
nok(1, 'get_number not implemented')
.return ()
test_get_number_catch:
.local pmc exception
.local string message
.get_results (exception)
message = exception['message']
message = substr message, 0, 28
is(message, 'get_number() not implemented', 'get_number not implemented')
.return ()
.end
.sub 'test_keyed_int_delegation'
$P99 = subclass ['Capture'], ['Match']
$P1 = new ['Match']
$P1[1] = 1
$I1 = elements $P1
is($I1, 2, 'elements - delegated to parent class')
$P99 = subclass ['Match'], ['Exp']
$P2 = new ['Exp']
$P2[1] = 1
$I2 = elements $P2
is($I2, 2, 'elements - delegated twice')
.end
.sub 'test_list_delegation'
$P0 = subclass ['Capture'], ['Match2']
addattribute $P0, '$.abc'
addattribute $P0, '$.xyz'
$P1 = new ['Match2']
$P1[1] = 1
$P2 = new ['String']
setattribute $P1, '$.abc', $P2
$P2 = new ['String']
setattribute $P1, '$.xyz', $P2
$P2 = $P1.'list'()
$P2 = 0
$I0 = elements $P2
is($I0, 0, 'list method delegation')
.end
.sub 'test_set_capture'
.local pmc capt
.local pmc capt2
$P1 = new ['String']
capt = new ['Capture']
capt2 = new ['Capture']
capt[0] = 1337
setref capt2, capt
$I0 = capt2[0]
is($I0, 1337, "Set PMC values correct")
$P0 = new ['Role']
push_eh set_badpmc
setref capt, $P0
pop_eh
goto finally
set_badpmc:
.get_results($P1)
ok(1, "Bad set_pmc handled properly")
finally:
.end
.sub 'test_freeze_thaw'
$P0 = new ["Capture"]
$P0["foo"] = "foo"
$P0[0] = "bar"
# Sanity check
$S0 = $P0["foo"]
"is"($S0, "foo")
$S0 = $P0[0]
"is"($S0, "bar")
$S1 = freeze $P0
$P0 = thaw $S1
$S0 = $P0["foo"]
"is"($S0, "foo", "Hash thawed")
$S0 = $P0[0]
"is"($S0, "bar", "Array thawed")
.end
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir:
Jump to Line
Something went wrong with that request. Please try again.