This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Croak on unimplemented already at import time
authorJarkko Hietaniemi <jhi@iki.fi>
Tue, 10 May 2016 12:56:13 +0000 (08:56 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Thu, 12 May 2016 00:58:57 +0000 (20:58 -0400)
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.

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

index fe33b0b..fcaf298 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 
 our ($AUTOLOAD, %SIGRT);
 
-our $VERSION = '1.67';
+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]" }
 
@@ -184,8 +172,39 @@ my %reimpl = (
     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 =~ /.*::(.*)/);
 
@@ -208,13 +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 "Unimplemented: $how instead of POSIX::$func()" if $how =~ /^use /;
-       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);
index 4fbdb48..ea43bc0 100644 (file)
@@ -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 };
index 2d8f819..9a03a75 100644 (file)
@@ -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");
 }