Permalink
Browse files

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.
  • Loading branch information...
1 parent 8852e31 commit 05a9a07a5bad262994c7980ced7fffdd93aa2867 Ævar Arnfjörð Bjarmason committed Feb 12, 2012
Showing with 68 additions and 58 deletions.
  1. +6 −0 ext/POSIX/POSIX.xs
  2. +62 −58 ext/POSIX/t/time.t
View
@@ -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
View
@@ -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: $!";

0 comments on commit 05a9a07

Please sign in to comment.