Update Time-Piece to CPAN version 1.26

  [DELTA]

1.26      2013-12-29
        - no changes since previous (trial) release

1.25_01   2013-12-16
        - fix compiling for WinCE, execution is untested
        - add a .gitignore (from Win32::API)
        - fix a compiler warning about unused var, and add inlining
        - add PERL_NO_GET_CONTEXT to XS to bring the binary into 21st century
        - refactor XS code to remove large sections of duplicate machine code
        - fix _crt_localtime to return year only once, previously
          _crt_localtime returned year (item #6) twice in the list

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 8e21940..9cb75c5 100755 (executable)
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1228,7 +1228,7 @@ use File::Glob qw(:case);
     },
 
     'Time::Piece' => {
-        'DISTRIBUTION' => 'RJBS/Time-Piece-1.24.tar.gz',
+        'DISTRIBUTION' => 'RJBS/Time-Piece-1.26.tar.gz',
         'FILES'        => q[cpan/Time-Piece],
     },
 

diff --git a/cpan/Time-Piece/Piece.pm b/cpan/Time-Piece/Piece.pm
index 3577718..895480c 100644 (file)
--- a/cpan/Time-Piece/Piece.pm
+++ b/cpan/Time-Piece/Piece.pm
@@ -19,7 +19,7 @@ our %EXPORT_TAGS = (
     ':override' => 'internal',
     );
 
-our $VERSION = '1.24';
+our $VERSION = '1.26';
 
 bootstrap Time::Piece $VERSION;
 

diff --git a/cpan/Time-Piece/Piece.xs b/cpan/Time-Piece/Piece.xs
index e5a77c7..bdf4860 100644 (file)
--- a/cpan/Time-Piece/Piece.xs
+++ b/cpan/Time-Piece/Piece.xs
@@ -1,6 +1,7 @@
 #ifdef __cplusplus
 extern "C" {
 #endif
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -9,6 +10,14 @@ extern "C" {
 }
 #endif
 
+#ifdef INLINE
+#  define TP_INLINE INLINE /* TP = Time::Piece */
+#elif defined(_MSC_VER)
+#  define TP_INLINE __forceinline /* __inline often doesn't work in O1 */
+#else
+#  define TP_INLINE inline
+#endif
+
 /* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX)
  * fields for which we don't have Configure support prior to Perl 5.8.0:
  *   char *tm_zone;   -- abbreviation of timezone name
@@ -133,6 +142,10 @@ my_init_tm(struct tm *ptm)        /* see mktime, strftime and asctime    */
 
 #undef getenv
 #undef putenv
+#  ifdef UNDER_CE
+#    define getenv xcegetenv
+#    define putenv xceputenv
+#  endif
 #undef malloc
 #undef free
 
@@ -945,15 +958,73 @@ label:
 }
 
 
-char *
+TP_INLINE char *
 our_strptime(pTHX_ const char *buf, const char *fmt, struct tm *tm)
 {
-       char *ret;
        int got_GMT = 0;
 
        return _strptime(aTHX_ buf, fmt, tm, &got_GMT);
 }
 
+/* Saves alot of machine code.
+   Takes a (auto) SP, which may or may not have been PUSHed before, puts
+   tm struct members on Perl stack, then returns new, advanced, SP to caller.
+   Assign the return of push_common_tm to your SP, so you can continue to PUSH
+   or do a PUTBACK and return eventually.
+   !!!! push_common_tm does not touch PL_stack_sp !!!!
+   !!!! do not use PUTBACK then SPAGAIN semantics around push_common_tm !!!!
+   !!!! You must mortalize whatever push_common_tm put on stack yourself to
+        avoid leaking !!!!
+*/
+SV **
+push_common_tm(pTHX_ SV ** SP, struct tm *mytm)
+{
+       PUSHs(newSViv(mytm->tm_sec));
+       PUSHs(newSViv(mytm->tm_min));
+       PUSHs(newSViv(mytm->tm_hour));
+       PUSHs(newSViv(mytm->tm_mday));
+       PUSHs(newSViv(mytm->tm_mon));
+       PUSHs(newSViv(mytm->tm_year));
+       PUSHs(newSViv(mytm->tm_wday));
+       PUSHs(newSViv(mytm->tm_yday));
+       return SP;
+}
+
+/* specialized common end of 2 XSUBs
+  SV ** SP -- pass your (auto) SP, which has not been PUSHed before, but was
+              reset to 0 (PPCODE only or SP -= items or XSprePUSH)
+  tm *mytm -- a tm *, will be proprocessed with my_mini_mktime
+  return   -- none, after calling return_11part_tm, you must call "return;"
+              no exceptions
+*/
+void
+return_11part_tm(pTHX_ SV ** SP, struct tm *mytm)
+{
+       my_mini_mktime(mytm);
+
+  /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm.tm_year, mytm.tm_mon, mytm.tm_mday, mytm.tm_hour, mytm.tm_min, mytm.tm_sec); */
+
+       EXTEND(SP, 11);
+       SP = push_common_tm(aTHX_ SP, mytm);
+       /* isdst */
+       PUSHs(newSViv(0));
+       /* epoch */
+       PUSHs(newSViv(0));
+       /* islocal */
+       PUSHs(newSViv(0));
+       PUTBACK;
+       {
+            SV ** endsp = SP; /* the SV * under SP needs to be mortaled */
+            SP -= (11 - 1); /* subtract 0 based count of SVs to mortal */
+/* mortal target of SP, then increment before function call
+   so SP is already calculated before next comparison to not stall CPU */
+            do {
+                sv_2mortal(*SP++);
+            } while(SP <= endsp);
+       }
+       return;
+}
+
 MODULE = Time::Piece     PACKAGE = Time::Piece
 
 PROTOTYPES: ENABLE
@@ -1037,8 +1108,9 @@ _strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1
 void
 _tzset()
   PPCODE:
+    PUTBACK; /* makes rest of this function tailcall friendly */
     my_tzset(aTHX);
-
+    return; /* skip XSUBPP's PUTBACK */
 
 void
 _strptime ( string, format )
@@ -1058,26 +1130,9 @@ _strptime ( string, format )
        if (*remainder != '\0') {
            warn("garbage at end of string in strptime: %s", remainder);
        }
-         
-       my_mini_mktime(&mytm);
 
-  /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm.tm_year, mytm.tm_mon, mytm.tm_mday, mytm.tm_hour, mytm.tm_min, mytm.tm_sec); */
-         
-       EXTEND(SP, 11);
-       PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
-       /* isdst */
-       PUSHs(sv_2mortal(newSViv(0)));
-       /* epoch */
-       PUSHs(sv_2mortal(newSViv(0)));
-       /* islocal */
-       PUSHs(sv_2mortal(newSViv(0)));
+       return_11part_tm(aTHX_ SP, &mytm);
+       return;
 
 void
 _mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
@@ -1094,61 +1149,32 @@ _mini_mktime(int sec, int min, int hour, int mday, int mon, int year)
        mytm.tm_mday = mday;
        mytm.tm_mon = mon;
        mytm.tm_year = year;
-       
-       my_mini_mktime(&mytm);
 
-       EXTEND(SP, 11);
-       PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
-       PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
-       /* isdst */
-       PUSHs(sv_2mortal(newSViv(0)));
-       /* epoch */
-       PUSHs(sv_2mortal(newSViv(0)));
-       /* islocal */
-       PUSHs(sv_2mortal(newSViv(0)));
+       return_11part_tm(aTHX_ SP, &mytm);
+       return;
 
 void
 _crt_localtime(time_t sec)
+    ALIAS:
+        _crt_gmtime = 1
     PREINIT:
         struct tm mytm;
     PPCODE:
-        mytm = *localtime(&sec);
+        if(ix) mytm = *gmtime(&sec);
+        else mytm = *localtime(&sec);
         /* Need to get: $s,$n,$h,$d,$m,$y */
         
         EXTEND(SP, 9);
-        PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_isdst)));
-        
-void
-_crt_gmtime(time_t sec)
-    PREINIT:
-        struct tm mytm;
-    PPCODE:
-        mytm = *gmtime(&sec);
-        /* Need to get: $s,$n,$h,$d,$m,$y */
-        
-        EXTEND(SP, 9);
-        PUSHs(sv_2mortal(newSViv(mytm.tm_sec)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_min)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_hour)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_mday)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_mon)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_year)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_wday)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_yday)));
-        PUSHs(sv_2mortal(newSViv(mytm.tm_isdst)));
-        
+        SP = push_common_tm(aTHX_ SP, &mytm);
+        PUSHs(newSViv(mytm.tm_isdst));
+        PUTBACK;
+        {
+            SV ** endsp = SP; /* the SV * under SP needs to be mortaled */
+            SP -= (9 - 1); /* subtract 0 based count of SVs to mortal */
+/* mortal target of SP, then increment before function call
+   so SP is already calculated before next comparison to not stall CPU */
+            do {
+                sv_2mortal(*SP++);
+            } while(SP <= endsp);
+        }
+        return;

diff --git a/cpan/Time-Piece/Seconds.pm b/cpan/Time-Piece/Seconds.pm
index 0d67ce5..3e82ec5 100644 (file)
--- a/cpan/Time-Piece/Seconds.pm
+++ b/cpan/Time-Piece/Seconds.pm
@@ -2,7 +2,7 @@ package Time::Seconds;
 use strict;
 use vars qw/@EXPORT @EXPORT_OK/;
 
-our $VERSION = '1.24';
+our $VERSION = '1.26';
 
 use Exporter 5.57 'import';