This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Additional tests for B and POSIX. The POSIX ones concern me a bit,
authorSteve Peters <steve@fisharerojo.org>
Sat, 26 Nov 2005 01:31:24 +0000 (01:31 +0000)
committerSteve Peters <steve@fisharerojo.org>
Sat, 26 Nov 2005 01:31:24 +0000 (01:31 +0000)
but I don't expect any black smokes because of testing on OpenBSD,
Linux, Win32, an Cygwin.

p4raw-id: //depot/perl@26206

MANIFEST
ext/B/t/b.t
ext/POSIX/t/time.t [new file with mode: 0644]

index 52c8b52..f677b9f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -833,6 +833,7 @@ ext/POSIX/t/is.t            See if POSIX isxxx() work
 ext/POSIX/t/posix.t            See if POSIX works
 ext/POSIX/t/sigaction.t                See if POSIX::sigaction works
 ext/POSIX/t/taint.t            See if POSIX works with taint
+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
 ext/re/hints/mpeix.pl          Hints for re for named architecture
index 70f4f59..4337109 100755 (executable)
@@ -22,7 +22,7 @@ BEGIN {
 $|  = 1;
 use warnings;
 use strict;
-use Test::More tests => 41;
+use Test::More tests => 53;
 
 BEGIN { use_ok( 'B' ); }
 
@@ -147,3 +147,19 @@ ok(! $gv_ref->is_empty(), "Test is_empty()");
 is($gv_ref->NAME(), "gv", "Test NAME()");
 is($gv_ref->SAFENAME(), "gv", "Test SAFENAME()");
 like($gv_ref->FILE(), qr/b\.t$/, "Testing FILE()");
+
+# The following return B::SPECIALs.
+is(ref B::sv_yes(), "B::SPECIAL", "B::sv_yes()");
+is(ref B::sv_no(), "B::SPECIAL", "B::sv_no()");
+is(ref B::sv_undef(), "B::SPECIAL", "B::sv_undef()");
+
+# More utility functions
+is(B::ppname(0), "pp_null", "Testing ppname (this might break if opnames.h is changed)");
+is(B::opnumber("null"), 0, "Testing opnumber with opname (null)");
+is(B::opnumber("pp_null"), 0, "Testing opnumber with opname (pp_null)");
+like(B::hash("wibble"), qr/0x[0-9a-f]*/, "Testing B::hash()");
+is(B::cstring("wibble"), '"wibble"', "Testing B::cstring()");
+is(B::perlstring("wibble"), '"wibble"', "Testing B::perlstring()");
+is(B::class(bless {}, "Wibble::Bibble"), "Bibble", "Testing B::class()");
+is(B::cast_I32(3.14), 3, "Testing B::cast_I32()");
+is(B::opnumber("localtime"), 294);
diff --git a/ext/POSIX/t/time.t b/ext/POSIX/t/time.t
new file mode 100644 (file)
index 0000000..8b30415
--- /dev/null
@@ -0,0 +1,56 @@
+#!perl -w
+
+use strict;
+
+use Config;
+use POSIX;
+use Test::More qw(no_plan);
+
+# go to UTC to avoid DST issues around the world when testing
+{
+    no warnings 'uninitialized';
+    $ENV{TZ} = undef;
+}
+
+SKIP: {
+    # It looks like POSIX.xs claims that only VMS and Mac OS traditional
+    # don't have tzset().  A config setting might be helpful.  Win32 actually
+    # seems ambiguous
+    skip "No tzset()", 2
+       if $^O eq "MacOS" || $^O eq "VMS" || $^O eq "cygwin" ||
+          $^O eq "MSWin32" || $^O eq "dos" || $^O eq "interix";
+    tzset();
+    my @tzname = tzname();
+    like($tzname[0], qr/[GMT|UTC]/i, "tzset() to GMT/UTC");
+    like($tzname[1], qr/[GMT|UTC]/i, "The whole year?");
+}
+
+# asctime and ctime...Let's stay below INT_MAX for 32-bits and
+# positive for some picky systems.
+
+is(asctime(localtime(0)), ctime(0), "asctime() and ctime() at zero");
+is(asctime(localtime(12345678)), ctime(12345678), "asctime() and ctime() at 12345678");
+
+# Careful!  strftime() is locale sensative.  Let's take care of that
+SKIP: {
+    skip "Win32's is missing a %e" if $^O eq "MSWin32";
+    my $orig_loc = setlocale(LC_TIME, "C") || die "Cannot setlocale() to C:  $!";
+    is(ctime(86400), strftime("%a %b %e %H:%M:%S %Y\n", localtime(86400)),
+        "get ctime() equal to strftime()");
+    setlocale(LC_TIME, $orig_loc) || die "Cannot setlocale() back to orig: $!";
+}
+
+# Hard to test other than to make sure it returns something numeric and < 0
+like(clock(), qr/\d*/, "clock() returns a numeric value");
+ok(clock() > 0, "...and its greater than zero");
+
+SKIP: {
+    skip "No difftime()", 1 if $Config{d_difftime} ne 'define';
+    is(difftime(2, 1), 1, "difftime()");
+}
+
+SKIP: {
+    skip "No mktime()", 1 if $Config{d_mktime} ne 'define';
+    my $time = time();
+    is(mktime(localtime($time)), $time, "mktime()");
+}