Permalink
Browse files

[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
  • Loading branch information...
1 parent 23fd884 commit 297e783574ce50f75ebb2d760fd06d8dd3330bf6 moritz committed Jan 5, 2009
Showing with 3,524 additions and 138 deletions.
  1. +0 −4 S02-builtin_data_types/anon_block.t
  2. +0 −1 S02-builtin_data_types/range.t
  3. +106 −0 S02-builtin_data_types/sigils-and-types.t
  4. +2 −2 S02-names_and_variables/contextual.t
  5. +4 −4 S03-junctions/misc.t
  6. +0 −1 S03-operators/basic-types.t
  7. +6 −4 S04-blocks-and-statements/pointy.t
  8. +46 −0 S04-closure-traits/in-eval.t
  9. +71 −0 S04-closure-traits/in-loop.t
  10. +40 −0 S04-closure-traits/interpolate.t
  11. +3 −3 S04-closure-traits/start.t
  12. +1 −1 S04-declarations/my.t
  13. +57 −0 S05-capture/named.t
  14. +53 −0 S05-mass/recursive.t
  15. +29 −0 S05-modifier/sigspace.t
  16. +57 −0 S06-macros/opaque-ast.t
  17. +43 −0 S06-multi/lexical-subs.t
  18. +75 −0 S06-routine-modifiers/proxy.t
  19. +1 −1 S06-signature/slurpy-params-2.t
  20. +10 −1 S06-signature/slurpy-params.t
  21. +1 −1 S12-attributes/instance.t
  22. +95 −0 S12-attributes/mutators.t
  23. +48 −0 S12-class/extending-arrays.t
  24. +125 −0 S12-class/magical-vars.t
  25. +62 −0 S12-construction/construction.t
  26. +45 −0 S12-construction/destruction.t
  27. +20 −0 S12-construction/named-params-in-BUILD.t
  28. +31 −0 S12-role/instantiation.t
  29. +120 −0 S12-role/parameterized.t
  30. +26 −0 S12-role/submethods.t
  31. +43 −0 S12-role/super.t
  32. +46 −0 S12-traits/basic.t
  33. +32 −0 S12-traits/parameterized.t
  34. +1 −1 S29-list/first.t
  35. +96 −1 S29-list/map.t
  36. +0 −59 S29-list/map_empty_list.t
  37. +0 −14 S29-list/map_flattening.t
  38. +0 −9 S29-list/map_function.t
  39. +0 −15 S29-list/map_topic.t
  40. +0 −15 S29-list/map_with_signature.t
  41. +2 −0 S29-scalar/undef.t
  42. +7 −1 S29-str/length.t
  43. +246 −0 integration/99problems-01-to-10.t
  44. +292 −0 integration/99problems-11-to-20.t
  45. +259 −0 integration/99problems-21-to-30.t
  46. +263 −0 integration/99problems-31-to-40.t
  47. +312 −0 integration/99problems-41-to-50.t
  48. +302 −0 integration/99problems-51-to-60.t
  49. +405 −0 integration/99problems-61-to-70.t
  50. +41 −0 integration/method-calls-and-instantiation.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';
@@ -141,7 +141,6 @@ is(+(6..8), 3, 'numification');
}
# infinite ranges
-#?rakudo skip 'infinite ranges not implemented'
{
my $inf = -Inf..Inf;
@@ -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>;
@@ -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.";
}
@@ -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
@@ -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)');
@@ -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
@@ -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";
@@ -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';
+}
@@ -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';
Oops, something went wrong.

0 comments on commit 297e783

Please sign in to comment.