From: Sébastien Aperghis-Tramoni Date: Fri, 7 Jul 2006 11:02:31 +0000 (+0200) Subject: Test scripts for I18N::Langinfo and POSIX X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6e32c2556cdfeacfb9822269affc662e030ab557;p=p5sagit%2Fp5-mst-13.2.git Test scripts for I18N::Langinfo and POSIX Message-ID: <1152262951.44ae23272ffa0@imp3-g19.free.fr> Only includes changes to: * ext/I18N/Langinfo/t/Langinfo.t * ext/POSIX/t/sysconf.t * ext/POSIX/t/termios.t p4raw-id: //depot/perl@28503 --- diff --git a/MANIFEST b/MANIFEST index 5c8b6dc..20bbc6f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1008,7 +1008,9 @@ 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 diff --git a/ext/I18N/Langinfo/t/Langinfo.t b/ext/I18N/Langinfo/t/Langinfo.t index 2061b7c..97ae5bf 100644 --- a/ext/I18N/Langinfo/t/Langinfo.t +++ b/ext/I18N/Langinfo/t/Langinfo.t @@ -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 diff --git a/ext/POSIX/t/sysconf.t b/ext/POSIX/t/sysconf.t new file mode 100644 index 0000000..cefaea1 --- /dev/null +++ b/ext/POSIX/t/sysconf.t @@ -0,0 +1,62 @@ +#!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); + +my @path_consts = qw( + _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT + _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE +); + +my @sys_consts = 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_TZNAME_MAX _SC_VERSION +); + +plan tests => 2 * 3 * @path_consts + 3 * @sys_consts; + +my $r; + +# testing fpathconf() +SKIP: { + my $fd = POSIX::open(File::Spec->curdir, O_RDONLY) + or skip "can't open current directory", 3 * @path_consts; + + for my $constant (@path_consts) { + $r = eval { pathconf( File::Spec->curdir, eval "$constant()" ) }; + is( $@, '', "calling pathconf($constant)" ); + ok( defined $r, "\tchecking that the returned value is defined: $r" ); + ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); + } +} + +# testing pathconf() +for my $constant (@path_consts) { + $r = eval { pathconf( File::Spec->rootdir, eval "$constant()" ) }; + is( $@, '', "calling pathconf($constant)" ); + ok( defined $r, "\tchecking that the returned value is defined: $r" ); + ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); +} + +# testing sysconf() +for my $constant (@sys_consts) { + $r = eval { sysconf( eval "$constant()" ) }; + is( $@, '', "calling sysconf($constant)" ); + ok( defined $r, "\tchecking that the returned value is defined: $r" ); + ok( looks_like_number($r), "\tchecking that the returned value looks like a number" ); +} + diff --git a/ext/POSIX/t/termios.t b/ext/POSIX/t/termios.t new file mode 100644 index 0000000..bd21232 --- /dev/null +++ b/ext/POSIX/t/termios.t @@ -0,0 +1,49 @@ +#!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; + +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() +for my $i (0..2) { + $r = eval { $termios->getattr($i) }; + is( $@, '', "calling getattr($i)" ); + 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" ); +} +