Permalink
Browse files

[t/spec] some test enhancements, corrections and fudging for rakudo.

git-svn-id: http://svn.pugscode.org/pugs@22515 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent e7ca07b commit 9bfcf50c34b5349c4b5537a07c73f3210977339b moritz committed Oct 5, 2008
View
@@ -17,6 +17,9 @@ use Test;
# my $pair = (a => 42);
# foo($pair); # pair passed positionally
# foo([,] $pair); # named
+#
+# S02 lists ':a' as being equivlaent to a => 1, so
+# the type of the value of that pair is Int, not Bool
plan 40;
@@ -25,8 +28,8 @@ sub f1 ($a, $b) { WHAT($a) ~ WHAT($b) }
{
is f1(a => 42, 23), "IntInt", "'a => 42' is a named";
is f1(:a(42), 23), "IntInt", "':a(42)' is a named";
- is f1(:a, 23), "BoolInt", "':a' is a named";
- is f1(:!a, 23), "BoolInt", "':!a' is also named";
+ is f1(:a, 23), "IntInt", "':a' is a named";
+ is f1(:!a, 23), "IntInt", "':!a' is also named";
is f1("a" => 42, 23), "PairInt", "'\"a\" => 42' is a named";
is f1(("a") => 42, 23), "PairInt", "'(\"a\") => 42' is a pair";
@@ -43,33 +46,25 @@ sub f2 (:$a!) { ~WHAT($a) }
is f2(a => 42), "Int", "'a => 42' is a named";
is f2(:a(42)), "Int", "':a(42)' is a named";
- #?rakudo todo 'Adverbial pairs without should produce a Bool (not Int)'
- is f2(:a), "Bool", "':a' is a named";
+ is f2(:a), "Int", "':a' is a named";
- #?rakudo todo '.() sub calls'
- is(f2.(:a), "Bool", "in 'f2.(:a)', ':a' is a named");
- #?rakudo todo 'Adverbial pairs without should produce a Bool (not Int)'
- is $f2(:a), "Bool", "in '\$f2(:a)', ':a' is a named";
- #?rakudo skip '.() sub calls'
- is $f2.(:a), "Bool", "in '\$f2.(:a)', ':a' is a named";
-
- #?rakudo 6 todo 'unknown'
+ is(f2.(:a), "Int", "in 'f2.(:a)', ':a' is a named");
+ is $f2(:a), "Int", "in '\$f2(:a)', ':a' is a named";
+ is $f2.(:a), "Int", "in '\$f2.(:a)', ':a' is a named";
+
+ #?rakudo 7 todo 'not every pair acts as named parameters'
dies_ok { f2("a" => 42) }, "'\"a\" => 42' is a pair";
dies_ok { f2(("a") => 42) }, "'(\"a\") => 42' is a pair";
dies_ok { f2((a => 42)) }, "'(a => 42)' is a pair";
dies_ok { f2(("a" => 42)) }, "'(\"a\" => 42)' is a pair";
dies_ok { f2((:a(42))) }, "'(:a(42))' is a pair";
dies_ok { f2((:a)) }, "'(:a)' is a pair";
- #?rakudo todo '.() sub calls'
dies_ok { f2.((:a)) }, "in 'f2.((:a))', '(:a)' is a pair";
- #?rakudo todo 'unknown'
+ #?rakudo 4 todo 'not every pair acts as named parameters'
dies_ok { $f2((:a)) }, "in '\$f2((:a))', '(:a)' is a pair";
- #?rakudo skip '.() sub calls'
dies_ok { $f2.((:a)) }, "in '\$f2.((:a))', '(:a)' is a pair";
- #?rakudo todo 'unknown'
dies_ok { $f2(((:a))) }, "in '\$f2(((:a)))', '(:a)' is a pair";
- #?rakudo skip '.() sub calls'
dies_ok { $f2.(((:a))) }, "in '\$f2.(((:a)))', '(:a)' is a pair";
}
@@ -78,6 +73,7 @@ sub f3 ($a) { ~WHAT($a) }
my $pair = (a => 42);
is f3($pair), "Pair", 'a $pair is not treated magically...';
+ # XXX investigate what [,] actually does, it has changed recently
#?pugs todo '[,]'
#?rakudo skip 'reduce meta op'
is f3([,] $pair), "Int", '...but [,] $pair is';
@@ -2,7 +2,7 @@ use v6;
use Test;
-plan 8;
+plan 10;
=begin desc
@@ -12,20 +12,29 @@ This test tests the C<$!> builtin.
# L<S04/"Exceptions"/"A bare die/fail takes $! as the default argument.">
-#?rakudo 3 skip 'unimpl $!'
+##?rakudo 3 skip 'unimpl $!'
-eval '&nonexisting_subroutine()';
+eval 'nonexisting_subroutine()';
+ok defined($!), 'nonexisting sub in eval makes $! defined';
+eval 'nonexisting_subroutine()';
+#?rakudo skip 'Test $! for truthness'
ok $!, 'Calling a nonexisting subroutine sets $!';
undefine $!;
+# XXX nonexisting_subroutine is detectable at compile time,
+# this test should be fixed somehow
try { nonexisting_subroutine; };
+ok $! !~~ undef, 'Calling a nonexisting subroutine defines $!';
+try { nonexisting_subroutine; };
+#?rakudo skip 'Test $! for truthness'
ok $!, 'Calling a nonexisting subroutine sets $!';
undefine $!;
my $called;
sub foo(Str $s) { return $called++ };
my @a;
try { foo(@a,@a) };
+#?rakudo skip 'Test $! for truthness'
ok $!, 'Calling a subroutine with a nonmatching signature sets $!';
ok !$called, 'The subroutine also was not called';
@@ -37,6 +46,7 @@ ok $!, 'Dividing one by zero sets $!';
sub incr ( $a is rw ) { $a++ };
undefine $!;
try { incr(19) };
+#?rakudo todo 'containers/values'
ok $!, 'Modifying a constant sets $!';
try {
@@ -46,4 +56,7 @@ try {
ok ~($!) ~~ /qwerty/, 'die sets $! properly';
die; # use the default argument
}
+#?rakudo todo 'stringification of $!'
ok ~($!) ~~ /qwerty/, 'die without argument uses $! properly';
+
+# vim: ft=perl6
@@ -12,8 +12,6 @@ eval_lives_ok 'my $!', '$! parses ok';
eval_lives_ok 'my $/', 'as does $/';
# things that should be invalid
-#?rakudo skip 'Null PMC access in type()'
eval_dies_ok 'my $f!ao = "beh";', "but normal varnames can't have ! in their name";
-#?rakudo skip 'Null PMC access in type()'
eval_dies_ok 'my $fo:o::b:ar = "bla"', "var names can't have colons in their names either";
@@ -6,18 +6,24 @@ plan 76;
# L<S02/"Whitespace and Comments"/This is known as the "unspace">
-is(4\ .sqrt, 2, 'unspace with numbers');
+
+#?rakudo skip "get_string() not implemented in class 'ResizableStringArray'"
+ok(4\ .sqrt == 2, 'unspace with numbers');
+#?rakudo skip 'unspace with comments'
is(4\#(quux).sqrt, 2, 'unspace with comments');
-is("x"\ .bytes, 1, 'unspace with strings');
-is("x"\ .bytes(), 1, 'unspace with strings + parens');
+is("x"\ .codes, 1, 'unspace with strings');
+is("x"\ .codes(), 1, 'unspace with strings + parens');
+#?rakudo skip 'lexicals in eval'
+{
my $foo = 4;
is(eval('$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, 6, 'unspace with postfix inc really postfix');
is(eval('$foo\ .--'), 6, 'unspace with postfix dec');
is($foo, 5, 'unspace with postfix dec really postfix');
+}
is("xxxxxx"\.bytes, 6, 'unspace without spaces');
is("xxxxxx"\
@@ -57,6 +63,7 @@ sub bar($x? = 'a') { $x }
$_ = 'b';
#XXX why is eval required here?
+{
is(eval('foo.id'), 'a', 'sanity - foo.id');
is(eval('foo .id'), 'b', 'sanity - foo .id');
is(eval('bar.id'), 'a', 'sanity - bar.id');
@@ -165,15 +172,19 @@ comment blah blah blah #6
end comment #5
.id'), 'a', 'hideous nested pod torture test');
+}
# L<S04/"Statement-ending blocks"/"Because subroutine declarations are expressions">
#XXX probably shouldn't be in this file...
+{
eval('sub f { 3 } sub g { 3 }');
eval_dies_ok('f', 'semicolon or newline required between blocks');
eval_dies_ok('g', 'semicolon or newline required between blocks');
+}
# L<S06/"Blocks"/"unless followed immediately by a comma">
-
+#
+{
sub baz(Code $x, *@y) { $x.(@y) }
is(eval('baz { @^x }, 1, 2, 3'), (1, 2, 3), 'comma immediately following arg block');
@@ -187,73 +198,77 @@ class Code is also {
is(eval('xyzzy { @^x }: 1, 2, 3'), (1, 2, 3), 'colon immediately following arg block');
is(eval('xyzzy { @^x } : 1, 2, 3'), (1, 2, 3), 'colon not immediately following arg block');
is(eval('xyzzy { @^x }\ : 1, 2, 3'), (1, 2, 3), 'unspace then colon following arg block');
+}
# L<S02/"Whitespace and Comments"/"natural conflict between postfix operators and infix operators">
#This creates syntactic ambiguity between
# ($n) ++ ($m)
# ($n++) $m
# ($n) (++$m)
# ($n) + (+$m)
-
-my $n = 1;
-my $m = 2;
-sub infix:<++>($x, $y) { 42 }
-
-#'$n++$m' should be a syntax error
-eval_dies_ok('$n++$m', 'infix requires space when ambiguous with postfix');
-is($n, 1, 'check $n');
-is($m, 2, 'check $m');
-
-#'$n ++$m' should be infix:<++>
-#no, really: http://moritz.faui2k3.org/irclog/out.pl?channel=perl6;date=2007-05-09#id_l328
-$n = 1; $m = 2;
-is(eval('$n ++$m'), 42, '$n ++$m with infix:<++> is $n ++ $m');
-is($n, 1, 'check $n');
-is($m, 2, 'check $m');
-
-#'$n ++ $m' should be infix:<++>
-$n = 1; $m = 2;
-is(eval('$n ++ $m'), 42, 'postfix requires no space w/ infix ambiguity');
-is($n, 1, 'check $n');
-is($m, 2, 'check $m');
-
-#These should all be postfix syntax errors
-$n = 1; $m = 2;
-eval_dies_ok('$n.++ $m', 'postfix dot w/ infix ambiguity');
-eval_dies_ok('$n\ ++ $m', 'postfix unspace w/ infix ambiguity');
-eval_dies_ok('$n\ .++ $m', 'postfix unspace w/ infix ambiguity');
-is($n, 1, 'check $n');
-is($m, 2, 'check $m');
-
-#Unspace inside operator splits it
-$n = 1; $m = 2;
-is(eval('$n+\ +$m'), 3, 'unspace inside operator splits it');
-is($n, 1, 'check $n');
-is($m, 2, 'check $m');
-
-$n = 1;
-eval_dies_ok('$n ++', 'postfix requires no space');
-is($n, 1, 'check $n');
-
-$n = 1;
-is(eval('$n.++'), 1, 'postfix dot');
-is($n, 2, 'check $n');
-
-$n = 1;
-is(eval('$n\ ++'), 1, 'postfix unspace');
-is($n, 2, 'check $n');
-
-$n = 1;
-is(eval('$n\ .++'), 1, 'postfix unspace');
-is($n, 2, 'check $n');
-
-# L<S02/"Lexical Conventions"/"U+301D codepoint has two closing alternatives">
-is(eval('foo\#〝 comment 〞.id'), 'a', 'unspace with U+301D/U+301E comment');
-eval_dies_ok('foo\#〝 comment 〟.id', 'unspace with U+301D/U+301F is invalid');
-
-# L<S02/"Whitespace and Comments"/".123">
-# .123 is equal to 0.123
-
-is eval(' .123'), 0.123, ' .123 is equal to 0.123';
-is eval('.123'), 0.123, '.123 is equal to 0.123';
+#?rakudo skip 'defining new operators'
+{
+ my $n = 1;
+ my $m = 2;
+ sub infix:<++>($x, $y) { 42 }
+
+ #'$n++$m' should be a syntax error
+ #?rakudo 3 skip 'test dependency'
+ eval_dies_ok('$n++$m', 'infix requires space when ambiguous with postfix');
+ is($n, 1, 'check $n');
+ is($m, 2, 'check $m');
+
+ #'$n ++$m' should be infix:<++>
+ #no, really: http://irclog.perlgeek.de/perl6/2007-05-09#id_l328
+ $n = 1; $m = 2;
+ is(eval('$n ++$m'), 42, '$n ++$m with infix:<++> is $n ++ $m');
+ is($n, 1, 'check $n');
+ is($m, 2, 'check $m');
+
+ #'$n ++ $m' should be infix:<++>
+ $n = 1; $m = 2;
+ is(eval('$n ++ $m'), 42, 'postfix requires no space w/ infix ambiguity');
+ is($n, 1, 'check $n');
+ is($m, 2, 'check $m');
+
+ #These should all be postfix syntax errors
+ $n = 1; $m = 2;
+ eval_dies_ok('$n.++ $m', 'postfix dot w/ infix ambiguity');
+ eval_dies_ok('$n\ ++ $m', 'postfix unspace w/ infix ambiguity');
+ eval_dies_ok('$n\ .++ $m', 'postfix unspace w/ infix ambiguity');
+ is($n, 1, 'check $n');
+ is($m, 2, 'check $m');
+
+ #Unspace inside operator splits it
+ $n = 1; $m = 2;
+ is(eval('$n+\ +$m'), 3, 'unspace inside operator splits it');
+ is($n, 1, 'check $n');
+ is($m, 2, 'check $m');
+
+ $n = 1;
+ eval_dies_ok('$n ++', 'postfix requires no space');
+ is($n, 1, 'check $n');
+
+ $n = 1;
+ is(eval('$n.++'), 1, 'postfix dot');
+ is($n, 2, 'check $n');
+
+ $n = 1;
+ is(eval('$n\ ++'), 1, 'postfix unspace');
+ is($n, 2, 'check $n');
+
+ $n = 1;
+ is(eval('$n\ .++'), 1, 'postfix unspace');
+ is($n, 2, 'check $n');
+
+ # L<S02/"Lexical Conventions"/"U+301D codepoint has two closing alternatives">
+ is(eval('foo\#〝 comment 〞.id'), 'a', 'unspace with U+301D/U+301E comment');
+ eval_dies_ok('foo\#〝 comment 〟.id', 'unspace with U+301D/U+301F is invalid');
+
+ # L<S02/"Whitespace and Comments"/".123">
+ # .123 is equal to 0.123
+
+ is eval(' .123'), 0.123, ' .123 is equal to 0.123';
+ is eval('.123'), 0.123, '.123 is equal to 0.123';
+}
View
@@ -12,6 +12,7 @@ enum Day <Sun Mon Tue Wed Thu Fri Sat>;
is Day::Sat, 6, 'Last item has the right value';
}
+#?rakudo skip 'infix:<but>'
{
my $x = 'Today' but Day::Mon;
ok $x.does(Day), 'Can test with .does() for enum type';
View
@@ -24,13 +24,15 @@ plan 10;
# Now testing basic correct inheritance.
{
my $a = 3;
+ #?rakudo todo 'Int type should somehow conform to Num'
ok($a.WHAT ~~ Num, "an Int isa Num");
ok($a.WHAT ~~ Object, "an Int isa Object");
}
# 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");
@@ -44,7 +46,9 @@ plan 10;
}
my $o = Foo.new;
is($o."WHAT", 'Bar', '."WHAT" calls the method instead of the macro');
+ #?rakudo todo '.WHAT not (easily overridable)'
is($o.WHAT, 'Foo', '.WHAT still works as intended');
my $meth = "WHAT";
+ #?rakudo skip 'indirect method calls'
is($o.$meth, 'Bar', '.$meth calls the method instead of the macro');
}
Oops, something went wrong.

0 comments on commit 9bfcf50

Please sign in to comment.