Update to Scalar-List-Utils 1.08

[p5sagit/p5-mst-13.2.git] / ext / List / Util / Util.xs

diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs
index c26c484..0b080c5 100644 (file)
--- a/ext/List/Util/Util.xs
+++ b/ext/List/Util/Util.xs
@@ -43,6 +43,12 @@ my_cxinc(pTHX)
 #    define NV double
 #endif
 
+#ifdef SVf_IVisUV
+#  define slu_sv_value(sv) (NV)(SvIOK(sv) ? SvIOK_UV(sv) ? SvUVX(sv) : SvIVX(sv) : SvNV(sv))
+#else
+#  define slu_sv_value(sv) (NV)(SvIOK(sv) ? SvIVX(sv) : SvNV(sv))
+#endif
+
 #ifndef Drand01
 #    define Drand01()          ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))
 #endif
@@ -90,6 +96,10 @@ sv_tainted(SV *sv)
 #  endif
 #endif
 
+#ifndef PTR2IV
+#  define PTR2IV(ptr) (IV)(ptr)
+#endif
+
 MODULE=List::Util      PACKAGE=List::Util
 
 void
@@ -107,10 +117,10 @@ CODE:
        XSRETURN_UNDEF;
     }
     retsv = ST(0);
-    retval = SvNV(retsv);
+    retval = slu_sv_value(retsv);
     for(index = 1 ; index < items ; index++) {
        SV *stacksv = ST(index);
-       NV val = SvNV(stacksv);
+       NV val = slu_sv_value(stacksv);
        if(val < retval ? !ix : ix) {
            retsv = stacksv;
            retval = val;
@@ -127,13 +137,16 @@ sum(...)
 PROTOTYPE: @
 CODE:
 {
+    SV *sv;
     int index;
     if(!items) {
        XSRETURN_UNDEF;
     }
-    RETVAL = SvNV(ST(0));
+    sv = ST(0);
+    RETVAL = slu_sv_value(sv);
     for(index = 1 ; index < items ; index++) {
-       RETVAL += SvNV(ST(index));
+       sv = ST(index);
+       RETVAL += slu_sv_value(sv);
     }
 }
 OUTPUT:
@@ -199,6 +212,7 @@ CODE:
     PERL_CONTEXT *cx;
     SV** newsp;
     I32 gimme = G_SCALAR;
+    I32 hasargs = 0;
     bool oldcatch = CATCH_GET;
 
     if(items <= 1) {
@@ -222,7 +236,10 @@ CODE:
     SAVESPTR(PL_op);
     ret = ST(1);
     CATCH_SET(TRUE);
-    PUSHBLOCK(cx, CXt_NULL, SP);
+    PUSHBLOCK(cx, CXt_SUB, SP);
+    PUSHSUB(cx);
+    if (!CvDEPTH(cv))
+        (void)SvREFCNT_inc(cv);
     for(index = 2 ; index < items ; index++) {
        GvSV(agv) = ret;
        GvSV(bgv) = ST(index);
@@ -250,6 +267,7 @@ CODE:
     PERL_CONTEXT *cx;
     SV** newsp;
     I32 gimme = G_SCALAR;
+    I32 hasargs = 0;
     bool oldcatch = CATCH_GET;
 
     if(items <= 1) {
@@ -269,7 +287,11 @@ CODE:
     SAVETMPS;
     SAVESPTR(PL_op);
     CATCH_SET(TRUE);
-    PUSHBLOCK(cx, CXt_NULL, SP);
+    PUSHBLOCK(cx, CXt_SUB, SP);
+    PUSHSUB(cx);
+    if (!CvDEPTH(cv))
+        (void)SvREFCNT_inc(cv);
+
     for(index = 1 ; index < items ; index++) {
        GvSV(PL_defgv) = ST(index);
        PL_op = reducecop;
@@ -380,6 +402,20 @@ CODE:
 OUTPUT:
     RETVAL
 
+IV
+refaddr(sv)
+    SV * sv
+PROTOTYPE: $
+CODE:
+{
+    if(!SvROK(sv)) {
+       XSRETURN_UNDEF;
+    }
+    RETVAL = PTR2IV(SvRV(sv));
+}
+OUTPUT:
+    RETVAL
+
 void
 weaken(sv)
        SV *sv
@@ -421,16 +457,34 @@ CODE:
 OUTPUT:
   RETVAL
 
+void
+isvstring(sv)
+       SV *sv
+PROTOTYPE: $
+CODE:
+#ifdef SvVOK
+  ST(0) = boolSV(SvVOK(sv));
+  XSRETURN(1);
+#else
+       croak("vstrings are not implemented in this release of perl");
+#endif
+
+
 BOOT:
 {
-#ifndef SvWEAKREF
+#if !defined(SvWEAKREF) || !defined(SvVOK)
     HV *stash = gv_stashpvn("Scalar::Util", 12, TRUE);
     GV *vargv = *(GV**)hv_fetch(stash, "EXPORT_FAIL", 11, TRUE);
     AV *varav;
     if (SvTYPE(vargv) != SVt_PVGV)
        gv_init(vargv, stash, "Scalar::Util", 12, TRUE);
     varav = GvAVn(vargv);
+#endif
+#ifndef SvWEAKREF
     av_push(varav, newSVpv("weaken",6));
     av_push(varav, newSVpv("isweak",6));
 #endif
+#ifndef SvVOK
+    av_push(varav, newSVpv("isvstring",9));
+#endif
 }