Permalink
Browse files

[t/spec] many small improvements:

 * variable declarations found by STD.pm
 * accidentially passing junctions to ok() (found by Rakudo)


git-svn-id: http://svn.pugscode.org/pugs@25376 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 0dcb2aa commit 8ed5f61e53c13d1dba7774acfa901b7fec513ee6 moritz committed Feb 18, 2009
View
@@ -83,17 +83,17 @@ if (! $err) {
%*ENV.delete('PUGS_ROCKS');
ok(!%*ENV.exists('PUGS_ROCKS'), 'We can remove keys from %*ENV');
-my $command = qq!$*EXECUTABLE_NAME -e "\%*ENV.perl.say" $redir $tempfile!;
+$command = qq!$*EXECUTABLE_NAME -e "\%*ENV.perl.say" $redir $tempfile!;
diag $command;
run $command;
-my $child_env = slurp $tempfile;
-my %child_env = eval $child_env;
+$child_env = slurp $tempfile;
+%child_env = eval $child_env;
unlink $tempfile;
ok(!%child_env.exists('PUGS_ROCKS'), 'The child did not see %*ENV<PUGS_ROCKS>');
-my $err = 0;
+$err = 0;
for %*ENV.kv -> $k,$v {
# Ignore env vars which bash and maybe other shells set automatically.
next if $k eq any <SHLVL _ OLDPWD PS1>;
@@ -193,7 +193,7 @@ plan 51;
$x = JuncInvTest1.new(n => 1) | JuncInvTest1.new(n => 2) & JuncInvTest1.new(n => 4);
my $r = $x.d;
- my $ok = $r.perl.subst(/\D/, '', :g) eq '248' | '284' | '482' | '842';
+ my $ok = ?($r.perl.subst(/\D/, '', :g) eq '248' | '284' | '482' | '842');
ok($ok, 'auto-threading over invocant produced correct junctional result');
JuncInvTest2.cnt = 0;
@@ -33,11 +33,13 @@ ok !($undef & -1), 'undef&-1 in boolean context';
ok ?(-1 ^ $undef), '-1^undef in boolean context';
ok ?($undef ^ -1), 'undef^-1 in boolean context';
-(1|$undef && pass '1|undef in boolean context') || flunk '1|undef in boolean context';
+#?rakudo skip 'junction bug (autothreads even though in boolean context)'
+#?DOES 3
{
+(1|$undef && pass '1|undef in boolean context') || flunk '1|undef in boolean context';
(1 & $undef && flunk '1&undef in boolean context') || pass '1&undef in boolean context';
-}
(1^$undef && pass '1^undef in boolean context') || flunk '1^undef in boolean context';
+}
ok !(0 | $undef), '0|undef in boolean context';
ok !($undef | 0), 'undef|0 in boolean context';
@@ -18,10 +18,10 @@ ok eval('<a b> X <c d>'), 'cross non-meta operator parses';
{
my @result = gather {
for @(1..3 X 'a'..'b') -> $n, $a {
- take "$n:$a"
+ take "$n|$a"
}
}
- is @result, <1:a 1:b 2:a 2:b 3:a 3:b>, 'smooth cross operator works';
+ is @result, <1|a 1|b 2|a 2|b 3|a 3|b>, 'smooth cross operator works';
}
# L<S03/List infix precedence/and a list of arrays in>
@@ -76,7 +76,7 @@ ok eval('<a b> X, <c d>'), 'cross metaoperator parses';
is (1,2 X* 3,4), (3,4,6,8), 'cross-product works';
# L<S03/Cross operators/underlying operator non-associating>
-dies_ok '@result Xcmp @expected Xcmp <1 2>',
+eval_dies_ok '@result Xcmp @expected Xcmp <1 2>',
'non-associating ops cannot be cross-ops';
# let's have some fun with X..., comparison ops and junctions:
View
@@ -108,11 +108,11 @@ plan 23;
my @odds = <1 3 5 7 9>;
my @even = <0 2 4 6 8>;
- my @numbers = do {@odds ==>> @evens};
- is(~@numbers, ~(@evens, @odds), 'basic ==>> test');
+ my @numbers = do {@odds ==>> @even};
+ is(~@numbers, ~(@even, @odds), 'basic ==>> test');
- my @numbers = do {@odds <<== @evens};
- is(~@numbers, ~(@odds, @evens), 'basic <<== test');
+ my @numbers = do {@odds <<== @even};
+ is(~@numbers, ~(@odds, @even), 'basic <<== test');
}
# feeding to whatever using ==> and ==>>
View
@@ -76,30 +76,32 @@ so it looks like a pugs-pcre interface bug.
=end pod
-"a" ~~ m:Perl5/a|(b)/;
-is($0, undef, 'An unmatched capture should be false.');
-my $str = "http://foo.bar/";
-ok(($str ~~ m:Perl5 {http{0,1}}));
-
-my $rule = '\d+';
-ok('2342' ~~ m:P5/$rule/, 'interpolated rule applied successfully');
-
-my $rule2 = 'he(l)+o';
-ok('hello' ~~ m:P5/$rule2/, 'interpolated rule applied successfully');
-
-my $rule3 = 'r+';
-my $subst = 'z';
-my $bar = "barrrr";
-$bar ~~ s:P5:g{$rule3}=qq{$subst};
-is($bar, "baz", 'variable interpolation in substitute regexp works with :g modifier');
-
-my $a = 'a:';
-$a ~~ s:P5 [(..)]=qq[{uc $0}];
-is($a, 'A:', 'closure interpolation with qq[] as delimiter');
-
-my $b = 'b:';
-$b ~~ s:P5{(..)} = uc $0;
-is($b, 'B:', 'closure interpolation with no delimiter');
+{
+ "a" ~~ m:Perl5/a|(b)/;
+ is($0, undef, 'An unmatched capture should be false.');
+ my $str = "http://foo.bar/";
+ ok(($str ~~ m:Perl5 {http{0,1}}));
+
+ my $rule = '\d+';
+ ok('2342' ~~ m:P5/$rule/, 'interpolated rule applied successfully');
+
+ my $rule2 = 'he(l)+o';
+ ok('hello' ~~ m:P5/$rule2/, 'interpolated rule applied successfully');
+
+ my $rule3 = 'r+';
+ my $subst = 'z';
+ my $bar = "barrrr";
+ $bar ~~ s:P5:g{$rule3}=qq{$subst};
+ is($bar, "baz", 'variable interpolation in substitute regexp works with :g modifier');
+
+ my $a = 'a:';
+ $a ~~ s:P5 [(..)]=qq[{uc $0}];
+ is($a, 'A:', 'closure interpolation with qq[] as delimiter');
+
+ my $b = 'b:';
+ $b ~~ s:P5{(..)} = uc $0;
+ is($b, 'B:', 'closure interpolation with no delimiter');
+}
{
diag "Now going to test numbered match variable.";
View
@@ -41,7 +41,7 @@ role R1 {
role R2 {
method foo($x, $y) { 2 }
}
-dies_ok 'class X does R1 does R2 { }', 'sanity: get composition conflict error';
+eval_dies_ok 'class X does R1 does R2 { }', 'sanity: get composition conflict error';
class C does R1 does R2 {
proto method foo() { "proto" }
}
View
@@ -16,7 +16,7 @@ is(@list.join("|"), "a|b|c", '@list.join("|") works');
my $joined2 = join("|", :values(@list));
is($joined2, "a|b|c", 'join("|", :values(@list)) works');
-my $joined2 = join("|", @list);
+$joined2 = join("|", @list);
is($joined2, "a|b|c", 'join("|", @list) works');
my $joined3 = join("|", "a", "b", "c");
View
@@ -142,43 +142,45 @@ ok(is_dt({ my $str = localtime() }()), 'localtime(), scalar context');
#-- 7 --
-my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
-my ($xsec,$foo);
-
-($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = try { gmtime($beg) };
-($xsec,$foo) = localtime($now);
-
-#?pugs todo 'bug'
-flunk("FIXME Time::Local should by numifiable");
-## ?pugs: todo
-#ok($sec != $xsec && $mday && $year, 'gmtime() list context');
+{
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
+ my ($xsec,$foo);
+
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = try { gmtime($beg) };
+ ($xsec,$foo) = localtime($now);
+
+ #?pugs todo 'bug'
+ flunk("FIXME Time::Local should by numifiable");
+ ## ?pugs: todo
+ #ok($sec != $xsec && $mday && $year, 'gmtime() list context');
+
+ #-- 8 --
+
+ if ($localyday && $yday) {
+ my $day_diff = $localyday - $yday;
+ #?pugs todo
+ ok($day_diff == 0 ||
+ $day_diff == 1 ||
+ $day_diff == -1 ||
+ $day_diff == 364 ||
+ $day_diff == 365 ||
+ $day_diff == -364 ||
+ $day_diff == -365,
+ 'gmtime() and localtime() agree what day of year');
+ } else {
+ #?pugs todo
+ ok(0, 'gmtime() and localtime() agree what day of year');
+ }
-#-- 8 --
+ #-- 9 --
-if ($localyday && $yday) {
- my $day_diff = $localyday - $yday;
- #?pugs todo
- ok($day_diff == 0 ||
- $day_diff == 1 ||
- $day_diff == -1 ||
- $day_diff == 364 ||
- $day_diff == 365 ||
- $day_diff == -364 ||
- $day_diff == -365,
- 'gmtime() and localtime() agree what day of year');
-} else {
#?pugs todo
- ok(0, 'gmtime() and localtime() agree what day of year');
+ ok(is_dt({ my $str = try { gmtime() } }()), 'gmtime(), scalar context');
+
+ # Ultimate implementation as of above test as Rule
+ #todo_ok(gmtime() ~~ /^Sun|Mon|Tue|Wed|Thu|Fri|Sat\s
+ # Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec\s
+ # \d\d\s\d\d:\d\d:\d\d\s\d**{4}$
+ # /,
+ # 'gmtime(), scalar context');
}
-
-#-- 9 --
-
-#?pugs todo
-ok(is_dt({ my $str = try { gmtime() } }()), 'gmtime(), scalar context');
-
-# Ultimate implementation as of above test as Rule
-#todo_ok(gmtime() ~~ /^Sun|Mon|Tue|Wed|Thu|Fri|Sat\s
-# Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec\s
-# \d\d\s\d\d:\d\d:\d\d\s\d**{4}$
-# /,
-# 'gmtime(), scalar context');

0 comments on commit 8ed5f61

Please sign in to comment.