Test scripts for I18N::Langinfo and POSIX
Sébastien Aperghis-Tramoni [Fri, 7 Jul 2006 11:02:31 +0000 (13:02 +0200)]
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

MANIFEST
ext/I18N/Langinfo/t/Langinfo.t
ext/POSIX/t/sysconf.t [new file with mode: 0644]
ext/POSIX/t/termios.t [new file with mode: 0644]

index 5c8b6dc..20bbc6f 100644 (file)
--- 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
index 2061b7c..97ae5bf 100644 (file)
@@ -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 (file)
index 0000000..cefaea1
--- /dev/null
@@ -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 (file)
index 0000000..bd21232
--- /dev/null
@@ -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" );
+}
+