Convert POSIX::sleep to an XS wrapper for PerlProc_sleep().

Previously it was a Perl wrapper for CORE::sleep, converting CORE::sleep's
return value of elapsed time slept into the POSIX return value of seconds
remaining. However, that approach could sometimes return a negative result
if CORE::sleep had slept for more than a second longer than the requested
time.

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index 9082f61..efd0cf7 100644 (file)
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -205,7 +205,7 @@ my $testpkgs = {
                      fmod floor dup2 dup difftime cuserid ctime
                      ctermid cosh constant close clock ceil
                      bootstrap atan asin asctime acos access abort
-                     _exit
+                     _exit sleep
                      /],
               },
 

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 1bad5e1..ab30a1c 100644 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1885,6 +1885,14 @@ pause()
     CLEANUP:
     PERL_ASYNC_CHECK();
 
+unsigned int
+sleep(seconds)
+       unsigned int    seconds
+    CODE:
+       RETVAL = PerlProc_sleep(seconds);
+    OUTPUT:
+       RETVAL
+
 SysRet
 setgid(gid)
        Gid_t           gid

diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index 9840b76..b6997ff 100644 (file)
--- a/ext/POSIX/lib/POSIX.pm
+++ b/ext/POSIX/lib/POSIX.pm
@@ -179,7 +179,6 @@ my %reimpl = (
     isatty    => 'filehandle => -t $_[0]',
     link      => 'oldfilename, newfilename => CORE::link($_[0], $_[1])',
     rmdir     => 'directoryname => CORE::rmdir($_[0])',
-    sleep     => 'seconds => $_[0] - CORE::sleep($_[0])',
     unlink    => 'filename => CORE::unlink($_[0])',
     utime     => 'filename, atime, mtime => CORE::utime($_[1], $_[2], $_[0])',
 );
@@ -391,7 +390,7 @@ our %EXPORT_TAGS = (
   # @EXPORT are actually shared hash key scalars, which will save some memory.
   our @EXPORT = keys %export;
 
-  our @EXPORT_OK = (qw(close lchown nice open pipe read times write
+  our @EXPORT_OK = (qw(close lchown nice open pipe read sleep times write
                       printf sprintf),
                    grep {!exists $export{$_}} keys %reimpl, keys %replacement);
 }