Change 33628 by [EMAIL PROTECTED] on 2008/04/02 16:51:24
Integrate:
[ 33316]
Avoid utf8 warnings when printing diagnostics
[ 33433]
use strict; and use Test::More; to give decent failure diagnostics.
(And less code)
[ 33440]
Fix skip counts introduced in #33433
[ 33565]
Subject: Re: Change 33556: [PATCH] borg parent.pm
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Tue, 25 Mar 2008 11:51:00 -0400
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.10/perl/ext/File/Glob/t/basic.t#2 integrate
... //depot/maint-5.10/perl/lib/Devel/SelfStubber.t#2 integrate
... //depot/maint-5.10/perl/t/op/pat.t#5 integrate
Differences ...
==== //depot/maint-5.10/perl/ext/File/Glob/t/basic.t#2 (xtext) ====
Index: perl/ext/File/Glob/t/basic.t
--- perl/ext/File/Glob/t/basic.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/ext/File/Glob/t/basic.t 2008-04-02 09:51:24.000000000 -0700
@@ -13,103 +13,89 @@
print "1..0\n";
exit 0;
}
- print "1..13\n";
}
-END {
- print "not ok 1\n" unless $loaded;
-}
-use File::Glob ':glob';
+use strict;
+use Test::More tests => 14;
+BEGIN {use_ok('File::Glob', ':glob')};
use Cwd ();
-$loaded = 1;
-print "ok 1\n";
-
-sub array {
- return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
-}
# look for the contents of the current directory
$ENV{PATH} = "/bin";
-delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
[EMAIL PROTECTED] = ();
+delete @ENV{qw(BASH_ENV CDPATH ENV IFS)};
+my @correct = ();
if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
@correct = grep { !/^\./ } sort readdir(D);
closedir D;
}
[EMAIL PROTECTED] = File::Glob::glob("*", 0);
+my @a = File::Glob::glob("*", 0);
@a = sort @a;
-if ("@a" ne "@correct" || GLOB_ERROR) {
- print "# |@a| ne |@correct|\nnot ";
+if (GLOB_ERROR) {
+ fail(GLOB_ERROR);
+} else {
+ is_deeply([EMAIL PROTECTED], [EMAIL PROTECTED]);
}
-print "ok 2\n";
# look up the user's home directory
# should return a list with one item, and not set ERROR
-if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS' && $^O ne 'os2'
- && $^O ne 'beos') {
- eval {
- ($name, $home) = (getpwuid($>))[0,7];
- 1;
- } and do {
- if (defined $home && defined $name && -d $home) {
- @a = bsd_glob("~$name", GLOB_TILDE);
- if ((scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR)) {
- print "not ";
- }
+SKIP: {
+ my ($name, $home);
+ skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS'
+ || $^O eq 'os2' || $^O eq 'beos';
+ skip "Can't find user for $>: $@", 1 unless eval {
+ ($name, $home) = (getpwuid($>))[0,7];
+ 1;
+ };
+ skip "$> has no home directory", 1
+ unless defined $home && defined $name && -d $home;
+
+ @a = bsd_glob("~$name", GLOB_TILDE);
+
+ if (GLOB_ERROR) {
+ fail(GLOB_ERROR);
+ } else {
+ is_deeply ([EMAIL PROTECTED], [$home]);
}
- };
}
-print "ok 3\n";
# check backslashing
# should return a list with one item, and not set ERROR
@a = bsd_glob('TEST', GLOB_QUOTE);
-if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
- local $/ = "][";
- print "# [EMAIL PROTECTED]";
- print "not ";
+if (GLOB_ERROR) {
+ fail(GLOB_ERROR);
+} else {
+ is_deeply([EMAIL PROTECTED], ['TEST']);
}
-print "ok 4\n";
# check nonexistent checks
# should return an empty list
# XXX since errfunc is NULL on win32, this test is not valid there
@a = bsd_glob("asdfasdf", 0);
-if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) {
- print "# |@a|\nnot ";
+SKIP: {
+ skip $^O, 1 if $^O eq 'MSWin32' || $^O eq 'NetWare';
+ is_deeply([EMAIL PROTECTED], []);
}
-print "ok 5\n";
# check bad protections
# should return an empty list, and set ERROR
-if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or
$^O eq 'VMS'
- or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>)
-{
- print "ok 6 # skipped\n";
-}
-else {
- $dir = "pteerslo";
+SKIP: {
+ skip $^O, 2 if $^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare'
+ or $^O eq 'os2' or $^O eq 'VMS' or $^O eq 'cygwin';
+ skip "AFS", 2 if Cwd::cwd() =~ m#^$Config{'afsroot'}#s;
+ skip "running as root", 2 if not $>;
+
+ my $dir = "pteerslo";
mkdir $dir, 0;
@a = bsd_glob("$dir/*", GLOB_ERR);
- #print "[EMAIL PROTECTED] = ", array(@a);
rmdir $dir;
- if (scalar(@a) != 0 || GLOB_ERROR == 0) {
- if ($^O eq 'vos') {
- print "not ok 6 # TODO hit VOS bug posix-956\n";
- } else {
- print "not ok 6\n";
- }
- }
- else {
- print "ok 6\n";
- }
+ local $TODO = 'hit VOS bug posix-956' if $^O eq 'vos';
+
+ isnt(GLOB_ERROR, 0);
+ is_deeply([EMAIL PROTECTED], []);
}
# check for csh style globbing
@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
-unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
- print "not ";
-}
-print "ok 7\n";
+is_deeply([EMAIL PROTECTED], ['a', 'b']);
@a = bsd_glob(
'{TES*,doesntexist*,a,b}',
@@ -123,30 +109,22 @@
print "# @a\n";
-unless (@a == 3
- and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
- and $a[1] eq 'a'
- and $a[2] eq 'b')
-{
- print "not ok 8 # @a\n";
-} else {
- print "ok 8\n";
-}
+is_deeply([EMAIL PROTECTED], [($^O eq 'VMS'? 'test.' : 'TEST'), 'a', 'b']);
# "~" should expand to $ENV{HOME}
$ENV{HOME} = "sweet home";
@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
-unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
- print "not ";
+SKIP: {
+ skip $^O, 1 if $^O eq "MacOS";
+ is_deeply([EMAIL PROTECTED], [$ENV{HOME}]);
}
-print "ok 9\n";
# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
mkdir "pteerslo", 0777;
chdir "pteerslo";
[EMAIL PROTECTED] = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
[EMAIL PROTECTED] = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
+my @f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
+my @f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
@f_names = sort(@f_names);
}
@@ -160,25 +138,17 @@
close T;
}
-$pat = "*.pl";
+my $pat = "*.pl";
-$ok = 1;
[EMAIL PROTECTED] = bsd_glob($pat, 0);
+my @g_names = bsd_glob($pat, 0);
print "# f_names = @f_names\n";
print "# g_names = @g_names\n";
-for (@f_names) {
- $ok = 0 unless $_ eq shift @g_names;
-}
-print $ok ? "ok 10\n" : "not ok 10\n";
+is_deeply([EMAIL PROTECTED], [EMAIL PROTECTED]);
-$ok = 1;
[EMAIL PROTECTED] = bsd_glob($pat);
+my @g_alpha = bsd_glob($pat);
print "# f_alpha = @f_alpha\n";
print "# g_alpha = @g_alpha\n";
-for (@f_alpha) {
- $ok = 0 unless $_ eq shift @g_alpha;
-}
-print $ok ? "ok 11\n" : "not ok 11\n";
+is_deeply([EMAIL PROTECTED], [EMAIL PROTECTED]);
unlink @f_names;
chdir "..";
@@ -186,7 +156,7 @@
# this can panic if PL_glob_index gets passed as flags to bsd_glob
<*>; <*>;
-print "ok 12\n";
+pass("Don't panic");
{
use File::Temp qw(tempdir);
@@ -203,11 +173,8 @@
chdir $dir
or die "Could not chdir to $dir: $!";
my(@glob_files) = glob("a*{d[e]}j");
- if (!(@glob_files == 1 && "@glob_files" eq "a_dej")) {
- print "not ";
- }
- my $todo = $^O ne 'VMS' ? '' : " # TODO home-made glob doesn't do regexes";
- print "ok 13$todo\n";
+ local $TODO = "home-made glob doesn't do regexes" if $^O eq 'VMS';
+ is_deeply([EMAIL PROTECTED], ['a_dej']);
chdir $cwd
or die "Could not chdir back to $cwd: $!";
}
==== //depot/maint-5.10/perl/lib/Devel/SelfStubber.t#2 (text) ====
Index: perl/lib/Devel/SelfStubber.t
--- perl/lib/Devel/SelfStubber.t#1~32694~ 2007-12-22 01:23:09.000000000
-0800
+++ perl/lib/Devel/SelfStubber.t 2008-04-02 09:51:24.000000000 -0700
@@ -48,7 +48,7 @@
push @cleanup, $file;
open FH, ">$file" or die $!;
select FH;
- Devel::SelfStubber->stub('Child', $inlib);
+ Devel::SelfStubber->stub('xChild', $inlib);
select STDOUT;
print "ok 1\n";
close FH or die $!;
@@ -56,7 +56,7 @@
open FH, $file or die $!;
my @A = <FH>;
- if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) {
+ if (@A == 1 && $A[0] =~ /^\s*sub\s+xChild::foo\s*;\s*$/) {
print "ok 2\n";
} else {
print "not ok 2\n";
@@ -112,14 +112,14 @@
}
# "wrong" and "right" may change if SelfLoader is changed.
-my %wrong = ( Parent => 'Parent', Child => 'Parent' );
-my %right = ( Parent => 'Parent', Child => 'Child' );
+my %wrong = ( xParent => 'xParent', xChild => 'xParent' );
+my %right = ( xParent => 'xParent', xChild => 'xChild' );
if ($^O eq 'VMS') {
# extra line feeds for MBX IPC
- %wrong = ( Parent => "Parent\n", Child => "Parent\n" );
- %right = ( Parent => "Parent\n", Child => "Child\n" );
+ %wrong = ( xParent => "xParent\n", xChild => "xParent\n" );
+ %right = ( xParent => "xParent\n", xChild => "xChild\n" );
}
-my @module = qw(Parent Child)
+my @module = qw(xParent xChild)
;
sub fail {
my ($left, $right) = @_;
@@ -225,18 +225,18 @@
}
__DATA__
-################ Parent.pm
-package Parent;
+################ xParent.pm
+package xParent;
sub foo {
return __PACKAGE__;
}
1;
__END__
-################ Child.pm
-package Child;
-require Parent;
[EMAIL PROTECTED] = 'Parent';
+################ xChild.pm
+package xChild;
+require xParent;
[EMAIL PROTECTED] = 'xParent';
use SelfLoader;
1;
==== //depot/maint-5.10/perl/t/op/pat.t#5 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#4~33135~ 2008-01-30 11:50:56.000000000 -0800
+++ perl/t/op/pat.t 2008-04-02 09:51:24.000000000 -0700
@@ -3708,6 +3708,7 @@
printf "%sok %d - %s$todo\n", ($ok ? "" : "not "), $test,
($name||$Message)."\tLine ".((caller)[2]);
+ no warnings 'utf8';
printf "# Failed test at line %d\n".
"# expected: %s\n".
"# result: %s\n",
End of Patch.
