Bump to 1.38 from blead

.travis.yml

@@ -0,0 +1,45 @@
+language: "perl"
+sudo: false
+perl:
+  - "5.8"
+  - "5.10"
+  - "5.12"
+  - "5.14"
+  - "5.16"
+  - "5.18"
+  - "5.20"
+  - "5.22"
+  - "5.24"
+  - "5.26"
+  - "dev"
+  - "blead"
+
+before_install:
+  - mkdir /home/travis/bin || true
+  - ln -s `which true` /home/travis/bin/cpansign
+  - eval $(curl https://travis-perl.github.io/init) --auto
+install:
+  - export AUTOMATED_TESTING=1 HARNESS_TIMER=1 AUTHOR_TESTING=0 RELEASE_TESTING=0
+  #- cpan-install --deps       # installs prereqs, including recommends
+  #- cpan-install Test::LeakTrace
+  - cpan-install --coverage   # installs coverage prereqs, if enabled
+
+before_script:
+  - coverage-setup
+
+notifications:
+  email:
+    on_success: change
+    on_failure: always
+
+matrix:
+  fast_finish: true
+  include:
+  allow_failures:
+    - env: COVERAGE=1 AUTHOR_TESTING=1
+    - perl: "blead"
+
+# Hack to not run on tag pushes:
+branches:
+  except:
+  - /^v?[0-9]+\.[0-9]+/

IO.pm

@@ -7,7 +7,7 @@ use Carp;
 use strict;
 use warnings;
 
-our $VERSION = "1.36_01";
+our $VERSION = "1.38";
 XSLoader::load 'IO', $VERSION;
 
 sub import {
@@ -18,6 +18,8 @@ sub import {
 
     my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir);
 
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l)
 	or croak $@;
 }

IO.xs

@@ -318,7 +318,7 @@ PPCODE:
 {
 #ifdef HAS_POLL
     const int nfd = (items - 1) / 2;
-    SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd));
+    SV *tmpsv = sv_2mortal(NEWSV(999,nfd * sizeof(struct pollfd)));
     /* We should pass _some_ valid pointer even if nfd is zero, but it
      * doesn't matter what it is, since we're telling it to not check any fds.
      */
@@ -337,7 +337,6 @@ PPCODE:
 	    sv_setiv(ST(i), fds[j].revents); i++;
 	}
     }
-    SvREFCNT_dec(tmpsv);
     XSRETURN_IV(ret);
 #else
 	not_here("IO::Poll::poll");

Makefile.PL

@@ -20,7 +20,7 @@ unless ($PERL_CORE or exists $Config{'i_poll'}) {
 }
 
 if ($] < 5.008 and !$PERL_CORE) {
-  open(FH,">typemap");
+  open(FH,'>','typemap');
   print FH "const char *            T_PV\n";
   close(FH);
 }

appveyor.cmd

@@ -0,0 +1,71 @@
+@echo off
+call :%*
+goto :eof
+
+:perl_setup
+if not defined perl_type set perl_type=system
+if "%perl_type%" == "cygwin" (
+  start /wait c:\cygwin\setup-x86.exe -q -g -P perl -P make -P gcc -P gcc-g++ -P libcrypt-devel
+  set "PATH=C:\cygwin\usr\local\bin;C:\cygwin\bin;%PATH%"
+) else if "%perl_type%" == "strawberry" (
+  if not defined perl_version (
+    cinst -y StrawberryPerl
+  ) else (
+    cinst -y StrawberryPerl --version %perl_version%
+  )
+  if errorlevel 1 (
+    type C:\ProgramData\chocolatey\logs\chocolatey.log
+    exit /b 1
+  )
+  set "PATH=C:\Strawberry\perl\site\bin;C:\Strawberry\perl\bin;C:\Strawberry\c\bin;%PATH%"
+) else if "%perl_type%" == "system" (
+  mkdir c:\dmake
+  cinst -y curl
+  curl http://www.cpan.org/authors/id/S/SH/SHAY/dmake-4.12.2.2.zip -o c:\dmake\dmake.zip
+  7z x c:\dmake\dmake.zip -oc:\ >NUL
+  set "PATH=c:\dmake;C:\MinGW\bin;%PATH%"
+) else (
+  echo.Unknown perl type "%perl_type%"! 1>&2
+  exit /b 1
+)
+for /f "usebackq delims=" %%d in (`perl -MConfig -e"print $Config{make}"`) do set "make=%%d"
+set "perl=perl"
+set "cpanm=call appveyor.cmd cpanm"
+set "cpan=%perl% -S cpan"
+set TAR_OPTIONS=--warning=no-unknown-keyword
+goto :eof
+
+:cpanm
+%perl% -S cpanm >NUL 2>&1
+if ERRORLEVEL 1 (
+  curl -V >NUL 2>&1
+  if ERRORLEVEL 1 cinst -y curl
+  curl -k -L https://cpanmin.us/ -o "%TEMP%\cpanm"
+  %perl% "%TEMP%\cpanm" -n App::cpanminus
+)
+set "cpanm=%perl% -S cpanm"
+%cpanm% %*
+goto :eof
+
+:local_lib
+if "%perl_type%" == "cygwin" goto :local_lib_cygwin
+%perl% -Ilib -Mlocal::lib=--shelltype=cmd %* > %TEMP%\local-lib.bat
+call %TEMP%\local-lib.bat
+del %TEMP%\local-lib.bat
+goto :eof
+
+:local_lib_cygwin
+for /f "usebackq delims=" %%d in (`sh -c "cygpath -w $HOME/perl5"`) do (
+  c:\perl\bin\perl.exe -Ilib -Mlocal::lib - %%d --shelltype=cmd > "%TEMP%\local-lib.bat"
+)
+setlocal
+  call "%TEMP%\local-lib.bat"
+endlocal & set "PATH=%PATH%"
+set "PATH_BACK=%PATH%"
+%perl% -Ilib -Mlocal::lib - --shelltype=cmd > "%TEMP%\local-lib.bat"
+call "%TEMP%\local-lib.bat"
+set "PATH=%PATH_BACK%"
+del "%TEMP%\local-lib.bat"
+goto :eof
+
+:eof

appveyor.yml

@@ -0,0 +1,18 @@
+version: '{build}'
+shallow_clone: true
+
+environment:
+  matrix:
+    - perl_type: system
+    - perl_type: strawberry
+    - perl_type: cygwin
+
+install:
+  - 'call appveyor.cmd perl_setup'
+  - '%perl% -V'
+  - '%cpanm% --installdeps -n --with-develop --with-recommends .'
+
+build: off
+
+test_script:
+  - 'prove -l t'

lib/IO/Handle.pm

@@ -122,8 +122,8 @@ otherwise.
 This works like <$io> described in L<perlop/"I/O Operators">
 except that it's more readable and can be safely called in a
 list context but still returns just one line.  If used as the conditional
-+within a C<while> or C-style C<for> loop, however, you will need to
-+emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>.
+within a C<while> or C-style C<for> loop, however, you will need to
+emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>.
 
 =item $io->getlines
 
@@ -271,7 +271,7 @@ use IO ();	# Load the XS module
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = "1.35";
+$VERSION = "1.37";
 $VERSION = eval $VERSION;
 
 @EXPORT_OK = qw(
@@ -366,7 +366,7 @@ sub fdopen {
     my ($io, $fd, $mode) = @_;
     local(*GLOB);
 
-    if (ref($fd) && "".$fd =~ /GLOB\(/o) {
+    if (ref($fd) && "$fd" =~ /GLOB\(/o) {
 	# It's a glob reference; Alias it as we cannot get name of anon GLOBs
 	my $n = qualify(*GLOB);
 	*GLOB = *{*$fd};
@@ -494,7 +494,7 @@ sub stat {
 ##
 
 sub autoflush {
-    my $old = new SelectSaver qualify($_[0], caller);
+    my $old = SelectSaver->new(qualify($_[0], caller));
     my $prev = $|;
     $| = @_ > 1 ? $_[1] : 1;
     $prev;
@@ -534,39 +534,39 @@ sub input_line_number {
 
 sub format_page_number {
     my $old;
-    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
     my $prev = $%;
     $% = $_[1] if @_ > 1;
     $prev;
 }
 
 sub format_lines_per_page {
     my $old;
-    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
     my $prev = $=;
     $= = $_[1] if @_ > 1;
     $prev;
 }
 
 sub format_lines_left {
     my $old;
-    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
     my $prev = $-;
     $- = $_[1] if @_ > 1;
     $prev;
 }
 
 sub format_name {
     my $old;
-    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
     my $prev = $~;
     $~ = qualify($_[1], caller) if @_ > 1;
     $prev;
 }
 
 sub format_top_name {
     my $old;
-    $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
+    $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]);
     my $prev = $^;
     $^ = qualify($_[1], caller) if @_ > 1;
     $prev;
@@ -640,7 +640,7 @@ sub constant {
 sub printflush {
     my $io = shift;
     my $old;
-    $old = new SelectSaver qualify($io, caller) if ref($io);
+    $old = SelectSaver->new(qualify($io, caller)) if ref($io);
     local $| = 1;
     if(ref($io)) {
         print $io @_;

lib/IO/Select.pm

@@ -11,7 +11,7 @@ use warnings::register;
 use     vars qw($VERSION @ISA);
 require Exporter;
 
-$VERSION = "1.22";
+$VERSION = "1.23";
 
 @ISA = qw(Exporter); # This is only so we can do version checking
 
@@ -315,10 +315,13 @@ Return an array of all registered handles.
 
 =item can_read ( [ TIMEOUT ] )
 
-Return an array of handles that are ready for reading. C<TIMEOUT> is
-the maximum amount of time to wait before returning an empty list, in
-seconds, possibly fractional. If C<TIMEOUT> is not given and any
-handles are registered then the call will block.
+Return an array of handles that are ready for reading.  C<TIMEOUT> is the
+maximum amount of time to wait before returning an empty list (with C<$!>
+unchanged), in seconds, possibly fractional.  If C<TIMEOUT> is not given
+and any handles are registered then the call will block indefinitely.
+Upon error, an empty list is returned, with C<$!> set to indicate the
+error.  To distinguish between timeout and error, set C<$!> to zero
+before calling this method, and check it after an empty list is returned.
 
 =item can_write ( [ TIMEOUT ] )
 
@@ -346,9 +349,14 @@ like C<new>. C<READ>, C<WRITE> and C<EXCEPTION> are either C<undef> or
 C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as
 for the core select call.
 
-The result will be an array of 3 elements, each a reference to an array
-which will hold the handles that are ready for reading, writing and have
-exceptions respectively. Upon error an empty list is returned.
+If at least one handle is ready for the specified kind of operation,
+the result will be an array of 3 elements, each a reference to an array
+which will hold the handles that are ready for reading, writing and
+have exceptions respectively.  Upon timeout, an empty list is returned,
+with C<$!> unchanged.  Upon error, an empty list is returned, with C<$!>
+set to indicate the error.  To distinguish between timeout and error,
+set C<$!> to zero before calling this method, and check it after an
+empty list is returned.
 
 =back
 

poll.c

@@ -18,9 +18,7 @@
 #ifdef I_SYS_TIME
 # include <sys/time.h>
 #endif
-#ifdef I_TIME
-# include <time.h>
-#endif
+#include <time.h>
 #include <sys/types.h>
 #if defined(HAS_SOCKET) && !defined(VMS) && !defined(ultrix) /* VMS handles sockets via vmsish.h, ULTRIX dies of socket struct redefinitions */
 #  include <sys/socket.h>

t/IO.t

@@ -93,7 +93,7 @@ my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' );
 my $flag;
 if ( -d $fakedir or mkpath( $fakedir ))
 {
-	if (open( OUT, ">$fakemod"))
+	if (open( OUT, '>', $fakemod ))
 	{
 		(my $package = <<'		END_HERE') =~ tr/\t//d;
 		package IO::fakemod;

t/cachepropagate-unix.t

@@ -14,10 +14,25 @@ use Test::More;
 plan skip_all => "UNIX domain sockets not implemented on $^O"
   if ($^O =~ m/^(?:qnx|nto|vos|MSWin32|VMS)$/);
 
-plan tests => 15;
-
 my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock');
 
+# check the socketpath fits in sun_path.
+#
+# pack_sockaddr_un() just truncates the path, this may change, but how
+# it will handle such a condition is undetermined (and we might need
+# to work with older versions of Socket outside of a perl build)
+# https://rt.cpan.org/Ticket/Display.html?id=116819
+
+my $name = eval { pack_sockaddr_un($socketpath) };
+if (defined $name) {
+    my ($packed_name) = eval { unpack_sockaddr_un($name) };
+    if (!defined $packed_name || $packed_name ne $socketpath) {
+        plan skip_all => "socketpath too long for sockaddr_un";
+    }
+}
+
+plan tests => 15;
+
 # start testing stream sockets:
 my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM,
 				     Listen => 1,

t/io_dir.t

@@ -42,7 +42,7 @@ ok(!$dot->rewind, "rewind on closed");
 ok(!defined($dot->read));
 }
 
-open(FH,'>X') || die "Can't create x";
+open(FH,'>','X') || die "Can't create x";
 print FH "X";
 close(FH) or die "Can't close: $!";
 

t/io_file.t

@@ -16,7 +16,7 @@ can_ok( $Class,                 "binmode" );
 ### use standard open to make sure we can compare binmodes
 ### on both.
 {   my $tmp;
-    open $tmp, ">$File" or die "Could not open '$File': $!";
+    open $tmp, '>', $File or die "Could not open '$File': $!";
     binmode $tmp;
     print $tmp $All_Chars; 
     close $tmp;