In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0f0aa27e84651bcff0f03646d2b397fa9f3ca003?hp=acdea6f0600816151724f1e3525a3e41433e2646>
- Log ----------------------------------------------------------------- commit 0f0aa27e84651bcff0f03646d2b397fa9f3ca003 Author: Nicholas Clark <[email protected]> Date: Sat Mar 12 18:55:18 2011 +0000 In pwent.t, sanitise the logic for opening /etc/passwd, and calling skip_all() It is now clearer what the code is doing when, and why. M t/op/pwent.t commit 9a0b91eb160f28718d47ab710f593f13edcddf42 Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 11:02:08 2011 +0000 Convert t/op/mydef.t to test.pl, strict and warnings. M t/op/mydef.t commit e205853886e506c9c43b97ba4ead8146bda01a70 Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 10:39:15 2011 +0000 In t/op/mydef.t, add missing C<eval> to a test. As the test is for 'ne', it passes without the eval. However, the test's description and surrounding code make it clear that it is a test for the results of eval. M t/op/mydef.t ----------------------------------------------------------------------- Summary of changes: t/op/mydef.t | 142 +++++++++++++++++++++++++++++----------------------------- t/op/pwent.t | 33 +++++++------- 2 files changed, 87 insertions(+), 88 deletions(-) diff --git a/t/op/mydef.t b/t/op/mydef.t index ca77c27..335033b 100644 --- a/t/op/mydef.t +++ b/t/op/mydef.t @@ -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( 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(); diff --git a/t/op/pwent.t b/t/op/pwent.t index d061d77..7880582 100644 --- a/t/op/pwent.t +++ b/t/op/pwent.t @@ -20,13 +20,6 @@ BEGIN { exit 0; } eval { require Config; import Config; }; - my $reason; - if ($Config{'i_pwd'} ne 'define') { - $reason = '$Config{i_pwd} undefined'; - } - elsif (not -f "/etc/passwd" ) { # Play safe. - $reason = 'no /etc/passwd file'; - } # Try NIS. $where = try_prog('NIS passwd', 'passwd', @@ -102,19 +95,25 @@ BEGIN { } } - if (not defined $where) { # Try local. + if (not defined $where) { + # Try local. + my $no_i_pwd = !$Config{i_pwd} && '$Config{i_pwd} undefined'; + my $PW = "/etc/passwd"; - if (-f $PW && open(PW, $PW) && defined(<PW>)) { - $where = $PW; + if (!-f $PW) { + skip_all($no_i_pwd) if $no_i_pwd; + skip_all("no $PW file"); + } elsif (open PW, '<', $PW) { + if(defined <PW>) { + $where = $PW; + } else { + skip_all($no_i_pwd) if $no_i_pwd; + die "\$Config{i_pwd} is defined, $PW exists but has no entries, all other approaches failed, giving up"; + } + } else { + die "Can't open $PW: $!"; } } - - undef $reason if defined $where; - - if ($reason) { # Give up. - print "1..0 # Skip: $reason\n"; - exit 0; - } } # By now the PW filehandle should be open and full of juicy password entries. -- Perl5 Master Repository
