Permalink
Browse files

[t/spec]

 * caps.t: update to current spec; tests for .chunks
 * S05-mass/rx.t: change infix:<also> to && in some places
 * a complete pass through the rakudo skip's, improving tests
   and finer graded fudging
Overall +221 passing tests


git-svn-id: http://svn.pugscode.org/pugs@26020 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 6cf8c9a commit 734bc95bdfa081fed82d7c8f7de135509da41005 moritz committed Mar 29, 2009
@@ -11,7 +11,7 @@ This covers anonymous blocks and subs, as well as pointy blocks
=end description
-plan 32;
+plan 31;
# L<S04/"The Relationship of Blocks and Declarations">
# L<S06/"Anonymous subroutines">
@@ -62,13 +62,6 @@ my $foo2;
{$foo2 = "blah"};
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;
-({$foo3 = "blah"});
-#?pugs eval "bug"
-#?rakudo todo "unknown"
-ok(!defined($foo3), "block enclosed by parentheses should not auto-execute (1)", );
-
my $foo4;
({$foo4 = "blah"},);
ok(!defined($foo4), "block enclosed by parentheses should not auto-execute (2)");
@@ -127,8 +127,7 @@ is($key, 1, '%hash.kv gave us our key');
is($val, 2, '%hash.kv gave us our val');
%hash9{2} = 3;
-#?rakudo 1 skip "rx:Perl5// not implemented"
-like(~%hash9, rx:Perl5/1\s+2\s+2\s+3/, "hash can stringify");
+ok(~%hash9 ~~ m{^(1\t2\s+2\t3|2\t3\s+1\t2)\s*$}, "hash can stringify");
my %hash10 = <1 2>;
is(%hash10<1>, 2, "assignment of pointy qw to hash");
@@ -158,14 +157,13 @@ test2 %h;
# the bias-to-the-right behaviour, consistent with Perl 5.
#
#?DOES 4
-#?rakudo skip "hash contextualizer unimplemented"
-{
+
my %dupl = (a => 1, b => 2, a => 3);
is %dupl<a>, 3, "hash creation with duplicate keys works correctly";
# Moved from t/xx-uncategorized/hashes-segfault.t
# Caused some versions of pugs to segfault
-my %hash = %(zip('a'..'d';1..4));
+my %hash = %('a'..'d' Z 1..4);
my $i = %hash.elems; # segfaults
is $i, 4, "%hash.elems works";
@@ -175,4 +173,3 @@ is $i, 4, "for %hash works";
eval ' @%(a => <b>)<a> ';
ok( $!, "doesn't really make sense, but shouldn't segfault, either ($!)");
-}
@@ -25,13 +25,13 @@ is($pair.value, 'bar', 'got the right $pair.value');
my @pair1a = kv($pair);
is(+@pair1a, 2, 'got the right number of elements in the list');
-#?rakudo 2 skip 'kv() ambiguity'
+#?rakudo 2 todo 'kv() ambiguity'
is(@pair1a[0], 'foo', 'got the right key');
is(@pair1a[1], 'bar', 'got the right value');
my @pair1b = kv $pair;
is(+@pair1b, 2, 'got the right number of elements in the list');
-#?rakudo 2 skip 'kv() ambiguity'
+#?rakudo 2 todo 'kv() ambiguity'
is(@pair1b[0], 'foo', 'got the right key');
is(@pair1b[1], 'bar', 'got the right value');
@@ -82,21 +82,18 @@ is($quux.key, 'quux', "lhs quotes" );
{
# L<S02/Immutable types/A single key-to-value association>
my $pair = :when<now>;
- #?rakudo 2 skip "parse failure"
- is ~(%$pair), "when\tnow";
+ is ~(%($pair)), "when\tnow\n", 'hash stringification';
# hold back this one according to audreyt
#ok $pair.does(Hash), 'Pair does Hash';
- # XXX is this test right? Doesn't %$stuff just imply role Associative?
#?pugs TODO "bug"
- ok (%$pair).does(Hash), '%() makes Pair to does Hash';
+ ok (%($pair) ~~ Hash), '%() makes creates a real Hash';
}
# illustrate a bug
-#?rakudo skip "parse failure"
{
my $var = 'foo' => 'bar';
- sub test1 (Any|Pair $pair) {
+ sub test1 (Pair $pair) {
isa_ok($pair,Pair);
my $testpair = $pair;
isa_ok($testpair,Pair); # new lvalue variable is also a Pair
@@ -301,7 +298,7 @@ L<"http://www.nntp.perl.org/group/perl.perl6.language/20122">
## These tests really belong in a different test file -- probably
## something in S06. --pmichaud
# L<S06/Named arguments/In other words :$when is shorthand for :when($when)>
-#?rakudo skip ':$arg not implemented'
+#?rakudo skip 'infix:<eqv>'
{
my $item = 'bar';
my $pair = (:$item);
@@ -314,7 +311,10 @@ L<"http://www.nntp.perl.org/group/perl.perl6.language/20122">
my %hash = foo => 'bar', baz => 'qux';
$pair = (:%hash);
ok($pair eqv (hash => %hash), ':%foo syntax works');
+}
+#?rakudo skip "Scope not found for PAST::Var '&code'"
+{
my sub code {return 42}
$pair = (:&code);
ok($pair eqv (code => &code), ':&foo syntax works');
@@ -75,10 +75,10 @@ is(qq{a{chr 98}c}, 'abc', "curly brace delimiters don't interfere with closure i
# Quoting constructs
# The next test will always succeed, but if there's a bug it probably
# won't compile.
-#?rakudo 6 skip 'Q quoting'
is(Q"abc\\d\\'\/", Q"abc\\d\\'\/", "raw quotation works");
is(q"abc\\d\"\'\/", Q|abc\d"\'\/|, "single quotation works"); #"
is(qq"abc\\d\"\'\/", Q|abc\d"'/|, "double quotation works"); #"
+#?rakudo 3 skip 'qa qb and array/hash interpolation'
is(qa"$world @list[] %hash{}", Q"$world 1 2 %hash{}", "only interpolate array");
is(qb"$world \\\"\n\t", "\$world \\\"\n\t", "only interpolate backslash");
is('$world \qq[@list[]] %hash{}', '$world 1 2 %hash{}', "interpolate quoting constructs in ''");
View
@@ -28,11 +28,12 @@ Note that non-ASCII tests are kept in quoting-unicode.t
is $s, ' foo bar ', 'string using q{}';
}
-#?rakudo skip 'Quoting with q{{ ... }}'
{
+ #?rakudo skip 'nested curlies in q{...}'
is q{ { foo } }, ' { foo } ', 'Can nest curlies in q{ .. }';
is q{{ab}}, 'ab', 'Unnested single curlies in q{{...}}';
is q{{ fo} }}, ' fo} ', 'Unnested single curlies in q{{...}}';
+ #?rakudo skip 'nested double curlies in q{{...}}'
is q{{ {{ } }} }}, ' {{ } }} ', 'Can nest double curlies in q{{...}}';
}
@@ -350,10 +351,10 @@ FOO
is(@q[0].perl, (p => "moose").perl, ":pair<anglequoted>", :todo<bug>);
};
-#?rakudo skip 'escape sequences'
{ # weird char escape sequences
is("\c97", "a", '\c97 is "a"');
is("\c102oo", "foo", '\c102 is "f", works next to other letters');
+ #?rakudo skip '\c123'
is("\c123", chr 123, '"\cXXX" and chr XXX are equivalent');
is("\c[12]3", chr(12) ~ "3", '\c[12]3 is the same as chr(12) concatenated with "3"');
is("\c[12] 3", chr(12) ~ " 3", 'respects spaces when interpolating a space character');
@@ -362,6 +363,7 @@ FOO
is("\x41", "A", 'hex interpolation - \x41 is "A"');
is("\o101", "A", 'octal interpolation - \o101 is also "A"' );
+ #?rakudo 3 skip '\c$char'
is("\c@", "\0", 'Unicode code point "@" converts correctly to "\0"');
is("\cA", chr 1, 'Unicode "A" is #1!');
is("\cZ", chr 26, 'Unicode "Z" is chr 26 (or \c26)');
@@ -13,14 +13,14 @@ is(4\#(quux).sqrt, 2, 'unspace with comments');
is("x"\ .chars, 1, 'unspace with strings');
is("x"\ .chars(), 1, 'unspace with strings + parens');
-#?rakudo todo 'lexicals in eval'
+#?rakudo skip 'unspace with postfix operators'
{
my $foo = 4;
-is(eval('$foo.++'), 4, '(short) unspace with postfix inc');
+is($foo.++, 4, '(short) unspace with postfix inc');
is($foo, 5, '(short) unspace with postfix inc really postfix');
-is(eval('$foo\ .++'), 5, 'unspace with postfix inc');
+is($foo\ .++, 5, 'unspace with postfix inc');
is($foo, 6, 'unspace with postfix inc really postfix');
-is(eval('$foo\ .--'), 6, 'unspace with postfix dec');
+is($foo\ .--, 6, 'unspace with postfix dec');
is($foo, 5, 'unspace with postfix dec really postfix');
}
View
@@ -6,7 +6,7 @@ use Test;
# V
# L<S03/Changes to Perl 5 operators/list assignment operator now parses on the right>
-plan 317;
+plan 318;
# tests various assignment styles
@@ -240,6 +240,10 @@ my @p;
is(WHAT %hash<foo>, 'Hash', "Verify //= autovivifies correctly");
%hash<bar> //= [];
is(WHAT %hash<bar>, 'Array', "Verify //= autovivifies correctly");
+
+ my $f //= 5;
+ #?rakudo todo '//= in declaration'
+ is $f, 5, '//= also works in declaration';
}
{
@@ -77,8 +77,8 @@ isa_ok($bool, Bool, 'it is a Bool type');
my $pair = ("foo" => "bar");
isa_ok($pair, Pair, 'it is a Pair type');
-#?rakudo skip 'rx/.../'
{
my $rule = rx/^hello\sworld$/;
+ #?rakudo todo 'type Regex'
isa_ok($rule, Regex, 'it is a Regex type');
}
@@ -86,11 +86,13 @@ ok(?(!(1 & 2 ^ 4) != 3), "blah blah blah");
ok(!($b != 3), "1 is ne 3, and (2 | 3) is both ne 3 and eq 3, so it's ne, so 1 ^ 2 | 3");
};
-#?rakudo skip "Junction autothreading"
+#?rakudo skip 'autothreading over abs()'
{
my $a = (abs -1 ^ -1); # read as abs(-1 ^ -1) -> (1^1)
ok(!($a == 1), 'junctive or binds more tightly then abs (1)');
+}
+{
my $b = ((abs -1) ^ -1); # -> (1 ^ -1)
ok($b == 1, "this is true because only one is == 1");
};
View
@@ -2,7 +2,7 @@ use v6;
use Test;
-plan 103;
+plan 101;
=begin kwid
@@ -256,23 +256,6 @@ caught that case.
=end begin Explanation
-#?rakudo skip 'pointy blocks'
-{
- #L<S09/"Junctions">
- my @x = 1..20;
- my $code = -> $x { $x % 2 };
- my @result;
- my $parsed = 0;
- try {
- @result = any(@x) ~~ $code;
- $parsed = 1;
- };
- ok $parsed, 'C<my @result = any(@x) ~~ $code> parses';
- my @expected_result = grep $code, @x;
- ok @result ~~ @expected_result,
- 'C<any(@x) ~~ {...}> works like C<grep>', :todo<feature>;
-}
-
{
my $result = 0;
my $parsed = 0;
@@ -1,6 +1,6 @@
use v6;
use Test;
-plan 16;
+plan 18;
# L<S04/The Relationship of Blocks and Declarations/"A bare closure without
# placeholder arguments that uses $_">
@@ -28,19 +28,22 @@ plan 16;
is({ 42 }.(), 42, 'no implicit $_ usage checking');
is({ 42 }.('Goodbye'), 42, '$_ gets assigned but isn\'t used');
- #?rakudo 2 todo 'arity of blocks with $_'
- is(({ $_ }.arity), 1, '{$_} is arity 1, of course');
- is(({ .say }.arity), 1, 'Blocks that uses $_ implicitly have arity 1');
+ is(({ $_ }.arity), 0, '{$_} is arity 0, of course');
+ is(({ .say }.arity), 0, 'Blocks that uses $_ implicitly have arity 0');
+ is(({ $_ }.count), 1, '{$_} is count 1');
+ is(({ .say }.count), 1, 'Blocks that uses $_ implicitly have count 1');
}
-#?rakudo skip 'pointy blocks'
{
- dies_ok(sub () { -> { "Boo!" }.(42) }, '-> {} is arity 0', :todo<feature>);
- dies_ok(sub () { -> { $_ }.(42) }, 'Even when we use $_', :todo<feature>);
+ #?pugs 4 todo 'pointy blocks'
+ #?rakudo 4 todo 'pointy blocks and $_'
+ $_ = 'Ack';
+ dies_ok({ (-> { "Boo!" }).(42) }, '-> {} is arity 0');
+ dies_ok({ (-> { $_ }).(42) }, 'Even when we use $_>');
- is(try { $_ = "Ack"; -> { $_ }.() }, 'Ack!', '$_ is lexical here', :todo<feature>);
- is(-> $a { $_ }.(42), 'Ack!', 'Even with parameters (?)', :todo<feature>);
- is(-> $_ { $_ }.(42), 42, 'But not when the parameter is $_');
+ is((-> { $_ }).(), 'Ack!', '$_ is lexical here');
+ is(-> $a { $_ }.(42), 'Ack!', 'Even with parameters (?)');
+ is(-> $_ { $_ }.(42), 42, 'But not when the parameter is $_');
eval_dies_ok( 'sub () { -> { $^a }.() }', 'Placeholders not allowed in ->');
View
@@ -225,44 +225,34 @@ my @elems = <a b c d e>;
}
# .key //= ++$i for @array1;
-#?rakudo skip 'implicit invocant'
+class TestClass{ has $.key is rw };
+
+#?rakudo todo '//='
{
- class TestClass is rw { has $.key; };
- my @array1 = (TestClass.new(),TestClass.new(:key<2>));
- my @array2 = (TestClass.new(:key<1>),TestClass.new(:key<3>));
+ my @array1 = (TestClass.new(:key<1>),TestClass.new());
my $i = 0;
- try { .key //= ++$i for @array1 };
- my $sum1 = @array1.map:{ $_.key };
- my $sum2 = @array2.map:{ $_.key };
- is( $sum1, $sum2, '.key //= ++$i for @array1;', :todo<bug>);
+ my $sum1 = [+] @array1.map: { $_.key };
+ is( $sum1, 2, '.key //= ++$i for @array1;', :todo<bug>);
}
# .key = 1 for @array1;
-#?rakudo skip 'implicit invocant'
{
- class TestClass is rw { has $.key; };
my @array1 = (TestClass.new(),TestClass.new(:key<2>));
- my @array2 = (TestClass.new(:key<1>),TestClass.new(:key<1>));
- try { .key = 1 for @array1 };
- my $sum1 = @array1.map:{ $_.key };
- my $sum2 = @array2.map:{ $_.key };
- is($sum1, $sum2, '.key = 1 for @array1;');
+ .key = 1 for @array1;
+ my $sum1 = [+] @array1.map: { $_.key };
+ is($sum1, 2, '.key = 1 for @array1;');
}
# $_.key = 1 for @array1;
-#?rakudo skip 'parsefail'
{
- class TestClass is rw { has $.key; };
my @array1 = (TestClass.new(),TestClass.new(:key<2>));
- my @array2 = (TestClass.new(:key<1>),TestClass.new(:key<1>));
$_.key = 1 for @array1;
- my $sum1 = @array1.map: { $_.key };
- my $sum2 = @array2.map: { $_.key };
- is( $sum1, $sum2, '$_.key = 1 for @array1;');
+ my $sum1 = [+] @array1.map: { $_.key };
+ is( $sum1, 2, '$_.key = 1 for @array1;');
}
@@ -422,7 +412,7 @@ eval_dies_ok('for(0..5) { }','keyword needs at least one whitespace after it');
is $c, 6, 'for loop ends in time using last';
}
-#?rakudo skip 'infinite for loop'
+#?rakudo skip 'lazy lists (loops)'
{
my $c;
for 1..* {
@@ -432,7 +422,7 @@ eval_dies_ok('for(0..5) { }','keyword needs at least one whitespace after it');
is $c, 6, 'infinte for loop ends in time using last';
}
-#?rakudo skip 'infinite for loop'
+#?rakudo skip 'lazy lists (loops)'
{
my $c;
for 1..Inf {
View
@@ -2,7 +2,7 @@ use v6;
use Test;
-plan 48;
+plan 47;
=begin pod
@@ -258,14 +258,12 @@ is(@got.join(","), "false,true", 'given { when .true { } }');
}
# given + n>1-arg closure (should fail)
-#?rakudo skip 'parsefail (-> $var {block})'
{
dies_ok {
given 41 {
when (-> $t, $r { $t == $r }) { ... }
}
}, 'fail on arities > 1';
- is $!, 'Unexpected arity in smart match: 2', '...with useful error message';
}
# given + 0-arg sub
Oops, something went wrong.

0 comments on commit 734bc95

Please sign in to comment.