FAQ
In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/19fc2965b60669d7bc25548edb32e3cdd86a68de?hp=ec35cd4c022dea519712ce60efb24e281b048471>

- Log -----------------------------------------------------------------
commit 19fc2965b60669d7bc25548edb32e3cdd86a68de
Author: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue May 10 08:56:13 2016 -0400

     Croak on unimplemented already at import time

     For example

       perl -MPOSIX=atexit -e 1

     is never going to work in runtime, so why should it work in compile time.

     This will probably break a lot of CPAN code, that have "good reasons"
     for their strange imports.

     Also the error messages change format, which will no doubt break another
     set of equally righteous CPAN modules.

M ext/POSIX/lib/POSIX.pm
M ext/POSIX/t/posix.t
M ext/POSIX/t/unimplemented.t

commit f914a2ba4b8f428b4efbe6b125d07f221f107a40
Author: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue May 10 08:42:37 2016 -0400

     Remove the deprecated POSIX::tmpnam as unsafe

M ext/POSIX/POSIX.xs
M ext/POSIX/lib/POSIX.pm
M ext/POSIX/lib/POSIX.pod
M ext/POSIX/t/posix.t

commit c60f3449d2166487bf605f16fd7f6537dfffc5e4
Author: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue May 10 08:41:37 2016 -0400

     Sort the %replacement and %reimpl

M ext/POSIX/lib/POSIX.pm
-----------------------------------------------------------------------

Summary of changes:
  ext/POSIX/POSIX.xs | 26 ---------
  ext/POSIX/lib/POSIX.pm | 139 ++++++++++++++++++++++++--------------------
  ext/POSIX/lib/POSIX.pod | 6 +-
  ext/POSIX/t/posix.t | 23 +++-----
  ext/POSIX/t/unimplemented.t | 5 +-
  5 files changed, 88 insertions(+), 111 deletions(-)

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 281bea8..f825e29 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -3241,32 +3241,6 @@ write(fd, buffer, nbytes)
   char * buffer
   size_t nbytes

-SV *
-tmpnam()
- PREINIT:
- STRLEN i;
- int len;
- CODE:
- RETVAL = newSVpvs("");
- SvGROW(RETVAL, L_tmpnam);
- /* Yes, we know tmpnam() is bad. So bad that some compilers
- * and linkers warn against using it. But it is here for
- * completeness. POSIX.pod warns against using it.
- *
- * Then again, maybe this should be removed at some point.
- * No point in enabling dangerous interfaces. */
- if (ckWARN_d(WARN_DEPRECATED)) {
- HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
- if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
- Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Calling POSIX::tmpnam() is deprecated");
- (void)hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
- }
- }
- len = strlen(tmpnam(SvPV(RETVAL, i)));
- SvCUR_set(RETVAL, len);
- OUTPUT:
- RETVAL
-
  void
  abort()

diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index 05bdbbe..fcaf298 100644
--- a/ext/POSIX/lib/POSIX.pm
+++ b/ext/POSIX/lib/POSIX.pm
@@ -4,7 +4,7 @@ use warnings;

  our ($AUTOLOAD, %SIGRT);

-our $VERSION = '1.65';
+our $VERSION = '1.68';

  require XSLoader;

@@ -18,18 +18,6 @@ use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD

  my $loaded;

-sub import {
- my $pkg = shift;
-
- load_imports() unless $loaded++;
-
- # Grandfather old foo_h form to new :foo_h form
- s/^(?=\w+_h$)/:/ for my @list = @_;
-
- local $Exporter::ExportLevel = 1;
- Exporter::import($pkg,@list);
-}
-
  sub croak { require Carp; goto &Carp::croak }
  sub usage { croak "Usage: POSIX::$_[0]" }

@@ -110,6 +98,7 @@ my %replacement = (
      strspn => undef,
      strtok => undef,
      tmpfile => 'IO::File::new_tmpfile',
+ tmpnam => 'use File::Temp',
      ungetc => 'IO::Handle::ungetc',
      vfprintf => undef,
      vprintf => undef,
@@ -117,74 +106,105 @@ my %replacement = (
  );

  my %reimpl = (
+ abs => 'x => CORE::abs($_[0])',
+ alarm => 'seconds => CORE::alarm($_[0])',
      assert => 'expr => croak "Assertion failed" if !$_[0]',
- tolower => 'string => lc($_[0])',
- toupper => 'string => uc($_[0])',
- closedir => 'dirhandle => CORE::closedir($_[0])',
- opendir => 'directory => my $dh; CORE::opendir($dh, $_[0]) ? $dh : undef',
- readdir => 'dirhandle => CORE::readdir($_[0])',
- rewinddir => 'dirhandle => CORE::rewinddir($_[0])',
- errno => '$! + 0',
- creat => 'filename, mode => &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1])',
- fcntl => 'filehandle, cmd, arg => CORE::fcntl($_[0], $_[1], $_[2])',
- getgrgid => 'gid => CORE::getgrgid($_[0])',
- getgrnam => 'name => CORE::getgrnam($_[0])',
      atan2 => 'x, y => CORE::atan2($_[0], $_[1])',
+ chdir => 'directory => CORE::chdir($_[0])',
+ chmod => 'mode, filename => CORE::chmod($_[0], $_[1])',
+ chown => 'uid, gid, filename => CORE::chown($_[0], $_[1], $_[2])',
+ closedir => 'dirhandle => CORE::closedir($_[0])',
      cos => 'x => CORE::cos($_[0])',
+ creat => 'filename, mode => &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1])',
+ errno => '$! + 0',
+ exit => 'status => CORE::exit($_[0])',
      exp => 'x => CORE::exp($_[0])',
      fabs => 'x => CORE::abs($_[0])',
- log => 'x => CORE::log($_[0])',
- pow => 'x, exponent => $_[0] ** $_[1]',
- sin => 'x => CORE::sin($_[0])',
- sqrt => 'x => CORE::sqrt($_[0])',
- getpwnam => 'name => CORE::getpwnam($_[0])',
- getpwuid => 'uid => CORE::getpwuid($_[0])',
- kill => 'pid, sig => CORE::kill $_[1], $_[0]',
- raise => 'sig => CORE::kill $_[0], $$; # Is this good enough',
+ fcntl => 'filehandle, cmd, arg => CORE::fcntl($_[0], $_[1], $_[2])',
+ fork => 'CORE::fork',
+ fstat => 'fd => CORE::open my $dup, "<&", $_[0]; CORE::stat($dup)', # Gross.
      getc => 'handle => CORE::getc($_[0])',
      getchar => 'CORE::getc(STDIN)',
- gets => 'scalar <STDIN>',
- remove => 'filename => (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0])',
- rename => 'oldfilename, newfilename => CORE::rename($_[0], $_[1])',
- rewind => 'filehandle => CORE::seek($_[0],0,0)',
- abs => 'x => CORE::abs($_[0])',
- exit => 'status => CORE::exit($_[0])',
- getenv => 'name => $ENV{$_[0]}',
- system => 'command => CORE::system($_[0])',
- strerror => 'errno => BEGIN { local $!; require locale; locale->import} my $e = $_[0] + 0; local $!; $! = $e; "$!"',
- strstr => 'big, little => CORE::index($_[0], $_[1])',
- chmod => 'mode, filename => CORE::chmod($_[0], $_[1])',
- fstat => 'fd => CORE::open my $dup, "<&", $_[0]; CORE::stat($dup)', # Gross.
- mkdir => 'directoryname, mode => CORE::mkdir($_[0], $_[1])',
- stat => 'filename => CORE::stat($_[0])',
- umask => 'mask => CORE::umask($_[0])',
- wait => 'CORE::wait()',
- waitpid => 'pid, options => CORE::waitpid($_[0], $_[1])',
- gmtime => 'time => CORE::gmtime($_[0])',
- localtime => 'time => CORE::localtime($_[0])',
- time => 'CORE::time',
- alarm => 'seconds => CORE::alarm($_[0])',
- chdir => 'directory => CORE::chdir($_[0])',
- chown => 'uid, gid, filename => CORE::chown($_[0], $_[1], $_[2])',
- fork => 'CORE::fork',
      getegid => '$) + 0',
+ getenv => 'name => $ENV{$_[0]}',
      geteuid => '$> + 0',
      getgid => '$( + 0',
+ getgrgid => 'gid => CORE::getgrgid($_[0])',
+ getgrnam => 'name => CORE::getgrnam($_[0])',
      getgroups => 'my %seen; grep !$seen{$_}++, split " ", $)',
      getlogin => 'CORE::getlogin()',
      getpgrp => 'CORE::getpgrp',
      getpid => '$$',
      getppid => 'CORE::getppid',
+ getpwnam => 'name => CORE::getpwnam($_[0])',
+ getpwuid => 'uid => CORE::getpwuid($_[0])',
+ gets => 'scalar <STDIN>',
      getuid => '$<',
+ gmtime => 'time => CORE::gmtime($_[0])',
      isatty => 'filehandle => -t $_[0]',
+ kill => 'pid, sig => CORE::kill $_[1], $_[0]',
      link => 'oldfilename, newfilename => CORE::link($_[0], $_[1])',
+ localtime => 'time => CORE::localtime($_[0])',
+ log => 'x => CORE::log($_[0])',
+ mkdir => 'directoryname, mode => CORE::mkdir($_[0], $_[1])',
+ opendir => 'directory => my $dh; CORE::opendir($dh, $_[0]) ? $dh : undef',
+ pow => 'x, exponent => $_[0] ** $_[1]',
+ raise => 'sig => CORE::kill $_[0], $$; # Is this good enough',
+ readdir => 'dirhandle => CORE::readdir($_[0])',
+ remove => 'filename => (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0])',
+ rename => 'oldfilename, newfilename => CORE::rename($_[0], $_[1])',
+ rewind => 'filehandle => CORE::seek($_[0],0,0)',
+ rewinddir => 'dirhandle => CORE::rewinddir($_[0])',
      rmdir => 'directoryname => CORE::rmdir($_[0])',
+ sin => 'x => CORE::sin($_[0])',
+ sqrt => 'x => CORE::sqrt($_[0])',
+ stat => 'filename => CORE::stat($_[0])',
+ strerror => 'errno => BEGIN { local $!; require locale; locale->import} my $e = $_[0] + 0; local $!; $! = $e; "$!"',
+ strstr => 'big, little => CORE::index($_[0], $_[1])',
+ system => 'command => CORE::system($_[0])',
+ time => 'CORE::time',
+ tolower => 'string => lc($_[0])',
+ toupper => 'string => uc($_[0])',
+ umask => 'mask => CORE::umask($_[0])',
      unlink => 'filename => CORE::unlink($_[0])',
      utime => 'filename, atime, mtime => CORE::utime($_[1], $_[2], $_[0])',
+ wait => 'CORE::wait()',
+ waitpid => 'pid, options => CORE::waitpid($_[0], $_[1])',
  );

+sub import {
+ my $pkg = shift;
+
+ load_imports() unless $loaded++;
+
+ # Grandfather old foo_h form to new :foo_h form
+ s/^(?=\w+_h$)/:/ for my @list = @_;
+
+ my @unimpl = sort grep { exists $replacement{$_} } @list;
+ if (@unimpl) {
+ for my $u (@unimpl) {
+ warn "Unimplemented: POSIX::$u(): ", unimplemented_message($u);
+ }
+ croak(sprintf("Unimplemented: %s",
+ join(" ", map { "POSIX::$_()" } @unimpl)));
+ }
+
+ local $Exporter::ExportLevel = 1;
+ Exporter::import($pkg,@list);
+}
+
  eval join ';', map "sub $_", keys %replacement, keys %reimpl;

+sub unimplemented_message {
+ my $func = shift;
+ my $how = $replacement{$func};
+ return "C-specific, stopped" unless defined $how;
+ return "$$how" if ref $how;
+ return "$how instead" if $how =~ /^use /;
+ return "Use method $how() instead" if $how =~ /::/;
+ return "C-specific: use $how instead";
+}
+
  sub AUTOLOAD {
      my ($func) = ($AUTOLOAD =~ /.*::(.*)/);

@@ -207,12 +227,7 @@ sub AUTOLOAD {
   goto &$AUTOLOAD;
      }
      if (exists $replacement{$func}) {
- my $how = $replacement{$func};
- croak "Unimplemented: POSIX::$func() is C-specific, stopped"
- unless defined $how;
- croak "Unimplemented: POSIX::$func() is $$how" if ref $how;
- croak "Use method $how() instead of POSIX::$func()" if $how =~ /::/;
- croak "Unimplemented: POSIX::$func() is C-specific: use $how instead";
+ croak "Unimplemented: POSIX::$func(): ", unimplemented_message($func);
      }

      constant($func);
diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod
index 840f04b..e903acc 100644
--- a/ext/POSIX/lib/POSIX.pod
+++ b/ext/POSIX/lib/POSIX.pod
@@ -1949,13 +1949,9 @@ Not implemented. Use method C<IO::File::new_tmpfile()> instead, or see L<File::

  =item C<tmpnam>

-Returns a name for a temporary file.
-
- $tmpfile = POSIX::tmpnam();
-
  For security reasons, which are probably detailed in your system's
  documentation for the C library C<tmpnam()> function, this interface
-should not be used; instead see L<File::Temp>.
+is no more available; instead use L<File::Temp>.

  =item C<tolower>

diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t
index bd5c300..ea43bc0 100644
--- a/ext/POSIX/t/posix.t
+++ b/ext/POSIX/t/posix.t
@@ -10,7 +10,7 @@ BEGIN {
      require 'loc_tools.pl';
  }

-use Test::More tests => 94;
+use Test::More tests => 93;

  use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write
        errno localeconv dup dup2 lseek access);
@@ -299,13 +299,13 @@ like ($@, qr/^Usage: POSIX::kill\(pid, sig\)/, "check its usage message");
  # Check unimplemented.
  $result = eval {POSIX::offsetof};
  is ($result, undef, "offsetof should fail");
-like ($@, qr/^Unimplemented: POSIX::offsetof\(\) is C-specific/,
+like ($@, qr/^Unimplemented: POSIX::offsetof\(\): C-specific/,
        "check its unimplemented message");

  # Check reimplemented.
  $result = eval {POSIX::fgets};
  is ($result, undef, "fgets should fail");
-like ($@, qr/^Use method IO::Handle::gets\(\) instead/,
+like ($@, qr/^Unimplemented: POSIX::fgets\(\): Use method IO::Handle::gets\(\) instead/,
        "check its redef message");

  eval { use strict; POSIX->import("S_ISBLK"); my $x = S_ISBLK };
@@ -402,19 +402,10 @@ SKIP: {
      cmp_ok($!, '==', POSIX::ENOTDIR);
  }

-{ # tmpnam() is deprecated
- my @warn;
- local $SIG{__WARN__} = sub { push @warn, "@_"; note "@_"; };
- my $x = sub { POSIX::tmpnam() };
- my $foo = $x->();
- $foo = $x->();
- is(@warn, 1, "POSIX::tmpnam() should warn only once per location");
- like($warn[0], qr!^Calling POSIX::tmpnam\(\) is deprecated at t/posix.t line \d+\.$!,
- "check POSIX::tmpnam warns by default");
- no warnings "deprecated";
- undef $warn;
- my $foo = POSIX::tmpnam();
- is($warn, undef, "... but the warning can be disabled");
+{ # tmpnam() has been removed as unsafe
+ my $x = eval { POSIX::tmpnam() };
+ is($x, undef, 'tmpnam has been removed');
+ like($@, qr/use File::Temp/, 'tmpnam advises File::Temp');
  }

  # Check that output is not flushed by _exit. This test should be last
diff --git a/ext/POSIX/t/unimplemented.t b/ext/POSIX/t/unimplemented.t
index 2d8f819..9a03a75 100644
--- a/ext/POSIX/t/unimplemented.t
+++ b/ext/POSIX/t/unimplemented.t
@@ -83,6 +83,7 @@ foreach ([atexit => 'C-specific: use END {} instead'],
    [strspn => 'C-specific, stopped'],
    [strtok => 'C-specific, stopped'],
    [tmpfile => \'IO::File::new_tmpfile'],
+ [tmpnam => \'use File::Temp'],
    [ungetc => \'IO::Handle::ungetc'],
    [vfprintf => 'C-specific, stopped'],
    [vprintf => 'C-specific, stopped'],
@@ -90,8 +91,8 @@ foreach ([atexit => 'C-specific: use END {} instead'],
   ) {
      my ($func, $action) = @$_;
      my $expect = ref $action
- ? qr/Use method $$action\(\) instead of POSIX::$func\(\) at \(eval/
- : qr/Unimplemented: POSIX::$func\(\) is \Q$action\E at \(eval/;
+ ? qr/Unimplemented: POSIX::$func\(\): .*$$action(?:\(\))? instead at \(eval/
+ : qr/Unimplemented: POSIX::$func\(\): \Q$action\E at \(eval/;
      is(eval "POSIX::$func(); 1", undef, "POSIX::$func fails as expected");
      like($@, $expect, "POSIX::$func gives expected error message");
  }

--
Perl5 Master Repository

Search Discussions

Related Discussions

Discussion Navigation
viewthread | post
posts ‹ prev | 1 of 1 | next ›
Discussion Overview
groupperl5-changes @
categoriesperl
postedMay 12, '16 at 1:14a
activeMay 12, '16 at 1:14a
posts1
users1
websiteperl.org

1 user in discussion

Jarkko Hietaniemi: 1 post

People

Translate

site design / logo © 2017 Grokbase