Skip to content

Instantly share code, notes, and snippets.

@eqhmcow
Created December 4, 2009 18:49
Show Gist options
  • Save eqhmcow/249244 to your computer and use it in GitHub Desktop.
Save eqhmcow/249244 to your computer and use it in GitHub Desktop.
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(&reginfo, &tmp_s))
+
+ if (tmp_s >= strbeg && regtry(&reginfo, &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