This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert t/op/mydef.t to test.pl, strict and warnings.
authorNicholas Clark <nick@ccl4.org>
Sun, 13 Mar 2011 11:02:08 +0000 (11:02 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 13 Mar 2011 11:02:08 +0000 (11:02 +0000)
t/op/mydef.t

index 123767c..335033b 100644 (file)
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
     chdir 't' if -d 't';
@@ -6,90 +6,84 @@ BEGIN {
     require './test.pl';
 }
 
-print "1..72\n";
-
-my $test = 0;
-sub ok ($@) {
-    my ($ok, $name) = @_;
-    ++$test;
-    print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";
-}
+use strict;
+no warnings 'misc';
 
 $_ = 'global';
-ok( $_ eq 'global', '$_ initial value' );
+is($_, 'global', '$_ initial value');
 s/oba/abo/;
-ok( $_ eq 'glabol', 's/// on global $_' );
+is($_, 'glabol', 's/// on global $_');
 
 {
     my $_ = 'local';
-    ok( $_ eq 'local', 'my $_ initial value' );
+    is($_, 'local', 'my $_ initial value');
     s/oca/aco/;
-    ok( $_ eq 'lacol', 's/// on my $_' );
+    is($_, 'lacol', 's/// on my $_');
     /(..)/;
-    ok( $1 eq 'la', '// on my $_' );
-    ok( tr/c/d/ == 1, 'tr/// on my $_ counts correctly' );
-    ok( $_ eq 'ladol', 'tr/// on my $_' );
+    is($1, 'la', '// on my $_');
+    cmp_ok(tr/c/d/, '==', 1, 'tr/// on my $_ counts correctly' );
+    is($_, 'ladol', 'tr/// on my $_');
     {
        my $_ = 'nested';
-       ok( $_ eq 'nested', 'my $_ nested' );
+       is($_, 'nested', 'my $_ nested');
        chop;
-       ok( $_ eq 'neste', 'chop on my $_' );
+       is($_, 'neste', 'chop on my $_');
     }
     {
        our $_;
-       ok( $_ eq 'glabol', 'gains access to our global $_' );
+       is($_, 'glabol', 'gains access to our global $_');
     }
-    ok( $_ eq 'ladol', 'my $_ restored' );
+    is($_, 'ladol', 'my $_ restored');
 }
-ok( $_ eq 'glabol', 'global $_ restored' );
+is($_, 'glabol', 'global $_ restored');
 s/abo/oba/;
-ok( $_ eq 'global', 's/// on global $_ again' );
+is($_, 'global', 's/// on global $_ again');
 {
     my $_ = 11;
     our $_ = 22;
-    ok( $_ eq 22, 'our $_ is seen explicitly' );
+    is($_, 22, 'our $_ is seen explicitly');
     chop;
-    ok( $_ eq 2, '...default chop chops our $_' );
+    is($_, 2, '...default chop chops our $_');
     /(.)/;
-    ok( $1 eq 2, '...default match sees our $_' );
+    is($1, 2, '...default match sees our $_');
 }
 
 $_ = "global";
 {
     my $_ = 'local';
     for my $_ ("foo") {
-       ok( $_ eq "foo", 'for my $_' );
+       is($_, "foo", 'for my $_');
        /(.)/;
-       ok( $1 eq "f", '...m// in for my $_' );
-       ok( our $_ eq 'global', '...our $_ inside for my $_' );
+       is($1, "f", '...m// in for my $_');
+       is(our $_, 'global', '...our $_ inside for my $_');
     }
-    ok( $_ eq 'local', '...my $_ restored outside for my $_' );
-    ok( our $_ eq 'global', '...our $_ restored outside for my $_' );
+    is($_, 'local', '...my $_ restored outside for my $_');
+    is(our $_, 'global', '...our $_ restored outside for my $_');
 }
 {
     my $_ = 'local';
     for ("implicit foo") { # implicit "my $_"
-       ok( $_ eq "implicit foo", 'for implicit my $_' );
+       is($_, "implicit foo", 'for implicit my $_');
        /(.)/;
-       ok( $1 eq "i", '...m// in for implicit my $_' );
-       ok( our $_ eq 'global', '...our $_ inside for implicit my $_' );
+       is($1, "i", '...m// in for implicit my $_');
+       is(our $_, 'global', '...our $_ inside for implicit my $_');
     }
-    ok( $_ eq 'local', '...my $_ restored outside for implicit my $_' );
-    ok( our $_ eq 'global', '...our $_ restored outside for implicit my $_' );
+    is($_, 'local', '...my $_ restored outside for implicit my $_');
+    is(our $_, 'global', '...our $_ restored outside for implicit my $_');
 }
 {
     my $_ = 'local';
-    ok( $_ eq "postfix foo", 'postfix for' ) for 'postfix foo';
-    ok( $_ eq 'local', '...my $_ restored outside postfix for' );
-    ok( our $_ eq 'global', '...our $_ restored outside postfix for' );
+    is($_, "postfix foo", 'postfix for' ) for 'postfix foo';
+    is($_, 'local', '...my $_ restored outside postfix for');
+    is(our $_, 'global', '...our $_ restored outside postfix for');
 }
 {
     for our $_ ("bar") {
-       ok( $_ eq "bar", 'for our $_' );
+       is($_, "bar", 'for our $_');
        /(.)/;
-       ok( $1 eq "b", '...m// in for our $_' );
+       is($1, "b", '...m// in for our $_');
     }
-    ok( $_ eq 'global', '...our $_ restored outside for our $_' );
+    is($_, 'global', '...our $_ restored outside for our $_');
 }
 
 {
@@ -101,27 +95,27 @@ $_ = "global";
        tmap1();
        tmap2();
        ok( /^[67]\z/, 'local lexical $_ is seen in map' );
-       { ok( our $_ eq 'global', 'our $_ still visible' ); }
+       { is(our $_, 'global', 'our $_ still visible'); }
        ok( $_ == 6 || $_ == 7, 'local lexical $_ is still seen in map' );
-       { my $_ ; ok( !defined, 'nested my $_ is undefined' ); }
+       { my $_ ; is($_, undef, 'nested my $_ is undefined'); }
     } 6, 7;
-    ok( $buf eq 'gxgx', q/...map doesn't modify outer lexical $_/ );
-    ok( $_ eq 'x', '...my $_ restored outside map' );
-    ok( our $_ eq 'global', '...our $_ restored outside map' );
-    map { my $_; ok( !defined, 'redeclaring $_ in map block undefs it' ); } 1;
+    is($buf, 'gxgx', q/...map doesn't modify outer lexical $_/);
+    is($_, 'x', '...my $_ restored outside map');
+    is(our $_, 'global', '...our $_ restored outside map');
+    map { my $_; is($_, undef, 'redeclaring $_ in map block undefs it'); } 1;
 }
-{ map { my $_; ok( !defined, 'declaring $_ in map block undefs it' ); } 1; }
+{ map { my $_; is($_, undef, 'declaring $_ in map block undefs it'); } 1; }
 {
     sub tmap3 () { return $_ };
     my $_ = 'local';
     sub tmap4 () { return $_ };
     my $x = join '-', map $_.tmap3.tmap4, 1 .. 2;
-    ok( $x eq '1globallocal-2globallocal', 'map without {}' );
+    is($x, '1globallocal-2globallocal', 'map without {}');
 }
 {
     for my $_ (1) {
        my $x = map $_, qw(a b);
-       ok( $x == 2, 'map in scalar context' );
+       is($x, 2, 'map in scalar context');
     }
 }
 {
@@ -133,47 +127,51 @@ $_ = "global";
        tgrep1();
        tgrep2();
        ok( /^[89]\z/, 'local lexical $_ is seen in grep' );
-       { ok( our $_ eq 'global', 'our $_ still visible' ); }
+       { is(our $_, 'global', 'our $_ still visible'); }
        ok( $_ == 8 || $_ == 9, 'local lexical $_ is still seen in grep' );
     } 8, 9;
-    ok( $buf eq 'gygy', q/...grep doesn't modify outer lexical $_/ );
-    ok( $_ eq 'y', '...my $_ restored outside grep' );
-    ok( our $_ eq 'global', '...our $_ restored outside grep' );
+    is($buf, 'gygy', q/...grep doesn't modify outer lexical $_/);
+    is($_, 'y', '...my $_ restored outside grep');
+    is(our $_, 'global', '...our $_ restored outside grep');
 }
 {
     sub tgrep3 () { return $_ };
     my $_ = 'local';
     sub tgrep4 () { return $_ };
     my $x = join '-', grep $_=$_.tgrep3.tgrep4, 1 .. 2;
-    ok( $x eq '1globallocal-2globallocal', 'grep without {} with side-effect' );
-    ok( $_ eq 'local', '...but without extraneous side-effects' );
+    is($x, '1globallocal-2globallocal', 'grep without {} with side-effect');
+    is($_, 'local', '...but without extraneous side-effects');
 }
 {
     for my $_ (1) {
        my $x = grep $_, qw(a b);
-       ok( $x == 2, 'grep in scalar context' );
+       is($x, 2, 'grep in scalar context');
     }
 }
 {
     my $s = "toto";
     my $_ = "titi";
-    $s =~ /to(?{ ok( $_ eq 'toto', 'my $_ in code-match # TODO' ) })to/
-       or ok( 0, "\$s=$s should match!" );
-    ok( our $_ eq 'global', '...our $_ restored outside code-match' );
+    my $r;
+    {
+       local $::TODO = 'Marked as todo since test was added in 59f00321bbc2d046';
+       $r = $s =~ /to(?{ is($_, 'toto', 'my $_ in code-match' ) })to/;
+    }
+    ok($r, "\$s=$s should match!");
+    is(our $_, 'global', '...our $_ restored outside code-match');
 }
 
 {
     my $_ = "abc";
     my $x = reverse;
-    ok( $x eq "cba", 'reverse without arguments picks up $_' );
+    is($x, "cba", 'reverse without arguments picks up $_');
 }
 
 {
     package notmain;
     our $_ = 'notmain';
-    ::ok( $::_ eq 'notmain', 'our $_ forced into main::' );
+    ::is($::_, 'notmain', 'our $_ forced into main::');
     /(.*)/;
-    ::ok( $1 eq 'notmain', '...m// defaults to our $_ in main::' );
+    ::is($1, 'notmain', '...m// defaults to our $_ in main::');
 }
 
 my $file = tempfile();
@@ -181,22 +179,22 @@ my $file = tempfile();
     open my $_, '>', $file or die "Can't open $file: $!";
     print $_ "hello\n";
     close $_;
-    ok( -s $file, 'writing to filehandle $_ works' );
+    cmp_ok(-s $file, '>', 5, 'writing to filehandle $_ works');
 }
 {
     open my $_, $file or die "Can't open $file: $!";
     my $x = <$_>;
-    ok( $x eq "hello\n", 'reading from <$_> works' );
+    is($x, "hello\n", 'reading from <$_> works');
     close $_;
 }
 
 {
     $fqdb::_ = 'fqdb';
-    ok( $fqdb::_ eq 'fqdb', 'fully qualified $_ is not in main' );
-    ok( eval q/$fqdb::_/ eq 'fqdb', 'fully qualified, evaled $_ is not in main' );
+    is($fqdb::_, 'fqdb', 'fully qualified $_ is not in main' );
+    is(eval q/$fqdb::_/, 'fqdb', 'fully qualified, evaled $_ is not in main' );
     package fqdb;
-    ::ok( $_ ne 'fqdb', 'unqualified $_ is in main' );
-    ::ok( eval q/$_/ ne 'fqdb', 'unqualified, evaled $_ is in main' );
+    ::isnt($_, 'fqdb', 'unqualified $_ is in main' );
+    ::isnt(eval q/$_/, 'fqdb', 'unqualified, evaled $_ is in main');
 }
 
 {
@@ -205,7 +203,7 @@ my $file = tempfile();
     $qunckkk = 4;
     package clank_est;
     our $qunckkk;
-    ::ok($qunckkk == 3, 'regular variables are not forced to main');
+    ::is($qunckkk, 3, 'regular variables are not forced to main');
 }
 
 {
@@ -214,5 +212,7 @@ my $file = tempfile();
     $_ = 4;
     package whack;
     our $_;
-    ::ok($_ == 4, '$_ is "special", and always forced to main');
+    ::is($_, 4, '$_ is "special", and always forced to main');
 }
+
+done_testing();