From 05a9a07a5bad262994c7980ced7fffdd93aa2867 Mon Sep 17 00:00:00 2001 From: =?utf8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= Date: Sun, 12 Feb 2012 14:35:50 +0000 Subject: [PATCH] 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. --- ext/POSIX/POSIX.xs | 6 +++ ext/POSIX/t/time.t | 120 +++++++++++++++++++++++++++-------------------------- 2 files changed, 68 insertions(+), 58 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 57b353d..34e712e 100644 --- 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 --- 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: $!"; -- 2.7.4