Change 30198 by [EMAIL PROTECTED] on 2007/02/10 20:31:15
Integrate:
[ 26435]
Add tests for untested math functions in POSIX
[ 28503]
Subject: [PATCH] Test scripts for I18N::Langinfo and POSIX
From: Sébastien Aperghis-Tramoni <[EMAIL PROTECTED]>
Date: Fri, 07 Jul 2006 11:02:31 +0200
Message-ID: <[EMAIL PROTECTED]>
Only includes changes to:
* ext/I18N/Langinfo/t/Langinfo.t
* ext/POSIX/t/sysconf.t
* ext/POSIX/t/termios.t
[ 28505]
POSIX test improvements on True64
Subject: [PATCH] the new POSIX tests
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Sat, 08 Jul 2006 11:43:05 +0300
Message-ID: <[EMAIL PROTECTED]>
[ 28508]
Subject: Skip some POSIX tests when the thing they are testing is
unimplemented
From: demerphq <[EMAIL PROTECTED]>
Date: Sat, 8 Jul 2006 17:55:09 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 28520]
Subject: [PATCH] Skip tests of a POSIX constant on Mac OS X because
saved IDs are borked
From: Dominic Dunlop <[EMAIL PROTECTED]>
Date: Sun, 9 Jul 2006 22:22:14 +0200
Message-Id: <[EMAIL PROTECTED]>
[ 28540]
Subject: [PATCH] sysconf.t: still failing in tru64, try harder to skip
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Date: Tue, 11 Jul 2006 09:23:08 +0300 (EEST)
Message-Id: <[EMAIL PROTECTED]>
[ 28572]
Skip tests for pathconf() and fpathconf() on HP-UX for
_PC_CHOWN_RESTRICTED. The HP-UX manpage suggests not trying
to do it, and that the errno will not be set on failure.
[ 28574]
Make sysconf tests handle unimplemented success indications
for the benefit of Mac OS X and VMS.
[ 28851]
return value of -1 without errno set is ok in
ext/POSIX/t/sysconf.t (it just means the feature is
not implemented, not defined, or has no limit)
[ 30014]
Fix ext/POSIX/t/sysconf.t failures on Cygwin.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#313 integrate
... //depot/maint-5.8/perl/ext/I18N/Langinfo/t/Langinfo.t#2 integrate
... //depot/maint-5.8/perl/ext/POSIX/POSIX.pod#18 integrate
... //depot/maint-5.8/perl/ext/POSIX/t/math.t#1 branch
... //depot/maint-5.8/perl/ext/POSIX/t/sysconf.t#1 branch
... //depot/maint-5.8/perl/ext/POSIX/t/termios.t#1 branch
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#313 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#312~30193~ 2007-02-10 09:24:50.000000000 -0800
+++ perl/MANIFEST 2007-02-10 12:31:15.000000000 -0800
@@ -790,9 +790,12 @@
ext/POSIX/POSIX.pod POSIX extension documentation
ext/POSIX/POSIX.xs POSIX extension external subroutines
ext/POSIX/t/is.t See if POSIX isxxx() work
+ext/POSIX/t/math.t Basic math tests for POSIX
ext/POSIX/t/posix.t See if POSIX works
ext/POSIX/t/sigaction.t See if POSIX::sigaction works
+ext/POSIX/t/sysconf.t See if POSIX works
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/waitpid.t See if waitpid works
ext/POSIX/typemap POSIX extension interface types
==== //depot/maint-5.8/perl/ext/I18N/Langinfo/t/Langinfo.t#2 (text) ====
Index: perl/ext/I18N/Langinfo/t/Langinfo.t
--- perl/ext/I18N/Langinfo/t/Langinfo.t#1~20271~ 2003-07-28
08:18:57.000000000 -0700
+++ perl/ext/I18N/Langinfo/t/Langinfo.t 2007-02-10 12:31:15.000000000 -0800
@@ -1,24 +1,35 @@
-#!./perl
+#!perl -T
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
- require Config; import Config;
- if ($Config{'extensions'} !~ m!\bI18N/Langinfo\b! ||
- $Config{'extensions'} !~ m!\bPOSIX\b!)
- {
- print "1..0 # skip: I18N::Langinfo or POSIX unavailable\n";
- exit 0;
+ if ($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
}
}
-
-use I18N::Langinfo qw(langinfo);
-use POSIX qw(setlocale LC_ALL);
-setlocale(LC_ALL, $ENV{LC_ALL} = $ENV{LANG} = "C");
+use strict;
+use Config;
+use Test::More;
+
+plan skip_all => "I18N::Langinfo or POSIX unavailable"
+ if $Config{'extensions'} !~ m!\bI18N/Langinfo\b!;
+
+my @constants = qw(ABDAY_1 DAY_1 ABMON_1 MON_1 RADIXCHAR AM_STR THOUSEP
D_T_FMT D_FMT T_FMT);
+
+plan tests => 1 + 3 * @constants;
+
+use_ok('I18N::Langinfo', 'langinfo', @constants);
+
+for my $constant (@constants) {
+ SKIP: {
+ my $string = eval { langinfo(eval "$constant()") };
+ is( $@, '', "calling langinfo() with $constant" );
+ skip "returned string was empty, skipping next two tests", 2 unless
$string;
+ ok( defined $string, "checking if the returned string is defined" );
+ cmp_ok( length($string), '>=', 1, "checking if the returned string has
a positive length" );
+ }
+}
-print "1..1\n"; # We loaded okay. That's about all we can hope for.
-print "ok 1\n";
exit(0);
# Background: the langinfo() (in C known as nl_langinfo()) interface
==== //depot/maint-5.8/perl/ext/POSIX/POSIX.pod#18 (text) ====
Index: perl/ext/POSIX/POSIX.pod
--- perl/ext/POSIX/POSIX.pod#17~28115~ 2006-05-06 17:03:20.000000000 -0700
+++ perl/ext/POSIX/POSIX.pod 2007-02-10 12:31:15.000000000 -0800
@@ -848,7 +848,8 @@
if (mkfifo($path, $mode)) { ....
Returns C<undef> on failure. The C<$mode> is similar to the
-mode of C<mkdir()>, see L<perlfunc/mkdir>.
+mode of C<mkdir()>, see L<perlfunc/mkdir>, though for C<mkfifo>
+you B<must> specify the C<$mode>.
=item mktime
@@ -1840,6 +1841,7 @@
Obtain the attributes for stdin.
+ $termios->getattr( 0 ) # Recommended for clarity.
$termios->getattr()
Obtain the attributes for stdout.
==== //depot/maint-5.8/perl/ext/POSIX/t/math.t#1 (text) ====
Index: perl/ext/POSIX/t/math.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/ext/POSIX/t/math.t 2007-02-10 12:31:15.000000000 -0800
@@ -0,0 +1,25 @@
+#!perl -w
+
+use strict;
+
+use POSIX;
+use Test::More tests => 14;
+
+# These tests are mainly to make sure that these arithmatic functions
+# exist and are accessible. They are not meant to be an exhaustive
+# test for the interface.
+
+is(acos(1), 0, "Basic acos(1) test");
+is(asin(0), 0, "Basic asin(0) test");
+is(atan(0), 0, "Basic atan(0) test");
+is(cosh(0), 1, "Basic cosh(0) test");
+is(floor(1.23441242), 1, "Basic floor(1.23441242) test");
+is(fmod(3.5, 2.0), 1.5, "Basic fmod(3.5, 2.0) test");
+is(join(" ", frexp(1)), "0.5 1", "Basic frexp(1) test");
+is(ldexp(0,1), 0, "Basic ldexp(0,1) test");
+is(log10(1), 0, "Basic log10(1) test");
+is(log10(10), 1, "Basic log10(10) test");
+is(join(" ", modf(1.76)), "0.76 1", "Basic modf(1.76) test");
+is(sinh(0), 0, "Basic sinh(0) test");
+is(tan(0), 0, "Basic tan(0) test");
+is(tanh(0), 0, "Basic tanh(0) test");
==== //depot/maint-5.8/perl/ext/POSIX/t/sysconf.t#1 (text) ====
Index: perl/ext/POSIX/t/sysconf.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/ext/POSIX/t/sysconf.t 2007-02-10 12:31:15.000000000 -0800
@@ -0,0 +1,167 @@
+#!perl -T
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ }
+
+ use Config;
+ use Test::More;
+ plan skip_all => "POSIX is unavailable" if $Config{'extensions'} !~
m!\bPOSIX\b!;
+}
+
+use strict;
+use File::Spec;
+use POSIX;
+use Scalar::Util qw(looks_like_number);
+
+sub check(@) {
+ grep { eval "&$_;1" or [EMAIL PROTECTED]/vendor has not defined POSIX
macro/ } @_
+}
+
+my @path_consts = check qw(
+ _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_NAME_MAX
+ _PC_NO_TRUNC _PC_PATH_MAX
+);
+
+my @path_consts_terminal = check qw(
+ _PC_MAX_CANON _PC_MAX_INPUT _PC_VDISABLE
+);
+
+my @path_consts_fifo = check qw(
+ _PC_PIPE_BUF
+);
+
+my @sys_consts = check qw(
+ _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
+ _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_PAGESIZE _SC_SAVED_IDS
+ _SC_STREAM_MAX _SC_VERSION _SC_TZNAME_MAX
+);
+
+my $tests = 2 * 3 * @path_consts +
+ 2 * 3 * @path_consts_terminal +
+ 2 * 3 * @path_consts_fifo +
+ 3 * @sys_consts;
+plan $tests
+ ? (tests => $tests)
+ : (skip_all => "No tests to run on this OS")
+;
+
+my $curdir = File::Spec->curdir;
+$curdir = VMS::Filespec::fileify($curdir) if $^O eq 'VMS';
+
+my $r;
+
+sub _check_and_report {
+ my ($eval_status, $return_val, $description) = @_;
+ my $success = defined($return_val) || $! == 0;
+ is( $eval_status, '', $description );
+ ok( $success, "\tchecking that the returned value is defined ("
+ . (defined($return_val) ? "yes, it's $return_val)" : "it
isn't)"
+ . " or that errno is clear ("
+ . (!($!+0) ? "it is)" : "it isn't, it's $!)"))
+ );
+ SKIP: {
+ skip "constant not implemented on $^O or no limit in effect", 1
+ if $success && !defined($return_val);
+ ok( looks_like_number($return_val), "\tchecking that the returned
value looks like a number" );
+ }
+}
+
+# testing fpathconf() on a non-terminal file
+SKIP: {
+ my $fd = POSIX::open($curdir, O_RDONLY)
+ or skip "could not open current directory ($!)", 3 * @path_consts;
+
+ for my $constant (@path_consts) {
+ $! = 0;
+ $r = eval { fpathconf( $fd, eval "$constant()" ) };
+ _check_and_report( $@, $r, "calling fpathconf($fd, $constant) " );
+ }
+
+ POSIX::close($fd);
+}
+
+# testing pathconf() on a non-terminal file
+for my $constant (@path_consts) {
+ $! = 0;
+ $r = eval { pathconf( $curdir, eval "$constant()" ) };
+ _check_and_report( $@, $r, qq[calling pathconf("$curdir", $constant)]
);
+}
+
+SKIP: {
+ my $TTY = "/dev/tty";
+
+ my $n = 2 * 3 * @path_consts_terminal;
+
+ -c $TTY
+ or skip("$TTY not a character file", $n);
+ open(TTY, $TTY)
+ or skip("failed to open $TTY: $!", $n);
+ -t TTY
+ or skip("TTY ($TTY) not a terminal file", $n);
+
+ my $fd = fileno(TTY);
+
+ # testing fpathconf() on a terminal file
+ for my $constant (@path_consts_terminal) {
+ $! = 0;
+ $r = eval { fpathconf( $fd, eval "$constant()" ) };
+ _check_and_report( $@, $r, qq[calling fpathconf($fd, $constant) ($TTY)]
);
+ }
+
+ close($fd);
+ # testing pathconf() on a terminal file
+ for my $constant (@path_consts_terminal) {
+ $! = 0;
+ $r = eval { pathconf( $TTY, eval "$constant()" ) };
+ _check_and_report( $@, $r, qq[calling pathconf($TTY, $constant)] );
+ }
+}
+
+my $fifo = "fifo$$";
+
+SKIP: {
+ eval { mkfifo($fifo, 0666) }
+ or skip("could not create fifo $fifo ($!)", 2 * 3 * @path_consts_fifo);
+
+ SKIP: {
+ my $fd = POSIX::open($fifo, O_RDWR)
+ or skip("could not open $fifo ($!)", 3 * @path_consts_fifo);
+
+ for my $constant (@path_consts_fifo) {
+ $! = 0;
+ $r = eval { fpathconf( $fd, eval "$constant()" ) };
+ _check_and_report( $@, $r, "calling fpathconf($fd, $constant)
($fifo)" );
+ }
+
+ POSIX::close($fd);
+ }
+
+ # testing pathconf() on a fifo file
+ for my $constant (@path_consts_fifo) {
+ $! = 0;
+ $r = eval { pathconf( $fifo, eval "$constant()" ) };
+ _check_and_report( $@, $r, qq[calling pathconf($fifo, $constant)] );
+ }
+}
+
+END {
+ 1 while unlink($fifo);
+}
+
+SKIP: {
+ if($^O eq 'cygwin') {
+ pop @sys_consts;
+ skip("No _SC_TZNAME_MAX on Cygwin", 3);
+ }
+
+}
+# testing sysconf()
+for my $constant (@sys_consts) {
+ $! = 0;
+ $r = eval { sysconf( eval "$constant()" ) };
+ _check_and_report( $@, $r, "calling sysconf($constant)" );
+}
+
==== //depot/maint-5.8/perl/ext/POSIX/t/termios.t#1 (text) ====
Index: perl/ext/POSIX/t/termios.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/ext/POSIX/t/termios.t 2007-02-10 12:31:15.000000000 -0800
@@ -0,0 +1,71 @@
+#!perl -T
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ }
+
+ use Config;
+ use Test::More;
+ plan skip_all => "POSIX is unavailable"
+ if $Config{'extensions'} !~ m!\bPOSIX\b!;
+}
+use strict;
+use POSIX;
+BEGIN {
+ plan skip_all => "POSIX::Termios not implemented"
+ if !eval "POSIX::Termios->new;1"
+ and [EMAIL PROTECTED]/not implemented/;
+}
+
+
+my @getters = qw(getcflag getiflag getispeed getlflag getoflag getospeed);
+
+plan tests => 3 + 2 * (3 + NCCS() + @getters);
+
+my $r;
+
+# create a new object
+my $termios = eval { POSIX::Termios->new };
+is( $@, '', "calling POSIX::Termios->new" );
+ok( defined $termios, "\tchecking if the object is defined" );
+isa_ok( $termios, "POSIX::Termios", "\tchecking the type of the object" );
+
+# testing getattr()
+
+SKIP: {
+ -t STDIN or skip("STDIN not a tty", 2);
+ $r = eval { $termios->getattr(0) };
+ is( $@, '', "calling getattr(0)" );
+ ok( defined $r, "\tchecking if the returned value is defined: $r" );
+}
+
+SKIP: {
+ -t STDOUT or skip("STDOUT not a tty", 2);
+ $r = eval { $termios->getattr(1) };
+ is( $@, '', "calling getattr(1)" );
+ ok( defined $r, "\tchecking if the returned value is defined: $r" );
+}
+
+SKIP: {
+ -t STDERR or skip("STDERR not a tty", 2);
+ $r = eval { $termios->getattr(2) };
+ is( $@, '', "calling getattr(2)" );
+ ok( defined $r, "\tchecking if the returned value is defined: $r" );
+}
+
+# testing getcc()
+for my $i (0..NCCS()-1) {
+ $r = eval { $termios->getcc($i) };
+ is( $@, '', "calling getcc($i)" );
+ ok( defined $r, "\tchecking if the returned value is defined: $r" );
+}
+
+# testing getcflag()
+for my $method (@getters) {
+ $r = eval { $termios->$method() };
+ is( $@, '', "calling $method()" );
+ ok( defined $r, "\tchecking if the returned value is defined: $r" );
+}
+
End of Patch.
