This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test the diagnostics for usage messages for POSIX wrapper functions.
authorNicholas Clark <nick@ccl4.org>
Wed, 31 Aug 2011 14:41:12 +0000 (16:41 +0200)
committerNicholas Clark <nick@ccl4.org>
Thu, 1 Sep 2011 19:54:10 +0000 (21:54 +0200)
Regularise the 3 inconsistent messages.

MANIFEST
ext/POSIX/lib/POSIX.pm
ext/POSIX/t/usage.t [new file with mode: 0644]

index 6943a35..0e76f02 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3641,6 +3641,7 @@ ext/POSIX/t/taint.t               See if POSIX works with taint
 ext/POSIX/t/termios.t          See if POSIX works
 ext/POSIX/t/time.t             See if POSIX time-related functions work
 ext/POSIX/t/unimplemented.t    Test the diagnostics for unimplemented functions
+ext/POSIX/t/usage.t            Test the diagnostics for usage messages
 ext/POSIX/t/waitpid.t          See if waitpid works
 ext/POSIX/typemap              POSIX extension interface types
 ext/re/hints/mpeix.pl          Hints for re for named architecture
index 990b73b..8c1f346 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 
 our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
 
-our $VERSION = "1.24";
+our $VERSION = '1.25';
 
 use AutoLoader;
 
@@ -153,7 +153,7 @@ sub getgrnam {
 }
 
 sub atan2 {
-    usage "atan2(x,y)" if @_ != 2;
+    usage "atan2(x, y)" if @_ != 2;
     CORE::atan2($_[0], $_[1]);
 }
 
@@ -178,7 +178,7 @@ sub log {
 }
 
 sub pow {
-    usage "pow(x,exponent)" if @_ != 2;
+    usage "pow(x, exponent)" if @_ != 2;
     $_[0] ** $_[1];
 }
 
@@ -377,7 +377,7 @@ sub scanf {
 }
 
 sub sprintf {
-    usage "sprintf(pattern,args)" if @_ == 0;
+    usage "sprintf(pattern, args...)" if @_ == 0;
     CORE::sprintf(shift,@_);
 }
 
diff --git a/ext/POSIX/t/usage.t b/ext/POSIX/t/usage.t
new file mode 100644 (file)
index 0000000..24e6a7e
--- /dev/null
@@ -0,0 +1,48 @@
+#!./perl -w
+
+use strict;
+use Test::More;
+use Config;
+
+plan(skip_all => "POSIX is unavailable")
+    unless $Config{extensions} =~ /\bPOSIX\b/;
+
+require POSIX;
+
+my %valid;
+my @all;
+
+my $argc = 0;
+for my $list ([qw(errno fork getchar getegid geteuid getgid getgroups getlogin
+                 getpgrp getpid getppid gets getuid time wait)],
+             [qw(abs alarm assert chdir closedir cos exit exp fabs fstat getc
+                 getenv getgrgid getgrnam getpwnam getpwuid gmtime isatty
+                 localtime log opendir raise readdir remove rewind rewinddir
+                 rmdir sin sleep sqrt stat strerror system tolower toupper
+                 umask unlink)],
+             [qw(atan2 chmod creat kill link mkdir pow rename strstr waitpid)],
+             [qw(chown fcntl utime)]) {
+    $valid{$_} = $argc foreach @$list;
+    push @all, @$list;
+    ++$argc;
+}
+
+my @try = 0 .. $argc - 1;
+foreach my $func (sort @all) {
+    my $arg_pat = join ', ', ('[a-z]+') x $valid{$func};
+    my $expect = qr/\AUsage: POSIX::$func\($arg_pat\) at \(eval/;
+    foreach my $try (@try) {
+       next if $valid{$func} == $try;
+       my $call = "POSIX::$func(" . join(', ', 1 .. $try) . ')';
+       is(eval "$call; 1", undef, "$call fails");
+       like($@, $expect, "POSIX::$func for $try arguments gives expected error")
+    }
+}
+
+foreach my $func (qw(printf sprintf)) {
+    is(eval "POSIX::$func(); 1", undef, "POSIX::$func() fails");
+    like($@, qr/\AUsage: POSIX::$func\(pattern, args\.\.\.\) at \(eval/,
+        "POSIX::$func for 0 arguments gives expected error");
+}
+
+done_testing();