Change 33133 by [EMAIL PROTECTED] on 2008/01/30 18:46:51
Integrate:
[ 32724]
A test for upgrading scalars. Curiously, before this, lib/Math/Trig.t
was the only code anywhere in the build or testsuite that upgraded an
NV to an RV.
[ 32726]
Use print rather than diag(), as these routine messages shouldn't be
going to STDERR.
[ 32746]
Localize $\ before changing it, so as not to affect print statements in
the rest of the test.
[ 32747]
Proper $TODO support in &ok() and &iseq() in pat.t
[ 32749]
Better diagnostics for the tests for #20683.
[ 32801]
Subject: [PATCH] shield t/test.pl functions from global print modifiers
From: Michael G Schwern <[EMAIL PROTECTED]>
Date: Tue, 01 Jan 2008 18:12:36 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 32839]
Protect me (and my fellow muppets) from screens of "syntax errors" if
one accidentally feeds embed.fnc or t/op/re_tests to the perl
interpreter.
[ 32842]
Make ext/re/t/re_funcs.t warnings clean.
[ 32856]
$Test::Harness::Verbose is a numeric value now so assigning -v to it
isnt all that helpful.
[ 32897]
Subject: [PATCH] ARRAY(0x...) is not very helpful in sprintf.t
diagnostics
Message-ID: <[EMAIL PROTECTED]>
From: "Yitzchak Scott-Thoennes" <[EMAIL PROTECTED]>
Date: Mon, 7 Jan 2008 23:24:01 -0800 (PST)
[ 32930]
grep the MANIFEST to avoid having hard coded numbers in readdir.t
[ 32988]
Generate the warnings masks programatically.
Get the correct line number when reporting errors from &check_bits.
[ 32995]
New tests for new ops. Most of them are TODO
[ 33058]
Subject: [PATCH t/cmd/for.t] Regression tests for 'for reverse ..'
From: Abigail <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
Date: Wed, 23 Jan 2008 23:53:25 +0100
[ 33087]
Test that lc, uc, etc on undef return ""
Affected files ...
... //depot/maint-5.10/perl/MANIFEST#9 integrate
... //depot/maint-5.10/perl/embed.fnc#3 integrate
... //depot/maint-5.10/perl/ext/Safe/t/safeops.t#2 integrate
... //depot/maint-5.10/perl/ext/re/t/re_funcs.t#2 integrate
... //depot/maint-5.10/perl/t/cmd/for.t#2 integrate
... //depot/maint-5.10/perl/t/harness#2 integrate
... //depot/maint-5.10/perl/t/op/caller.t#2 integrate
... //depot/maint-5.10/perl/t/op/lc.t#2 integrate
... //depot/maint-5.10/perl/t/op/pat.t#3 integrate
... //depot/maint-5.10/perl/t/op/re_tests#2 integrate
... //depot/maint-5.10/perl/t/op/readdir.t#2 integrate
... //depot/maint-5.10/perl/t/op/regexp.t#2 integrate
... //depot/maint-5.10/perl/t/op/sprintf.t#2 integrate
... //depot/maint-5.10/perl/t/op/upgrade.t#1 branch
... //depot/maint-5.10/perl/t/test.pl#2 integrate
Differences ...
==== //depot/maint-5.10/perl/MANIFEST#9 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#8~33132~ 2008-01-30 10:18:00.000000000 -0800
+++ perl/MANIFEST 2008-01-30 10:46:51.000000000 -0800
@@ -3850,6 +3850,7 @@
t/op/undef.t See if undef works
t/op/universal.t See if UNIVERSAL class works
t/op/unshift.t See if unshift works
+t/op/upgrade.t See if upgrading and assigning scalars works
t/op/utf8decode.t See if UTF-8 decoding works
t/op/utfhash.t See if utf8 keys in hashes behave
t/op/utftaint.t See if utf8 and taint work together
==== //depot/maint-5.10/perl/embed.fnc#3 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#2~33123~ 2008-01-30 03:45:08.000000000 -0800
+++ perl/embed.fnc 2008-01-30 10:46:51.000000000 -0800
@@ -1,3 +1,5 @@
+: BEGIN {die "You meant to run embed.pl"} # Stop early if fed to perl.
+:
: Lines are of the form:
: flags|return_type|function_name|arg1|arg2|...|argN
:
==== //depot/maint-5.10/perl/ext/Safe/t/safeops.t#2 (text) ====
Index: perl/ext/Safe/t/safeops.t
--- perl/ext/Safe/t/safeops.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/Safe/t/safeops.t 2008-01-30 10:46:51.000000000 -0800
@@ -49,7 +49,7 @@
sub testop {
my ($op, $opname, $code) = @_;
pass("$op : skipped") and return if $code =~ /^SKIP/;
- pass("$op : skipped") and return if $code =~ m://: && $] < 5.009; # no dor
+ pass("$op : skipped") and return if $code =~ m://|~~: && $] < 5.010;
my $c = new Safe;
$c->deny_only($op);
$c->reval($code);
@@ -423,4 +423,10 @@
method_named $x->y()
dor $x // $y
dorassign $x //= $y
+once SKIP {use feature 'state'; state $foo = 42;}
+say SKIP {use feature 'say'; say "foo";}
+smartmatch $x ~~ $y
+aeach SKIP each @t
+akeys SKIP keys @t
+avalues SKIP values @t
custom SKIP (no way)
==== //depot/maint-5.10/perl/ext/re/t/re_funcs.t#2 (text) ====
Index: perl/ext/re/t/re_funcs.t
--- perl/ext/re/t/re_funcs.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/ext/re/t/re_funcs.t 2008-01-30 10:46:51.000000000 -0800
@@ -11,6 +11,7 @@
}
use strict;
+use warnings;
use Test::More; # test count at bottom of file
use re qw(is_regexp regexp_pattern regmust
@@ -42,7 +43,7 @@
if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
my @names = sort +regnames();
is("@names","A B","regnames");
- my @names = sort +regnames(0);
+ @names = sort +regnames(0);
is("@names","A B","regnames");
my $names = regnames();
is($names, "B", "regnames in scalar context");
==== //depot/maint-5.10/perl/t/cmd/for.t#2 (xtext) ====
Index: perl/t/cmd/for.t
--- perl/t/cmd/for.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/cmd/for.t 2008-01-30 10:46:51.000000000 -0800
@@ -1,6 +1,6 @@
#!./perl
-print "1..80\n";
+print "1..118\n";
for ($i = 0; $i <= 10; $i++) {
$x[$i] = $i;
@@ -129,6 +129,16 @@
$r .= $_;
}
is ($r, '123', 'Forwards for list via map');
+$r = '';
+for (1 .. 3) {
+ $r .= $_;
+}
+is ($r, '123', 'Forwards for list via ..');
+$r = '';
+for ('A' .. 'C') {
+ $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for list via ..');
$r = '';
for (reverse @array) {
@@ -150,6 +160,16 @@
$r .= $_;
}
is ($r, '321', 'Reverse for list via map');
+$r = '';
+for (reverse 1 .. 3) {
+ $r .= $_;
+}
+is ($r, '321', 'Reverse for list via ..');
+$r = '';
+for (reverse 'A' .. 'C') {
+ $r .= $_;
+}
+is ($r, 'CBA', 'Reverse orwards for list via ..');
$r = '';
for my $i (@array) {
@@ -171,6 +191,16 @@
$r .= $i;
}
is ($r, '123', 'Forwards for list via map with var');
+$r = '';
+for my $i (1 .. 3) {
+ $r .= $i;
+}
+is ($r, '123', 'Forwards for list via .. with var');
+$r = '';
+for my $i ('A' .. 'C') {
+ $r .= $i;
+}
+is ($r, 'ABC', 'Forwards for list via .. with var');
$r = '';
for my $i (reverse @array) {
@@ -192,6 +222,16 @@
$r .= $i;
}
is ($r, '321', 'Reverse for list via map with var');
+$r = '';
+for my $i (reverse 1 .. 3) {
+ $r .= $i;
+}
+is ($r, '321', 'Reverse for list via .. with var');
+$r = '';
+for my $i (reverse 'A' .. 'C') {
+ $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for list via .. with var');
# For some reason the generate optree is different when $_ is implicit.
$r = '';
@@ -214,6 +254,16 @@
$r .= $_;
}
is ($r, '123', 'Forwards for list via map with explicit $_');
+$r = '';
+for $_ (1 .. 3) {
+ $r .= $_;
+}
+is ($r, '123', 'Forwards for list via .. with var with explicit $_');
+$r = '';
+for $_ ('A' .. 'C') {
+ $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for list via .. with var with explicit $_');
$r = '';
for $_ (reverse @array) {
@@ -235,6 +285,16 @@
$r .= $_;
}
is ($r, '321', 'Reverse for list via map with explicit $_');
+$r = '';
+for $_ (reverse 1 .. 3) {
+ $r .= $_;
+}
+is ($r, '321', 'Reverse for list via .. with var with explicit $_');
+$r = '';
+for $_ (reverse 'A' .. 'C') {
+ $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for list via .. with var with explicit $_');
# I don't think that my is that different from our in the optree. But test a
# few:
@@ -258,6 +318,16 @@
$r .= $i;
}
is ($r, '321', 'Reverse for list via map with our var');
+$r = '';
+for our $i (reverse 1 .. 3) {
+ $r .= $i;
+}
+is ($r, '321', 'Reverse for list via .. with our var');
+$r = '';
+for our $i (reverse 'A' .. 'C') {
+ $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for list via .. with our var');
$r = '';
@@ -280,6 +350,16 @@
$r .= $_;
}
is ($r, 'A321', 'Reverse for list via map with leading value');
+$r = '';
+for ('A', reverse 1 .. 3) {
+ $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value');
+$r = '';
+for (1, reverse 'A' .. 'C') {
+ $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value');
$r = '';
for (reverse (@array), 1) {
@@ -301,6 +381,16 @@
$r .= $_;
}
is ($r, '321A', 'Reverse for list via map with trailing value');
+$r = '';
+for (reverse (1 .. 3), 'A') {
+ $r .= $_;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value');
+$r = '';
+for (reverse ('A' .. 'C'), 1) {
+ $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value');
$r = '';
@@ -324,6 +414,16 @@
$r .= $_;
}
is ($r, 'A321', 'Reverse for list via map with leading value with explicit
$_');
+$r = '';
+for $_ ('A', reverse 1 .. 3) {
+ $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value with explicit $_');
+$r = '';
+for $_ (1, reverse 'A' .. 'C') {
+ $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value with explicit $_');
$r = '';
for $_ (reverse (@array), 1) {
@@ -347,6 +447,16 @@
}
is ($r, '321A',
'Reverse for list via map with trailing value with explicit $_');
+$r = '';
+for $_ (reverse (1 .. 3), 'A') {
+ $r .= $_;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value with explicit
$_');
+$r = '';
+for $_ (reverse ('A' .. 'C'), 1) {
+ $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value with explicit
$_');
$r = '';
for my $i (1, reverse @array) {
@@ -368,6 +478,16 @@
$r .= $i;
}
is ($r, 'A321', 'Reverse for list via map with leading value and var');
+$r = '';
+for my $i ('A', reverse 1 .. 3) {
+ $r .= $i;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value and var');
+$r = '';
+for my $i (1, reverse 'A' .. 'C') {
+ $r .= $i;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value and var');
$r = '';
for my $i (reverse (@array), 1) {
@@ -389,6 +509,16 @@
$r .= $i;
}
is ($r, '321A', 'Reverse for list via map with trailing value and var');
+$r = '';
+for my $i (reverse (1 .. 3), 'A') {
+ $r .= $i;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value and var');
+$r = '';
+for my $i (reverse ('A' .. 'C'), 1) {
+ $r .= $i;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value and var');
$r = '';
@@ -401,6 +531,26 @@
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for value and array via map');
+$r = '';
+for (reverse 1 .. 3, @array) {
+ $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array');
+$r = '';
+for (reverse 'X' .. 'Z', @array) {
+ $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array');
+$r = '';
+for (reverse map {$_} 1 .. 3, @array) {
+ $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map');
+$r = '';
+for (reverse map {$_} 'X' .. 'Z', @array) {
+ $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map');
$r = '';
for (reverse (@array, 1)) {
@@ -423,6 +573,26 @@
$r .= $_;
}
is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_');
+$r = '';
+for $_ (reverse 1 .. 3, @array) {
+ $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array with explicit $_');
+$r = '';
+for $_ (reverse 'X' .. 'Z', @array) {
+ $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 1 .. 3, @array) {
+ $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 'X' .. 'Z', @array) {
+ $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map with explicit $_');
$r = '';
for $_ (reverse (@array, 1)) {
@@ -446,6 +616,26 @@
$r .= $i;
}
is ($r, 'CBA1', 'Reverse for value and array via map with var');
+$r = '';
+for my $i (reverse 1 .. 3, @array) {
+ $r .= $i;
+}
+is ($r, 'CBA321', 'Reverse for .. and array with var');
+$r = '';
+for my $i (reverse 'X' .. 'Z', @array) {
+ $r .= $i;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array with var');
+$r = '';
+for my $i (reverse map {$_} 1 .. 3, @array) {
+ $r .= $i;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map with var');
+$r = '';
+for my $i (reverse map {$_} 'X' .. 'Z', @array) {
+ $r .= $i;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map with var');
$r = '';
for my $i (reverse (@array, 1)) {
==== //depot/maint-5.10/perl/t/harness#2 (text) ====
Index: perl/t/harness
--- perl/t/harness#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/harness 2008-01-30 10:46:51.000000000 -0800
@@ -14,7 +14,7 @@
use Test::Harness;
$Test::Harness::switches = ""; # Too much noise otherwise
-$Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
+$Test::Harness::Verbose++ while @ARGV && $ARGV[0] eq '-v' && shift;
if ($ARGV[0] && $ARGV[0] eq '-torture') {
shift;
==== //depot/maint-5.10/perl/t/op/caller.t#2 (text) ====
Index: perl/t/op/caller.t
--- perl/t/op/caller.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/caller.t 2008-01-30 10:46:51.000000000 -0800
@@ -77,6 +77,7 @@
sub check_bits
{
+ local $Level = $Level + 2;
my ($got, $exp, $desc) = @_;
if (! ok($got eq $exp, $desc)) {
diag(' got: ' . show_bits($got));
@@ -90,22 +91,32 @@
check_bits( (caller(0))[9], $w, "warnings match caller ($id)");
}
-# NB : extend the warning mask values below when new warnings are added
{
no warnings;
+ # Build the warnings mask dynamically
+ my ($default, $registered);
+ BEGIN {
+ for my $i (0..$warnings::LAST_BIT/2 - 1) {
+ vec($default, $i, 2) = 1;
+ }
+ $registered = $default;
+ vec($registered, $warnings::LAST_BIT/2, 2) = 1;
+ }
BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 12, 'all bits off via "no
warnings"' ) }
testwarn("\0" x 12, 'no bits');
use warnings;
- BEGIN { check_bits( ${^WARNING_BITS},
"\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", 'default bits on via "use
warnings"' ); }
- BEGIN { testwarn("\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05",
'all'); }
+ BEGIN { check_bits( ${^WARNING_BITS}, $default,
+ 'default bits on via "use warnings"' ); }
+ BEGIN { testwarn($default, 'all'); }
# run-time :
# the warning mask has been extended by warnings::register
- testwarn("\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", 'ahead of
w::r');
+ testwarn($registered, 'ahead of w::r');
use warnings::register;
- BEGIN { check_bits( ${^WARNING_BITS},
"\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", 'warning bits on via "use
warnings::register"' ) }
- testwarn("\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", 'following
w::r');
+ BEGIN { check_bits( ${^WARNING_BITS}, $registered,
+ 'warning bits on via "use warnings::register"' ) }
+ testwarn($registered, 'following w::r');
}
==== //depot/maint-5.10/perl/t/op/lc.t#2 (text) ====
Index: perl/t/op/lc.t
--- perl/t/op/lc.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/lc.t 2008-01-30 10:46:51.000000000 -0800
@@ -6,7 +6,12 @@
require './test.pl';
}
-plan tests => 88;
+plan tests => 92;
+
+is(lc(undef), "", "lc(undef) is ''");
+is(lcfirst(undef), "", "lcfirst(undef) is ''");
+is(uc(undef), "", "uc(undef) is ''");
+is(ucfirst(undef), "", "ucfirst(undef) is ''");
$a = "HELLO.* world";
$b = "hello.* WORLD";
==== //depot/maint-5.10/perl/t/op/pat.t#3 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#2~33132~ 2008-01-30 10:18:00.000000000 -0800
+++ perl/t/op/pat.t 2008-01-30 10:46:51.000000000 -0800
@@ -2033,9 +2033,10 @@
# Force scalar context on the patern match
sub ok ($;$) {
my($ok, $name) = @_;
+ my $todo = $TODO ? " # TODO $TODO" : '';
printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
- ($name||$Message)."\tLine ".((caller)[2]);
+ ($name||$Message)."$todo\tLine ".((caller)[2]);
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
@@ -3074,12 +3075,15 @@
ok($a !~ /^\C{4}y/, q{don't match \C{4}y});
}
-$_ = 'aaaaaaaaaa';
-utf8::upgrade($_); chop $_; $\="\n";
-ok(/[^\s]+/, "m/[^\s]/ utf8");
-ok(/[^\d]+/, "m/[^\d]/ utf8");
-ok(($a = $_, $_ =~ s/[^\s]+/./g), "s/[^\s]/ utf8");
-ok(($a = $_, $a =~ s/[^\d]+/./g), "s/[^\s]/ utf8");
+{
+ local $\;
+ $_ = 'aaaaaaaaaa';
+ utf8::upgrade($_); chop $_; $\="\n";
+ ok(/[^\s]+/, "m/[^\s]/ utf8");
+ ok(/[^\d]+/, "m/[^\d]/ utf8");
+ ok(($a = $_, $_ =~ s/[^\s]+/./g), "s/[^\s]/ utf8");
+ ok(($a = $_, $a =~ s/[^\d]+/./g), "s/[^\s]/ utf8");
+}
ok("\x{100}" =~ /\x{100}/, "[perl #15397]");
ok("\x{100}" =~ /(\x{100})/, "[perl #15397]");
@@ -3134,13 +3138,13 @@
foreach (1,2,3,4) {
$p++ if /(??{ $p })/
}
- ok ($p == 5, "[perl #20683] (??{ }) returns stale values");
+ iseq ($p, 5, "[perl #20683] (??{ }) returns stale values");
{ package P; $a=1; sub TIESCALAR { bless[] } sub FETCH { $a++ } }
tie $p, P;
foreach (1,2,3,4) {
/(??{ $p })/
}
- ok ( $p == 5, "(??{ }) returns stale values");
+ iseq ( $p, 5, "(??{ }) returns stale values");
}
{
@@ -3445,6 +3449,7 @@
}
{
+ local $TODO = "See changes 26925-26928, which reverted change 26410";
package lv;
$var = "abc";
sub variable : lvalue { $var }
@@ -3453,16 +3458,17 @@
my $o = bless [], "lv";
my $f = "";
eval { for (1..2) { $f .= $1 if $o->variable =~ /(.)/g } };
- ok($f eq "ab", "pos retained between calls # TODO") or print "# [EMAIL
PROTECTED]";
+ ok($f eq "ab", "pos retained between calls") or print "# [EMAIL
PROTECTED]";
}
{
+ local $TODO = "See changes 26925-26928, which reverted change 26410";
$var = "abc";
sub variable : lvalue { $var }
my $f = "";
eval { for (1..2) { $f .= $1 if variable() =~ /(.)/g } };
- ok($f eq "ab", "pos retained between calls # TODO") or print "# [EMAIL
PROTECTED]";
+ ok($f eq "ab", "pos retained between calls") or print "# [EMAIL
PROTECTED]";
}
# [perl #37836] Simple Regex causes SEGV when run on specific data
@@ -3692,13 +3698,14 @@
sub iseq($$;$) {
my ( $got, $expect, $name)[EMAIL PROTECTED];
+ my $todo = $TODO ? " # TODO $TODO" : '';
$_=defined($_) ? "'$_'" : "undef"
for $got, $expect;
my $ok= $got eq $expect;
- printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+ printf "%sok %d - %s$todo\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
printf "# Failed test at line %d\n".
@@ -4106,12 +4113,13 @@
iseq($^R,'Nothing');
}
{
- local $Message="RT#22395";
+ local $Message="RT 22395";
+ local $TODO = "Should be L+1 not L*(L+3)/2 (L=$l)";
our $count;
for my $l (10,100,1000) {
$count=0;
('a' x $l) =~ /(.*)(?{$count++})[bc]/;
- iseq( $count, $l + 1, "# TODO Should be L+1 not L*(L+3)/2 (L=$l)");
+ iseq( $count, $l + 1);
}
}
{
==== //depot/maint-5.10/perl/t/op/re_tests#2 (text) ====
Index: perl/t/op/re_tests
--- perl/t/op/re_tests#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/re_tests 2008-01-30 10:46:51.000000000 -0800
@@ -1,3 +1,6 @@
+# This stops me getting screenfulls of syntax errors every time I accidentally
+# run this file via a shell glob
+__END__
abc abc y $& abc
abc abc y $-[0] 0
abc abc y $+[0] 3
==== //depot/maint-5.10/perl/t/op/readdir.t#2 (xtext) ====
Index: perl/t/op/readdir.t
--- perl/t/op/readdir.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/readdir.t 2008-01-30 10:46:51.000000000 -0800
@@ -20,11 +20,12 @@
@D = grep(/^[^\.].*\.t$/i, readdir(OP));
closedir(OP);
-##
-## This range will have to adjust as the number of tests expands,
-## as it's counting the number of .t files in src/t
-##
-my ($min, $max) = (150, 170);
+open $man, "<../MANIFEST" or die "Can't open ../MANIFEST: $!";
+my $expect;
+while (<$man>) {
+ ++$expect if m!^t/op/[^/]+\t!;
+}
+my ($min, $max) = ($expect - 10, $expect + 10);
if (@D > $min && @D < $max) { print "ok 2\n"; }
else {
printf "not ok 2 # counting op/*.t, expect $min < %d < $max files\n",
==== //depot/maint-5.10/perl/t/op/regexp.t#2 (xtext) ====
Index: perl/t/op/regexp.t
--- perl/t/op/regexp.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/regexp.t 2008-01-30 10:46:51.000000000 -0800
@@ -77,9 +77,9 @@
TEST:
foreach (@tests) {
$test++;
- if (!/\S/ || /^\s*#/) {
+ if (!/\S/ || /^\s*#/ || /^__END__$/) {
print "ok $test # (Blank line or comment)\n";
- if (/\S/) { print $_ };
+ if (/#/) { print $_ };
next;
}
chomp;
==== //depot/maint-5.10/perl/t/op/sprintf.t#2 (xtext) ====
Index: perl/t/op/sprintf.t
--- perl/t/op/sprintf.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/op/sprintf.t 2008-01-30 10:46:51.000000000 -0800
@@ -49,8 +49,8 @@
}
$evalData = eval $data;
- $data = ref $evalData ? $evalData : [$evalData];
- push @tests, [$template, $data, $result, $comment];
+ $evalData = ref $evalData ? $evalData : [$evalData];
+ push @tests, [$template, $evalData, $result, $comment, $data];
}
print '1..', scalar @tests, "\n";
@@ -66,9 +66,9 @@
};
for ($i = 1; @tests; $i++) {
- ($template, $data, $result, $comment) = @{shift @tests};
+ ($template, $evalData, $result, $comment, $data) = @{shift @tests};
$w = undef;
- $x = sprintf(">$template<", @$data);
+ $x = sprintf(">$template<", @$evalData);
substr($x, -1, 0) = $w if $w;
# $x may have 3 exponent digits, not 2
my $y = $x;
==== //depot/maint-5.10/perl/t/op/upgrade.t#1 (text) ====
Index: perl/t/op/upgrade.t
--- /dev/null 2008-01-30 12:36:05.487199339 -0800
+++ perl/t/op/upgrade.t 2008-01-30 10:46:51.000000000 -0800
@@ -0,0 +1,50 @@
+#!./perl -w
+
+# Check that we can "upgrade" from anything to anything else.
+# Curiously, before this, lib/Math/Trig.t was the only code anywhere in the
+# build or testsuite that upgraded an NV to an RV
+
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+use strict;
+
+my $null;
+
+$! = 1;
+my %types = (
+ null => $null,
+ iv => 3,
+ nv => .5,
+ rv => [],
+ pv => "Perl rules",
+ pviv => 3,
+ pvnv => 1==1,
+ pvmg => $^,
+);
+
+# This is somewhat cheating but I can't think of anything built in that I can
+# copy that already has type PVIV
+$types{pviv} = "Perl rules!";
+
+# use Devel::Peek; Dump $pvmg;
+
+my @keys = keys %types;
+plan tests => @keys * @keys;
+
+foreach my $source_type (@keys) {
+ foreach my $dest_type (@keys) {
+ # Pads re-using variables might contaminate this
+ my $vars = {};
+ $vars->{dest} = $types{$dest_type};
+ $vars->{source} = $types{$source_type};
+ # The assignment can potentially trigger assertion failures, so it's
+ # useful to have the diagnostics about what was attempted printed first
+ print "# Assigning $source_type to $dest_type\n";
+ $vars->{dest} = $vars->{source};
+ is ($vars->{dest}, $vars->{source});
+ }
+}
==== //depot/maint-5.10/perl/t/test.pl#2 (text) ====
Index: perl/t/test.pl
--- perl/t/test.pl#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/t/test.pl 2008-01-30 10:46:51.000000000 -0800
@@ -24,6 +24,17 @@
$TODO = 0;
$NO_ENDING = 0;
+# Use this instead of print to avoid interference while testing globals.
+sub _print {
+ local($\, $", $,) = (undef, ' ', '');
+ print STDOUT @_;
+}
+
+sub _print_stderr {
+ local($\, $", $,) = (undef, ' ', '');
+ print STDERR @_;
+}
+
sub plan {
my $n;
if (@_ == 1) {
@@ -36,7 +47,7 @@
my %plan = @_;
$n = $plan{tests};
}
- print STDOUT "1..$n\n" unless $noplan;
+ _print "1..$n\n" unless $noplan;
$planned = $n;
}
@@ -44,10 +55,10 @@
my $ran = $test - 1;
if (!$NO_ENDING) {
if (defined $planned && $planned != $ran) {
- print STDERR
+ _print_stderr
"# Looks like you planned $planned tests but ran $ran.\n";
} elsif ($noplan) {
- print "1..$ran\n";
+ _print "1..$ran\n";
}
}
}
@@ -58,8 +69,8 @@
return unless @_;
my @mess = map { /^#/ ? "$_\n" : "# $_\n" }
map { split /\n/ } @_;
- my $fh = $TODO ? *STDOUT : *STDERR;
- print $fh @mess;
+ my $func = $TODO ? \&_print : \&_print_stderr;
+ $func->(@mess);
}
@@ -69,9 +80,9 @@
sub skip_all {
if (@_) {
- print STDOUT "1..0 # Skipped: @_\n";
+ _print "1..0 # Skipped: @_\n";
} else {
- print STDOUT "1..0\n";
+ _print "1..0\n";
}
exit(0);
}
@@ -90,7 +101,7 @@
}
$out .= " # TODO $TODO" if $TODO;
- print STDOUT "$out\n";
+ _print "$out\n";
unless ($pass) {
_diag "# Failed $where\n";
@@ -306,7 +317,7 @@
my $why = shift;
my $n = @_ ? shift : 1;
for (1..$n) {
- print STDOUT "ok $test # skip: $why\n";
+ _print "ok $test # skip: $why\n";
$test = $test + 1;
}
local $^W = 0;
@@ -318,7 +329,7 @@
my $n = @_ ? shift : 1;
for (1..$n) {
- print STDOUT "not ok $test # TODO & SKIP: $why\n";
+ _print "not ok $test # TODO & SKIP: $why\n";
$test = $test + 1;
}
local $^W = 0;
@@ -345,12 +356,12 @@
$key = "" . $key;
if (exists $orig->{$key}) {
if ($orig->{$key} ne $value) {
- print STDOUT "# key ", _qq($key), " was ", _qq($orig->{$key}),
+ _print "# key ", _qq($key), " was ", _qq($orig->{$key}),
" now ", _qq($value), "\n";
$fail = 1;
}
} else {
- print STDOUT "# key ", _qq($key), " is ", _qq($value),
+ _print "# key ", _qq($key), " is ", _qq($value),
", not in original.\n";
$fail = 1;
}
@@ -359,7 +370,7 @@
# Force a hash recompute if this perl's internals can cache the hash key.
$_ = "" . $_;
next if (exists $suspect->{$_});
- print STDOUT "# key ", _qq($_), " was ", _qq($orig->{$_}), " now
missing.\n";
+ _print "# key ", _qq($_), " was ", _qq($orig->{$_}), " now missing.\n";
$fail = 1;
}
!$fail;
@@ -476,7 +487,7 @@
if ($args{verbose}) {
my $stdindisplay = $stdin;
$stdindisplay =~ s/\n/\n\#/g;
- print STDERR "# $stdindisplay\n";
+ _print_stderr "# $stdindisplay\n";
}
`$stdin`;
$runperl .= q{ < teststdin };
@@ -494,7 +505,7 @@
if ($args{verbose}) {
my $runperldisplay = $runperl;
$runperldisplay =~ s/\n/\n\#/g;
- print STDERR "# $runperldisplay\n";
+ _print_stderr "# $runperldisplay\n";
}
return $runperl;
}
@@ -547,7 +558,7 @@
*run_perl = \&runperl; # Nice alias.
sub DIE {
- print STDERR "# @_\n";
+ _print_stderr "# @_\n";
exit 1;
}
@@ -603,7 +614,7 @@
sub unlink_all {
foreach my $file (@_) {
1 while unlink $file;
- print STDERR "# Couldn't unlink '$file': $!\n" if -f $file;
+ _print_stderr "# Couldn't unlink '$file': $!\n" if -f $file;
}
}
End of Patch.
