In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c7056edeeaf89b005f3208bdca4c2abea3db3639?hp=7fc107ddc1604a2609b74883c5addd8812aad822>
- Log ----------------------------------------------------------------- commit c7056edeeaf89b005f3208bdca4c2abea3db3639 Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 15:49:50 2011 +0000 Convert t/re/reg_email.t to test.pl, strict and warnings. M t/re/reg_email.t commit cb07477ea9af3a143e6227a4db7952cd7b78dd76 Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 15:20:07 2011 +0000 In overload.t, move require './test.pl' into BEGIN to avoid stubbing subs. Also move the use of strict and warnings after the BEGIN block, so that they can take advantage of the @INC setting it performs. Swap to done_testing(). M t/re/overload.t commit ead3e2795abc84cb11c00e977613ee250337ac2f Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 15:16:15 2011 +0000 Convert t/op/magic.t to test.pl, strict and warnings. Use ok() rather than the more "obvious" is(), cmp_ok() etc to strictly control the number of accesses made to the passed in value. For example, is() accesses its $got more than once, which defeats the purpose of this test. M t/op/gmagic.t commit d7c80187036be58c864290cfc30e77b70a3e019d Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 15:04:42 2011 +0000 Convert t/op/die_unwind.t to test.pl, strict and warnings. M t/op/die_unwind.t commit cbd22dec502b132d778d14024303d80364cfb501 Author: Nicholas Clark <[email protected]> Date: Sun Mar 13 14:44:47 2011 +0000 Convert t/op/die_except.t to test.pl, strict and warnings. M t/op/die_except.t ----------------------------------------------------------------------- Summary of changes: t/op/die_except.t | 35 ++++++++++------------ t/op/die_unwind.t | 37 +++++++++++------------- t/op/gmagic.t | 80 ++++++++++++++++++++++++---------------------------- t/re/overload.t | 17 +++-------- t/re/reg_email.t | 15 +++++---- 5 files changed, 83 insertions(+), 101 deletions(-) diff --git a/t/op/die_except.t b/t/op/die_except.t index b0fcadb..679a23f 100644 --- a/t/op/die_except.t +++ b/t/op/die_except.t @@ -1,10 +1,7 @@ -#!./perl +#!./perl -w -print "1..12\n"; -my $test_num = 0; -sub ok { - print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n"; -} +require './test.pl'; +use strict; { package End; @@ -22,8 +19,8 @@ $val = eval { $@ = "t1\n"; 1; }; $err = $@; -ok $val == 1; -ok $err eq ""; +is($val, 1); +is($err, ""); $@ = "t0\n"; $val = eval { @@ -33,8 +30,8 @@ $val = eval { }; 1; }; $err = $@; -ok !defined($val); -ok $err eq "t3\n"; +is($val, undef); +is($err, "t3\n"); $@ = "t0\n"; $val = eval { @@ -42,8 +39,8 @@ $val = eval { local $@ = "t2\n"; 1; }; $err = $@; -ok $val == 1; -ok $err eq ""; +is($val, 1); +is($err, ""); $@ = "t0\n"; $val = eval { @@ -54,8 +51,8 @@ $val = eval { }; 1; }; $err = $@; -ok !defined($val); -ok $err eq "t3\n"; +is($val, undef); +is($err, "t3\n"); $@ = "t0\n"; $val = eval { @@ -63,8 +60,8 @@ $val = eval { my $c = end { $@ = "t2\n"; }; 1; }; $err = $@; -ok $val == 1; -ok $err eq ""; +is($val, 1); +is($err, ""); $@ = "t0\n"; $val = eval { @@ -75,7 +72,7 @@ $val = eval { }; 1; }; $err = $@; -ok !defined($val); -ok $err eq "t3\n"; +is($val, undef); +is($err, "t3\n"); -1; +done_testing(); diff --git a/t/op/die_unwind.t b/t/op/die_unwind.t index 36772c4..2dc5042 100644 --- a/t/op/die_unwind.t +++ b/t/op/die_unwind.t @@ -1,4 +1,7 @@ -#!./perl +#!./perl -w + +require './test.pl'; +use strict; # # This test checks for $@ being set early during an exceptional @@ -10,12 +13,6 @@ # unwinding has been developed. # -print "1..12\n"; -my $test_num = 0; -sub ok { - print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n"; -} - { package End; sub DESTROY { $_[0]->() } @@ -32,9 +29,9 @@ $val = eval { my $c = end { $uerr = $@; $@ = "t2\n"; }; 1; }; $err = $@; -ok $uerr eq ""; -ok $val == 1; -ok $err eq ""; +is($uerr, ""); +is($val, 1); +is($err, ""); $@ = "t0\n"; $val = eval { @@ -42,9 +39,9 @@ $val = eval { my $c = end { $uerr = $@; $@ = "t2\n"; }; 1; }; $err = $@; -ok $uerr eq "t1\n"; -ok $val == 1; -ok $err eq ""; +is($uerr, "t1\n"); +is($val, 1); +is($err, ""); $@ = ""; $val = eval { @@ -54,9 +51,9 @@ $val = eval { }; 1; }; $err = $@; -ok $uerr eq "t3\n"; -ok !defined($val); -ok $err eq "t3\n"; +is($uerr, "t3\n"); +is($val, undef); +is($err, "t3\n"); $@ = "t0\n"; $val = eval { @@ -67,8 +64,8 @@ $val = eval { }; 1; }; $err = $@; -ok $uerr eq "t3\n"; -ok !defined($val); -ok $err eq "t3\n"; +is($uerr, "t3\n"); +is($val, undef); +is($err, "t3\n"); -1; +done_testing(); diff --git a/t/op/gmagic.t b/t/op/gmagic.t index 850f50d..2979c08 100644 --- a/t/op/gmagic.t +++ b/t/op/gmagic.t @@ -1,67 +1,62 @@ #!./perl -w BEGIN { - $| = 1; chdir 't' if -d 't'; @INC = '../lib'; + require './test.pl'; } -print "1..24\n"; +use strict; -my $t = 1; tie my $c => 'Tie::Monitor'; -my $tied_to; -sub ok { - my($ok, $got, $exp, $rexp, $wexp) = @_; - my($rgot, $wgot) = ($tied_to || tied $c)->init(0); - print $ok ? "ok $t\n" : "# expected $exp, got $got\nnot ok $t\n"; - ++$t; - if ($rexp == $rgot && $wexp == $wgot) { - print "ok $t\n"; - } else { - print "# read $rgot expecting $rexp\n" if $rgot != $rexp; - print "# wrote $wgot expecting $wexp\n" if $wgot != $wexp; - print "not ok $t\n"; - } - ++$t; +sub expected_tie_calls { + my ($obj, $rexp, $wexp) = @_; + local $::Level = $::Level + 1; + my ($rgot, $wgot) = $obj->init(); + is ($rgot, $rexp); + is ($wgot, $wexp); } -sub ok_undef { ok(!defined($_[0]), shift, "undef", @_) } -sub ok_numeric { ok($_[0] == $_[1], @_) } -sub ok_string { ok($_[0] eq $_[1], @_) } - +# Use ok() instead of is(), cmp_ok() etc, to strictly control number of accesses my($r, $s); -# the thing itself -ok_numeric($r = $c + 0, 0, 1, 0); -ok_string($r = "$c", '0', 1, 0); - -# concat -ok_string($c . 'x', '0x', 1, 0); -ok_string('x' . $c, 'x0', 1, 0); +ok($r = $c + 0 == 0, 'the thing itself'); +expected_tie_calls(tied $c, 1, 0); +ok($r = "$c" eq '0', 'the thing itself'); +expected_tie_calls(tied $c, 1, 0); + +ok($c . 'x' eq '0x', 'concat'); +expected_tie_calls(tied $c, 1, 0); +ok('x' . $c eq 'x0', 'concat'); +expected_tie_calls(tied $c, 1, 0); $s = $c . $c; -ok_string($s, '00', 2, 0); +ok($s eq '00', 'concat'); +expected_tie_calls(tied $c, 2, 0); $r = 'x'; $s = $c = $r . 'y'; -ok_string($s, 'xy', 1, 1); +ok($s eq 'xy', 'concat'); +expected_tie_calls(tied $c, 1, 1); $s = $c = $c . 'x'; -ok_string($s, '0x', 2, 1); +ok($s eq '0x', 'concat'); +expected_tie_calls(tied $c, 2, 1); $s = $c = 'x' . $c; -ok_string($s, 'x0', 2, 1); +ok($s eq 'x0', 'concat'); +expected_tie_calls(tied $c, 2, 1); $s = $c = $c . $c; -ok_string($s, '00', 3, 1); +ok($s eq '00', 'concat'); +expected_tie_calls(tied $c, 3, 1); -# multiple magic in core functions $s = chop($c); -ok_string($s, '0', 1, 1); +ok($s eq '0', 'multiple magic in core functions'); +expected_tie_calls(tied $c, 1, 1); -# Assignment should not ignore magic when the last thing assigned # was a glob -$tied_to = tied $c; +my $tied_to = tied $c; $c = *strat; $s = $c; -ok_string $s, *strat, 1, 1; -$tied_to = undef; +ok($s eq *strat, + 'Assignment should not ignore magic when the last thing assigned was a glob'); +expected_tie_calls($tied_to, 1, 1); # A plain *foo should not call get-magic on *foo. # This method of scalar-tying an immutable glob relies on details of the @@ -71,11 +66,10 @@ my $tyre = tie $::{gelp} => 'Tie::Monitor'; # Compilation of this eval autovivifies the *gelp glob. eval '$tyre->init(0); () = \*gelp'; my($rgot, $wgot) = $tyre->init(0); -print "not " unless $rgot == 0; -print "ok ", $t++, " - a plain *foo causes no get-magic\n"; -print "not " unless $wgot == 0; -print "ok ", $t++, " - a plain *foo causes no set-magic\n"; +ok($rgot == 0, 'a plain *foo causes no get-magic'); +ok($wgot == 0, 'a plain *foo causes no set-magic'); +done_testing(); # adapted from Tie::Counter by Abigail package Tie::Monitor; diff --git a/t/re/overload.t b/t/re/overload.t index f89069b..4e99bd3 100644 --- a/t/re/overload.t +++ b/t/re/overload.t @@ -1,19 +1,13 @@ -#!./perl - -use strict; -use warnings; -no warnings 'syntax'; +#!./perl -w BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + require './test.pl'; } -sub is; -sub plan; - -require './test.pl'; -plan tests => 3; +use strict; +no warnings 'syntax'; { # Bug #77084 points out a corruption problem when scalar //g is used @@ -39,5 +33,4 @@ plan tests => 3; is $1, $TAG, "void context //g against overloaded object"; } - -__END__ +done_testing(); diff --git a/t/re/reg_email.t b/t/re/reg_email.t index 6255ee3..27f1f35 100644 --- a/t/re/reg_email.t +++ b/t/re/reg_email.t @@ -1,4 +1,4 @@ -#!./perl +#!./perl -w # # Tests to make sure the regexp engine doesn't run into limits too soon. # @@ -6,9 +6,10 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; + require './test.pl'; } -print "1..13\n"; +use strict; my $email = qr { (?(DEFINE) @@ -66,13 +67,9 @@ my $email = qr { (?&address) }x; - run_tests() unless caller; sub run_tests { - my $count = 0; - - $| = 1; # rewinding DATA is necessary with PERLIO=stdio when this # test is run from another thread seek *DATA, 0, 0; @@ -80,10 +77,14 @@ sub run_tests { while (<DATA>) { chomp; next if /^#/; - print /^$email$/ ? "ok " : "not ok ", ++ $count, "\n"; + like($_, qr/^$email$/, $_); } + + done_testing(); } +1; # Because reg_email_thr.t will (indirectly) require this script. + # # Acme::MetaSyntactic ++ # -- Perl5 Master Repository
