Change 33216 by [EMAIL PROTECTED] on 2008/02/02 22:23:57
Integrate:
[ 33133]
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 ""
[ 33151]
Integrate:
[ 32869]
Fix bug #49298: B::Deparse fails to deparse a reference to an anonymous
hash
[ 32909]
Subject: [PATCH] B::Deparse fixes for implicit smartmatching in
given/when
From: Florian Ragwitz <[EMAIL PROTECTED]>
Date: Tue, 8 Jan 2008 19:56:47 +0100
Message-ID: <[EMAIL PROTECTED]>
[ 33162]
Integrate:
[ 33127]
Formatting for C<<{ bydepth => 1 }>> doesn't seem to be working
right in the manpage.
[ 33144]
Subject: [PATCH] fix for regression to File/DosGlob.pm
From: "Davies, Alex" <[EMAIL PROTECTED]>
Date: Wed, 30 Jan 2008 12:39:11 -0500
Message-ID: <[EMAIL PROTECTED]>
Fixes File::DosGlob's handling of drive relative glob patterns
(e.g. "D:*pl")
[ 33165]
Integrate:
[ 32878]
Fix "grep in void context" warnings
[ 33163]
The penultimate deparse test needs a name, else things can warn.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#422 integrate
... //depot/maint-5.8/perl/embed.fnc#242 integrate
... //depot/maint-5.8/perl/ext/B/t/deparse.t#18 integrate
... //depot/maint-5.8/perl/ext/SDBM_File/t/sdbm.t#4 integrate
... //depot/maint-5.8/perl/ext/Safe/t/safeops.t#5 integrate
... //depot/maint-5.8/perl/ext/re/t/re_funcs.t#1 branch
... //depot/maint-5.8/perl/t/cmd/for.t#8 integrate
... //depot/maint-5.8/perl/t/harness#9 integrate
... //depot/maint-5.8/perl/t/op/caller.t#5 integrate
... //depot/maint-5.8/perl/t/op/lc.t#14 integrate
... //depot/maint-5.8/perl/t/op/pat.t#51 integrate
... //depot/maint-5.8/perl/t/op/re_tests#20 integrate
... //depot/maint-5.8/perl/t/op/readdir.t#5 integrate
... //depot/maint-5.8/perl/t/op/regexp.t#6 integrate
... //depot/maint-5.8/perl/t/op/sprintf.t#22 integrate
... //depot/maint-5.8/perl/t/op/upgrade.t#1 branch
... //depot/maint-5.8/perl/t/test.pl#23 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#422 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#421~33211~ 2008-02-02 12:21:10.000000000 -0800
+++ perl/MANIFEST 2008-02-02 14:23:57.000000000 -0800
@@ -3137,6 +3137,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.8/perl/embed.fnc#242 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#241~33214~ 2008-02-02 14:01:39.000000000 -0800
+++ perl/embed.fnc 2008-02-02 14:23:57.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.8/perl/ext/B/t/deparse.t#18 (text) ====
Index: perl/ext/B/t/deparse.t
--- perl/ext/B/t/deparse.t#17~33215~ 2008-02-02 14:01:58.000000000 -0800
+++ perl/ext/B/t/deparse.t 2008-02-02 14:23:57.000000000 -0800
@@ -396,13 +396,14 @@
keys @$a if keys @ARGV;
values @ARGV if values @$a;
####
+# 51 Anonymous arrays and hashes, and references to them
my $a = {};
my $b = \{};
my $c = [];
my $d = \[];
####
# SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl
version"
-# 51 implicit smartmatch in given/when
+# 52 implicit smartmatch in given/when
given ('foo') {
when ('bar') { continue; }
when ($_ ~~ 'quux') { continue; }
==== //depot/maint-5.8/perl/ext/SDBM_File/t/sdbm.t#4 (text) ====
Index: perl/ext/SDBM_File/t/sdbm.t
--- perl/ext/SDBM_File/t/sdbm.t#3~20962~ 2003-08-31 01:12:31.000000000
-0700
+++ perl/ext/SDBM_File/t/sdbm.t 2008-02-02 14:23:57.000000000 -0800
@@ -490,7 +490,7 @@
$h{"fred"} = "joe" ;
ok(76, $h{"fred"} eq "joe");
- eval { grep { $h{$_} } (1, 2, 3) };
+ eval { map { $h{$_} } (1, 2, 3) };
ok (77, ! $@);
@@ -506,7 +506,7 @@
ok(79, $db->FIRSTKEY() eq "fred") ;
- eval { grep { $h{$_} } (1, 2, 3) };
+ eval { map { $h{$_} } (1, 2, 3) };
ok (80, ! $@);
undef $db ;
==== //depot/maint-5.8/perl/ext/Safe/t/safeops.t#5 (text) ====
Index: perl/ext/Safe/t/safeops.t
--- perl/ext/Safe/t/safeops.t#4~30787~ 2007-03-30 07:53:45.000000000 -0700
+++ perl/ext/Safe/t/safeops.t 2008-02-02 14:23:57.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.8/perl/ext/re/t/re_funcs.t#1 (text) ====
Index: perl/ext/re/t/re_funcs.t
--- /dev/null 2008-02-01 14:47:59.480979692 -0800
+++ perl/ext/re/t/re_funcs.t 2008-02-02 14:23:57.000000000 -0800
@@ -0,0 +1,65 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config;
+ if (($Config::Config{'extensions'} !~ /\bre\b/) ){
+ print "1..0 # Skip -- Perl configured without re module\n";
+ exit 0;
+ }
+}
+
+use strict;
+use warnings;
+
+use Test::More; # test count at bottom of file
+use re qw(is_regexp regexp_pattern regmust
+ regname regnames regnames_count);
+{
+ my $qr=qr/foo/pi;
+ ok(is_regexp($qr),'is_regexp($qr)');
+ ok(!is_regexp(''),'is_regexp("")');
+ is((regexp_pattern($qr))[0],'foo','regexp_pattern[0]');
+ is((regexp_pattern($qr))[1],'ip','regexp_pattern[1]');
+ is(regexp_pattern($qr),'(?pi-xsm:foo)','scalar regexp_pattern');
+ ok(!regexp_pattern(''),'!regexp_pattern("")');
+}
+{
+ my $qr=qr/here .* there/x;
+ my ($anchored,$floating)=regmust($qr);
+ is($anchored,'here',"Regmust anchored - qr//");
+ is($floating,'there',"Regmust floating - qr//");
+ my $foo='blah';
+ ($anchored,$floating)=regmust($foo);
+ is($anchored,undef,"Regmust anchored - non ref");
+ is($floating,undef,"Regmust anchored - non ref");
+ my $bar=['blah'];
+ ($anchored,$floating)=regmust($foo);
+ is($anchored,undef,"Regmust anchored - ref");
+ is($floating,undef,"Regmust anchored - ref");
+}
+
+if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
+ my @names = sort +regnames();
+ is("@names","A B","regnames");
+ @names = sort +regnames(0);
+ is("@names","A B","regnames");
+ my $names = regnames();
+ is($names, "B", "regnames in scalar context");
+ @names = sort +regnames(1);
+ is("@names","A B C","regnames");
+ is(join("", @{regname("A",1)}),"13");
+ is(join("", @{regname("B",1)}),"24");
+ {
+ if ('foobar'=~/(?<foo>foo)(?<bar>bar)/) {
+ is(regnames_count(),2);
+ } else {
+ ok(0); ok(0);
+ }
+ }
+ is(regnames_count(),3);
+}
+# New tests above this line, don't forget to update the test count below!
+use Test::More tests => 20;
+# No tests here!
==== //depot/maint-5.8/perl/t/cmd/for.t#8 (xtext) ====
Index: perl/t/cmd/for.t
--- perl/t/cmd/for.t#7~30498~ 2007-03-07 09:01:50.000000000 -0800
+++ perl/t/cmd/for.t 2008-02-02 14:23:57.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.8/perl/t/harness#9 (text) ====
Index: perl/t/harness
--- perl/t/harness#8~31162~ 2007-05-07 04:15:06.000000000 -0700
+++ perl/t/harness 2008-02-02 14:23:57.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.8/perl/t/op/caller.t#5 (text) ====
Index: perl/t/op/caller.t
--- perl/t/op/caller.t#4~32346~ 2007-11-16 14:11:27.000000000 -0800
+++ perl/t/op/caller.t 2008-02-02 14:23:57.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,21 +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\025", 'default bits on via "use
warnings"' ); }
- BEGIN { testwarn("\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\025",
'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\x55", '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\x55", 'warning bits on via "use
warnings::register"' ) }
- testwarn("\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55",'following
w::r');
+ BEGIN { check_bits( ${^WARNING_BITS}, $registered,
+ 'warning bits on via "use warnings::register"' ) }
+ testwarn($registered, 'following w::r');
}
==== //depot/maint-5.8/perl/t/op/lc.t#14 (text) ====
Index: perl/t/op/lc.t
--- perl/t/op/lc.t#13~32394~ 2007-11-18 14:16:34.000000000 -0800
+++ perl/t/op/lc.t 2008-02-02 14:23:57.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.8/perl/t/op/pat.t#51 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#50~33211~ 2008-02-02 12:21:10.000000000 -0800
+++ perl/t/op/pat.t 2008-02-02 14:23:57.000000000 -0800
@@ -2037,9 +2037,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:".((caller)[2]);
+ ($name||$Message)."$todo\tLine ".((caller)[2]);
printf "# Failed test at line %d\n", (caller)[2] unless $ok;
@@ -3092,12 +3093,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]");
@@ -3152,13 +3156,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");
}
{
@@ -3449,6 +3453,7 @@
}
{
+ local $TODO = "See changes 26925-26928, which reverted change 26410";
package lv;
$var = "abc";
sub variable : lvalue { $var }
@@ -3457,16 +3462,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
@@ -3569,13 +3575,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:".((caller)[2]);
printf "# Failed test at line %d\n".
==== //depot/maint-5.8/perl/t/op/re_tests#20 (text) ====
Index: perl/t/op/re_tests
--- perl/t/op/re_tests#19~33175~ 2008-02-01 12:32:00.000000000 -0800
+++ perl/t/op/re_tests 2008-02-02 14:23:57.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.8/perl/t/op/readdir.t#5 (xtext) ====
Index: perl/t/op/readdir.t
--- perl/t/op/readdir.t#4~30495~ 2007-03-07 08:11:42.000000000 -0800
+++ perl/t/op/readdir.t 2008-02-02 14:23:57.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) = (140, 160);
+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.8/perl/t/op/regexp.t#6 (xtext) ====
Index: perl/t/op/regexp.t
--- perl/t/op/regexp.t#5~30623~ 2007-03-18 16:08:11.000000000 -0700
+++ perl/t/op/regexp.t 2008-02-02 14:23:57.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.8/perl/t/op/sprintf.t#22 (xtext) ====
Index: perl/t/op/sprintf.t
--- perl/t/op/sprintf.t#21~30663~ 2007-03-21 11:17:59.000000000 -0700
+++ perl/t/op/sprintf.t 2008-02-02 14:23:57.000000000 -0800
@@ -48,8 +48,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";
@@ -65,9 +65,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.8/perl/t/op/upgrade.t#1 (text) ====
Index: perl/t/op/upgrade.t
--- /dev/null 2008-02-01 14:47:59.480979692 -0800
+++ perl/t/op/upgrade.t 2008-02-02 14:23:57.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.8/perl/t/test.pl#23 (text) ====
Index: perl/t/test.pl
--- perl/t/test.pl#22~32991~ 2008-01-17 09:17:05.000000000 -0800
+++ perl/t/test.pl 2008-02-02 14:23:57.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.
