From: Nicholas Clark Date: Tue, 13 Oct 2009 14:10:40 +0000 (+0100) Subject: Move tests for $[ from comp/hints.t to op/array_base.t X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a026e652f130da8b58678a660c78f33c386027aa;p=p5sagit%2Fp5-mst-13.2.git Move tests for $[ from comp/hints.t to op/array_base.t Tests in t/comp/ are too early to rely on pragmata working. --- diff --git a/MANIFEST b/MANIFEST index 4052510..8b0f5d8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4311,6 +4311,7 @@ t/op/anonsub.t See if anonymous subroutines work t/op/append.t See if . works t/op/args.t See if operations on @_ work t/op/arith.t See if arithmetic works +t/op/array_base.aux Auxiliary file for the $[ test t/op/array_base.t Tests for the $[, which is deprecated t/op/array.t See if array operations work t/op/assignwarn.t See if OP= operators warn correctly for undef targets diff --git a/t/comp/hints.aux b/t/comp/hints.aux index 79b6dee..bb75d7b 100644 --- a/t/comp/hints.aux +++ b/t/comp/hints.aux @@ -1,5 +1,4 @@ -our($ra1, $ri1, $rf1, $rfe1); -$ra1 = $[; +our($ri1, $rf1, $rfe1); BEGIN { $ri1 = $^H; $rf1 = $^H{foo}; $rfe1 = exists($^H{foo}); } 1; diff --git a/t/comp/hints.t b/t/comp/hints.t index f197c6b..f8c6dca 100644 --- a/t/comp/hints.t +++ b/t/comp/hints.t @@ -4,7 +4,7 @@ @INC = '../lib'; -BEGIN { print "1..32\n"; } +BEGIN { print "1..23\n"; } BEGIN { print "not " if exists $^H{foo}; print "ok 1 - \$^H{foo} doesn't exist initially\n"; @@ -93,41 +93,20 @@ BEGIN { } { - $[ = 11; - print +($[ == 11 ? "" : "not "), "ok 17 - setting \$[ affects \$[\n"; - our $t11; BEGIN { $t11 = $^H{'$['} } - print +($t11 == 11 ? "" : "not "), "ok 18 - setting \$[ affects \$^H{'\$['}\n"; - - BEGIN { $^H{'$['} = 22 } - print +($[ == 22 ? "" : "not "), "ok 19 - setting \$^H{'\$['} affects \$[\n"; - our $t22; BEGIN { $t22 = $^H{'$['} } - print +($t22 == 22 ? "" : "not "), "ok 20 - setting \$^H{'\$['} affects \$^H{'\$['}\n"; - - BEGIN { %^H = () } - print +($[ == 0 ? "" : "not "), "ok 21 - clearing \%^H affects \$[\n"; - our $t0; BEGIN { $t0 = $^H{'$['} } - print +($t0 == 0 ? "" : "not "), "ok 22 - clearing \%^H affects \$^H{'\$['}\n"; -} - -{ - $[ = 13; BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; } our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; } - print +($[ == 13 ? "" : "not "), "ok 23 - \$[ correct before require\n"; - print +($ri0 & 0x04000000 ? "" : "not "), "ok 24 - \$^H correct before require\n"; - print +($rf0 eq "z" ? "" : "not "), "ok 25 - \$^H{foo} correct before require\n"; + print +($ri0 & 0x04000000 ? "" : "not "), "ok 17 - \$^H correct before require\n"; + print +($rf0 eq "z" ? "" : "not "), "ok 18 - \$^H{foo} correct before require\n"; our($ra1, $ri1, $rf1, $rfe1); BEGIN { require "comp/hints.aux"; } - print +($ra1 == 0 ? "" : "not "), "ok 26 - \$[ cleared for require\n"; - print +(!($ri1 & 0x04000000) ? "" : "not "), "ok 27 - \$^H cleared for require\n"; - print +(!defined($rf1) && !$rfe1 ? "" : "not "), "ok 28 - \$^H{foo} cleared for require\n"; + print +(!($ri1 & 0x04000000) ? "" : "not "), "ok 19 - \$^H cleared for require\n"; + print +(!defined($rf1) && !$rfe1 ? "" : "not "), "ok 20 - \$^H{foo} cleared for require\n"; our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; } - print +($[ == 13 ? "" : "not "), "ok 29 - \$[ correct after require\n"; - print +($ri2 & 0x04000000 ? "" : "not "), "ok 30 - \$^H correct after require\n"; - print +($rf2 eq "z" ? "" : "not "), "ok 31 - \$^H{foo} correct after require\n"; + print +($ri2 & 0x04000000 ? "" : "not "), "ok 21 - \$^H correct after require\n"; + print +($rf2 eq "z" ? "" : "not "), "ok 22 - \$^H{foo} correct after require\n"; } # Add new tests above this require, in case it fails. @@ -139,7 +118,7 @@ my $result = runperl( stderr => 1 ); print "not " if length $result; -print "ok 32 - double-freeing hints hash\n"; +print "ok 23 - double-freeing hints hash\n"; print "# got: $result\n" if length $result; __END__ diff --git a/t/op/array_base.aux b/t/op/array_base.aux new file mode 100644 index 0000000..79b6dee --- /dev/null +++ b/t/op/array_base.aux @@ -0,0 +1,5 @@ +our($ra1, $ri1, $rf1, $rfe1); +$ra1 = $[; +BEGIN { $ri1 = $^H; $rf1 = $^H{foo}; $rfe1 = exists($^H{foo}); } + +1; diff --git a/t/op/array_base.t b/t/op/array_base.t index 9804790..3cc9b24 100644 --- a/t/op/array_base.t +++ b/t/op/array_base.t @@ -3,7 +3,7 @@ use strict; require './test.pl'; -plan (tests => 8); +plan (tests => 24); no warnings 'deprecated'; # Bug #27024 @@ -36,3 +36,47 @@ no warnings 'deprecated'; like($@, qr/That use of \$\[ is unsupported/, 'cannot assign list of <1 elements to $['); } + + +{ + $[ = 11; + cmp_ok($[ + 0, '==', 11, 'setting $[ affects $['); + our $t11; BEGIN { $t11 = $^H{'$['} } + cmp_ok($t11, '==', 11, 'setting $[ affects $^H{\'$[\'}'); + + BEGIN { $^H{'$['} = 22 } + cmp_ok($[ + 0, '==', 22, 'setting $^H{\'$\'} affects $['); + our $t22; BEGIN { $t22 = $^H{'$['} } + cmp_ok($t22, '==', 22, 'setting $^H{\'$[\'} affects $^H{\'$[\'}'); + + BEGIN { %^H = () } + my $val = do { + no warnings 'uninitialized'; + $[; + }; + cmp_ok($val, '==', 0, 'clearing %^H affects $['); + our $t0; BEGIN { $t0 = $^H{'$['} } + cmp_ok($t0, '==', 0, 'clearing %^H affects $^H{\'$[\'}'); +} + +{ + $[ = 13; + BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; } + + our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; } + cmp_ok($[ + 0, '==', 13, '$[ correct before require'); + ok($ri0 & 0x04000000, '$^H correct before require'); + is($rf0, "z", '$^H{foo} correct before require'); + + our($ra1, $ri1, $rf1, $rfe1); + BEGIN { require "op/array_base.aux"; } + cmp_ok($ra1, '==', 0, '$[ cleared for require'); + ok(!($ri1 & 0x04000000), '$^H cleared for require'); + is($rf1, undef, '$^H{foo} cleared for require'); + ok(!$rfe1, '$^H{foo} cleared for require'); + + our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; } + cmp_ok($[ + 0, '==', 13, '$[ correct after require'); + ok($ri2 & 0x04000000, '$^H correct after require'); + is($rf2, "z", '$^H{foo} correct after require'); +}