Created
December 4, 2009 18:49
-
-
Save eqhmcow/249244 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
From: Niko Tyni <[email protected]> | |
Subject: Add support for Abstract namespace sockets. | |
Closes: 490660, 329291 | |
blead commits | |
99f13d4c3419e967e95c5ac6a3af61e9bb0fd3c0 | |
89904c08923161afd23c629d5c2c7472a09c16bb | |
by Lubomir Rintel <[email protected]> | |
trivially backported for 5.10.1 by Niko Tyni <[email protected]> | |
--- | |
ext/Socket/Socket.xs | 33 ++++++++++++++++++++++++--------- | |
ext/Socket/t/Socket.t | 14 ++++++++++++-- | |
2 files changed, 36 insertions(+), 11 deletions(-) | |
diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs | |
index 076297f..3522303 100644 | |
--- a/ext/Socket/Socket.xs | |
+++ b/ext/Socket/Socket.xs | |
@@ -303,6 +303,7 @@ pack_sockaddr_un(pathname) | |
struct sockaddr_un sun_ad; /* fear using sun */ | |
STRLEN len; | |
char * pathname_pv; | |
+ int addr_len; | |
Zero( &sun_ad, sizeof sun_ad, char ); | |
sun_ad.sun_family = AF_UNIX; | |
@@ -336,7 +337,17 @@ pack_sockaddr_un(pathname) | |
Copy( pathname_pv, sun_ad.sun_path, len, char ); | |
# endif | |
if (0) not_here("dummy"); | |
- ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad)); | |
+ if (len > 1 && sun_ad.sun_path[0] == '\0') { | |
+ /* Linux-style abstract-namespace socket. | |
+ * The name is not a file name, but an array of arbitrary | |
+ * character, starting with \0 and possibly including \0s, | |
+ * therefore the length of the structure must denote the | |
+ * end of that character array */ | |
+ addr_len = (void *)&sun_ad.sun_path - (void *)&sun_ad + len; | |
+ } else { | |
+ addr_len = sizeof sun_ad; | |
+ } | |
+ ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len)); | |
#else | |
ST(0) = (SV *) not_here("pack_sockaddr_un"); | |
#endif | |
@@ -352,7 +363,7 @@ unpack_sockaddr_un(sun_sv) | |
struct sockaddr_un addr; | |
STRLEN sockaddrlen; | |
char * sun_ad = SvPVbyte(sun_sv,sockaddrlen); | |
- char * e; | |
+ int addr_len; | |
# ifndef __linux__ | |
/* On Linux sockaddrlen on sockets returned by accept, recvfrom, | |
getpeername and getsockname is not equal to sizeof(addr). */ | |
@@ -371,13 +382,17 @@ unpack_sockaddr_un(sun_sv) | |
addr.sun_family, | |
AF_UNIX); | |
} | |
- e = (char*)addr.sun_path; | |
- /* On Linux, the name of abstract unix domain sockets begins | |
- * with a '\0', so allow this. */ | |
- while ((*e || (e == addr.sun_path && e[1] && sockaddrlen > 1)) | |
- && e < (char*)addr.sun_path + sizeof addr.sun_path) | |
- ++e; | |
- ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - (char*)addr.sun_path)); | |
+ | |
+ if (addr.sun_path[0] == '\0') { | |
+ /* Linux-style abstract socket address begins with a nul | |
+ * and can contain nuls. */ | |
+ addr_len = (void *)&addr - (void *)&addr.sun_path + sockaddrlen; | |
+ } else { | |
+ for (addr_len = 0; addr.sun_path[addr_len] | |
+ && addr_len < sizeof addr.sun_path; addr_len++); | |
+ } | |
+ | |
+ ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len)); | |
#else | |
ST(0) = (SV *) not_here("unpack_sockaddr_un"); | |
#endif | |
diff --git a/ext/Socket/t/Socket.t b/ext/Socket/t/Socket.t | |
index f707999..d1e7447 100755 | |
--- a/ext/Socket/t/Socket.t | |
+++ b/ext/Socket/t/Socket.t | |
@@ -14,7 +14,7 @@ BEGIN { | |
use Socket qw(:all); | |
-print "1..17\n"; | |
+print "1..18\n"; | |
$has_echo = $^O ne 'MSWin32'; | |
$alarmed = 0; | |
@@ -152,7 +152,7 @@ print (($@ =~ /^Bad arg length for Socket::sockaddr_family, length is 0, should | |
if ($^O eq 'linux') { | |
# see if we can handle abstract sockets | |
- my $test_abstract_socket = chr(0) . '/tmp/test-perl-socket'; | |
+ my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world'; | |
my $addr = sockaddr_un ($test_abstract_socket); | |
my ($path) = sockaddr_un ($addr); | |
if ($test_abstract_socket eq $path) { | |
@@ -163,7 +163,17 @@ if ($^O eq 'linux') { | |
print "# got <$path>\n"; | |
print "not ok 17\n"; | |
} | |
+ | |
+ # see if we calculate the address structure length correctly | |
+ if (length ($test_abstract_socket) + 2 == length $addr) { | |
+ print "ok 18\n"; | |
+ } else { | |
+ print "# got ".(length $addr)."\n"; | |
+ print "not ok 18\n"; | |
+ } | |
+ | |
} else { | |
# doesn't have abstract socket support | |
print "ok 17 - skipped on this platform\n"; | |
+ print "ok 18 - skipped on this platform\n"; | |
} | |
-- | |
tg: (daf8b46..) fixes/abstract-sockets (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: Honor TMPDIR when open()ing an anonymous temporary file | |
Closes: 528544 | |
[perl #66452] | |
As reported by Norbert Buchmuller <[email protected]>, opening an anonymous | |
temporary file with the magical open($fh, '+>', undef) ignores TMPDIR. | |
--- | |
perlio.c | 20 ++++++++++++++++---- | |
t/io/perlio.t | 15 ++++++++++++++- | |
2 files changed, 30 insertions(+), 5 deletions(-) | |
diff --git a/perlio.c b/perlio.c | |
index 3803247..3ce579f 100644 | |
--- a/perlio.c | |
+++ b/perlio.c | |
@@ -5167,18 +5167,30 @@ PerlIO_tmpfile(void) | |
f = PerlIO_fdopen(fd, "w+b"); | |
#else /* WIN32 */ | |
# if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2) | |
- SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX"); | |
+ int fd = -1; | |
+ char tempname[] = "/tmp/PerlIO_XXXXXX"; | |
+ const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR"); | |
+ SV * const sv = tmpdir && *tmpdir ? newSVpv(tmpdir, 0) : NULL; | |
/* | |
* I have no idea how portable mkstemp() is ... NI-S | |
*/ | |
- const int fd = mkstemp(SvPVX(sv)); | |
+ if (sv) { | |
+ /* if TMPDIR is set and not empty, we try that first */ | |
+ sv_catpv(sv, tempname + 4); | |
+ fd = mkstemp(SvPVX(sv)); | |
+ } | |
+ if (fd < 0) { | |
+ /* else we try /tmp */ | |
+ fd = mkstemp(tempname); | |
+ } | |
if (fd >= 0) { | |
f = PerlIO_fdopen(fd, "w+"); | |
if (f) | |
PerlIOBase(f)->flags |= PERLIO_F_TEMP; | |
- PerlLIO_unlink(SvPVX_const(sv)); | |
+ PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname); | |
} | |
- SvREFCNT_dec(sv); | |
+ if (sv) | |
+ SvREFCNT_dec(sv); | |
# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */ | |
FILE * const stdio = PerlSIO_tmpfile(); | |
diff --git a/t/io/perlio.t b/t/io/perlio.t | |
index c145945..c1eebec 100755 | |
--- a/t/io/perlio.t | |
+++ b/t/io/perlio.t | |
@@ -8,13 +8,14 @@ BEGIN { | |
} | |
} | |
-use Test::More tests => 37; | |
+use Test::More tests => 39; | |
use_ok('PerlIO'); | |
my $txt = "txt$$"; | |
my $bin = "bin$$"; | |
my $utf = "utf$$"; | |
+my $nonexistent = "nex$$"; | |
my $txtfh; | |
my $binfh; | |
@@ -89,6 +90,17 @@ ok(close($utffh)); | |
# report after STDOUT is restored | |
ok($status, ' re-open STDOUT'); | |
close OLDOUT; | |
+ | |
+ SKIP: { | |
+ skip("TMPDIR not honored on this platform", 2) | |
+ if !$Config{d_mkstemp} | |
+ || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2'; | |
+ local $ENV{TMPDIR} = $nonexistent; | |
+ ok( open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to a non-existent dir'); | |
+ | |
+ mkdir $ENV{TMPDIR}; | |
+ ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir'); | |
+ } | |
} | |
# in-memory open | |
@@ -136,5 +148,6 @@ END { | |
1 while unlink $txt; | |
1 while unlink $bin; | |
1 while unlink $utf; | |
+ rmdir $nonexistent; | |
} | |
-- | |
tg: (daf8b46..) fixes/anon-tmpfile-dir (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: Separate instance error strings from each other | |
Closes: 539355 | |
[rt.perl.org #48879] | |
Included upstream in Archive-Tar-1.54. | |
--- | |
lib/Archive/Tar.pm | 17 +++++++++++++++-- | |
t/06_error.t | 39 +++++++++++++++++++++++++++++++++++++++ | |
2 files changed, 54 insertions(+), 2 deletions(-) | |
diff --git a/lib/Archive/Tar.pm b/lib/Archive/Tar.pm | |
index 022a172..bc97c0e 100644 | |
--- a/lib/Archive/Tar.pm | |
+++ b/lib/Archive/Tar.pm | |
@@ -117,7 +117,7 @@ sub new { | |
### copying $tmpl here since a shallow copy makes it use the | |
### same aref, causing for files to remain in memory always. | |
- my $obj = bless { _data => [ ], _file => 'Unknown' }, $class; | |
+ my $obj = bless { _data => [ ], _file => 'Unknown', _error => '' }, $class; | |
if (@_) { | |
unless ( $obj->read( @_ ) ) { | |
@@ -1445,6 +1445,10 @@ method call instead. | |
my $self = shift; | |
my $msg = $error = shift; | |
$longmess = Carp::longmess($error); | |
+ if (ref $self) { | |
+ $self->{_error} = $error; | |
+ $self->{_longmess} = $longmess; | |
+ } | |
### set Archive::Tar::WARN to 0 to disable printing | |
### of errors | |
@@ -1457,7 +1461,11 @@ method call instead. | |
sub error { | |
my $self = shift; | |
- return shift() ? $longmess : $error; | |
+ if (ref $self) { | |
+ return shift() ? $self->{_longmess} : $self->{_error}; | |
+ } else { | |
+ return shift() ? $longmess : $error; | |
+ } | |
} | |
} | |
@@ -1817,6 +1825,11 @@ use is very much discouraged. Use the C<error()> method instead: | |
warn $tar->error unless $tar->extract; | |
+Note that in older versions of this module, the C<error()> method | |
+would return an effectively global value even when called an instance | |
+method as above. This has since been fixed, and multiple instances of | |
+C<Archive::Tar> now have separate error strings. | |
+ | |
=head2 $Archive::Tar::INSECURE_EXTRACT_MODE | |
This variable indicates whether C<Archive::Tar> should allow | |
diff --git a/t/06_error.t b/t/06_error.t | |
new file mode 100644 | |
index 0000000..5c728bc | |
--- /dev/null | |
+++ b/t/06_error.t | |
@@ -0,0 +1,39 @@ | |
+BEGIN { | |
+ if( $ENV{PERL_CORE} ) { | |
+ chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar'; | |
+ } | |
+ use lib '../../..'; | |
+} | |
+ | |
+BEGIN { chdir 't' if -d 't' } | |
+ | |
+use Test::More 'no_plan'; | |
+use strict; | |
+use lib '../lib'; | |
+ | |
+use Archive::Tar; | |
+use File::Spec; | |
+ | |
+$Archive::Tar::WARN = 0; | |
+ | |
+my $t1 = Archive::Tar->new; | |
+my $t2 = Archive::Tar->new; | |
+ | |
+is($Archive::Tar::error, "", "global error string is empty"); | |
+is($t1->error, "", "error string of object 1 is empty"); | |
+is($t2->error, "", "error string of object 2 is empty"); | |
+ | |
+ok(!$t1->read(), "can't read without a file"); | |
+ | |
+isnt($t1->error, "", "error string of object 1 is set"); | |
+is($Archive::Tar::error, $t1->error, "global error string equals that of object 1"); | |
+is($Archive::Tar::error, Archive::Tar->error, "the class error method returns the global error"); | |
+is($t2->error, "", "error string of object 2 is still empty"); | |
+ | |
+my $src = File::Spec->catfile( qw[src short b] ); | |
+ok(!$t2->read($src), "error when opening $src"); | |
+ | |
+isnt($t2->error, "", "error string of object 1 is set"); | |
+isnt($t2->error, $t1->error, "error strings of objects 1 and 2 differ"); | |
+is($Archive::Tar::error, $t2->error, "global error string equals that of object 2"); | |
+is($Archive::Tar::error, Archive::Tar->error, "the class error method returns the global error"); | |
-- | |
tg: (daf8b46..) fixes/archive-tar-instance-error (depends on: upstream) | |
Subject: Integrate a grammar fix from upstream. | |
Closes: 443733 | |
This is fixed in blead by change 33129 but was skipped for maint-5.10. | |
--- | |
lib/Math/BigInt/CalcEmu.pm | 2 +- | |
1 files changed, 1 insertions(+), 1 deletions(-) | |
diff --git a/lib/Math/BigInt/CalcEmu.pm b/lib/Math/BigInt/CalcEmu.pm | |
index 79efac6..5810f5d 100644 | |
--- a/lib/Math/BigInt/CalcEmu.pm | |
+++ b/lib/Math/BigInt/CalcEmu.pm | |
@@ -295,7 +295,7 @@ Math::BigInt::CalcEmu - Emulate low-level math with BigInt code | |
=head1 DESCRIPTION | |
Contains routines that emulate low-level math functions in BigInt, e.g. | |
-optional routines the low-level math package does not provide on it's own. | |
+optional routines the low-level math package does not provide on its own. | |
Will be loaded on demand and called automatically by BigInt. | |
-- | |
tg: (daf8b46..) fixes/assorted_docs (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: Allow for flock returning EAGAIN instead of EWOULDBLOCK on linux/parisc | |
Closes: 543731 | |
git://github.com/pfenwick/autodie.git commit | |
037738e11a6097734b0e1dabdd77b92e5fe35219 | |
--- | |
lib/Fatal.pm | 14 +++++++++++++- | |
lib/autodie/t/flock.t | 12 ++++++++++-- | |
2 files changed, 23 insertions(+), 3 deletions(-) | |
diff --git a/lib/Fatal.pm b/lib/Fatal.pm | |
old mode 100644 | |
new mode 100755 | |
index 18e71ed..c17a257 | |
--- a/lib/Fatal.pm | |
+++ b/lib/Fatal.pm | |
@@ -5,6 +5,7 @@ use Carp; | |
use strict; | |
use warnings; | |
use Tie::RefHash; # To cache subroutine refs | |
+use Config; | |
use constant PERL510 => ( $] >= 5.010 ); | |
@@ -52,6 +53,10 @@ our %_EWOULDBLOCK = ( | |
MSWin32 => 33, | |
); | |
+# the linux parisc port has separate EAGAIN and EWOULDBLOCK, | |
+# and the kernel returns EAGAIN | |
+my $try_EAGAIN = ($^O eq 'linux' and $Config{archname} =~ /hppa|parisc/) ? 1 : 0; | |
+ | |
# We have some tags that can be passed in for use with import. | |
# These are all assumed to be CORE:: | |
@@ -720,6 +725,11 @@ sub _one_invocation { | |
my $EWOULDBLOCK = eval { POSIX::EWOULDBLOCK(); } | |
|| $_EWOULDBLOCK{$^O} | |
|| _autocroak("Internal error - can't overload flock - EWOULDBLOCK not defined on this system."); | |
+ my $EAGAIN = $EWOULDBLOCK; | |
+ if ($try_EAGAIN) { | |
+ $EAGAIN = eval { POSIX::EAGAIN(); } | |
+ || _autocroak("Internal error - can't overload flock - EAGAIN not defined on this system."); | |
+ } | |
require Fcntl; # For Fcntl::LOCK_NB | |
@@ -735,7 +745,9 @@ sub _one_invocation { | |
# If we failed, but we're using LOCK_NB and | |
# returned EWOULDBLOCK, it's not a real error. | |
- if (\$_[1] & Fcntl::LOCK_NB() and \$! == $EWOULDBLOCK ) { | |
+ if (\$_[1] & Fcntl::LOCK_NB() and | |
+ (\$! == $EWOULDBLOCK or | |
+ ($try_EAGAIN and \$! == $EAGAIN ))) { | |
return \$retval; | |
} | |
diff --git a/lib/autodie/t/flock.t b/lib/autodie/t/flock.t | |
index a7550ba..6421a56 100755 | |
--- a/lib/autodie/t/flock.t | |
+++ b/lib/autodie/t/flock.t | |
@@ -2,7 +2,8 @@ | |
use strict; | |
use Test::More; | |
use Fcntl qw(:flock); | |
-use POSIX qw(EWOULDBLOCK); | |
+use POSIX qw(EWOULDBLOCK EAGAIN); | |
+use Config; | |
require Fatal; | |
@@ -10,6 +11,9 @@ my $EWOULDBLOCK = eval { EWOULDBLOCK() } | |
|| $Fatal::_EWOULDBLOCK{$^O} | |
|| plan skip_all => "EWOULDBLOCK not defined on this system"; | |
+my $try_EAGAIN = ($^O eq 'linux' and $Config{archname} =~ /hppa|parisc/) ? 1 : 0; | |
+my $EAGAIN = eval { EAGAIN() }; | |
+ | |
my ($self_fh, $self_fh2); | |
eval { | |
@@ -55,7 +59,11 @@ eval { | |
$return = flock($self_fh2, LOCK_EX | LOCK_NB); | |
}; | |
-is($!+0, $EWOULDBLOCK, "Double-flocking should be EWOULDBLOCK"); | |
+if (!$try_EAGAIN) { | |
+ is($!+0, $EWOULDBLOCK, "Double-flocking should be EWOULDBLOCK"); | |
+} else { | |
+ ok($!+0 == $EWOULDBLOCK || $!+0 == $EAGAIN, "Double-flocking should be EWOULDBLOCK or EAGAIN"); | |
+} | |
ok(!$return, "flocking a file twice should fail"); | |
is($@, "", "Non-blocking flock should not fail on EWOULDBLOCK"); | |
-- | |
tg: (daf8b46..) fixes/autodie-flock (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: make the threads-shared test suite more robust, fixing failures on hppa | |
Closes: 554218 | |
Fix from threads-shared-1.31: | |
Handle thread creation failures in tests due to lack of memory, etc. | |
--- | |
ext/threads-shared/t/stress.t | 28 ++++++++++++++++++++++++---- | |
1 files changed, 24 insertions(+), 4 deletions(-) | |
diff --git a/ext/threads-shared/t/stress.t b/ext/threads-shared/t/stress.t | |
index e36ab0a..adfd1ed 100755 | |
--- a/ext/threads-shared/t/stress.t | |
+++ b/ext/threads-shared/t/stress.t | |
@@ -39,7 +39,11 @@ use threads::shared; | |
my $mutex = 1; | |
share($mutex); | |
+ my $warning; | |
+ $SIG{__WARN__} = sub { $warning = shift; }; | |
+ | |
my @threads; | |
+ | |
for (reverse(1..$cnt)) { | |
$threads[$_] = threads->create(sub { | |
my $tnum = shift; | |
@@ -71,10 +75,26 @@ use threads::shared; | |
cond_broadcast($mutex); | |
return ('okay'); | |
}, $_); | |
+ | |
+ # Handle thread creation failures | |
+ if ($warning) { | |
+ my $printit = 1; | |
+ if ($warning =~ /returned 11/) { | |
+ $warning = "Thread creation failed due to 'No more processes'\n"; | |
+ $printit = (! $ENV{'PERL_CORE'}); | |
+ } elsif ($warning =~ /returned 12/) { | |
+ $warning = "Thread creation failed due to 'No more memory'\n"; | |
+ $printit = (! $ENV{'PERL_CORE'}); | |
+ } | |
+ print(STDERR "# Warning: $warning") if ($printit); | |
+ lock($mutex); | |
+ $mutex = $_ + 1; | |
+ last; | |
+ } | |
} | |
# Gather thread results | |
- my ($okay, $failures, $timeouts, $unknown) = (0, 0, 0, 0); | |
+ my ($okay, $failures, $timeouts, $unknown) = (0, 0, 0, 0, 0); | |
for (1..$cnt) { | |
if (! $threads[$_]) { | |
$failures++; | |
@@ -92,10 +112,10 @@ use threads::shared; | |
} | |
} | |
} | |
+ | |
if ($failures) { | |
- # Most likely due to running out of memory | |
- print(STDERR "# Warning: $failures threads failed\n"); | |
- print(STDERR "# Note: errno 12 = ENOMEM\n"); | |
+ my $only = $cnt - $failures; | |
+ print(STDERR "# Warning: Intended to use $cnt threads, but could only muster $only\n"); | |
$cnt -= $failures; | |
} | |
-- | |
tg: (daf8b46..) fixes/hppa-thread-eagain (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: Add gcc predefined macros to $Config{cppsymbols} on GNU/Hurd. | |
Closes: 544307 | |
Patch by Samuel Thibault, not forwarded upstream yet. | |
--- | |
Configure | 2 +- | |
1 files changed, 1 insertions(+), 1 deletions(-) | |
diff --git a/Configure b/Configure | |
index 5e863b3..eed6f9b 100755 | |
--- a/Configure | |
+++ b/Configure | |
@@ -21375,7 +21375,7 @@ $eunicefix Cppsym.try | |
./Cppsym < Cppsym.know > Cppsym.true | |
: Add in any linux cpp "predefined macros": | |
case "$osname::$gccversion" in | |
- *linux*::*.*|*gnukfreebsd*::*.*) | |
+ *linux*::*.*|*gnukfreebsd*::*.*|gnu::*.*) | |
tHdrH=_tmpHdr | |
rm -f $tHdrH'.h' $tHdrH | |
touch $tHdrH'.h' | |
-- | |
tg: (8d48651..) fixes/hurd_cppsymbols (depends on: fixes/kfreebsd_cppsymbols) | |
From: Niko Tyni <[email protected]> | |
Subject: Fix File::Copy::copy with pipes on GNU/kFreeBSD | |
Quoting Petr Salinger in http://bugs.debian.org/537555: | |
The Copy tries to detect whether source and dest are the same files. | |
Unfortunately, on the GNU/kFreeBSD the kernel returns for all pipes | |
as device and inode numbers just zero. See pipe_stat() in | |
http://www.freebsd.org/cgi/cvsweb.cgi/src/sys/kern/sys_pipe.c | |
Patch by Petr Salinger, tests by Niko Tyni. | |
Backported from blead change 16f708c9bc0dc48713b200031295a40bed83bbfc | |
--- | |
lib/File/Copy.pm | 2 +- | |
lib/File/Copy.t | 15 ++++++++++++++- | |
2 files changed, 15 insertions(+), 2 deletions(-) | |
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm | |
index e1d7724..1da5437 100644 | |
--- a/lib/File/Copy.pm | |
+++ b/lib/File/Copy.pm | |
@@ -115,7 +115,7 @@ sub copy { | |
my @fs = stat($from); | |
if (@fs) { | |
my @ts = stat($to); | |
- if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) { | |
+ if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] && !-p $from) { | |
carp("'$from' and '$to' are identical (not copied)"); | |
return 0; | |
} | |
diff --git a/lib/File/Copy.t b/lib/File/Copy.t | |
index bcfa207..2e5ce9c 100755 | |
--- a/lib/File/Copy.t | |
+++ b/lib/File/Copy.t | |
@@ -14,7 +14,7 @@ use Test::More; | |
my $TB = Test::More->builder; | |
-plan tests => 115; | |
+plan tests => 117; | |
# We're going to override rename() later on but Perl has to see an override | |
# at compile time to honor it. | |
@@ -272,6 +272,19 @@ for my $cross_partition_test (0..1) { | |
} | |
} | |
+SKIP: { | |
+ skip("fork required to test pipe copying", 2) | |
+ if (!$Config{'d_fork'}); | |
+ | |
+ open(my $IN, "-|") || exec $^X, '-e', 'print "Hello, world!\n"'; | |
+ open(my $OUT, "|-") || exec $^X, '-ne', 'exit(/Hello/ ? 55 : 0)'; | |
+ | |
+ ok(copy($IN, $OUT), "copy pipe to another"); | |
+ close($OUT); | |
+ is($? >> 8, 55, "content copied through the pipes"); | |
+ close($IN); | |
+} | |
+ | |
END { | |
1 while unlink "file-$$"; | |
1 while unlink "lib/file-$$"; | |
-- | |
tg: (daf8b46..) fixes/kfreebsd-filecopy-pipes (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: [PATCH] fixes/kfreebsd_cppsymbols | |
Closes: 533098 | |
This is needed at least by h2ph, otherwise the generated .ph files | |
choke on missing __LONG_MAX__ and similar definitions. | |
Upstream commit 3b910a06633f63976a6da223b122193040fbe96d | |
--- | |
Configure | 2 +- | |
1 files changed, 1 insertions(+), 1 deletions(-) | |
diff --git a/Configure b/Configure | |
index 01fa3c0..5e863b3 100755 | |
--- a/Configure | |
+++ b/Configure | |
@@ -21375,7 +21375,7 @@ $eunicefix Cppsym.try | |
./Cppsym < Cppsym.know > Cppsym.true | |
: Add in any linux cpp "predefined macros": | |
case "$osname::$gccversion" in | |
- *linux*::*.*) | |
+ *linux*::*.*|*gnukfreebsd*::*.*) | |
tHdrH=_tmpHdr | |
rm -f $tHdrH'.h' $tHdrH | |
touch $tHdrH'.h' | |
-- | |
tg: (daf8b46..) fixes/kfreebsd_cppsymbols (depends on: upstream) | |
Subject: Complete the documentation for Net::SMTP | |
[rt.cpan.org #36038] | |
--- | |
lib/Net/SMTP.pm | 1 + | |
1 files changed, 1 insertions(+), 0 deletions(-) | |
diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm | |
index a28496d..07b2498 100644 | |
--- a/lib/Net/SMTP.pm | |
+++ b/lib/Net/SMTP.pm | |
@@ -625,6 +625,7 @@ Net::SMTP will attempt to extract the address from the value passed. | |
B<Debug> - Enable debugging information | |
+B<Port> - Select a port on the remote host to connect to (default is 25) | |
Example: | |
-- | |
tg: (daf8b46..) fixes/net_smtp_docs (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: fix pod errors | |
POD formatting errors already fixed upstream. | |
Signed-off-by: Niko Tyni <[email protected]> | |
--- | |
lib/Object/Accessor.pm | 1 + | |
1 files changed, 1 insertions(+), 0 deletions(-) | |
diff --git a/lib/Object/Accessor.pm b/lib/Object/Accessor.pm | |
index e5cd266..87a4c9f 100644 | |
--- a/lib/Object/Accessor.pm | |
+++ b/lib/Object/Accessor.pm | |
@@ -690,6 +690,7 @@ under C<lvalue> conditions. | |
See C<perldoc perlsub> for details. | |
+=back | |
=cut | |
-- | |
tg: (daf8b46..) fixes/pod-nitpicks (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: Escape backslashes in .IX entries | |
Closes: 521256 | |
Applicable parts of podlators upstream git commit | |
release/2.2.2-6-g8de2177 | |
--- | |
lib/Pod/Man.pm | 1 + | |
lib/Pod/t/man.t | 11 ++++++++++- | |
2 files changed, 11 insertions(+), 1 deletions(-) | |
diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm | |
index 71a4d7a..7662935 100644 | |
--- a/lib/Pod/Man.pm | |
+++ b/lib/Pod/Man.pm | |
@@ -712,6 +712,7 @@ sub outindex { | |
for (@output) { | |
my ($type, $entry) = @$_; | |
$entry =~ s/\"/\"\"/g; | |
+ $entry =~ s/\\/\\\\/g; | |
$self->output (".IX $type " . '"' . $entry . '"' . "\n"); | |
} | |
} | |
diff --git a/lib/Pod/t/man.t b/lib/Pod/t/man.t | |
index 419cce3..c4588bc 100755 | |
--- a/lib/Pod/t/man.t | |
+++ b/lib/Pod/t/man.t | |
@@ -17,7 +17,7 @@ BEGIN { | |
} | |
unshift (@INC, '../blib/lib'); | |
$| = 1; | |
- print "1..25\n"; | |
+ print "1..26\n"; | |
} | |
END { | |
@@ -482,3 +482,12 @@ Some raw nroff. | |
.PP | |
More text. | |
### | |
+=head1 INDEX | |
+ | |
+Index entry matching a whitespace escape.X<\n> | |
+### | |
+.SH "INDEX" | |
+.IX Header "INDEX" | |
+Index entry matching a whitespace escape. | |
+.IX Xref "\\n" | |
+### | |
-- | |
tg: (daf8b46..) fixes/pod2man-index-backslash (depends on: upstream) | |
From: Niko Tyni <[email protected]> | |
Subject: Fix \G crash on first match | |
Closes: 545234 | |
[perl 69056] | |
Blead commit 63ffbc4d3039a00fa04e97838017b299c6ef612f | |
--- | |
regexec.c | 5 ++++- | |
1 files changed, 4 insertions(+), 1 deletions(-) | |
diff --git a/regexec.c b/regexec.c | |
index 7a42c4f..5beb8ca 100644 | |
--- a/regexec.c | |
+++ b/regexec.c | |
@@ -1853,6 +1853,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st | |
if (s > reginfo.ganch) | |
goto phooey; | |
s = reginfo.ganch - prog->gofs; | |
+ if (s < strbeg) | |
+ goto phooey; | |
} | |
} | |
else if (data) { | |
@@ -1928,7 +1930,8 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st | |
is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN | |
and we only enter this block when the same bit is set. */ | |
char *tmp_s = reginfo.ganch - prog->gofs; | |
- if (regtry(®info, &tmp_s)) | |
+ | |
+ if (tmp_s >= strbeg && regtry(®info, &tmp_s)) | |
goto got_it; | |
goto phooey; | |
} | |
-- | |
tg: (daf8b46..) fixes/positive-gpos (depends on: upstream) | |
Subject: Always use PERLRUNINST when building perl modules. | |
Revert part of upstream change 24524 to always use PERLRUNINST when | |
building perl modules: Some PDL demos expect blib to be implicitly | |
searched. | |
--- | |
lib/ExtUtils/MM_Unix.pm | 5 +---- | |
1 files changed, 1 insertions(+), 4 deletions(-) | |
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm | |
index ad28b22..1f6b2ef 100644 | |
--- a/lib/ExtUtils/MM_Unix.pm | |
+++ b/lib/ExtUtils/MM_Unix.pm | |
@@ -3031,14 +3031,11 @@ sub processPL { | |
# pm_to_blib depends on then it can't depend on pm_to_blib | |
# else we have a dependency loop. | |
my $pm_dep; | |
- my $perlrun; | |
if( defined $self->{PM}{$target} ) { | |
$pm_dep = ''; | |
- $perlrun = 'PERLRUN'; | |
} | |
else { | |
$pm_dep = 'pm_to_blib'; | |
- $perlrun = 'PERLRUNINST'; | |
} | |
$m .= <<MAKE_FRAG; | |
@@ -3047,7 +3044,7 @@ all :: $target | |
\$(NOECHO) \$(NOOP) | |
$target :: $plfile $pm_dep | |
- \$($perlrun) $plfile $target | |
+ \$(PERLRUNINST) $plfile $target | |
MAKE_FRAG | |
} | |
-- | |
tg: (daf8b46..) fixes/processPL (depends on: upstream) | |
From: Eugene V. Lyubimkin <[email protected]> | |
Subject: [PATCH] fixes/trie-logic-match | |
Resolves segmentation fault in some tricky tainted non-UTF-8 matches. | |
Signed-off-by: Eugene V. Lyubimkin <[email protected]> | |
--- | |
ext/re/t/regop.t | 12 ++++++------ | |
regcomp.c | 17 +++++++++++------ | |
regexec.c | 9 ++------- | |
3 files changed, 19 insertions(+), 19 deletions(-) | |
diff --git a/ext/re/t/regop.t b/ext/re/t/regop.t | |
index 7fe7b20..f111b91 100755 | |
--- a/ext/re/t/regop.t | |
+++ b/ext/re/t/regop.t | |
@@ -233,12 +233,12 @@ anchored "ABC" at 0 | |
#Freeing REx: "(\\.COM|\\.EXE|\\.BAT|\\.CMD|\\.VBS|\\.VBE|\\.JS|\\.JSE|\\."...... | |
%MATCHED% | |
floating ""$ at 3..4 (checking floating) | |
-1:1[1] 3:2[1] 5:2[64] 45:83[1] 47:84[1] 48:85[0] | |
-stclass EXACTF <.> minlen 3 | |
-Found floating substr ""$ at offset 30... | |
-Does not contradict STCLASS... | |
-Guessed: match at offset 26 | |
-Matching stclass EXACTF <.> against ".exe" | |
+#1:1[1] 3:2[1] 5:2[64] 45:83[1] 47:84[1] 48:85[0] | |
+#stclass EXACTF <.> minlen 3 | |
+#Found floating substr ""$ at offset 30... | |
+#Does not contradict STCLASS... | |
+#Guessed: match at offset 26 | |
+#Matching stclass EXACTF <.> against ".exe" | |
--- | |
#Compiling REx "[q]" | |
#size 12 nodes Got 100 bytes for offset annotations. | |
diff --git a/regcomp.c b/regcomp.c | |
index 49e69b2..b7fb032 100644 | |
--- a/regcomp.c | |
+++ b/regcomp.c | |
@@ -2820,13 +2820,18 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, | |
} | |
} else { | |
/* | |
- Currently we assume that the trie can handle unicode and ascii | |
- matches fold cased matches. If this proves true then the following | |
- define will prevent tries in this situation. | |
- | |
- #define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT) | |
-*/ | |
+ Currently we do not believe that the trie logic can | |
+ handle case insensitive matching properly when the | |
+ pattern is not unicode (thus forcing unicode semantics). | |
+ | |
+ If/when this is fixed the following define can be swapped | |
+ in below to fully enable trie logic. | |
+ | |
#define TRIE_TYPE_IS_SAFE 1 | |
+ | |
+*/ | |
+#define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT) | |
+ | |
if ( last && TRIE_TYPE_IS_SAFE ) { | |
make_trie( pRExC_state, | |
startbranch, first, cur, tail, count, | |
diff --git a/regexec.c b/regexec.c | |
index 7a42c4f..32994de 100644 | |
--- a/regexec.c | |
+++ b/regexec.c | |
@@ -1006,16 +1006,15 @@ Perl_re_intuit_start(pTHX_ REGEXP * const prog, SV *sv, char *strpos, | |
#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, \ | |
uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \ | |
- UV uvc_unfolded = 0; \ | |
switch (trie_type) { \ | |
case trie_utf8_fold: \ | |
if ( foldlen>0 ) { \ | |
- uvc_unfolded = uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \ | |
+ uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \ | |
foldlen -= len; \ | |
uscan += len; \ | |
len=0; \ | |
} else { \ | |
- uvc_unfolded = uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \ | |
+ uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \ | |
uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \ | |
foldlen -= UNISKIP( uvc ); \ | |
uscan = foldbuf + UNISKIP( uvc ); \ | |
@@ -1041,7 +1040,6 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \ | |
uvc = (UV)*uc; \ | |
len = 1; \ | |
} \ | |
- \ | |
if (uvc < 256) { \ | |
charid = trie->charmap[ uvc ]; \ | |
} \ | |
@@ -1054,9 +1052,6 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \ | |
charid = (U16)SvIV(*svpp); \ | |
} \ | |
} \ | |
- if (!charid && trie_type == trie_utf8_fold && !UTF) { \ | |
- charid = trie->charmap[uvc_unfolded]; \ | |
- } \ | |
} STMT_END | |
#define REXEC_FBC_EXACTISH_CHECK(CoNd) \ | |
-- | |
tg: (daf8b46..) fixes/trie-logic-match (depends on: upstream) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment