Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[t/spec]

 * wrote tests for multis with multiple signatures
 * corrected redo.t
 * some unfudges
 * fixed slurpy-params-2.t to use [+] @a instead of @a.sum


git-svn-id: http://svn.pugscode.org/pugs@24939 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
commit 1af085ab1a243aeeac7a2a398fa81498610b2ca6 1 parent ecb0510
moritz authored
View
16 S04-statements/redo.t
@@ -83,12 +83,18 @@ plan 10;
my $stopping = 100;
my $sum = 0;
for 1..10 -> $i is copy {
- $sum += $i;
- $i -= 1;
- last if !$stopping--;
- if $i > 0 { redo }
+ $sum += $i;
+ $i -= 1;
+ last if !$stopping--;
+ if $i > 0 {
+ redo
+ }
}
- is($sum, 220, "testRedoWithFor", :todo<bug>);
+ say $sum;
+ # pugs, rakudo and perl5 independently agree that this should be
+ # 201, not 220 as the ruby example says.
+ # that's because the ruby example doesn't have the 'is copy' trait.
+ is($sum, 201, "testRedoWithFor");
$stopping = 100;
$sum = 0;
View
12 S05-grammar/inheritance.t
@@ -11,17 +11,18 @@ grammar Grammar::Foo {
token foo { 'foo' };
};
-is('foo' ~~ /^<Grammar::Foo::foo>$/, 'foo', 'got right match');
+is(~('foo' ~~ /^<Grammar::Foo::foo>$/), 'foo', 'got right match (foo)');
grammar Grammar::Bar is Grammar::Foo {
token bar { 'bar' };
token any { <foo> | <bar> };
};
-is(~('bar' ~~ /^<Grammar::Bar::bar>$/), 'bar', 'got right match');
-is(~('foo' ~~ /^<Grammar::Bar::foo>$/), 'foo', 'got right match');
-is(~('foo' ~~ /^<Grammar::Bar::any>$/), 'foo', 'got right match');
-is(~('bar' ~~ /^<Grammar::Bar::any>$/), 'bar', 'got right match');
+is(~('bar' ~~ /^<Grammar::Bar::bar>$/), 'bar', 'got right match (bar)');
+#?rakudo skip 'directly calling inherited grammar rule'
+is(~('foo' ~~ /^<Grammar::Bar::foo>$/), 'foo', 'got right match (foo)');
+is(~('foo' ~~ /^<Grammar::Bar::any>$/), 'foo', 'got right match (any)');
+is(~('bar' ~~ /^<Grammar::Bar::any>$/), 'bar', 'got right match (any)');
grammar Grammar::Baz is Grammar::Bar {
token baz { 'baz' };
@@ -29,6 +30,7 @@ grammar Grammar::Baz is Grammar::Bar {
};
is(~('baz' ~~ /^<Grammar::Baz::baz>$/), 'baz', 'got right match');
+#?rakudo 2 skip 'calling inherited grammar rule'
is(~('foo' ~~ /^<Grammar::Baz::foo>$/), 'foo', 'got right match');
is(~('bar' ~~ /^<Grammar::Baz::bar>$/), 'bar', 'got right match');
is(~('foo' ~~ /^<Grammar::Baz::any>$/), 'foo', 'got right match');
View
59 S06-signature/multiple-signatures.t
@@ -0,0 +1,59 @@
+use v6;
+use Test;
+
+# this tests signatures, so the file lives in S06-signature/, although
+# the features are (mostly?) described in S13
+
+plan 11;
+
+# L<S13/Syntax/"Perl allows you to declare multiple signatures for a
+# given body">
+
+# normal subs
+{
+ multi sub si (Str $s, Int $i)
+ | (Int $i, Str $s) {
+ die "dispatch went wrong" unless $s ~~ Str && $i ~~ Int;
+ "s:$s i:$i";
+ }
+ is si("a", 3), "s:a i:3", 'sub with two sigs dispatches correctly (1)';
+ is si(3, "b"), "s:b i:3", 'sub with two sigs dispatches correctly (2)';
+}
+
+# try it with three sigs as well, and mixed named/positionals
+{
+ multi sub three (Str $s, Int $i, Num :$n)
+ | (Int $i, Str :$s, Num :$n)
+ | (Num :$s, Int :$i, Str :$n) {
+ "$s $i $n";
+ }
+ is three('abc', 3, :n(2.3)), 'abc 3 2.3', 'multi dispatch on three() (1)';
+ is three(4, :s<x>, :n(2.3)), 'x 4 2.3', 'multi dispatch on three() (2)';
+ is three(:i(4), :s(0.2), :n('f')), '0.2 4 f', 'multi dispatch on three() (3)';
+}
+
+# L<S13/Syntax/"except that there really is only one body">
+
+{
+ multi sub count (Str $s, Int $i)
+ | (Int $i, Str $s) {
+ state $x = 0;
+ ++$x;
+ }
+ is count("a", 3), 1, 'initialization of state var in multi with two sigs';
+ is count("a", 2), 2, 'state var works';
+ is count(2, 'a'), 3, '... and there is only one';
+}
+
+# L<S13/Syntax/"must all bind the same set of formal variable names">
+
+{
+ eval_dies_ok q[ multi sub x ($x, $y) | ($x, $y, $z) { 1 }],
+ 'multis with multiple sigs must have the same set of formal variables';
+ eval_dies_ok q[ multi sub x ($x, $y) | ($x, @y) { 1 }],
+ 'multis with multiple sigs must have the same set of formal variables';
+}
+
+# common sense
+eval_dies_ok q[ only sub y (Int $x, Str $y) | (Str $x, Int $y) ],
+ 'and "only" sub can not have multiple signatures';
View
11 S06-signature/slurpy-params-2.t
@@ -23,7 +23,7 @@ plan 26;
my sub foo($n, *%h, *@a) { };
my sub foo1($n, *%h, *@a) { $n }
my sub foo2($n, *%h, *@a) { %h<x> + %h<y> + %h<n> }
-my sub foo3($n, *%h, *@a) { @a.sum }
+my sub foo3($n, *%h, *@a) { [+] @a }
## all pairs will be slurped into hash, except the key which has the same name
## as positional parameter
@@ -37,8 +37,10 @@ is (foo2 1, x => 20, y => 300, 4000), 320,
is (foo3 1, x => 20, y => 300, 4000), 4000,
'Testing the value for slurpy *@a';
+# XXX should this really die?
+#?rakudo todo 'positional params can be accessed as named ones'
dies_ok { foo 1, n => 20, y => 300, 4000 },
- 'Testing: `sub foo($n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`', :todo<bug>;
+ 'Testing: `sub foo($n, *%h, *@a){ }; foo 1, n => 20, y => 300, 4000`';
## We *can* pass positional arguments as a 'named' pair with slurpy *%h.
## Only *remaining* pairs are slurped into the *%h
@@ -46,6 +48,7 @@ dies_ok { foo 1, n => 20, y => 300, 4000 },
diag('Testing without positional arguments');
lives_ok { foo n => 20, y => 300, 4000 },
'Testing: `sub foo($n, *%h, *@a){ }; foo n => 20, y => 300, 4000`';
+#?rakudo 5 todo 'positional params can be passed as named ones'
is (foo1 n => 20, y => 300, 4000), 20,
'Testing the value for positional';
is (foo2 n => 20, y => 300, 4000), 300,
@@ -76,7 +79,7 @@ dies_ok { foo 1, x => 20, y => 300, 4000 },
my sub foo(:$n, *%h, *@a) { };
my sub foo1(:$n, *%h, *@a) { $n };
my sub foo2(:$n, *%h, *@a) { %h<x> + %h<y> + %h<n> };
-my sub foo3(:$n, *%h, *@a) { return @a.sum };
+my sub foo3(:$n, *%h, *@a) { [+] @a };
diag("Testing with named arguments (named param isn't required)");
lives_ok { foo 1, x => 20, y => 300, 4000 },
@@ -136,7 +139,7 @@ L<<S06/List parameters/Slurpy scalar parameters capture what would otherwise be
sub first(*$f, *$s, *@r){ return $f };
sub second(*$f, *$s, *@r){ return $s };
-sub rest(*$f, *$s, *@r){ return @r.sum };
+sub rest(*$f, *$s, *@r){ return [+] @r };
diag 'Testing with slurpy scalar';
is first(1, 2, 3, 4, 5), 1,
'Testing the first slurpy scalar...';
View
28 S06-traits/slurpy-is-rw.t
@@ -2,38 +2,18 @@ use v6;
use Test;
-=begin description
-
-Splatted parameters shouldn't be rw even if stated as such
-
-=end description
-
-plan 3;
+plan 2;
# test splatted parameter for rw ability
# L<S06/"Subroutine traits"/"is rw">
my @test = 1..5;
-try {
+lives_ok {
my sub should_work ( *@list is rw ) {
@list[0] = "hi";
}
should_work(@test);
-};
-
-ok(
- !$!,
- "trying to use an 'is rw' splat does work out",
-);
-is(@test[0], "hi", "@test was unchanged");
-
-try {
- my sub should_work (*@list is rw) { }
-};
-
-ok(
- !$!,
- "trying to define an 'is rw' splat works too",
-);
+}, "trying to use an 'is rw' splat does work out";
+is(@test[0], "hi", "@test was changed");
# vim: ft=perl6
View
46 S12-attributes/mutators.t
@@ -23,6 +23,7 @@ my $lvm = LValueMutator.new(:foo(3));
#?pugs todo 'oo'
# XXX is this correct? .new calls BUILD, which in turn calls bless,
# which in turns initializes the attributes directly
+#?rakudo todo 'OO (test needs review)'
is($lvm.foo, 3, "constructor uses lvalue accessor method");
ok($lvm.get_foo ~~ undef, "constructor doesn't simply set attributes");
@@ -55,17 +56,21 @@ is($mv.constant, 6, "normal attribute");
dies_ok { $mv.constant = 7 }, "can't change a non-rw attribute";
is($mv.constant, 6, "attribute didn't change value");
+#?rakudo todo 'overring mutators'
is($count, 2, "mutator was called");
-is($mv.varies, 9, "mutator called during object construction");
-is($count, 3, "accessor was called");
-is($mv.varies, 11, "attribute with mutating accessor");
-is($count, 4, "accessor was called");
-
-$count = 0;
-$mv.varies = 13;
-is($count, 2, "mutator was called");
-is($mv.varies, 16, "attribute with overridden mutator");
-is($count, 3, "accessor and mutator were called");
+#?rakudo skip 'oo: mutators'
+{
+ is($mv.varies, 9, "mutator called during object construction");
+ is($count, 3, "accessor was called");
+ is($mv.varies, 11, "attribute with mutating accessor");
+ is($count, 4, "accessor was called");
+
+ $count = 0;
+ $mv.varies = 13;
+ is($count, 2, "mutator was called");
+ is($mv.varies, 16, "attribute with overridden mutator");
+ is($count, 3, "accessor and mutator were called");
+}
# test interface tentatively not entirely disapproved of by
# all(@Larry) at L<"http://xrl.us/gnxp">
@@ -81,15 +86,18 @@ class MagicSub {
}
}
-my $mv = MagicVal.new(:constant(6), :varies(6));
+#?rakudo skip 'class Proxy'
+{
+ my $mv = MagicVal.new(:constant(6), :varies(6));
-is($mv.constant, 6, "normal attribute");
-is($mv.constant, 6, "normal attribute");
-dies_ok { $mv.constant = 7 }, "can't change a non-rw attribute";
-is($mv.constant, 6, "attribute didn't change value");
+ is($mv.constant, 6, "normal attribute");
+ is($mv.constant, 6, "normal attribute");
+ dies_ok { $mv.constant = 7 }, "can't change a non-rw attribute";
+ is($mv.constant, 6, "attribute didn't change value");
-is($mv.varies, 9, "mutator called during object construction");
-is($mv.varies, 11, "attribute with mutating accessor");
+ is($mv.varies, 9, "mutator called during object construction");
+ is($mv.varies, 11, "attribute with mutating accessor");
-$mv.varies = 13;
-is($mv.varies, 16, "attribute with overridden mutator");
+ $mv.varies = 13;
+ is($mv.varies, 16, "attribute with overridden mutator");
+}
View
14 S12-class/extending-arrays.t
@@ -2,7 +2,7 @@ use v6;
use Test;
-plan 10;
+plan 11;
class Array is also { method test_method { 1 }; };
class Hash is also { method test_method { 1 }; };
@@ -46,3 +46,15 @@ is(try({ (:key<value>).value; }), 'value', "method on a bare pair");
my $pair = :key<value>;
is $pair.value, 'value', "method on a named pair";
+
+{
+ class List is also {
+ method twice {
+ gather {
+ take $_ * 2 for self;
+ }
+ }
+ }
+
+ is (1, 2, 3).twice.join('|'), "2|4|6", 'can extend class List';
+}
View
1  S12-methods/what.t
@@ -31,7 +31,6 @@ plan 10;
# And a quick test for Code:
{
my $a = sub ($x) { 100 + $x };
- #?rakudo 2 todo 'correct types for subs and blocks'
ok($a.WHAT === Sub, "a sub's type is Sub");
ok($a.WHAT ~~ Routine, "a sub isa Routine");
ok($a.WHAT ~~ Code, "a sub isa Code");
View
10 S29-list/classify.t
@@ -3,7 +3,7 @@ use Test;
# L<S29/"List"/"=item classify">
-plan 11;
+plan 10;
#?pugs todo 'feature'
{
@@ -25,10 +25,8 @@ plan 11;
is( %by_five{20}, 4);
}
-# .classify shouldn't work on non-arrays
+# .classify should work on non-arrays
{
- dies_ok { 42.classify: { $_ } }, "method form of classify should not work on numbers";
- dies_ok { "str".classify: { $_ } }, "method form of classify should not work on strings";
-#?pugs todo 'feature'
- is eval(q<<< ~(42,).classify: { 1 } >>>), "42", "method form of classify should work on arrays";
+ lives_ok { 42.classify: { $_ } }, "method form of classify should not work on numbers";
+ lives_ok { "str".classify: { $_ } }, "method form of classify should not work on strings";
}
Please sign in to comment.
Something went wrong with that request. Please try again.