Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Test mergeback
  • Loading branch information
@sorear
sorear committed Feb 18, 2011
1 parent ca96dd2 commit ef92f25
Show file tree
Hide file tree
Showing 3 changed files with 187 additions and 187 deletions.
2 changes: 1 addition & 1 deletion TODO
View file
Expand Up @@ -30,7 +30,7 @@ EASY
Fudge and run your favorite spectest file.

Stuff spectests are blocking on: "is readonly", "[+]",
"Block", "&prefix:<\>", "&hash",
"Block", "&hash",
"writable $_", "closure for", "ranges of chars", "gather for",
"unless", "my regex / <&foo>", "m//",

Expand Down
187 changes: 186 additions & 1 deletion test.pl
View file
Expand Up @@ -2,7 +2,7 @@

use Test;

plan 731;
plan 786;

ok 1, "one is true";
ok 2, "two is also true";
Expand Down Expand Up @@ -1592,3 +1592,188 @@
is ord('0'), 48, "ord works";
is chr(65), 'A', "chr works";
}
{
is [ 1..5 ], "1 2 3 4 5", "Ranges work in list context";
is [ 1 ..^ 5 ], "1 2 3 4", "Tail exclusion works";
is [ 1 ^.. 5 ], "2 3 4 5", "Head exclusion works";
is [ 1 ^..^ 5 ], "2 3 4", "Dual exclusion works";
is [ ^5 ], "0 1 2 3 4", "Shorthand form works";
is ((5 .. *)[3]), 8, "Infinite ranges can be iterated";
ok 3 ~~ 1..4, "Range checking works (+)";
ok 5 !~~ 1..4, "Range checking works (-)";
}
{
my $i = 0;
1 < ($i++; 2) < 3;
is $i, 1, "Chained comparisons only evaluate terms once";
my $foo = [5];
for $foo { .shift }
is +$foo, 0, ".method works";
my $x = 5;
$x ~~ .++;
is $x, 6, "~~ topicalization works";
my $y;
given 12 { $y = $_ }
is $y, 12, "prefix given works";
$y = $_ given 24;
is $y, 24, "postfix given works";
my $z = '';
$z ~= $_ for 1, 2, 3;
is $z, '123', "postfix for works";
my $k = '';
given 12 {
$k ~= 1 when 12;
$k ~= 2 when * > 5;
$k ~= 3 when * <= 5;
}
is $k, '12', "postfix when works";
$k = '';
given 12 {
when 9 { $k ~= 1 }
when * > 6 { $k ~= 2 }
when * > 3 { $k ~= 3 }
}
is $k, '2', "normal when works";
given my $g { #OK
$_ = 'abc';
s/b/d/;
is $_, 'adc', 'simple s/// works';
is $/, 'b', 's/// sets $/';
$k = 'bac';
$k ~~ s/c/g/;
is $k, 'bag', '~~ s/// works';
$_ = 'abc';
s/(\w)/$0$0/;
is $_, 'aabc', 's/// can refer to $/';
$_ = 'abc';
ok ?(s/b/x/), 's/// is true if replacing';
$_ = 'abc';
ok !(s/d/x/), 's/// is false if not replacing';
is $_, 'abc', '... and target unchanged';
$_ = 'abc';
s!a!xx!;
is $_, 'xxbc', 's/// with alternate delims works';
$_ = 'abc123';
s{b} = 'g' ~ 'k';
is $_, 'agkc123', 's{} = works';
$_ = 'abc123';
s{\D+} = $/ ~ $/;
is $_, 'abcabc123', 's{} = can refer to $/';
$_ = 'abc123';
s{\d+} *= 2;
is $_, 'abc246', 'metaoperator s{} works';
}
}
{
my $a = 0;
{
A: while True {
$a++; while True { last A }; $a++;
last;
}
}
is $a, 1, "last with label works";
sub funlp($fn) {
A: while True {
$fn(A)
}
}
my $b = 0;
funlp(-> $o {
$b++; funlp(-> $i { last $o }); $b++; #OK
last;
});
is $b, 1, "last with label object is not fooled by names";
my $c = 0;
funlp(-> $o { #OK
$c++; funlp(-> $i { last "A" }); $c++; #OK
last;
});
is $c, 2, "last with name picks innermost";
sub loopy () { True }
ok loopy, "can call functions starting with 'loop'";
my @a = "abc" ~~ /abc/;
is +@a, 1, "capture-less matches return 1 item";
@a = "abc" ~~ /(a)(b)(c)/;
is +@a, 3, "capturing matches return catures in list context";
}
{
is ~[4,0 Z+ 2,0 Z+ 1,0], "7 0", "Z+ works";
is ~[1,2 X+ 3,4 X+ 5,6], "9 10 10 11 10 11 11 12", "X+ works";
is ~[4,0 Z 2,0 Z 1,0], "4 2 1 0 0 0", "Z works";
is ~[1,2 X 3,4 X 5,6], "1 3 5 1 3 6 1 4 5 1 4 6 2 3 5 2 3 6 2 4 5 2 4 6", "X works";
ok "{1}" ~~ Str, "string interpolation stringifies";
is q:to[A] , " x\n", "q:to strips equal whitespace";
x
A
}
{
my class X1 {
my @foo = 4, 5, 6;
method a() { @foo }
method b() { [ 1, 2, 3 ] }
method test() {
is +[ @.b ], 3, '@.foo syntax listifies';
is +[ $.a ], 1, '$.foo syntax itemifies';
}
}
X1.test;
constant $foo = 1, 2, 3;
constant @bar = 4;
constant %baz = a => 3, c => 6;
is +[ $foo ], 1, '$-constants itemize';
is +@bar, 1, '@-constants listize';
is %baz<c>, 6, '%-constants hashize';
my class X2 {
method test($x) { $x * $x }
}
my class X3 is X2 {
method test($) {
is callsame(), 25, "callsame() works";
is callwith(self, 6), 36, "callwith() works";
}
}
X3.test(5);
}
{
"f" ~~ /<alpha>?/;
ok $<alpha>.^isa(Match), "? returns match directly on success";
my $r = &return;
sub dfoo() { return; }
sub dbar() { return 5; }
sub dquux() { return 5, 10; }
sub foo() { $r(); }
sub bar() { $r(5); }
sub quux() { $r(5, 10); }
is +[ foo ], 0, "can return no values (i)";
is +[ bar ], 1, "can return one value (i)";
ok (bar() == 5), "one value isn't wrapped (i)";
is +[ quux ], 2, "can return two values (i)";
is +[ dfoo ], 0, "can return no values";
is +[ dbar ], 1, "can return one value";
ok (dbar() == 5), "one value isn't wrapped";
is +[ dquux ], 2, "can return two values";
}
185 changes: 0 additions & 185 deletions test2.pl
View file
Expand Up @@ -2,191 +2,6 @@
use Test;
use MONKEY_TYPING;

{
is [ 1..5 ], "1 2 3 4 5", "Ranges work in list context";
is [ 1 ..^ 5 ], "1 2 3 4", "Tail exclusion works";
is [ 1 ^.. 5 ], "2 3 4 5", "Head exclusion works";
is [ 1 ^..^ 5 ], "2 3 4", "Dual exclusion works";
is [ ^5 ], "0 1 2 3 4", "Shorthand form works";
is ((5 .. *)[3]), 8, "Infinite ranges can be iterated";
ok 3 ~~ 1..4, "Range checking works (+)";
ok 5 !~~ 1..4, "Range checking works (-)";
}

{
my $i = 0;
1 < ($i++; 2) < 3;
is $i, 1, "Chained comparisons only evaluate terms once";

my $foo = [5];
for $foo { .shift }
is +$foo, 0, ".method works";

my $x = 5;
$x ~~ .++;
is $x, 6, "~~ topicalization works";

my $y;
given 12 { $y = $_ }
is $y, 12, "prefix given works";

$y = $_ given 24;
is $y, 24, "postfix given works";

my $z = '';
$z ~= $_ for 1, 2, 3;
is $z, '123', "postfix for works";

my $k = '';
given 12 {
$k ~= 1 when 12;
$k ~= 2 when * > 5;
$k ~= 3 when * <= 5;
}
is $k, '12', "postfix when works";

$k = '';
given 12 {
when 9 { $k ~= 1 }
when * > 6 { $k ~= 2 }
when * > 3 { $k ~= 3 }
}
is $k, '2', "normal when works";

given my $g { #OK
$_ = 'abc';
s/b/d/;
is $_, 'adc', 'simple s/// works';
is $/, 'b', 's/// sets $/';
$k = 'bac';
$k ~~ s/c/g/;
is $k, 'bag', '~~ s/// works';
$_ = 'abc';
s/(\w)/$0$0/;
is $_, 'aabc', 's/// can refer to $/';
$_ = 'abc';
ok ?(s/b/x/), 's/// is true if replacing';
$_ = 'abc';
ok !(s/d/x/), 's/// is false if not replacing';
is $_, 'abc', '... and target unchanged';
$_ = 'abc';
s!a!xx!;
is $_, 'xxbc', 's/// with alternate delims works';
$_ = 'abc123';
s{b} = 'g' ~ 'k';
is $_, 'agkc123', 's{} = works';
$_ = 'abc123';
s{\D+} = $/ ~ $/;
is $_, 'abcabc123', 's{} = can refer to $/';
$_ = 'abc123';
s{\d+} *= 2;
is $_, 'abc246', 'metaoperator s{} works';
}
}

{
my $a = 0;
{
A: while True {
$a++; while True { last A }; $a++;
last;
}
}
is $a, 1, "last with label works";
sub funlp($fn) {
A: while True {
$fn(A)
}
}
my $b = 0;
funlp(-> $o {
$b++; funlp(-> $i { last $o }); $b++; #OK
last;
});
is $b, 1, "last with label object is not fooled by names";
my $c = 0;
funlp(-> $o { #OK
$c++; funlp(-> $i { last "A" }); $c++; #OK
last;
});
is $c, 2, "last with name picks innermost";

sub loopy () { True }
ok loopy, "can call functions starting with 'loop'";

my @a = "abc" ~~ /abc/;
is +@a, 1, "capture-less matches return 1 item";
@a = "abc" ~~ /(a)(b)(c)/;
is +@a, 3, "capturing matches return catures in list context";
}

{
is ~[4,0 Z+ 2,0 Z+ 1,0], "7 0", "Z+ works";
is ~[1,2 X+ 3,4 X+ 5,6], "9 10 10 11 10 11 11 12", "X+ works";
is ~[4,0 Z 2,0 Z 1,0], "4 2 1 0 0 0", "Z works";
is ~[1,2 X 3,4 X 5,6], "1 3 5 1 3 6 1 4 5 1 4 6 2 3 5 2 3 6 2 4 5 2 4 6", "X works";

ok "{1}" ~~ Str, "string interpolation stringifies";
is q:to[A] , " x\n", "q:to strips equal whitespace";
x
A
}
{
my class X1 {
my @foo = 4, 5, 6;
method a() { @foo }
method b() { [ 1, 2, 3 ] }
method test() {
is +[ @.b ], 3, '@.foo syntax listifies';
is +[ $.a ], 1, '$.foo syntax itemifies';
}
}
X1.test;
constant $foo = 1, 2, 3;
constant @bar = 4;
constant %baz = a => 3, c => 6;
is +[ $foo ], 1, '$-constants itemize';
is +@bar, 1, '@-constants listize';
is %baz<c>, 6, '%-constants hashize';
my class X2 {
method test($x) { $x * $x }
}
my class X3 is X2 {
method test($) {
is callsame(), 25, "callsame() works";
is callwith(self, 6), 36, "callwith() works";
}
}
X3.test(5);
}
{
"f" ~~ /<alpha>?/;
ok $<alpha>.^isa(Match), "? returns match directly on success";
my $r = &return;
sub dfoo() { return; }
sub dbar() { return 5; }
sub dquux() { return 5, 10; }
sub foo() { $r(); }
sub bar() { $r(5); }
sub quux() { $r(5, 10); }
is +[ foo ], 0, "can return no values (i)";
is +[ bar ], 1, "can return one value (i)";
ok (bar() == 5), "one value isn't wrapped (i)";
is +[ quux ], 2, "can return two values (i)";
is +[ dfoo ], 0, "can return no values";
is +[ dbar ], 1, "can return one value";
ok (dbar() == 5), "one value isn't wrapped";
is +[ dquux ], 2, "can return two values";
}
#is $?FILE, 'test.pl', '$?FILE works';
#is $?ORIG.substr(0,5), '# vim', '$?ORIG works';

Expand Down

0 comments on commit ef92f25

Please sign in to comment.