[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
Raku · Feb 18, 2009 · 8ed5f61 · 8ed5f61
1 parent 0dcb2aa
commit 8ed5f61
Show file tree

Hide file tree

Showing 9 changed files with 82 additions and 76 deletions.
diff --git a/S02-magicals/env.t b/S02-magicals/env.t
@@ -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>;

diff --git a/S03-junctions/autothreading.t b/S03-junctions/autothreading.t
@@ -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;

diff --git a/S03-junctions/boolean-context.t b/S03-junctions/boolean-context.t
@@ -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';

diff --git a/S03-operators/cross-metaop.t b/S03-operators/cross-metaop.t
@@ -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:

diff --git a/S03-operators/feed.t b/S03-operators/feed.t
@@ -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 ==>>

diff --git a/S05-modifier/perl5_0.t b/S05-modifier/perl5_0.t
@@ -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.";

diff --git a/S12-methods/multi.t b/S12-methods/multi.t
@@ -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" }
 }

diff --git a/S29-list/join.t b/S29-list/join.t
@@ -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");

diff --git a/S29-time/time.t b/S29-time/time.t
@@ -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');