Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: nqp-p6
Fetching contributors…

Cannot retrieve contributors at this time

361 lines (272 sloc) 8.394 kb
#!./parrot
# Copyright (C) 2006-2010, Parrot Foundation.
=head1 NAME
t/pmc/callcontext.t - test CallContext PMC
=head1 SYNOPSIS
% prove t/pmc/callcontext.t
=head1 DESCRIPTION
Tests the CallContext PMC.
=cut
.sub 'main' :main
.include 'test_more.pir'
plan(65)
test_instantiate()
test_get_set_attrs()
test_indexed_access()
test_indexed_boxing()
test_keyed_access()
test_shift_access()
test_shift_acess_empty()
test_exists()
test_clone()
test_short_sign()
test_named_args('Int' => 10, 'Num' => 3.14, 'Str' => 'A String', 'Pmc' => 'A String PMC')
.end
.sub 'test_instantiate'
$P0 = new ['CallContext']
ok(1, 'Instantiated CallContext')
.end
.sub 'test_get_set_attrs'
$P0 = new ['CallContext']
$P5 = new 'String'
$P5 = 'moonbomb'
setattribute $P0, 'return_flags', $P5
ok(1, 'set return_flags attribute')
getattribute $P1, $P0, 'return_flags'
is($P5,'moonbomb', 'got return_flags attribute')
$P5 = 'cheese'
setattribute $P0, 'arg_flags', $P5
ok(1, 'set arg_flags attribute')
getattribute $P1, $P0, 'arg_flags'
is($P5,'cheese', 'got arg_flags attribute')
$P5 = 'nothing'
push_eh eh
$I0 = 1
setattribute $P0, 'unexisting_attribute_123', $P5
$I0 = 0
eh:
pop_eh
ok($I0, 'exception when set an unexisting attribute')
.end
.sub 'test_indexed_access'
$P0 = new [ 'CallContext' ]
$P0[0] = 100
$I0 = elements $P0
is( $I0, 1, 'elements after set_*_indexed' )
$P0[1] = 1.11
$I0 = elements $P0
is( $I0, 2, 'elements after set_*_indexed' )
$S0 = '2.22'
$P0[2] = $S0
$I0 = elements $P0
is( $I0, 3, 'elements after set_*_indexed' )
$P1 = new [ 'Float' ]
$P1 = 3.33
$P0[3] = $P1
$I0 = elements $P0
is( $I0, 4, 'elements after set_*_indexed' )
$I1 = $P0[0]
is( $I1, 100, 'set_integer_keyed_int/get_integer_keyed_int pair' )
$N1 = $P0[1]
is( $N1, 1.11, 'set_number_keyed_int/get_number_keyed_int pair' )
$S1 = $P0[2]
is( $S1, '2.22', 'set_string_keyed_int/get_string_keyed_int pair' )
$P1 = $P0[3]
is( $P1, 3.33, 'set_pmc_keyed_int/get_pmc_keyed_int pair' )
$I2 = $P0[4]
is($I2, 0, 'unexisting get_integer_keyed_int')
$N2 = $P0[4]
is($N2, 0.0, 'unexisting get_number_keyed_int')
$S2 = $P0[4]
null $S3
is($S2, $S3, 'unexisting get_string_keyed_int')
$P2 = $P0[4]
null $P3
is($P2, $P3, 'unexisting get_pmc_keyed_int')
.end
.sub 'test_indexed_boxing'
$P0 = new [ 'CallContext' ]
$P0[0] = 100
$P0[1] = 1.11
$S0 = '2.22'
$P0[2] = $S0
$P1 = new [ 'Float' ]
$P1 = 3.33
$P0[3] = $P1
$I0 = $P0[1]
is( $I0, 1, 'indexed float converted to int on get_integer_keyed_int' )
$I0 = $P0[2]
is( $I0, 2, 'indexed string converted to int on get_integer_keyed_int' )
$I0 = $P0[3]
is( $I0, 3, 'indexed PMC converted to int on get_integer_keyed_int' )
$N0 = $P0[0]
is( $N0, 100.0, 'indexed integer converted to num on get_number_keyed_int' )
$N0 = $P0[2]
is( $N0, 2.22, 'indexed string converted to num on get_number_keyed_int' )
$N0 = $P0[3]
is( $N0, 3.33, 'indexed PMC converted to int num get_number_keyed_int' )
$S0 = $P0[0]
is( $S0, '100', 'indexed int converted to string on get_string_keyed_int' )
$S0 = $P0[1]
is( $S0, '1.11', 'indexed num converted to string on get_string_keyed_int' )
$S0 = $P0[3]
is( $S0, '3.33', 'indexed PMC converted to string get_string_keyed_int' )
$P1 = $P0[0]
is( $P1, 100, 'indexed int converted to PMC on get_pmc_keyed_int' )
$P1 = $P0[1]
is( $P1, 1.11, 'indexed float converted to PMC on get_pmc_keyed_int' )
$P1 = $P0[2]
is( $P1, 2.22, 'indexed string converted to PMC on get_pmc_keyed_int' )
.end
.sub 'test_keyed_access'
$P0 = new [ 'CallContext' ]
$P0['foo'] = 100
$S0 = 'bar'
$P0[$S0] = 1.11
$P0['baz'] = '2.22'
$P1 = new [ 'Float' ]
$P1 = 3.33
$P0['qux'] = $P1
$I0 = $P0['foo']
is( $I0, 100, 'set/get_intval_keyed' )
$N0 = $P0[$S0]
is( $N0, 1.11, 'set/get_number_keyed' )
$S0 = $P0['baz']
is( $S0, '2.22', 'set/get_string_keyed' )
$P2 = $P0['qux']
is( $P2, 3.33, 'set/get_pmc_keyed' )
$P1 = getattribute $P0, 'named'
$I0 = elements $P1
is( $I0, 4, 'elements after set_*_keyed' )
$P4 = $P0['baz']
is($P4, '2.22', 'get_pmc_keyed with boxing')
$P3 = new ['CallContext']
$I1 = $P0['unexisting']
is($I1, 0, 'get_integer_keyed whith empty CallContext')
$N1 = $P0['unexisting']
is($N1, 0.0, 'get_number_keyed whith empty CallContext')
$S1 = $P0['unexisting']
null $S2
is($S1, $S2, 'get_string_keyed whith empty CallContext')
$P3 = $P0['unexisting']
null $P4
is($P3, $P4, 'get_pmc_keyed whith empty CallContext')
.end
.sub 'test_exists'
$P0 = new [ 'CallContext' ]
$P0[0] = 111
$P0['foo'] = 100
$I0 = exists $P0[0]
ok( $I0, 'exists_keyed_int' )
$I0 = exists $P0['foo']
ok( $I0, 'exists_keyed_str' )
$I0 = exists $P0[100]
nok( $I0, 'exists_keyed_int -- non-existent' )
$I0 = exists $P0['bar']
nok( $I0, 'exists_keyed_str -- non-existent' )
$P1 = new ['CallContext']
$I0 = exists $P1[1]
nok($I0, 'test exists_keyed_int whith empty CallContext')
$P2 = new ['String']
$P2 = 'unexisting'
$I0 = exists $P1[$P2]
nok($I0, 'test exists_keyed whith empty CallContext')
.end
.sub 'test_clone'
$P0 = new ['CallContext']
$P0[0] = 42
$P0[1] = "Hello Parrot"
$P0['floatval'] = 3.14159
$P0 = 'PISS'
$P2 = new['String']
$P2 = 'return attr'
setattribute $P0, 'return_flags', $P2
$P3 = new['String']
$P3 = 'arg attr'
setattribute $P0, 'arg_flags', $P3
$P1 = clone $P0
$I2 = $P1[0]
is($I2, 42, 'clone - integer positional cloned')
$S2 = $P1[1]
is($S2, "Hello Parrot", 'clone - string positional cloned')
$N2 = $P1['floatval']
is($N2, 3.14159, 'clone - named number cloned')
$S3 = $P0
is($S3, 'PISS', 'clone - with a short signature string')
getattribute $P4, $P0, 'return_flags'
is($P4,'return attr', 'clone - with return_flags attribute')
getattribute $P4, $P0, 'arg_flags'
is($P4,'arg attr', 'clone - with arg_flags attribute')
.end
.sub 'test_shift_access'
$P0 = new ['CallContext']
$P1 = new [ 'String' ]
$P1 = 'derF'
$P3 = new ['String']
$P3 = 'Second'
unshift $P0, $P3
unshift $P0, $P1
$S1 = shift $P0
is($S1, 'derF', 'shift should convert to proper type (PMC -> STRING)')
unshift $P0, $P1
$P2 = shift $P0
is($P2, 'derF', '... but not convert when unnecesary')
$I0 = issame $P1, $P2
ok($I0, '... returning the same item' )
# no unshift_string for now
$P0[0] = 'Fred'
$P2 = shift $P0
is($P2, 'Fred', 'shift should convert to proper type (STRING -> PMC)')
$P0[0] = 'Fred'
$S2 = shift $P0
is($S2, 'Fred', '... but not convert when unnecessary')
.end
.sub 'test_shift_acess_empty'
$P0 = new['CallContext']
$I0 = 1
push_eh first_eh
$P1 = shift $P0
$I0 = 0
first_eh:
pop_eh
ok($I0, 'exception when shift_pmc an empty CallContext')
push_eh second_eh
$I0 = 1
$S0 = shift $P0
$I0 = 0
second_eh:
pop_eh
ok($I0, 'exception when shift_string an empty CallContext')
.end
.sub 'test_short_sign'
$P0 = new ['CallContext']
$P1 = new ['String']
$P1 = 'PMC String'
$S0 = 'String'
$I0 = 123
$N0 = 3.14
$P0[0] = $P1
$P0[1] = $S0
$P0[2] = $I0
$P0[3] = $N0
$S1 = $P0
is($S1, 'PSIN', 'get short signature string from arguments type')
$P0 = 'NISP'
$S2 = $P0
is($S2, 'NISP', 'set short signature')
.end
.sub 'test_named_args'
.param int i :named('Int')
.param num n :named('Num')
.param string s :named('Str')
.param pmc p :named('Pmc')
is( i, 10, 'set/get_intval_keyed_str' )
is( n, 3.14, 'set/get_number_keyed_str' )
is( s, 'A String', 'set/get_string_keyed_str' )
is( p, 'A String PMC', 'set/get_pmc_keyed_str' )
.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.