[t] and [t/spec]

 * more tests for slurpy args + is copy/is rw
 * moved macro test to spec/
 * moved closure trait tests to spec/
 * add tests for hygienic macros
 * remove some is($something, undef) instances, ack++
 * moved most tests from examples/99problems to spec/integration/99problems*
   and merged ten each into one file; solved problems 55, 57, 59.
 * moved lexical_subs.t to spec/
 * more tests for Unicode string lengths
 * merge most of map_*.t into map.t
 * moved a regex test to spec/, deleted a mostly wrong/pointless regex test
 * moved oo construction and destruction tests to spec/
 * moved all tests in oo/roles/ and oo/traits/ to spec/
 * fudged pointy.t for rakudo


git-svn-id: http://svn.pugscode.org/pugs@24767 c213334d-75ef-0310-aa23-eaa082d1ae64

S02-builtin_data_types/anon_block.t

@@ -36,22 +36,18 @@ is($anon_block(), 1, '{} <anon block> works');
 { 
     # pointy subs
     my $pointy_block = -> { 1 };
-    #?rakudo skip "Block sub type"
     isa_ok($pointy_block, Block);
     is($pointy_block(), 1, '-> {} <"pointy" block> works');
 
     my $pointy_block_w_arg = -> $arg { 1 + $arg };
-    #?rakudo skip "Block sub type"
     isa_ok($pointy_block_w_arg, Block);
     is($pointy_block_w_arg(3), 4, '-> $arg {} <"pointy" block w/args> works');
 
     my $pointy_block_w_multiple_args = -> $arg1, $arg2 { $arg1 + $arg2 };
-    #?rakudo skip "Block sub type"
     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_nested = -> $a { -> $b { $a + $b }};
-    #?rakudo 2 skip "Block sub type"
     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';

S02-builtin_data_types/range.t

@@ -141,7 +141,6 @@ is(+(6..8), 3, 'numification');
 }
 
 # infinite ranges
-#?rakudo skip 'infinite ranges not implemented'
 {
     my $inf = -Inf..Inf;
 

S02-builtin_data_types/sigils-and-types.t

@@ -0,0 +1,106 @@
+use v6;
+
+use Test;
+
+
+
+=begin pod
+
+XXX These should go in Prelude.pm but if defined there they are not visible
+no matter if they are declared as builtin, export, primitive or combinations of the three.
+
+
+role Positional is builtin {
+  multi postcircumfix:<[ ]> {...}
+}
+
+role Abstraction is builtin {
+  # TODO fill me (no defined methods in S02)
+}
+
+role Associative is builtin {
+  multi postcircumfix:<{ }> {...}
+}
+
+role Callable is builtin {
+  multi postcircumfix:<( )> {...}
+}
+
+# This classes actually have a definition outside of Prelude 
+but this definition does not include declaration of sigil traits.
+ 
+class List does Positional ;
+
+class Capture does Positional does Associative;
+
+class Hash does Associative;
+class Pair does Associative;
+class Set does Associative;
+
+class Class does Abstraction;
+class Role does Abstraction;
+class Package does Abstraction;
+class Module does Abstraction;
+
+class Code does Callable;
+
+
+=end pod
+
+plan 38;
+
+my $scalar;
+ok $scalar.does(Object), 'unitialized $var does Object';
+$scalar = 1;
+ok $scalar.does(Object), 'value contained in a $var does Object';
+
+
+
+my @array;
+ok @array.does(Positional), 'unitialized @var does Positional';
+my @array = [];
+ok @array.does(Positional), 'value contained in a @var does Positional';
+my @array = 1;
+ok @array.does(Positional), 'generic val in a @var is converted to Positional';
+
+for <List Seq Range Buf Capture> -> $c {
+    ok eval($c).does(Positional), "$c does Positional";
+}
+
+my %hash;
+ok %hash.does(Associative), 'uninitialized %var does Associative', :todo<feature>;
+%hash = {};
+ok %hash.does(Associative), 'value in %var does Associative';
+
+for <Pair Mapping Set Bag KeyHash Capture> -> $c {
+  if eval('$c') {
+    ok $c.does(Associative), "$c does Associative";
+  }
+}
+
+ok Class.does(Abstraction), 'a class is an Abstraction';
+ok Positional.does(Abstraction), 'a Role is an Abstraction';
+ok ::Main.does(Abstraction), 'a Package is an abstraction';
+ok eval {$?GRAMMAR.does(Abstraction)}, 'a Grammar is an abstraction';
+ok $?MODULE.does(Abstraction), 'a Module is an abstraction';
+
+sub foo {}
+ok &foo.does(Callable), 'a Sub does Callable';
+#?rakudo skip 'method outside class - fix test?'
+{
+method meth {}
+ok &meth.does(Callable), 'a Method does Callable';
+}
+multi mul {}
+ok &mul.does(Callable), 'a multi does Callable';
+proto pro {}
+ok &pro.does(Callable), 'a proto does Callable';
+
+# &token, &rule return a Method?
+token bar {<?>}
+ok &bar.does(Callable), 'a token does Callable', :todo<feature>;
+rule baz {<?>}
+ok &baz.does(Callable), 'a rule does Callable', :todo<feature>;
+# &quux returns a Sub ?
+macro quux {}
+ok &quux.does(Callable), 'a rule does Callable', :todo<feature>;

S02-names_and_variables/contextual.t

@@ -16,12 +16,12 @@ plan 5;
 	%*ENV.delete('THIS_NEVER_EXISTS');
         my $rv = eval('$+THIS_NEVER_EXISTS');
 	ok $!, "Testing for accessing contextual which is deleted.";
-	is $rv, undef, "Testing for value of contextual variables that was deleted.";
+	ok $rv ~~ undef, "Testing for value of contextual variables that was deleted.";
 }
 
 {
 	my $rv = eval('$+THIS_IS_NEVER_THERE_EITHER');
         ok $!, "Test for contextual which doesn't exists.";
-	is $rv, undef, "Testing for value of contextual variables that never existed.";
+	ok $rv ~~ undef, "Testing for value of contextual variables that never existed.";
 }
 

S03-junctions/misc.t

@@ -276,15 +276,15 @@ L<S03/Junctive operators/They thread through operations>
 
 #?rakudo skip 'Junction.pick'
 {
-    is(none(1).pick, undef, 'none(1).pick should be undef');
-    is(none(1,1).pick, undef, 'none(1,1).pick should be undef');
+    ok(none(1).pick ~~ undef, 'none(1).pick should be undef');
+    ok(none(1,1).pick ~~ undef, 'none(1,1).pick should be undef');
 
     is(one(1).pick, 1, 'one(1).pick should be 1');
-    is(one(1,1).pick, undef, 'one(1,1).pick should be undef');
+    ok(one(1,1).pick ~~ undef, 'one(1,1).pick should be undef');
 
     is(all(1).pick, 1, 'all(1).pick should be 1');
     is(all(1,1).pick, 1, 'all(1,1).pick should be 1');
-    is(all(1,2).pick, undef, 'all(1,2).pick should be undef');
+    ok(all(1,2).pick ~~ undef, 'all(1,2).pick should be undef');
 }
 
 # junction in boolean context

S03-operators/basic-types.t

@@ -51,7 +51,6 @@ isa_ok($s2, Hash, 'it is a Hash type (bare block)');
 my $s2a = { $^a };
 isa_ok($s2a, Block, 'it is a Parametric type (bare block with placeholder parameters)');
 
-#?rakudo skip 'Block type'
 {
     my $s3 = -> {};
     isa_ok($s3, Block, 'it is a Block type (pointy block)');

S04-blocks-and-statements/pointy.t

@@ -2,7 +2,7 @@ use v6;
 
 use Test;
 
-plan 12;
+plan 13;
 
 =begin description
 
@@ -32,7 +32,7 @@ is $got, 'x 123', 'called pointy immediately: -> $x { ... }(...)';
 
 # L<S04/Statement-ending blocks/End-of-statement cannot occur within a bracketed expression>
 my @a;
-ok eval('@a = ("one", -> $x { $x**2 }, "three")'), 
+lives_ok { @a = ("one", -> $x { $x**2 }, "three")} , 
         'pointy sub without preceding comma';
 is @a[0], 'one', 'pointy sub in list previous argument';
 isa_ok @a[1], Code, 'pointy sub in list';
@@ -48,14 +48,16 @@ my $s = -> {
 };
 try { $s.() };
 #?pugs todo 'feature'
-is(!defined($!), undef, 'pointy with block control exceptions');
+#?rakudo 2 todo 'pointy blocks and last/redo'
+ok(!defined($!), 'pointy with block control exceptions');
 is $n, 10, "pointy control exceptions ran";
 
 # L<S06/""Pointy blocks""/will return from the innermost enclosing sub or method>
 my $str = '';
 
 sub outer {  
     my $s = -> { 
+        #?rakudo skip '&?ROUTINE'
         is(&?ROUTINE.name, '&Main::outer', 'pointy still sees outer\'s &?ROUTINE'); 
 
         $str ~= 'inner'; 
@@ -78,7 +80,7 @@ is $str, 'inner', 'return in pointy returns from enclosing sub';
 
 # -> { $^a, $^b } is illegal; you can't mix real sigs with placeholders,
 # and the -> introduces a sig of ().  TimToady #perl6 2008-May-24
-eval_dies_ok(q{ -> { $^a, $^b } }, '-> { $^a, $^b } is illegal');
+eval_dies_ok(q{{ -> { $^a, $^b } }}, '-> { $^a, $^b } is illegal');
 
 
 # vim: ft=perl6

S04-closure-traits/in-eval.t

@@ -0,0 +1,46 @@
+use v6;
+
+# Test closure traits in eval strings
+
+use Test;
+
+plan 18;
+
+# L<S04/Closure traits/Code "generated at run time" "still fire off"
+#   "can't" "travel back in time" >
+
+my ($code, $hist, $handle);
+
+$code = '$handle = { START { $hist ~= "F" } }';
+ok eval($code), 'eval START {...} works';
+ok $hist ~~ undef, 'START {...} has not run yet';
+is $handle(), 'F', 'START {...} fired';
+is $handle(), 'F', 'START {...} fired only once';
+
+$code = '$handle = { INIT { $hist ~= "I" } }';
+ok eval($code), 'eval INIT {...} works';
+is $hist, 'FI', 'INIT {...} already fired at run-time';
+is $handle(), 'FI', 'INIT {...} fired only once';
+
+$code = '$handle = { CHECK { $hist ~= "C" } }';
+ok eval($code), 'eval CHECK {...} works';
+is $hist, 'FIC', 'CHECK {...} fires at run-time';
+is $handle(), 'FIC', 'CHECK {...} fired only once';
+
+$code = '$handle = { BEGIN { $hist ~= "B" } }';
+ok eval($code), 'eval BEGIN {...} works';
+is $hist, 'FICB', 'CHECK {...} fired at run-time';
+is $handle(), 'FICB', 'CHECK {...} fired only once';
+
+#?rakudo skip 'variables in BEGIN/END blocks'
+{
+    END {
+        is $hist, 'FICBE', 'the END {...} in eval has run already';
+    }
+}
+
+$code = '$handle = { END { $hist ~= "E" } }';
+ok eval($code), 'eval END {...} works';
+ok $handle, '$handle to the closure returned as expected';
+is $hist, 'FICB', 'END {...} doesn\'t run yet';
+ok $handle() ~~ undef, "END \{...\} doesn't run yet";

S04-closure-traits/in-loop.t

@@ -0,0 +1,71 @@
+use v6;
+
+use Test;
+
+plan 2;
+
+# TODO, based on synopsis 4:
+#
+# * KEEP, UNDO, PRE, POST, CONTROL
+#   CATCH is tested in t/spec/S04-statements/try.t
+#
+# * $var will undo, etc
+#
+# * LEAVE type blocks in the context of CATCH
+#
+# * PRE/POST in classes is not the same as LEAVE/ENTER
+
+# L<S04/"Closure traits">
+
+{
+    my $str;
+
+    for 1..10 -> $i {
+        last if $i > 3;
+        $str ~= "($i a)";
+        next if $i % 2 == 1;
+        $str ~= "($i b)";
+        LAST  { $str ~= "($i Lst)" }
+        LEAVE { $str ~= "($i Lv)"  }
+        NEXT  { $str ~= "($i N)"   }
+        FIRST { $str ~= "($i F)"   }
+        ENTER { $str ~= "($i E)"   }
+    }
+
+    is $str, "(1 F)(1 E)(1 a)" ~ "(1 N)(1 Lv)" ~
+                  "(2 E)(2 a)(2 b)(2 N)(2 Lv)" ~
+                  "(3 E)(3 a)" ~ "(3 N)(3 Lv)" ~
+                  "(4 E)"  ~          "(4 Lv)(4 Lst)",
+       'trait blocks work properly in for loop';
+}
+
+{
+    my $str;
+
+    for 1..10 -> $i {
+        last if $i > 3;
+        $str ~= "($i a)";
+
+        ENTER { $str ~= "($i E1)"   }
+        LAST  { $str ~= "($i Lst1)" }
+        FIRST { $str ~= "($i F1)"   }
+        LEAVE { $str ~= "($i Lv1)"  }
+
+        next if $i % 2 == 1;
+        $str ~= "($i b)";
+
+        LAST  { $str ~= "($i Lst2)" }
+        NEXT  { $str ~= "($i N1)"   }
+        FIRST { $str ~= "($i F2)"   }
+        LEAVE { $str ~= "($i Lv2)"  }
+        ENTER { $str ~= "($i E2)"   }
+        NEXT  { $str ~= "($i N2)"   }
+    }
+
+    is $str, 
+"(1 F1)(1 F2)(1 E1)(1 E2)(1 a)" ~ "(1 N2)(1 N1)" ~  "(1 Lv2)(1 Lv1)" ~
+            "(2 E1)(2 E2)(2 a)(2 b)(2 N2)(2 N1)" ~  "(2 Lv2)(2 Lv1)" ~
+            "(3 E1)(3 E2)(3 a)" ~ "(3 N2)(3 N1)" ~  "(3 Lv2)(3 Lv1)" ~
+            "(4 E1)(4 E2)"  ~                       "(4 Lv2)(4 Lv1)" ~ "(4 Lst2)(4 Lst1)",
+       'trait blocks work properly in for loop';
+}

S04-closure-traits/interpolate.t

@@ -0,0 +1,40 @@
+use v6;
+
+# Test closure traits interpolated in double-quoted strings
+
+use Test;
+
+plan 6;
+
+# [TODO] add tests for ENTER/LEAVE/KEEP/UNDO/PRE/POST/etc
+
+# L<S04/Closure traits/END "at run time" ALAP>
+
+# IRC log:
+# ----------------------------------------------------------------
+# agentzh   question: should BEGIN blocks interpolated in double-quoted
+#           strings be fired at compile-time or run-time?
+#           for example, say "This is { BEGIN { say 'hi' } }";
+# audreyt   compile time.
+#           qq is not eval.
+
+my $hist;
+
+END {
+    is $hist, 'BCISE', 'interpolated END {...} executed';
+}
+
+ok "{ END { $hist ~= 'E' } }" ~~ undef,
+    'END {...} not yet executed';
+
+is "{ START { $hist ~= 'S' } }", "BCIS",
+    'START {...} fired at run-time, entry time of the mainline code';
+
+is "{ INIT { $hist ~= 'I' } }", 'BCI',
+    'INIT {...} fired at the beginning of runtime';
+
+is "{ CHECK { $hist ~= 'C' } }", "BC",
+    'CHECK {...} fired at compile-time, ALAP';
+
+is "{ BEGIN { $hist ~= 'B' } }", "B",
+    'BEGIN {...} fired at compile-time, ASAP';