Permalink
Browse files

[spec] more fudging in S02-builtin_data_types/ - some if it successful

git-svn-id: http://svn.pugscode.org/pugs@21037 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
moritz
moritz committed Jun 25, 2008
1 parent c0eec78 commit 63c4f609dd07e42bb4c9d3b17790ead304c13c8f
@@ -19,37 +19,43 @@ plan 32;
# L<S06/"Anonymous subroutines"> # L<S06/"Anonymous subroutines">
# anon blocks # anon blocks
my $anon_sub = sub { 1 }; my $anon_sub = sub { 1 };
isa_ok($anon_sub, 'Sub'); #?rakudo todo 'type Sub for subs'
isa_ok($anon_sub, Sub);
is($anon_sub(), 1, 'sub { } works'); is($anon_sub(), 1, 'sub { } works');
my $anon_sub_w_arg = sub ($arg) { 1 + $arg }; my $anon_sub_w_arg = sub ($arg) { 1 + $arg };
isa_ok($anon_sub_w_arg, 'Sub'); #?rakudo todo 'type Sub for subs'
isa_ok($anon_sub_w_arg, Sub);
is($anon_sub_w_arg(3), 4, 'sub ($arg) {} works'); is($anon_sub_w_arg(3), 4, 'sub ($arg) {} works');
# L<S06/"Blocks"> # L<S06/"Blocks">
# anon blocks # anon blocks
my $anon_block = { 1 }; my $anon_block = { 1 };
isa_ok($anon_block, 'Block'); #?rakudo todo 'type Block for blocks'
isa_ok($anon_block, Block);
is($anon_block(), 1, '{} <anon block> works'); is($anon_block(), 1, '{} <anon block> works');
# L<S06/""Pointy blocks""> # L<S06/""Pointy blocks"">
# pointy subs #?rakudo skip "parse failure: pointy block as an expression"
my $pointy_block = -> { 1 }; {
isa_ok($pointy_block, 'Block'); # pointy subs
is($pointy_block(), 1, '-> {} <"pointy" block> works'); my $pointy_block = -> { 1 };
isa_ok($pointy_block, 'Block');
my $pointy_block_w_arg = -> $arg { 1 + $arg }; is($pointy_block(), 1, '-> {} <"pointy" block> works');
isa_ok($pointy_block_w_arg, 'Block');
is($pointy_block_w_arg(3), 4, '-> $arg {} <"pointy" block w/args> works'); my $pointy_block_w_arg = -> $arg { 1 + $arg };
isa_ok($pointy_block_w_arg, 'Block');
my $pointy_block_w_multiple_args = -> $arg1, $arg2 { $arg1 + $arg2 }; is($pointy_block_w_arg(3), 4, '-> $arg {} <"pointy" block w/args> works');
isa_ok($pointy_block_w_multiple_args, 'Block');
is($pointy_block_w_multiple_args(3, 4), 7, '-> $arg1, $arg2 {} <"pointy" block w/multiple args> works'); my $pointy_block_w_multiple_args = -> $arg1, $arg2 { $arg1 + $arg2 };
isa_ok($pointy_block_w_multiple_args, 'Block');
my $pointy_block_nested = -> $a { -> $b { $a + $b }}; is($pointy_block_w_multiple_args(3, 4), 7, '-> $arg1, $arg2 {} <"pointy" block w/multiple args> works');
isa_ok($pointy_block_nested, Block);
isa_ok($pointy_block_nested(5), Block); my $pointy_block_nested = -> $a { -> $b { $a + $b }};
is $pointy_block_nested(5)(6), 11, '-> $a { -> $b { $a+$b }} nested <"pointy" block> works'; isa_ok($pointy_block_nested, Block);
isa_ok($pointy_block_nested(5), Block);
is $pointy_block_nested(5)(6), 11, '-> $a { -> $b { $a+$b }} nested <"pointy" block> works';
}
# L<S06/"Blocks"> # L<S06/"Blocks">
# bare blocks # bare blocks
@@ -62,30 +68,37 @@ my $foo2;
{$foo2 = "blah"}; {$foo2 = "blah"};
is($foo2, "blah", "lone block w/out a semicolon actually executes it's content"); is($foo2, "blah", "lone block w/out a semicolon actually executes it's content");
# XXX if this test is correct, it certainly needs a smartlink
my $foo3; my $foo3;
({$foo3 = "blah"}); ({$foo3 = "blah"});
ok(!defined($foo3), "block enclosed by parentheses should not auto-execute (1)", :todo<bug>); #?pugs eval "bug"
#?rakudo todo "unknown"
ok(!defined($foo3), "block enclosed by parentheses should not auto-execute (1)", );
my $foo4; my $foo4;
({$foo4 = "blah"},); ({$foo4 = "blah"},);
ok(!defined($foo4), "block enclosed by parentheses should not auto-execute (2)"); ok(!defined($foo4), "block enclosed by parentheses should not auto-execute (2)");
my ($one, $two); my $one;
my $two;
# The try's here because it should die: $foo{...} should only work if $foo isa # The try's here because it should die: $foo{...} should only work if $foo isa
# Hash (or sth. which provides appropriate tieing/&postcircumfix:<{ # Hash (or sth. which provides appropriate tieing/&postcircumfix:<{
# }>/whatever, but a Code should surely not support hash access). # }>/whatever, but a Code should surely not support hash access).
# Additionally, a smart compiler will detect thus errors at compile-time, so I # Additionally, a smart compiler will detect thus errors at compile-time, so I
# added an eval(). --iblech # added an eval(). --iblech
try { eval '0,{$one = 1}{$two = 2}' }; try { eval '0,{$one = 1}{$two = 2}' };
is($one, undef, 'two blocks ({} {}) no semicolon after either,.. first block does not execute'); is($one, undef, 'two blocks ({} {}) no semicolon after either,.. first block does not execute');
#?rakudo todo 'blocks as subscripts (?)'
is($two, 2, '... but second block does (parsed as hash subscript)'); is($two, 2, '... but second block does (parsed as hash subscript)');
my ($one_a, $two_a); my $one_a;
my $two_a;
{$one_a = 1}; {$two_a = 2} {$one_a = 1}; {$two_a = 2}
is($one_a, 1, '... two blocks ({}; {}) semicolon after the first only,.. first block does execute'); is($one_a, 1, '... two blocks ({}; {}) semicolon after the first only,.. first block does execute');
is($two_a, 2, '... and second block does too'); is($two_a, 2, '... and second block does too');
my ($one_b, $two_b); my $one_b;
my $two_b;
{ {
$one_b = 1 $one_b = 1
} }
@@ -95,13 +108,15 @@ my ($one_b, $two_b);
is($one_b, 1, '... two stand-alone blocks ({\n...\n}\n{\n...\n}),.. first block does execute'); is($one_b, 1, '... two stand-alone blocks ({\n...\n}\n{\n...\n}),.. first block does execute');
is($two_b, 2, '... and second block does too'); is($two_b, 2, '... and second block does too');
my ($one_c, $two_c); my $one_c;
my $two_c;
{$one_c = 1}; {$two_c = 2}; {$one_c = 1}; {$two_c = 2};
is($one_c, 1, '... two blocks ({}; {};) semicolon after both,.. first block does execute'); is($one_c, 1, '... two blocks ({}; {};) semicolon after both,.. first block does execute');
is($two_c, 2, '... and second block does too'); is($two_c, 2, '... and second block does too');
sub f { { 3 } } sub f { { 3 } }
is(f(), 3, 'bare blocks immediately runs even as the last statement'); is(f(), 3, 'bare blocks immediately runs even as the last statement');
#?rakudo 4 skip 'calling postcircumfix:<()> with a dot'
is((sub { { 3 } }).(), 3, 'ditto for anonymous subs'); is((sub { { 3 } }).(), 3, 'ditto for anonymous subs');
is((sub { { { 3 } } }).(), 3, 'ditto, even if nested'); is((sub { { { 3 } } }).(), 3, 'ditto, even if nested');
dies_ok({(sub { { $^x } }).()}, 'implicit params become errors'); dies_ok({(sub { { $^x } }).()}, 'implicit params become errors');
@@ -7,21 +7,22 @@ plan 4;
my $here; my $here;
#?rakudo skip 'defining operators'
{ {
my @a; my @a;
$here = 0; $here = 0;
multi infix:<..> ( Int $a, Int $b ) { $here++ } multi infix:<..> ( Int $a, Int $b ) { $here++ }
@a = 1..2; @a = 1..2;
is $here, 1, "range operator was redefined";
} }
is $here, 1, "range operator was redefined";
{ {
my @a; my @a;
$here = 0; $here = 0;
multi push ( Array @a, *@data ) { $here++ } multi push ( Array @a, *@data ) { $here++ }
push @a, 2; push @a, 2;
is $here, 1, "push operator was redefined";
} }
is $here, 1, "push operator was redefined";
{ {
my @a; my @a;
@@ -4,25 +4,27 @@ use Test;
plan 7; plan 7;
#?rakudo skip 'Undef to integer'
{ {
# L<S09/Autovivification/In Perl 6 these read-only operations are indeed non-destructive:> # L<S09/Autovivification/In Perl 6 these read-only operations are indeed non-destructive:>
my %a; my %a;
my $b = %a<b><c>; my $b = %a<b><c>;
is %a.keys.elems, 0, 'fetching doesn't autovivify.'; is %a.keys.elems, 0, "fetching doesn't autovivify.";
} }
#?rakudo skip 'Undef to integer'
{ {
# L<S09/Autovivification/In Perl 6 these read-only operations are indeed non-destructive:> # L<S09/Autovivification/In Perl 6 these read-only operations are indeed non-destructive:>
my %a; my %a;
my $b = exists %a<b><c>; my $b = exists %a<b><c>;
is %a.keys.elems, 0, 'exists doesn't autovivify.'; is %a.keys.elems, 0, "exists doesn't autovivify.";
} }
{ {
# L<S09/Autovivification/But these bindings do autovivify:> # L<S09/Autovivification/But these bindings do autovivify:>
my %a; my %a;
bar(%a<b><c>); bar(%a<b><c>);
is %a.keys.elems, 0, 'in ro arguments doesn't autovivify.'; is %a.keys.elems, 0, "in ro arguments doesn't autovivify.";
} }
{ {
@@ -32,6 +34,7 @@ plan 7;
is %a.keys.elems, 1, 'binding autovivifies.'; is %a.keys.elems, 1, 'binding autovivifies.';
} }
#?rakudo skip 'prefix:<\\>'
{ {
# L<S09/Autovivification/But these bindings do autovivify:> # L<S09/Autovivification/But these bindings do autovivify:>
my %a; my %a;
@@ -9,6 +9,7 @@ plan 34;
is(@array.elems, 5, 'array has 5 elements'); is(@array.elems, 5, 'array has 5 elements');
is(@array[0], 11, 'first value is 11'); is(@array[0], 11, 'first value is 11');
#?rakudo skip "whatever star"
is(@array[*-1], 15, 'last value is 15'); is(@array[*-1], 15, 'last value is 15');
# 3[0] etc. should *not* work, but (3,)[0] should. # 3[0] etc. should *not* work, but (3,)[0] should.
# That's similar as with the .kv issue we've had: 3.kv should fail, but # That's similar as with the .kv issue we've had: 3.kv should fail, but
@@ -21,6 +22,8 @@ plan 34;
is(@array[0].elems, 5, 'arrayref has 5 elements'); is(@array[0].elems, 5, 'arrayref has 5 elements');
is(@array[0][0], 11, 'first element in arrayref is 11'); is(@array[0][0], 11, 'first element in arrayref is 11');
#?rakudo skip "whatever star"
is(@array[0][*-1], 15, 'last element in arrayref is 15'); is(@array[0][*-1], 15, 'last element in arrayref is 15');
} }
@@ -30,8 +33,10 @@ plan 34;
is(@array[0].elems, 5, 'first arrayref has 5 elements'); is(@array[0].elems, 5, 'first arrayref has 5 elements');
is(@array[1].elems, 5, 'second arrayref has 5 elements'); is(@array[1].elems, 5, 'second arrayref has 5 elements');
is(@array[0][0], 11, 'first element in first arrayref is 11'); is(@array[0][0], 11, 'first element in first arrayref is 11');
#?rakudo skip "whatever star"
is(@array[0][*-1], 15, 'last element in first arrayref is 15'); is(@array[0][*-1], 15, 'last element in first arrayref is 15');
is(@array[1][0], 21, 'first element in second arrayref is 21'); is(@array[1][0], 21, 'first element in second arrayref is 21');
#?rakudo 3 skip "whatever star"
is(@array[1][*-1], 25, 'last element in second arrayref is 25'); is(@array[1][*-1], 25, 'last element in second arrayref is 25');
is(@array[*-1][0], 31, 'first element in last arrayref is 31'); is(@array[*-1][0], 31, 'first element in last arrayref is 31');
is(@array[*-1][*-1], 35, 'last element in last arrayref is 35'); is(@array[*-1][*-1], 35, 'last element in last arrayref is 35');
@@ -42,7 +47,9 @@ plan 34;
is(%hash<k1>.elems, 5, 'k1 has 5 elements'); is(%hash<k1>.elems, 5, 'k1 has 5 elements');
is(%hash<k1>[0], 11, 'first element in k1 is 11'); is(%hash<k1>[0], 11, 'first element in k1 is 11');
#?rakudo skip "whatever star"
is(%hash<k1>[*-1], 15, 'last element in k1 is 15'); is(%hash<k1>[*-1], 15, 'last element in k1 is 15');
#?rakudo skip "Can't compare to undef (?)"
is(%hash<12>, undef, 'nothing at key "12"'); is(%hash<12>, undef, 'nothing at key "12"');
} }
@@ -52,13 +59,16 @@ plan 34;
is(%hash<k1>.elems, 5, 'k1 has 5 elements'); is(%hash<k1>.elems, 5, 'k1 has 5 elements');
is(%hash<k2>.elems, 5, 'k2 has 5 elements'); is(%hash<k2>.elems, 5, 'k2 has 5 elements');
is(%hash<k1>[0], 11, 'first element in k1 is 11'); is(%hash<k1>[0], 11, 'first element in k1 is 11');
#?rakudo skip "whatever star"
is(%hash<k1>[*-1], 15, 'last element in k1 is 15'); is(%hash<k1>[*-1], 15, 'last element in k1 is 15');
is(%hash<k2>[0], 21, 'first element in k1 is 21'); is(%hash<k2>[0], 21, 'first element in k1 is 21');
#?rakudo skip "whatever star"
is(%hash<k2>[*-1], 25, 'last element in k1 is 25'); is(%hash<k2>[*-1], 25, 'last element in k1 is 25');
is(%hash<12>, undef, 'nothing at key "12"'); is(%hash<12>, undef, 'nothing at key "12"');
is(%hash<22>, undef, 'nothing at key "22"'); is(%hash<22>, undef, 'nothing at key "22"');
} }
#?rakudo skip "prefix:<\\>"
{ {
my @a; my @a;
push @a, 1; push @a, 1;

0 comments on commit 63c4f60

Please sign in to comment.