This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "Merge branch 'avar/POSIX-strptime' into blead"
authorÆvar Arnfjörð Bjarmason <avar@cpan.org>
Wed, 15 Feb 2012 18:46:06 +0000 (18:46 +0000)
committerÆvar Arnfjörð Bjarmason <avar@cpan.org>
Wed, 15 Feb 2012 18:48:14 +0000 (18:48 +0000)
This reverts commit 0e582130ad8fc3afc6514f60b7a513c550379b7d, reversing
changes made to a748fe11f70695552294fe4e31343b2dacb59db2.

Conflicts:

ext/POSIX/POSIX.xs
ext/POSIX/lib/POSIX.pm

ext/B/t/concise-xs.t
ext/POSIX/POSIX.xs
ext/POSIX/lib/POSIX.pm
ext/POSIX/lib/POSIX.pod
ext/POSIX/t/export.t
ext/POSIX/t/time.t

index a09e0de..efd0cf7 100644 (file)
@@ -193,7 +193,7 @@ my $testpkgs = {
               XS => [qw/ write wctomb wcstombs uname tzset tzname
                      ttyname tmpnam times tcsetpgrp tcsendbreak
                      tcgetpgrp tcflush tcflow tcdrain tanh tan
-                     sysconf strxfrm strtoul strtol strtod strptime
+                     sysconf strxfrm strtoul strtol strtod
                      strftime strcoll sinh sigsuspend sigprocmask
                      sigpending sigaction setuid setsid setpgid
                      setlocale setgid read pipe pause pathconf
index 66bfa91..7e30a82 100644 (file)
@@ -13,9 +13,6 @@
 
 #define PERL_NO_GET_CONTEXT
 
-/* Solaris needs this in order not to zero out all the untouched fields in strptime() */
-#define _STRPTIME_DONTZERO
-
 #include "EXTERN.h"
 #define PERLIO_NOT_STDIO 1
 #include "perl.h"
@@ -1845,151 +1842,6 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
        }
 
 void
-strptime(str, fmt, sec=-1, min=-1, hour=-1, mday=-1, mon=-1, year=-1, wday=-1, yday=-1, isdst=-1)
-       SV *            str
-       SV *            fmt
-       int             sec
-       int             min
-       int             hour
-       int             mday
-       int             mon
-       int             year
-       int             wday
-       int             yday
-       int             isdst
-    PPCODE:
-       {
-           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 */
-           const U8 *orig_bytes;  /* SvPV of orig_str */
-           MAGIC *posmg = NULL;
-           STRLEN str_offset = 0;
-           struct tm tm;
-           char *remains;
-
-           init_tm(&tm);       /* XXX workaround - see init_tm() in core util.c */
-           tm.tm_sec = sec;
-           tm.tm_min = min;
-           tm.tm_hour = hour;
-           tm.tm_mday = mday;
-           tm.tm_mon = mon;
-           tm.tm_year = year;
-           tm.tm_wday = wday;
-           tm.tm_yday = yday;
-           tm.tm_isdst = isdst;
-
-           if(SvROK(str) && !SvOBJECT(SvRV(str))) {
-               SV *ref = SvRV(str);
-
-               if(SvTYPE(ref) > SVt_PVMG || SvREADONLY(ref))
-                   croak("str is not a reference to a mutable scalar");
-
-               str = ref;
-               returning_pos = 1;
-
-               if(SvTYPE(str) >= SVt_PVMG && SvMAGIC(str))
-                   posmg = mg_find(str, PERL_MAGIC_regex_global);
-
-               if(posmg)
-                   str_offset = posmg->mg_len;
-           }
-           else if(SvROK(str) && SvTYPE(SvRV(str)) == SVt_REGEXP) {
-               croak("str is not a reference to a mutable scalar");
-           }
-
-           /* If fmt and str differ in UTF-8ness then take a temporary copy
-            * of and regrade it to match fmt, taking care to update the
-            * offset in both cases. */
-           if(!SvUTF8(str) && SvUTF8(fmt)) {
-               orig_str = str;
-               str = sv_mortalcopy(str);
-               sv_utf8_upgrade_nomg(str);
-
-               str_c = SvPV_nolen(str);
-
-               if(str_offset) {
-                   str_offset = utf8_hop((U8*)str_c, str_offset) - (U8*)str_c;
-               }
-           }
-           else if(SvUTF8(str) && !SvUTF8(fmt)) {
-               orig_str = str;
-               str = sv_mortalcopy(str);
-               /* If downgrade fails then str must have contained characters
-                * that could not possibly be matched by fmt */
-               if(!sv_utf8_downgrade(str, 1))
-                 XSRETURN(0);
-
-               str_c = SvPV_nolen(str);
-
-               if(str_offset) {
-                 orig_bytes = (U8*)SvPV_nolen(orig_str);
-                 str_offset = utf8_distance(orig_bytes + str_offset, orig_bytes);
-               }
-           }
-           else {
-             /* else it doesn't matter if both or neither are, because they'll match */
-             str_c = SvPV_nolen(str);
-           }
-
-           remains = strptime(str_c + str_offset, SvPV_nolen(fmt), &tm);
-
-           if(!remains)
-               /* failed parse */
-               XSRETURN(0);
-           if(remains[0] && !returning_pos)
-               /* leftovers - without ref we can't signal this so this is a failure */
-               XSRETURN(0);
-
-           if(returning_pos) {
-               if(orig_str) {
-                   if(SvUTF8(str))
-                       /* str is a UTF-8 upgraded copy of the original non-UTF-8
-                        * string the caller referred us to in orig_str */
-                       str_offset = utf8_distance((U8*)remains, (U8*)str_c);
-                   else
-                       str_offset = utf8_hop(orig_bytes, remains - str_c) - orig_bytes;
-
-                   str = orig_str;
-               }
-               else {
-                   str_offset = remains - str_c;
-               }
-               if(!posmg)
-                   posmg = sv_magicext(str, NULL, PERL_MAGIC_regex_global,
-                       &PL_vtbl_mglob, NULL, 0);
-               posmg->mg_len = str_offset;
-           }
-
-           if(tm.tm_mday > -1 && tm.tm_mon > -1 && tm.tm_year > -1) {
-               /* if we leave sec/min/hour == -1, then these will be
-                * normalised to the previous day */
-               int was_sec, was_min, was_hour;
-               was_sec  = tm.tm_sec;  tm.tm_sec  = 0;
-               was_min  = tm.tm_min;  tm.tm_min  = 0;
-               was_hour = tm.tm_hour; tm.tm_hour = 0;
-
-               if(mktime(&tm) == (time_t)-1)
-                   XSRETURN(0);
-
-               tm.tm_sec  = was_sec;
-               tm.tm_min  = was_min;
-               tm.tm_hour = was_hour;
-           }
-
-           EXTEND(SP, 9);
-           PUSHs(tm.tm_sec  != -1 ? sv_2mortal(newSViv(tm.tm_sec))  : &PL_sv_undef);
-           PUSHs(tm.tm_min  != -1 ? sv_2mortal(newSViv(tm.tm_min))  : &PL_sv_undef);
-           PUSHs(tm.tm_hour != -1 ? sv_2mortal(newSViv(tm.tm_hour)) : &PL_sv_undef);
-           PUSHs(tm.tm_mday != -1 ? sv_2mortal(newSViv(tm.tm_mday)) : &PL_sv_undef);
-           PUSHs(tm.tm_mon  != -1 ? sv_2mortal(newSViv(tm.tm_mon))  : &PL_sv_undef);
-           PUSHs(tm.tm_year != -1 ? sv_2mortal(newSViv(tm.tm_year)) : &PL_sv_undef);
-           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);
-       }
-
-void
 tzset()
   PPCODE:
     my_tzset(aTHX);
index 88f3dde..ec5c076 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 
 our ($AUTOLOAD, %SIGRT);
 
-our $VERSION = '1.28_001';
+our $VERSION = '1.28';
 
 require XSLoader;
 
@@ -360,7 +360,7 @@ our %EXPORT_TAGS = (
                tcflow tcflush tcgetattr tcsendbreak tcsetattr )],
 
     time_h =>  [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
-               difftime mktime strftime strptime tzset tzname)],
+               difftime mktime strftime tzset tzname)],
 
     unistd_h =>        [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
                STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
@@ -386,21 +386,13 @@ our %EXPORT_TAGS = (
   # De-duplicate the export list: 
   my %export;
   @export{map {@$_} values %EXPORT_TAGS} = ();
+  # Doing the de-dup with a temporary hash has the advantage that the SVs in
+  # @EXPORT are actually shared hash key scalars, which will save some memory.
+  our @EXPORT = keys %export;
 
   our @EXPORT_OK = (qw(close lchown nice open pipe read sleep times write
                       printf sprintf),
                    grep {!exists $export{$_}} keys %reimpl, keys %replacement);
-
-  # Symbols that should not be exported by default because they are recently
-  # added. It would upset too much of CPAN to export these by default
-  foreach (qw(strptime)) {
-    delete $export{$_};
-    push @EXPORT_OK, $_;
-  }
-
-  # Doing the de-dup with a temporary hash has the advantage that the SVs in
-  # @EXPORT are actually shared hash key scalars, which will save some memory.
-  our @EXPORT = keys %export;
 }
 
 require Exporter;
index b24df0a..f935ae0 100644 (file)
@@ -1349,65 +1349,6 @@ strncpy() is C-specific, use C<=> instead, see L<perlop>.
 strpbrk() is C-specific, use regular expressions instead,
 see L<perlre>.
 
-=item strptime
-
-Parse date and time information from a string. Returns a 9-element list of
-time and date information.
-
-Synopsis:
-
-       (sec, min, hour, mday, mon, year, wday, yday, isdst) =
-           strptime(str, fmt, [@init])
-
-Optionally, an existing 9-element list of time and date informaiton may be
-passed to initialise the structure before parsing. Any fields not parsed by
-the format will be left as initialised.
-
-The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
-I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1.  The
-year (C<year>) is given in years since 1900.  I.e., the year 1995 is 95; the
-year 2001 is 101.  Consult your system's C<strftime()> manpage for details
-about these and the other arguments.
-
-If you want your code to be portable, your format (C<fmt>) argument
-should use only the conversion specifiers defined by the ANSI C
-standard (C89, to play safe).  These are C<aAbBcdHIjmMpSUwWxXyYZ%>.
-But even then, the results of some of the conversion specifiers are
-non-portable.  For example, the specifiers C<aAbBcpZ> change according
-to the locale settings of the user, and both how to set locales (the
-locale names) and what output to expect are non-standard.
-The specifier C<c> changes according to the timezone settings of the
-user and the timezone computation rules of the operating system.
-The C<Z> specifier is notoriously unportable since the names of
-timezones are non-standard. Sticking to the numeric specifiers is the
-safest route.
-
-The return values are made consistent as though by calling C<mktime()>
-before they are returned, if all of the C<mday>, C<mon> and C<year> fields
-are valid.
-
-The string for Tuesday, December 12, 1995.
-
-       @time = POSIX::strptime( "Tuesday, December 12, 1995",
-           "%A, %B %d, %Y", 0, 0, 0 );
-
-       local $, = ", ";
-       print @time, "\n";
-
-If the input string is not valid, or not consumed completely by the format,
-then an error occurs; indicated by C<strptime()> returning an empty list.
-
-By passing a reference to a string as the value to parse, C<strptime()> will
-use the C<pos()> position to start the parse, and to return the position where
-it finished. In this situation, it is not an error if the entire input is not
-consumed by the format.
-
-       $str = "18:05:29 is the time";
-       @time = POSIX::strptime( \$str, "%H:%M:%S" );
-       local $, = ", ";
-       print @time[0..2], "\n";
-       print pos($str) . "\n";
-
 =item strrchr
 
 strrchr() is C-specific, see L<perlfunc/rindex> instead.
index 0753178..07d428e 100644 (file)
@@ -102,8 +102,8 @@ my %expect = (
                     getpgrp getppid getpwnam getpwuid gmtime kill lchown link
                     localtime log mkdir nice open opendir pipe printf rand
                     read readdir rename rewinddir rmdir sin sleep sprintf sqrt
-                    srand stat strptime system time times umask unlink utime
-                    wait waitpid write)],
+                    srand stat system time times umask unlink utime wait
+                    waitpid write)],
 );
 
 plan (tests => 2 * keys %expect);
index f6954b3..90b54ca 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 
 use Config;
 use POSIX;
-use Test::More tests => 41;
+use Test::More tests => 19;
 
 # go to UTC to avoid DST issues around the world when testing.  SUS3 says that
 # null should get you UTC, but some environments want the explicit names.
@@ -68,86 +68,6 @@ 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');
-
-@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');
-
-@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');
-
-# 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("July 4", "%b %d");
-is_deeply([@time[3,4]], [4, 7-1], 'strptime() partial yields correct mday/mon');
-
-@time = POSIX::strptime("Foobar", "%H:%M:%S");
-is(scalar @time, 0, 'strptime() invalid input yields empty list');
-
-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');
-
-$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');
-
-{
-   # 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;
-
-   my @want = (undef, undef, undef, 1, 2-1, 2012-1900, 3, 31, 0);
-
-   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 $str = "\x{ea} $date \x{ea}";
-   pos($str) = 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');
-
-   utf8::upgrade my $str_U = $str;
-   pos($str_U) = 2;
-
-   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');
-
-   # 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($date_UU, $fmt_UU)], \@want, 'strptime() on non-Latin-1 Unicode');
-}
-
-eval { POSIX::strptime({}, "format") };
-like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on HASH ref');
-
-eval { POSIX::strptime(\"boo", "format") };
-like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on const literal ref');
-
-eval { POSIX::strptime(qr/boo!/, "format") };
-like($@, qr/not a reference to a mutable scalar/, 'strptime() dies on Regexp');
-
-$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: $!";
 
 # clock() seems to have different definitions of what it does between POSIX