Use the strptime() probe in POSIX.xs & tests

My merge of strptime() in v5.15.7-367-g0e58213 would break systems
that didn't have strptime in the C library, use the probe H.Merijn
Brand kindly provided in v5.15.7-370-g8852e31 to deal with that.

Now we'll just croak on systems without strptime(3) if the
POSIX::strptime() function is called, in the same way we croak for
other unimplemented functions in there:

    $ ./perl -Ilib -MPOSIX=strptime -e 'strptime(qw/foo bar/)'
    POSIX::strptime not implemented on this architecture at -e line 1.

This patch is best viewed with the -w option to show or git log, I've
re-indented some code in time.t for the new SKIP block I've added.

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 57b353d..34e712e 100644 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -13,8 +13,10 @@
 
 #define PERL_NO_GET_CONTEXT
 
+#ifdef HAS_STRPTIME
 /* Solaris needs this in order not to zero out all the untouched fields in strptime() */
 #define _STRPTIME_DONTZERO
+#endif
 
 #include "EXTERN.h"
 #define PERLIO_NOT_STDIO 1
@@ -1859,6 +1861,9 @@ strptime(str, fmt, sec=-1, min=-1, hour=-1, mday=-1, mon=-1, year=-1, wday=-1, y
        int             isdst
     PPCODE:
        {
+#ifndef HAS_STRPTIME
+           (void)not_here("strptime");
+#else
            const char *str_c;
            int returning_pos = 0; /* true if caller wants us to set pos() marker on str */
            SV *orig_str = NULL;   /* caller's original SV* if we have had to regrade it */
@@ -1986,6 +1991,7 @@ strptime(str, fmt, sec=-1, min=-1, hour=-1, mday=-1, mon=-1, year=-1, wday=-1, y
            PUSHs(tm.tm_wday != -1 ? sv_2mortal(newSViv(tm.tm_wday)) : &PL_sv_undef);
            PUSHs(tm.tm_yday != -1 ? sv_2mortal(newSViv(tm.tm_yday)) : &PL_sv_undef);
            PUSHs(tm.tm_isdst!= -1 ? sv_2mortal(newSViv(tm.tm_isdst)): &PL_sv_undef);
+#endif
        }
 
 void

diff --git a/ext/POSIX/t/time.t b/ext/POSIX/t/time.t
index f6954b3..27f0932 100644 (file)
--- a/ext/POSIX/t/time.t
+++ b/ext/POSIX/t/time.t
@@ -68,85 +68,89 @@ is(ord strftime($ss, POSIX::localtime(time)),
    223, 'Format string has correct character');
 unlike($ss, qr/\w/, 'Still not internally UTF-8 encoded');
 
-my @time = POSIX::strptime("2011-12-18 12:34:56", "%Y-%m-%d %H:%M:%S");
-is_deeply(\@time, [56, 34, 12, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all 6 fields');
+SKIP: {
+    skip "No strptime()", 22 if $Config{d_strptime} ne 'define';
 
-@time = POSIX::strptime("2011-12-18", "%Y-%m-%d", 1, 23, 4);
-is_deeply(\@time, [1, 23, 4, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all date fields with passed time');
+    my @time = POSIX::strptime("2011-12-18 12:34:56", "%Y-%m-%d %H:%M:%S");
+    is_deeply(\@time, [56, 34, 12, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all 6 fields');
 
-@time = POSIX::strptime("2011-12-18", "%Y-%m-%d");
-is_deeply(\@time, [undef, undef, undef, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all date fields with no time');
+    @time = POSIX::strptime("2011-12-18", "%Y-%m-%d", 1, 23, 4);
+    is_deeply(\@time, [1, 23, 4, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all date fields with passed time');
 
-# tm_year == 6 => 1906, which is a negative time_t. Lets use 106 as 2006 instead
-@time = POSIX::strptime("12:34:56", "%H:%M:%S", 1, 2, 3, 4, 5, 106);
-is_deeply(\@time, [56, 34, 12, 4, 5, 106, 0, 154, 1], 'strptime() all time fields with passed date');
+    @time = POSIX::strptime("2011-12-18", "%Y-%m-%d");
+    is_deeply(\@time, [undef, undef, undef, 18, 12-1, 2011-1900, 0, 351, 0], 'strptime() all date fields with no time');
 
-@time = POSIX::strptime("July 4", "%b %d");
-is_deeply([@time[3,4]], [4, 7-1], 'strptime() partial yields correct mday/mon');
+    # tm_year == 6 => 1906, which is a negative time_t. Lets use 106 as 2006 instead
+    @time = POSIX::strptime("12:34:56", "%H:%M:%S", 1, 2, 3, 4, 5, 106);
+    is_deeply(\@time, [56, 34, 12, 4, 5, 106, 0, 154, 1], 'strptime() all time fields with passed date');
 
-@time = POSIX::strptime("Foobar", "%H:%M:%S");
-is(scalar @time, 0, 'strptime() invalid input yields empty list');
+    @time = POSIX::strptime("July 4", "%b %d");
+    is_deeply([@time[3,4]], [4, 7-1], 'strptime() partial yields correct mday/mon');
 
-my $str;
-@time = POSIX::strptime(\($str = "01:02:03"), "%H:%M:%S", -1,-1,-1, 1,0,70);
-is_deeply(\@time, [3, 2, 1, 1, 0, 70, 4, 0, 0], 'strptime() parses SCALAR ref');
-is(pos($str), 8, 'strptime() sets pos() magic on SCALAR ref');
+    @time = POSIX::strptime("Foobar", "%H:%M:%S");
+    is(scalar @time, 0, 'strptime() invalid input yields empty list');
 
-$str = "Text with 2012-12-01 datestamp";
-pos($str) = 10;
-@time = POSIX::strptime(\$str, "%Y-%m-%d", 0, 0, 0);
-is_deeply(\@time, [0, 0, 0, 1, 12-1, 2012-1900, 6, 335, 0], 'strptime() starts SCALAR ref at pos()');
-is(pos($str), 20, 'strptime() updates pos() magic on SCALAR ref');
+    my $str;
+    @time = POSIX::strptime(\($str = "01:02:03"), "%H:%M:%S", -1,-1,-1, 1,0,70);
+    is_deeply(\@time, [3, 2, 1, 1, 0, 70, 4, 0, 0], 'strptime() parses SCALAR ref');
+    is(pos($str), 8, 'strptime() sets pos() magic on SCALAR ref');
 
-{
-   # Latin-1 vs. UTF-8 strings
-   my $date = "2012\x{e9}02\x{e9}01";
-   utf8::upgrade my $date_U = $date;
-   my $fmt = "%Y\x{e9}%m\x{e9}%d";
-   utf8::upgrade my $fmt_U = $fmt;
+    $str = "Text with 2012-12-01 datestamp";
+    pos($str) = 10;
+    @time = POSIX::strptime(\$str, "%Y-%m-%d", 0, 0, 0);
+    is_deeply(\@time, [0, 0, 0, 1, 12-1, 2012-1900, 6, 335, 0], 'strptime() starts SCALAR ref at pos()');
+    is(pos($str), 20, 'strptime() updates pos() magic on SCALAR ref');
 
-   my @want = (undef, undef, undef, 1, 2-1, 2012-1900, 3, 31, 0);
+    {
+        # Latin-1 vs. UTF-8 strings
+        my $date = "2012\x{e9}02\x{e9}01";
+        utf8::upgrade my $date_U = $date;
+        my $fmt = "%Y\x{e9}%m\x{e9}%d";
+        utf8::upgrade my $fmt_U = $fmt;
 
-   is_deeply([POSIX::strptime($date_U, $fmt  )], \@want, 'strptime() UTF-8 date, legacy fmt');
-   is_deeply([POSIX::strptime($date,   $fmt_U)], \@want, 'strptime() legacy date, UTF-8 fmt');
-   is_deeply([POSIX::strptime($date_U, $fmt_U)], \@want, 'strptime() UTF-8 date, UTF-8 fmt');
+        my @want = (undef, undef, undef, 1, 2-1, 2012-1900, 3, 31, 0);
 
-   my $str = "\x{ea} $date \x{ea}";
-   pos($str) = 2;
+        is_deeply([POSIX::strptime($date_U, $fmt  )], \@want, 'strptime() UTF-8 date, legacy fmt');
+        is_deeply([POSIX::strptime($date,   $fmt_U)], \@want, 'strptime() legacy date, UTF-8 fmt');
+        is_deeply([POSIX::strptime($date_U, $fmt_U)], \@want, 'strptime() UTF-8 date, UTF-8 fmt');
 
-   is_deeply([POSIX::strptime(\$str, $fmt_U)], \@want, 'strptime() legacy data SCALAR ref, UTF-8 fmt');
-   is(pos($str), 12, 'pos() of legacy data SCALAR after strptime() UTF-8 fmt');
+        my $str = "\x{ea} $date \x{ea}";
+        pos($str) = 2;
 
-   utf8::upgrade my $str_U = $str;
-   pos($str_U) = 2;
+        is_deeply([POSIX::strptime(\$str, $fmt_U)], \@want, 'strptime() legacy data SCALAR ref, UTF-8 fmt');
+        is(pos($str), 12, 'pos() of legacy data SCALAR after strptime() UTF-8 fmt');
 
-   is_deeply([POSIX::strptime(\$str_U, $fmt)], \@want, 'strptime() UTF-8 data SCALAR ref, legacy fmt');
-   is(pos($str_U), 12, 'pos() of UTF-8 data SCALAR after strptime() legacy fmt');
+        utf8::upgrade my $str_U = $str;
+        pos($str_U) = 2;
 
-   # High (>U+FF) strings
-   my $date_UU = "2012\x{1234}02\x{1234}01";
-   my $fmt_UU  = "%Y\x{1234}%m\x{1234}%d";
+        is_deeply([POSIX::strptime(\$str_U, $fmt)], \@want, 'strptime() UTF-8 data SCALAR ref, legacy fmt');
+        is(pos($str_U), 12, 'pos() of UTF-8 data SCALAR after strptime() legacy fmt');
 
-   is_deeply([POSIX::strptime($date_UU, $fmt_UU)], \@want, 'strptime() on non-Latin-1 Unicode');
-}
+        # High (>U+FF) strings
+        my $date_UU = "2012\x{1234}02\x{1234}01";
+        my $fmt_UU  = "%Y\x{1234}%m\x{1234}%d";
 
-eval { POSIX::strptime({}, "format") };
-like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on HASH ref');
+        is_deeply([POSIX::strptime($date_UU, $fmt_UU)], \@want, 'strptime() on non-Latin-1 Unicode');
+    }
 
-eval { POSIX::strptime(\"boo", "format") };
-like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on const literal ref');
+    eval { POSIX::strptime({}, "format") };
+    like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on HASH ref');
 
-eval { POSIX::strptime(qr/boo!/, "format") };
-like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on Regexp');
+    eval { POSIX::strptime(\"boo", "format") };
+    like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on const literal ref');
 
-$str = bless [], "WithStringOverload";
-{
-   package WithStringOverload;
-   use overload '""' => sub { return "2012-02-01" };
-}
+    eval { POSIX::strptime(qr/boo!/, "format") };
+    like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on Regexp');
 
-@time = POSIX::strptime($str, "%Y-%m-%d", 0, 0, 0);
-is_deeply(\@time, [0, 0, 0, 1, 2-1, 2012-1900, 3, 31, 0], 'strptime() allows object with string overload');
+    $str = bless [], "WithStringOverload";
+    {
+        package WithStringOverload;
+        use overload '""' => sub { return "2012-02-01" };
+    }
+
+    @time = POSIX::strptime($str, "%Y-%m-%d", 0, 0, 0);
+    is_deeply(\@time, [0, 0, 0, 1, 2-1, 2012-1900, 3, 31, 0], 'strptime() allows object with string overload');
+}
 
 setlocale(LC_TIME, $orig_loc) || die "Cannot setlocale() back to orig: $!";