Changeset 22515 for t

Timestamp:

10/05/08 19:58:12 (7 weeks ago)

Author:

moritz

Message:

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

Location:

t/spec

Files:

• S02-literals/pairs.t (modified) (5 diffs)
• S02-magicals/dollar_bang.t (modified) (5 diffs)
• S02-names_and_variables/varnames.t (modified) (1 diff)
• S02-whitespace_and_comments/unspace.t (modified) (6 diffs)
• S12-enums/basic.t (modified) (1 diff)
• S12-methods/what.t (modified) (3 diffs)
• S29-context/eval.t (modified) (2 diffs)
• S29-str/split-simple.t (modified) (2 diffs)

t/spec/S02-literals/pairs.t

@@ -18 +18 @@
 #   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;
@@ -26 +29 @@
     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";
@@ -44 +47 @@
     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";
+    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 6 todo 'unknown'
+    #?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";
@@ -61 +60 @@
     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";
 }
@@ -79 +74 @@
 
     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'

t/spec/S02-magicals/dollar_bang.t

@@ -3 +3 @@
 use Test;
 
-plan 8;
+plan 10;
 
 =begin desc
@@ -13 +13 @@
 # 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 $!';
 
@@ -27 +35 @@
 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';
@@ -38 +47 @@
 undefine $!;
 try { incr(19) };
+#?rakudo todo 'containers/values'
 ok $!, 'Modifying a constant sets $!';
 
@@ -47 +57 @@
     die; # use the default argument
 }
+#?rakudo todo 'stringification of $!'
 ok ~($!) ~~ /qwerty/, 'die without argument uses $! properly';
+
+# vim: ft=perl6

t/spec/S02-names_and_variables/varnames.t

@@ -13 +13 @@
 
 # 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";
 

t/spec/S02-whitespace_and_comments/unspace.t

@@ -7 +7 @@
 # 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');
@@ -19 +24 @@
 is(eval('$foo\       .--'), 6, 'unspace with postfix dec');
 is($foo, 5, 'unspace with postfix dec really postfix');
+}
 
 is("xxxxxx"\.bytes, 6, 'unspace without spaces');
@@ -58 +64 @@
 
 #XXX why is eval required here?
+{
 is(eval('foo.id'), 'a', 'sanity - foo.id');
 is(eval('foo .id'), 'b', 'sanity - foo .id');
@@ -166 +173 @@
     .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) }
 
@@ -188 +199 @@
 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">
@@ -195 +207 @@
 # ($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';
+}
+

t/spec/S12-enums/basic.t

@@ -13 +13 @@
 }
 
+#?rakudo skip 'infix:<but>'
 {
     my $x = 'Today' but Day::Mon;

t/spec/S12-methods/what.t

@@ -25 +25 @@
 {
   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");
@@ -32 +33 @@
 {
   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");
@@ -45 +47 @@
     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');
 }

t/spec/S29-context/eval.t

@@ -11 +11 @@
 =end pod
 
-#?rakudo skip "Null PMC access in find_method()"
-
-#?rakudo emit =begin unimpl
-
 # eval should evaluate the code in the lexical scope of eval's caller
-sub make_eval_closure { my $a = 5; sub ($s) { eval $s } };
-is(make_eval_closure()('$a'), 5, 'eval runs code in the proper lexical scope');
-
-#?rakudo emit =end unimpl
+#?rakudo skip 'eval as closure'
+{
+    sub make_eval_closure {
+        my $a = 5;
+        return sub ($s) {
+            eval $s 
+        };
+    };
+    is(make_eval_closure().('$a'), 5, 'eval runs code in the proper lexical scope');
+}
 
 is(eval('5'), 5, 'simple eval works and returns the value');
 my $foo = 1234;
-#?rakudo skip "unimpl Null PMC access in find_method"
+#?rakudo skip 'eval needs access to outer scope'
 is(eval('$foo'), $foo, 'simple eval using variable defined outside');
 
 # traps die?
-#?rakudo skip "unimpl Null PMC access in type()"
+#?rakudo skip 'Null PMC access in type()'
 ok(!eval('die; 1'), "eval can trap die");
 
-ok(!eval('my @a = (1); @a<0>'), "eval returns undef on syntax error");
+ok(eval('my @a = (1); @a!<0>') ~~ undef, "eval returns undef on syntax error");
 
-#?rakudo skip "unimpl Null PMC access in type()"
+#?rakudo skip 'eval should trap fatal use statement'
 ok(!eval('use Poison; 1'), "eval can trap a fatal use statement");
 
@@ -38 +40 @@
 ok(v() == 123, "a plain subroutine");
 eval 'sub v { 456 }';
+#?rakudo todo 'eval can override subroutines (specced?)'
 ok(v() == 456, "eval can overwrite a subroutine");
 
 # L<S04/Exception handlers/Perl 6's eval function only evaluates strings, not blocks.>
-#?rakudo skip "unimpl Null PMC access in find_method"
+#?rakudo skip 'eval { block } is gone '
 dies_ok({eval {42}}, 'block eval is gone');

t/spec/S29-str/split-simple.t

@@ -2 +2 @@
 use Test;
 
-plan 30;
+plan 32;
 
 =begin description
@@ -51 +51 @@
 );
 
+# zero-width assertions shouldn't loop
+# with additional spaces
+# a b 3 4 d 5 z    split on <before \d>
+#    ^ ^   ^   
+#  => result: 'ab', '3', '4d', '5z'
+#  (confirmed by perl 5)
+
+#?rakudo skip 'split with zero-width assertions'
+#?DOES 2
+{
+split_test 'ab34d5z'.split(/<before \d>/), <ab 3 4d 5z>, 'split with zero-width assertions';
+}
+
 # As per Larry, ''.split('') is the empty list
 # http://www.nntp.perl.org/group/perl.perl6.language/2008/09/msg29730.html