Update List-Util to CPAN version 1.25
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Sun, 27 May 2012 21:19:38 +0000 (22:19 +0100)
committerRicardo Signes <rjbs@cpan.org>
Sun, 24 Jun 2012 22:28:57 +0000 (18:28 -0400)
  [DELTA]

1.25 -- Sat Mar 24 13:10:13 UTC 2012

  * Restore back-compat. to perl 5.6 (thanks to Zefram)

1.24 -- Thu Mar 22 18:10:10 UTC 2012

  * Update to 1.24 release version (no other changes since 1.23_04).

1.23_04 -- Sat Mar 10 00:16:16 UTC 2012

  * RT#72700 Fix off-by-two on string literal length

1.23_03 -- Tue Sep 14 10:09:59 CDT 2010

  * Min perl version supported for build is not 5.008
  * Dropped the pure-Perl implementation of both Scalar::- and List::Util.
  * RT#61118 Fix assumption in sum() that once magic, always magic

1.23_02 -- Tue Mar 30 11:09:15 CDT 2010

  * Fix first() and reduce() to check the callback first; &first(1) is now illigal. [gfx]
  * Fix reduce() to allow XSUB callbacks [gfx]
  * Fix first() to allow XSUB callbacks [gfx]
  * Resolve RT #55763: tainted() doesn't do SvGETMAGIC(sv) [gfx]
  * define CvISXSUB so older perl versions will still compile

1.23_01 -- Mon Mar 22 08:24:11 CDT 2010

  * Add failing tests; SVt_RV is not directly SvROK [gfx]
  * Implement openhandle() in XS (with extra tests) [gfx]
  * Modernize *.pm [gfx]
  * Modernize ListUtil.xs [gfx]
  * Add ppport.h [gfx]
  * Fix an overloading issue on sum(), and add tests for overloading [gfx]
  * Small tweaks for minstr()/maxstr() [gfx]
  * Optimize dualvar() [gfx]
  * Use sv_copypv() instead of SvPV() and sv_setpv() [gfx]
  * avoid non-portable warnings

39 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/List-Util/Changes
cpan/List-Util/ListUtil.xs
cpan/List-Util/Makefile.PL
cpan/List-Util/XS.pp [deleted file]
cpan/List-Util/lib/List/Util.pm
cpan/List-Util/lib/List/Util/PP.pm [deleted file]
cpan/List-Util/lib/List/Util/XS.pm
cpan/List-Util/lib/Scalar/Util.pm
cpan/List-Util/lib/Scalar/Util/PP.pm [deleted file]
cpan/List-Util/t/expfail.t [deleted file]
cpan/List-Util/t/first.t
cpan/List-Util/t/getmagic-once.t [new file with mode: 0644]
cpan/List-Util/t/max.t
cpan/List-Util/t/min.t
cpan/List-Util/t/openhan.t
cpan/List-Util/t/p_00version.t [deleted file]
cpan/List-Util/t/p_blessed.t [deleted file]
cpan/List-Util/t/p_first.t [deleted file]
cpan/List-Util/t/p_lln.t [deleted file]
cpan/List-Util/t/p_max.t [deleted file]
cpan/List-Util/t/p_maxstr.t [deleted file]
cpan/List-Util/t/p_min.t [deleted file]
cpan/List-Util/t/p_minstr.t [deleted file]
cpan/List-Util/t/p_openhan.t [deleted file]
cpan/List-Util/t/p_readonly.t [deleted file]
cpan/List-Util/t/p_reduce.t [deleted file]
cpan/List-Util/t/p_refaddr.t [deleted file]
cpan/List-Util/t/p_reftype.t [deleted file]
cpan/List-Util/t/p_shuffle.t [deleted file]
cpan/List-Util/t/p_sum.t [deleted file]
cpan/List-Util/t/p_tainted.t [deleted file]
cpan/List-Util/t/reduce.t
cpan/List-Util/t/reftype.t
cpan/List-Util/t/sum.t
cpan/List-Util/t/tainted.t
mkppport.lst
pod/perldelta.pod

index 04e8fca..877212e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1491,10 +1491,8 @@ cpan/libnet/t/smtp.t             libnet
 cpan/libnet/t/time.t           libnet
 cpan/List-Util/Changes                 Util extension
 cpan/List-Util/lib/List/Util.pm                List::Util
-cpan/List-Util/lib/List/Util/PP.pm     List::Util
 cpan/List-Util/lib/List/Util/XS.pm     List::Util
 cpan/List-Util/lib/Scalar/Util.pm      Scalar::Util
-cpan/List-Util/lib/Scalar/Util/PP.pm   Scalar::Util
 cpan/List-Util/ListUtil.xs             Util extension
 cpan/List-Util/Makefile.PL             Util extension
 cpan/List-Util/multicall.h             Util extension
@@ -1502,8 +1500,8 @@ cpan/List-Util/README                     Util extension
 cpan/List-Util/t/00version.t           Scalar::Util
 cpan/List-Util/t/blessed.t             Scalar::Util
 cpan/List-Util/t/dualvar.t             Scalar::Util
-cpan/List-Util/t/expfail.t             List::Util
 cpan/List-Util/t/first.t               List::Util
+cpan/List-Util/t/getmagic-once.t
 cpan/List-Util/t/isvstring.t           Scalar::Util
 cpan/List-Util/t/lln.t                 Scalar::Util
 cpan/List-Util/t/maxstr.t              List::Util
@@ -1511,23 +1509,7 @@ cpan/List-Util/t/max.t                   List::Util
 cpan/List-Util/t/minstr.t              List::Util
 cpan/List-Util/t/min.t                 List::Util
 cpan/List-Util/t/openhan.t             Scalar::Util
-cpan/List-Util/t/p_00version.t         Scalar::Util
-cpan/List-Util/t/p_blessed.t           Scalar::Util
-cpan/List-Util/t/p_first.t             List::Util
-cpan/List-Util/t/p_lln.t               Scalar::Util
-cpan/List-Util/t/p_maxstr.t            List::Util
-cpan/List-Util/t/p_max.t               List::Util
-cpan/List-Util/t/p_minstr.t            List::Util
-cpan/List-Util/t/p_min.t               List::Util
-cpan/List-Util/t/p_openhan.t           Scalar::Util
-cpan/List-Util/t/p_readonly.t          Scalar::Util
-cpan/List-Util/t/p_reduce.t            List::Util
-cpan/List-Util/t/p_refaddr.t           Scalar::Util
-cpan/List-Util/t/p_reftype.t           Scalar::Util
 cpan/List-Util/t/proto.t               Scalar::Util
-cpan/List-Util/t/p_shuffle.t           List::Util
-cpan/List-Util/t/p_sum.t               List::Util
-cpan/List-Util/t/p_tainted.t           Scalar::Util
 cpan/List-Util/t/readonly.t            Scalar::Util
 cpan/List-Util/t/reduce.t              List::Util
 cpan/List-Util/t/refaddr.t             Scalar::Util
@@ -1537,7 +1519,6 @@ cpan/List-Util/t/stack-corruption.t       List::Util
 cpan/List-Util/t/sum.t                 List::Util
 cpan/List-Util/t/tainted.t             Scalar::Util
 cpan/List-Util/t/weak.t                        Scalar::Util
-cpan/List-Util/XS.pp                   List::Util
 cpan/Locale-Codes/ChangeLog                    Locale::Codes
 cpan/Locale-Codes/lib/Locale/Codes/API.pod     Locale::Codes documentation
 cpan/Locale-Codes/lib/Locale/Codes/Changes.pod Locale::Codes documentation
index 1b1810e..dd3c34f 100755 (executable)
@@ -1579,7 +1579,7 @@ use File::Glob qw(:case);
 
     'Scalar-List-Utils' => {
         'MAINTAINER'   => 'gbarr',
-        'DISTRIBUTION' => 'GBARR/Scalar-List-Utils-1.23.tar.gz',
+        'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.25.tar.gz',
 
         # Note that perl uses its own version of Makefile.PL
         'FILES'    => q[cpan/List-Util],
index 552a95a..f737c1d 100644 (file)
@@ -1,3 +1,42 @@
+1.25 -- Sat Mar 24 13:10:13 UTC 2012
+
+  * Restore back-compat. to perl 5.6 (thanks to Zefram)
+
+1.24 -- Thu Mar 22 18:10:10 UTC 2012
+
+  * Update to 1.24 release version (no other changes since 1.23_04).
+
+1.23_04 -- Sat Mar 10 00:16:16 UTC 2012
+
+  * RT#72700 Fix off-by-two on string literal length
+
+1.23_03 -- Tue Sep 14 10:09:59 CDT 2010
+
+  * Min perl version supported for build is not 5.008
+  * Dropped the pure-Perl implementation of both Scalar::- and List::Util.
+  * RT#61118 Fix assumption in sum() that once magic, always magic
+
+1.23_02 -- Tue Mar 30 11:09:15 CDT 2010
+
+  * Fix first() and reduce() to check the callback first; &first(1) is now illigal. [gfx]
+  * Fix reduce() to allow XSUB callbacks [gfx]
+  * Fix first() to allow XSUB callbacks [gfx]
+  * Resolve RT #55763: tainted() doesn't do SvGETMAGIC(sv) [gfx]
+  * define CvISXSUB so older perl versions will still compile
+
+1.23_01 -- Mon Mar 22 08:24:11 CDT 2010
+
+  * Add failing tests; SVt_RV is not directly SvROK [gfx]
+  * Implement openhandle() in XS (with extra tests) [gfx]
+  * Modernize *.pm [gfx]
+  * Modernize ListUtil.xs [gfx]
+  * Add ppport.h [gfx]
+  * Fix an overloading issue on sum(), and add tests for overloading [gfx]
+  * Small tweaks for minstr()/maxstr() [gfx]
+  * Optimize dualvar() [gfx]
+  * Use sv_copypv() instead of SvPV() and sv_setpv() [gfx]
+  * avoid non-portable warnings
+
 1.23 -- Wed Mar 10 20:50:00 CST 2010
 
   * Add a test file to ensure 'GETMAGIC' called once [gfx]
index 7da9b95..be4b68c 100644 (file)
@@ -7,31 +7,23 @@
 #include <perl.h>
 #include <XSUB.h>
 
-#ifndef PERL_VERSION
-#    include <patchlevel.h>
-#    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
-#        include <could_not_find_Perl_patchlevel.h>
-#    endif
-#    define PERL_REVISION      5
-#    define PERL_VERSION       PATCHLEVEL
-#    define PERL_SUBVERSION    SUBVERSION
-#endif
+#define NEED_sv_2pv_flags 1
+#include "ppport.h"
 
-#if PERL_VERSION >= 6
+#if PERL_BCDVERSION >= 0x5006000
 #  include "multicall.h"
 #endif
 
-#ifndef aTHX
-#  define aTHX
-#  define pTHX
+#ifndef CvISXSUB
+#  define CvISXSUB(cv) CvXSUB(cv)
 #endif
+
 /* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc)
    was not exported. Therefore platforms like win32, VMS etc have problems
    so we redefine it here -- GMB
 */
-#if PERL_VERSION < 7
+#if PERL_BCDVERSION < 0x5007000
 /* Not in 5.6.1. */
-#  define SvUOK(sv)           SvIOK_UV(sv)
 #  ifdef cxinc
 #    undef cxinc
 #  endif
@@ -40,13 +32,24 @@ static I32
 my_cxinc(pTHX)
 {
     cxstack_max = cxstack_max * 3 / 2;
-    Renew(cxstack, cxstack_max + 1, struct context);      /* XXX should fix CXINC macro */
+    Renew(cxstack, cxstack_max + 1, struct context); /* fencepost bug in older CXINC macros requires +1 here */
     return cxstack_ix + 1;
 }
 #endif
 
-#if PERL_VERSION < 6
-#    define NV double
+#ifndef sv_copypv
+#define sv_copypv(a, b) my_sv_copypv(aTHX_ a, b)
+static void
+my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
+{
+    STRLEN len;
+    const char * const s = SvPV_const(ssv,len);
+    sv_setpvn(dsv,s,len);
+    if (SvUTF8(ssv))
+        SvUTF8_on(dsv);
+    else
+        SvUTF8_off(dsv);
+}
 #endif
 
 #ifdef SVf_IVisUV
@@ -55,81 +58,6 @@ my_cxinc(pTHX)
 #  define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
 #endif
 
-#ifndef Drand01
-#    define Drand01()          ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))
-#endif
-
-#if PERL_VERSION < 5
-#  ifndef gv_stashpvn
-#    define gv_stashpvn(n,l,c) gv_stashpv(n,c)
-#  endif
-#  ifndef SvTAINTED
-
-static bool
-sv_tainted(pTHX_ SV *sv)
-{
-    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
-       MAGIC *mg = mg_find(sv, 't');
-       if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
-           return TRUE;
-    }
-    return FALSE;
-}
-
-#    define SvTAINTED_on(sv) sv_magic((sv), Nullsv, 't', Nullch, 0)
-#    define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(aTHX_ sv))
-#  endif
-#  define PL_defgv defgv
-#  define PL_op op
-#  define PL_curpad curpad
-#  define CALLRUNOPS runops
-#  define PL_curpm curpm
-#  define PL_sv_undef sv_undef
-#  define PERL_CONTEXT struct context
-#endif
-#if (PERL_VERSION < 5) || (PERL_VERSION == 5 && PERL_SUBVERSION <50)
-#  ifndef PL_tainting
-#    define PL_tainting tainting
-#  endif
-#  ifndef PL_stack_base
-#    define PL_stack_base stack_base
-#  endif
-#  ifndef PL_stack_sp
-#    define PL_stack_sp stack_sp
-#  endif
-#  ifndef PL_ppaddr
-#    define PL_ppaddr ppaddr
-#  endif
-#endif
-
-#ifndef PTR2UV
-#  define PTR2UV(ptr) (UV)(ptr)
-#endif
-
-#ifndef SvUV_set
-#  define SvUV_set(sv, val) (((XPVUV*)SvANY(sv))->xuv_uv = (val))
-#endif
-
-#ifndef PERL_UNUSED_DECL
-#  ifdef HASATTRIBUTE
-#    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-#      define PERL_UNUSED_DECL
-#    else
-#      define PERL_UNUSED_DECL __attribute__((unused))
-#    endif
-#  else
-#    define PERL_UNUSED_DECL
-#  endif
-#endif
-
-#ifndef dNOOP
-#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
-#endif
-
-#ifndef GvSVn
-#  define GvSVn GvSV
-#endif
-
 MODULE=List::Util      PACKAGE=List::Util
 
 void
@@ -187,51 +115,71 @@ sum(...)
 PROTOTYPE: @
 CODE:
 {
+    dXSTARG;
     SV *sv;
     SV *retsv = NULL;
     int index;
     NV retval = 0;
+    int magic;
     if(!items) {
        XSRETURN_UNDEF;
     }
-    sv = ST(0);
-    if (SvAMAGIC(sv)) {
-        retsv = sv_newmortal();
+    sv    = ST(0);
+    magic = SvAMAGIC(sv);
+    if (magic) {
+        retsv = TARG;
         sv_setsv(retsv, sv);
     }
     else {
         retval = slu_sv_value(sv);
     }
     for(index = 1 ; index < items ; index++) {
-       sv = ST(index);
-        if (retsv || SvAMAGIC(sv)) {
-            if (!retsv) {
-                retsv = sv_newmortal();
-                sv_setnv(retsv,retval);
+        sv = ST(index);
+        if(!magic && SvAMAGIC(sv)){
+            magic = TRUE;
+            if (!retsv)
+                retsv = TARG;
+            sv_setnv(retsv,retval);
+        }
+        if (magic) {
+            SV* const tmpsv = amagic_call(retsv, sv, add_amg, SvAMAGIC(retsv) ? AMGf_assign : 0);
+            if(tmpsv) {
+                magic = SvAMAGIC(tmpsv);
+                if (!magic) {
+                    retval = slu_sv_value(tmpsv);
+                }
+                else {
+                    retsv = tmpsv;
+                }
             }
-            if (!amagic_call(retsv, sv, add_amg, AMGf_assign)) {
-                sv_setnv(retsv, SvNV(retsv) + SvNV(sv));
+            else {
+                /* fall back to default */
+                magic = FALSE;
+                retval = SvNV(retsv) + SvNV(sv);
             }
         }
         else {
           retval += slu_sv_value(sv);
         }
     }
-    if (!retsv) {
-        retsv = sv_newmortal();
+    if (!magic) {
+        if (!retsv)
+            retsv = TARG;
         sv_setnv(retsv,retval);
     }
     ST(0) = retsv;
     XSRETURN(1);
 }
 
+#define SLU_CMP_LARGER   1
+#define SLU_CMP_SMALLER -1
 
 void
 minstr(...)
 PROTOTYPE: @
 ALIAS:
-    minstr = 2
-    maxstr = 0
+    minstr = SLU_CMP_LARGER
+    maxstr = SLU_CMP_SMALLER
 CODE:
 {
     SV *left;
@@ -239,12 +187,6 @@ CODE:
     if(!items) {
        XSRETURN_UNDEF;
     }
-    /*
-      sv_cmp & sv_cmp_locale return 1,0,-1 for gt,eq,lt
-      so we set ix to the value we are looking for
-      xsubpp does not allow -ve values, so we start with 0,2 and subtract 1
-    */
-    ix -= 1;
     left = ST(0);
 #ifdef OPpLOCALE
     if(MAXARG & OPpLOCALE) {
@@ -278,35 +220,52 @@ reduce(block,...)
 PROTOTYPE: &@
 CODE:
 {
-    dMULTICALL;
     SV *ret = sv_newmortal();
     int index;
     GV *agv,*bgv,*gv;
     HV *stash;
-    I32 gimme = G_SCALAR;
     SV **args = &PL_stack_base[ax];
-    CV *cv;
+    CV* cv    = sv_2cv(block, &stash, &gv, 0);
 
-    if(items <= 1) {
-       XSRETURN_UNDEF;
-    }
-    cv = sv_2cv(block, &stash, &gv, 0);
     if (cv == Nullcv) {
        croak("Not a subroutine reference");
     }
-    PUSH_MULTICALL(cv);
-    agv = gv_fetchpv("a", TRUE, SVt_PV);
-    bgv = gv_fetchpv("b", TRUE, SVt_PV);
+
+    if(items <= 1) {
+       XSRETURN_UNDEF;
+    }
+
+    agv = gv_fetchpv("a", GV_ADD, SVt_PV);
+    bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
     SAVESPTR(GvSV(agv));
     SAVESPTR(GvSV(bgv));
     GvSV(agv) = ret;
     SvSetSV(ret, args[1]);
-    for(index = 2 ; index < items ; index++) {
-       GvSV(bgv) = args[index];
-       MULTICALL;
-       SvSetSV(ret, *PL_stack_sp);
+
+    if(!CvISXSUB(cv)) {
+        dMULTICALL;
+        I32 gimme = G_SCALAR;
+
+        PUSH_MULTICALL(cv);
+        for(index = 2 ; index < items ; index++) {
+            GvSV(bgv) = args[index];
+            MULTICALL;
+            SvSetSV(ret, *PL_stack_sp);
+        }
+        POP_MULTICALL;
     }
-    POP_MULTICALL;
+    else {
+        for(index = 2 ; index < items ; index++) {
+            dSP;
+            GvSV(bgv) = args[index];
+
+            PUSHMARK(SP);
+            call_sv((SV*)cv, G_SCALAR);
+
+            SvSetSV(ret, *PL_stack_sp);
+        }
+    }
+
     ST(0) = ret;
     XSRETURN(1);
 }
@@ -317,34 +276,50 @@ first(block,...)
 PROTOTYPE: &@
 CODE:
 {
-    dMULTICALL;
     int index;
     GV *gv;
     HV *stash;
-    I32 gimme = G_SCALAR;
     SV **args = &PL_stack_base[ax];
-    CV *cv;
+    CV *cv    = sv_2cv(block, &stash, &gv, 0);
+    if (cv == Nullcv) {
+       croak("Not a subroutine reference");
+    }
 
     if(items <= 1) {
        XSRETURN_UNDEF;
     }
-    cv = sv_2cv(block, &stash, &gv, 0);
-    if (cv == Nullcv) {
-       croak("Not a subroutine reference");
-    }
-    PUSH_MULTICALL(cv);
+
     SAVESPTR(GvSV(PL_defgv));
 
-    for(index = 1 ; index < items ; index++) {
-       GvSV(PL_defgv) = args[index];
-       MULTICALL;
-       if (SvTRUE(*PL_stack_sp)) {
-         POP_MULTICALL;
-         ST(0) = ST(index);
-         XSRETURN(1);
-       }
+    if(!CvISXSUB(cv)) {
+        dMULTICALL;
+        I32 gimme = G_SCALAR;
+        PUSH_MULTICALL(cv);
+
+        for(index = 1 ; index < items ; index++) {
+            GvSV(PL_defgv) = args[index];
+            MULTICALL;
+            if (SvTRUEx(*PL_stack_sp)) {
+                POP_MULTICALL;
+                ST(0) = ST(index);
+                XSRETURN(1);
+            }
+        }
+        POP_MULTICALL;
+    }
+    else {
+        for(index = 1 ; index < items ; index++) {
+            dSP;
+            GvSV(PL_defgv) = args[index];
+
+            PUSHMARK(SP);
+            call_sv((SV*)cv, G_SCALAR);
+            if (SvTRUEx(*PL_stack_sp)) {
+                ST(0) = ST(index);
+                XSRETURN(1);
+            }
+        }
     }
-    POP_MULTICALL;
     XSRETURN_UNDEF;
 }
 
@@ -398,30 +373,27 @@ dualvar(num,str)
 PROTOTYPE: $$
 CODE:
 {
-    STRLEN len;
-    char *ptr = SvPV(str,len);
-    ST(0) = sv_newmortal();
-    (void)SvUPGRADE(ST(0),SVt_PVNV);
-    sv_setpvn(ST(0),ptr,len);
-    if (SvUTF8(str))
-        SvUTF8_on(ST(0));
+    dXSTARG;
+    (void)SvUPGRADE(TARG, SVt_PVNV);
+    sv_copypv(TARG,str);
     if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
-       SvNV_set(ST(0), SvNV(num));
-       SvNOK_on(ST(0));
+       SvNV_set(TARG, SvNV(num));
+       SvNOK_on(TARG);
     }
 #ifdef SVf_IVisUV
     else if (SvUOK(num)) {
-       SvUV_set(ST(0), SvUV(num));
-       SvIOK_on(ST(0));
-       SvIsUV_on(ST(0));
+       SvUV_set(TARG, SvUV(num));
+       SvIOK_on(TARG);
+       SvIsUV_on(TARG);
     }
 #endif
     else {
-       SvIV_set(ST(0), SvIV(num));
-       SvIOK_on(ST(0));
+       SvIV_set(TARG, SvIV(num));
+       SvIOK_on(TARG);
     }
     if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str)))
-       SvTAINTED_on(ST(0));
+       SvTAINTED_on(TARG);
+       ST(0) = TARG;
     XSRETURN(1);
 }
 
@@ -431,8 +403,7 @@ blessed(sv)
 PROTOTYPE: $
 CODE:
 {
-    if (SvMAGICAL(sv))
-       mg_get(sv);
+    SvGETMAGIC(sv);
     if(!(SvROK(sv) && SvOBJECT(SvRV(sv)))) {
        XSRETURN_UNDEF;
     }
@@ -447,8 +418,7 @@ reftype(sv)
 PROTOTYPE: $
 CODE:
 {
-    if (SvMAGICAL(sv))
-       mg_get(sv);
+    SvGETMAGIC(sv);
     if(!SvROK(sv)) {
        XSRETURN_UNDEF;
     }
@@ -463,8 +433,7 @@ refaddr(sv)
 PROTOTYPE: $
 CODE:
 {
-    if (SvMAGICAL(sv))
-       mg_get(sv);
+    SvGETMAGIC(sv);
     if(!SvROK(sv)) {
        XSRETURN_UNDEF;
     }
@@ -501,6 +470,7 @@ readonly(sv)
        SV *sv
 PROTOTYPE: $
 CODE:
+  SvGETMAGIC(sv);
   RETVAL = SvREADONLY(sv);
 OUTPUT:
   RETVAL
@@ -510,6 +480,7 @@ tainted(sv)
        SV *sv
 PROTOTYPE: $
 CODE:
+  SvGETMAGIC(sv);
   RETVAL = SvTAINTED(sv);
 OUTPUT:
   RETVAL
@@ -520,6 +491,7 @@ isvstring(sv)
 PROTOTYPE: $
 CODE:
 #ifdef SvVOK
+  SvGETMAGIC(sv);
   ST(0) = boolSV(SvVOK(sv));
   XSRETURN(1);
 #else
@@ -532,13 +504,11 @@ looks_like_number(sv)
 PROTOTYPE: $
 CODE:
   SV *tempsv;
+  SvGETMAGIC(sv);
   if (SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) {
     sv = tempsv;
   }
-  else if (SvMAGICAL(sv)) {
-      SvGETMAGIC(sv);
-  }
-#if (PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION <5)
+#if PERL_BCDVERSION < 0x5008005
   if (SvPOK(sv) || SvPOKp(sv)) {
     RETVAL = looks_like_number(sv);
   }
@@ -566,9 +536,7 @@ CODE:
        }
        if (SvPOK(proto)) {
            /* set the prototype */
-           STRLEN len;
-           char *ptr = SvPV(proto, len);
-           sv_setpvn(sv, ptr, len);
+           sv_copypv(sv, proto);
        }
        else {
            /* delete the prototype */
@@ -581,6 +549,35 @@ CODE:
     XSRETURN(1);
 }
 
+void
+openhandle(SV* sv)
+PROTOTYPE: $
+CODE:
+{
+    IO* io = NULL;
+    SvGETMAGIC(sv);
+    if(SvROK(sv)){
+        /* deref first */
+        sv = SvRV(sv);
+    }
+
+    /* must be GLOB or IO */
+    if(isGV(sv)){
+        io = GvIO((GV*)sv);
+    }
+    else if(SvTYPE(sv) == SVt_PVIO){
+        io = (IO*)sv;
+    }
+
+    if(io){
+        /* real or tied filehandle? */
+        if(IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)){
+            XSRETURN(1);
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
 BOOT:
 {
     HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE);
@@ -595,7 +592,7 @@ BOOT:
     varav = GvAVn(vargv);
 #endif
     if (SvTYPE(rmcgv) != SVt_PVGV)
-       gv_init(rmcgv, lu_stash, "List::Util", 12, TRUE);
+       gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
     rmcsv = GvSVn(rmcgv);
 #ifndef SvWEAKREF
     av_push(varav, newSVpv("weaken",6));
index 1cba5ab..40f9167 100644 (file)
@@ -1,5 +1,5 @@
 # -*- perl -*-
-BEGIN { require 5.006; } # allow CPAN testers to get the point
+BEGIN { require 5.006; }
 use strict;
 use warnings;
 use Config;
@@ -7,13 +7,6 @@ use File::Spec;
 use ExtUtils::MakeMaker;
 my $PERL_CORE = grep { $_ eq 'PERL_CORE=1' } @ARGV;
 
-my $do_xs = $PERL_CORE || can_cc();
-
-for (@ARGV) {
-  /^-pm/ and $do_xs = 0;
-  /^-xs/ and $do_xs = 1;
-}
-
 WriteMakefile(
   NAME         => q[List::Util],
   ABSTRACT     => q[Common Scalar and List utility subroutines],
@@ -38,11 +31,10 @@ WriteMakefile(
       INSTALLDIRS => q[perl],
       PREREQ_PM   => {'Test::More' => 0,},
       (eval { ExtUtils::MakeMaker->VERSION(6.31) } ? (LICENSE => 'perl') : ()),
-      ($do_xs ? () : (XS => {}, C => [], OBJECT => '')),
       ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (
           META_MERGE => {
             resources => {    ##
-              repository => 'http://github.com/gbarr/Scalar-List-Utils',
+              repository => 'https://github.com/Scalar-List-Utils/Scalar-List-Utils',
             },
           }
           )
@@ -52,35 +44,3 @@ WriteMakefile(
   ),
 );
 
-
-sub can_cc {
-
-    foreach my $cmd (split(/ /, $Config::Config{cc})) {
-        my $_cmd = $cmd;
-        return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
-
-        for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
-            my $abs = File::Spec->catfile($dir, $_[1]);
-            return $abs if (-x $abs or $abs = MM->maybe_command($abs));
-        }
-    }
-
-    return;
-}
-
-package MY;
-
-sub init_PM  {
-  my $self = shift;
-
-  $self->SUPER::init_PM(@_);
-
-  return if $do_xs;
-
-  my $pm = $self->{PM};
-  my $pm_file = File::Spec->catfile(qw(lib List Util XS.pm));
-
-  # When installing pure perl, install XS.pp as XS.pm
-  $self->{PM}{'XS.pp'} = delete $self->{PM}{$pm_file};
-}
-
diff --git a/cpan/List-Util/XS.pp b/cpan/List-Util/XS.pp
deleted file mode 100644 (file)
index 6521f63..0000000
+++ /dev/null
@@ -1,45 +0,0 @@
-package List::Util::XS;
-use strict;
-use vars qw($VERSION);
-
-$VERSION = undef;
-
-sub VERSION {
-  require Carp;
-  Carp::croak("You need to install Scalar-List-Utils with a C compiler to ensure the XS is compiled")
-    if defined $_[1];
-  $VERSION;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-List::Util::XS - Indicate if List::Util was compiled with a C compiler
-
-=head1 SYNOPSIS
-
-    use List::Util::XS 1.20;
-
-=head1 DESCRIPTION
-
-B<*** This instalation does not have XS installed ***>
-
-C<List::Util::XS> can be used as a dependency to ensure List::Util was
-installed using a C compiler and that the XS version is installed.
-
-During installation C<$List::Util::XS::VERSION> will be set to
-C<undef> if the XS was not compiled.
-
-=head1 SEE ALSO
-
-L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2008 Graham Barr <gbarr@pobox.com>. All rights reserved.
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
index aced6b1..033ef50 100644 (file)
@@ -9,35 +9,16 @@
 package List::Util;
 
 use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION $XS_VERSION $TESTING_PERL_ONLY);
 require Exporter;
 
-@ISA        = qw(Exporter);
-@EXPORT_OK  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION    = "1.23";
-$XS_VERSION = $VERSION;
+our @ISA        = qw(Exporter);
+our @EXPORT_OK  = qw(first min max minstr maxstr reduce sum shuffle);
+our $VERSION    = "1.25";
+our $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
-eval {
-  # PERL_DL_NONLAZY must be false, or any errors in loading will just
-  # cause the perl code to be tested
-  local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
-  eval {
-    require XSLoader;
-    XSLoader::load('List::Util', $XS_VERSION);
-    1;
-  } or do {
-    require DynaLoader;
-    local @ISA = qw(DynaLoader);
-    bootstrap List::Util $XS_VERSION;
-  };
-} unless $TESTING_PERL_ONLY;
-
-
-if (!defined &sum) {
-  require List::Util::PP;
-  List::Util::PP->import;
-}
+require XSLoader;
+XSLoader::load('List::Util', $XS_VERSION);
 
 1;
 
diff --git a/cpan/List-Util/lib/List/Util/PP.pm b/cpan/List-Util/lib/List/Util/PP.pm
deleted file mode 100644 (file)
index 2771329..0000000
+++ /dev/null
@@ -1,83 +0,0 @@
-# List::Util::PP.pm
-#
-# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package List::Util::PP;
-
-use strict;
-use warnings;
-use vars qw(@ISA @EXPORT $VERSION $a $b);
-require Exporter;
-
-@ISA     = qw(Exporter);
-@EXPORT  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION = "1.23";
-$VERSION = eval $VERSION;
-
-sub reduce (&@) {
-  my $code = shift;
-  require Scalar::Util;
-  my $type = Scalar::Util::reftype($code);
-  unless($type and $type eq 'CODE') {
-    require Carp;
-    Carp::croak("Not a subroutine reference");
-  }
-  no strict 'refs';
-
-  return shift unless @_ > 1;
-
-  use vars qw($a $b);
-
-  my $caller = caller;
-  local(*{$caller."::a"}) = \my $a;
-  local(*{$caller."::b"}) = \my $b;
-
-  $a = shift;
-  foreach (@_) {
-    $b = $_;
-    $a = &{$code}();
-  }
-
-  $a;
-}
-
-sub first (&@) {
-  my $code = shift;
-  require Scalar::Util;
-  my $type = Scalar::Util::reftype($code);
-  unless($type and $type eq 'CODE') {
-    require Carp;
-    Carp::croak("Not a subroutine reference");
-  }
-
-  foreach (@_) {
-    return $_ if &{$code}();
-  }
-
-  undef;
-}
-
-
-sub sum (@) { reduce { $a + $b } @_ }
-
-sub min (@) { reduce { $a < $b ? $a : $b } @_ }
-
-sub max (@) { reduce { $a > $b ? $a : $b } @_ }
-
-sub minstr (@) { reduce { $a lt $b ? $a : $b } @_ }
-
-sub maxstr (@) { reduce { $a gt $b ? $a : $b } @_ }
-
-sub shuffle (@) {
-  my @a=\(@_);
-  my $n;
-  my $i=@_;
-  map {
-    $n = rand($i--);
-    (${$a[$n]}, $a[$n] = $a[$i])[0];
-  } @_;
-}
-
-1;
index 2dcb03a..d46853c 100644 (file)
@@ -1,18 +1,10 @@
 package List::Util::XS;
 use strict;
-use vars qw($VERSION);
 use List::Util;
 
-$VERSION = "1.23";           # FIXUP
+our $VERSION = "1.25";       # FIXUP
 $VERSION = eval $VERSION;    # FIXUP
 
-sub _VERSION { # FIXUP
-  require Carp;
-  Carp::croak("You need to install Scalar-List-Utils with a C compiler to ensure the XS is compiled")
-    if defined $_[1];
-  $VERSION;
-}
-
 1;
 __END__
 
@@ -32,6 +24,10 @@ installed using a C compiler and that the XS version is installed.
 During installation C<$List::Util::XS::VERSION> will be set to
 C<undef> if the XS was not compiled.
 
+Starting with release 1.23_03, Scalar-List-Util is B<always> using
+the XS implementation, but for backwards compatibility, we still
+ship the C<List::Util::XS> module which just loads C<List::Util>.
+
 =head1 SEE ALSO
 
 L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
index 24138ca..ab97fe5 100644 (file)
@@ -7,37 +7,33 @@
 package Scalar::Util;
 
 use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
 require Exporter;
 require List::Util; # List::Util loads the XS
 
-@ISA       = qw(Exporter);
-@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
-$VERSION    = "1.23";
+our @ISA       = qw(Exporter);
+our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
+our $VERSION    = "1.25";
 $VERSION   = eval $VERSION;
 
-unless (defined &dualvar) {
-  # Load Pure Perl version if XS not loaded
-  require Scalar::Util::PP;
-  Scalar::Util::PP->import;
-  push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
+our @EXPORT_FAIL;
+
+unless (defined &weaken) {
+  push @EXPORT_FAIL, qw(weaken);
+}
+unless (defined &isweak) {
+  push @EXPORT_FAIL, qw(isweak isvstring);
+}
+unless (defined &isvstring) {
+  push @EXPORT_FAIL, qw(isvstring);
 }
 
 sub export_fail {
-  if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded
-    my $pat = join("|", @EXPORT_FAIL);
-    if (my ($err) = grep { /^($pat)$/ } @_ ) {
-      require Carp;
-      Carp::croak("$err is only available with the XS version of Scalar::Util");
-    }
-  }
-
-  if (grep { /^(weaken|isweak)$/ } @_ ) {
+  if (grep { /^(?:weaken|isweak)$/ } @_ ) {
     require Carp;
     Carp::croak("Weak references are not implemented in the version of perl");
   }
 
-  if (grep { /^(isvstring)$/ } @_ ) {
+  if (grep { /^isvstring$/ } @_ ) {
     require Carp;
     Carp::croak("Vstrings are not implemented in the version of perl");
   }
@@ -45,24 +41,6 @@ sub export_fail {
   @_;
 }
 
-sub openhandle ($) {
-  my $fh = shift;
-  my $rt = reftype($fh) || '';
-
-  return defined(fileno($fh)) ? $fh : undef
-    if $rt eq 'IO';
-
-  if (reftype(\$fh) eq 'GLOB') { # handle  openhandle(*DATA)
-    $fh = \(my $tmp=$fh);
-  }
-  elsif ($rt ne 'GLOB') {
-    return undef;
-  }
-
-  (tied(*$fh) or defined(fileno($fh)))
-    ? $fh : undef;
-}
-
 1;
 
 __END__
diff --git a/cpan/List-Util/lib/Scalar/Util/PP.pm b/cpan/List-Util/lib/Scalar/Util/PP.pm
deleted file mode 100644 (file)
index 7850e1b..0000000
+++ /dev/null
@@ -1,108 +0,0 @@
-# Scalar::Util::PP.pm
-#
-# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-# This module is normally only loaded if the XS module is not available
-
-package Scalar::Util::PP;
-
-use strict;
-use warnings;
-use vars qw(@ISA @EXPORT $VERSION $recurse);
-require Exporter;
-use B qw(svref_2object);
-
-@ISA     = qw(Exporter);
-@EXPORT  = qw(blessed reftype tainted readonly refaddr looks_like_number);
-$VERSION = "1.23";
-$VERSION = eval $VERSION;
-
-sub blessed ($) {
-  return undef unless length(ref($_[0]));
-  my $b = svref_2object($_[0]);
-  return undef unless $b->isa('B::PVMG');
-  my $s = $b->SvSTASH;
-  return $s->isa('B::HV') ? $s->NAME : undef;
-}
-
-sub refaddr($) {
-  return undef unless length(ref($_[0]));
-
-  my $addr;
-  if(defined(my $pkg = blessed($_[0]))) {
-    $addr .= bless $_[0], 'Scalar::Util::Fake';
-    bless $_[0], $pkg;
-  }
-  else {
-    $addr .= $_[0]
-  }
-
-  $addr =~ /0x(\w+)/;
-  local $^W;
-  no warnings 'portable';
-  hex($1);
-}
-
-{
-  my %tmap = qw(
-    B::NULL   SCALAR
-
-    B::HV     HASH
-    B::AV     ARRAY
-    B::CV     CODE
-    B::IO     IO
-    B::GV     GLOB
-    B::REGEXP REGEXP
-  );
-
-  sub reftype ($) {
-    my $r = shift;
-
-    return undef unless length(ref($r));
-
-    my $t = ref(svref_2object($r));
-
-    return
-        exists $tmap{$t} ? $tmap{$t}
-      : length(ref($$r)) ? 'REF'
-      :                    'SCALAR';
-  }
-}
-
-sub tainted {
-  local($@, $SIG{__DIE__}, $SIG{__WARN__});
-  local $^W = 0;
-  no warnings;
-  eval { kill 0 * $_[0] };
-  $@ =~ /^Insecure/;
-}
-
-sub readonly {
-  return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR");
-
-  local($@, $SIG{__DIE__}, $SIG{__WARN__});
-  my $tmp = $_[0];
-
-  !eval { $_[0] = $tmp; 1 };
-}
-
-sub looks_like_number {
-  local $_ = shift;
-
-  # checks from perlfaq4
-  return 0 if !defined($_);
-  if (ref($_)) {
-    require overload;
-    return overload::Overloaded($_) ? defined(0 + $_) : 0;
-  }
-  return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
-  return 1 if (/^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/); # a C float
-  return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
-
-  0;
-}
-
-
-1;
diff --git a/cpan/List-Util/t/expfail.t b/cpan/List-Util/t/expfail.t
deleted file mode 100644 (file)
index 02fc192..0000000
+++ /dev/null
@@ -1,29 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless (-d 'blib') {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       keys %Config; # Silence warning
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-    }
-}
-
-use Test::More tests => 3;
-use strict;
-
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-require Scalar::Util;
-
-for my $func (qw(dualvar set_prototype weaken)) {
-       eval { Scalar::Util->import($func); };
-       like(
-           $@,
-           qr/$func is only available with the XS/,
-           "no pure perl $func: error raised",
-       );
-}
index 1378c39..497cdd5 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 use List::Util qw(first);
 use Test::More;
-plan tests => 19 + ($::PERL_ONLY ? 0 : 2);
+plan tests => 22 + ($::PERL_ONLY ? 0 : 2);
 my $v;
 
 ok(defined &first,     'defined');
@@ -114,6 +114,15 @@ if (!$::PERL_ONLY) { SKIP: {
 
 } }
 
+use constant XSUBC_TRUE  => 1;
+use constant XSUBC_FALSE => 0;
+
+is first(\&XSUBC_TRUE,  42, 1, 2, 3), 42,    'XSUB callbacks';
+is first(\&XSUBC_FALSE, 42, 1, 2, 3), undef, 'XSUB callbacks';
+
+
+eval { &first(1) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
 eval { &first(1,2) };
 ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
 eval { &first(qw(a b)) };
diff --git a/cpan/List-Util/t/getmagic-once.t b/cpan/List-Util/t/getmagic-once.t
new file mode 100644 (file)
index 0000000..00b3490
--- /dev/null
@@ -0,0 +1,47 @@
+#!./perl
+
+BEGIN {
+    unless (-d 'blib') {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       keys %Config; # Silence warning
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+    }
+}
+use strict;
+use Scalar::Util qw(blessed reftype refaddr);
+use Test::More tests => 6;
+
+my $getmagic_count;
+
+{
+    package T;
+    use Tie::Scalar;
+    use base qw(Tie::StdScalar);
+
+    sub FETCH {
+        $getmagic_count++;
+        my($self) = @_;
+        return $self->SUPER::FETCH;
+    }
+}
+
+tie my $var, 'T';
+
+$var = bless {};
+
+$getmagic_count = 0;
+ok blessed($var);
+is $getmagic_count, 1, 'blessed';
+
+$getmagic_count = 0;
+ok reftype($var);
+is $getmagic_count, 1, 'reftype';
+
+$getmagic_count = 0;
+ok refaddr($var);
+is $getmagic_count, 1, 'refaddr';
index aff9166..9607015 100644 (file)
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 8;
+use Test::More tests => 10;
 use List::Util qw(max);
 
 my $v;
@@ -45,6 +45,7 @@ is($v, 3, 'overload');
 $v = max($thr,$two,$one);
 is($v, 3, 'overload');
 
+
 { package Foo;
 
 use overload
@@ -59,12 +60,17 @@ use overload
   }
 }
 
-SKIP: {
-  eval { require bignum; } or skip("Need bignum for testing overloading",1);
+use Math::BigInt;
+
+my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65);
+my $v2 = $v1 - 1;
+my $v3 = $v2 - 1;
+$v = max($v1,$v2,$v1,$v3,$v1);
+is($v, $v1, 'bigint');
+
+$v = max($v1, 1, 2, 3);
+is($v, $v1, 'bigint and normal int');
+
+$v = max(1, 2, $v1, 3);
+is($v, $v1, 'bigint and normal int');
 
-  my $v1 = 2**65;
-  my $v2 = $v1 - 1;
-  my $v3 = $v2 - 1;
-  $v = max($v1,$v2,$v1,$v3,$v1);
-  is($v, $v1, 'bigint');
-}
index 13d1116..8d5be5e 100644 (file)
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 8;
+use Test::More tests => 10;
 use List::Util qw(min);
 
 my $v;
@@ -59,12 +59,17 @@ use overload
   }
 }
 
-SKIP: {
-  eval { require bignum; } or skip("Need bignum for testing overloading",1);
+use Math::BigInt;
+
+my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65);
+my $v2 = $v1 - 1;
+my $v3 = $v2 - 1;
+$v = min($v1,$v2,$v1,$v3,$v1);
+is($v, $v3, 'bigint');
+
+$v = min($v1, 1, 2, 3);
+is($v, 1, 'bigint and normal int');
+
+$v = min(1, 2, $v1, 3);
+is($v, 1, 'bigint and normal int');
 
-  my $v1 = 2**65;
-  my $v2 = $v1 - 1;
-  my $v3 = $v2 - 1;
-  $v = min($v1,$v2,$v1,$v3,$v1);
-  is($v, $v3, 'bigint');
-}
index bf4e6c1..e0dffb6 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 14;
+use Test::More tests => 21;
 use Scalar::Util qw(openhandle);
 
 ok(defined &openhandle, 'defined');
@@ -36,16 +36,20 @@ SKIP: {
     skip "3-arg open only on 5.6 or later", 1 if $]<5.006;
 
     open my $fh, "<", $0;
-    skip "could not open $0 for reading: $!", 1 unless $fh;
+    skip "could not open $0 for reading: $!", 2 unless $fh;
     is(openhandle($fh), $fh, "works with indirect filehandles");
+    close($fh);
+    is(openhandle($fh), undef, "works with indirect filehandles");
 }
 
 SKIP: {
-    skip "in-memory files only on 5.8 or later", 1 if $]<5.008;
+    skip "in-memory files only on 5.8 or later", 2 if $]<5.008;
 
     open my $fh, "<", \"in-memory file";
-    skip "could not open in-memory file: $!", 1 unless $fh;
+    skip "could not open in-memory file: $!", 2 unless $fh;
     is(openhandle($fh), $fh, "works with in-memory files");
+    close($fh);
+    is(openhandle($fh), undef, "works with in-memory files");
 }
 
 ok(openhandle(\*DATA), "works for \*DATA");
@@ -55,7 +59,7 @@ ok(openhandle(*DATA{IO}), "works for *DATA{IO}");
 {
     require IO::Handle;
     my $fh = IO::Handle->new_from_fd(fileno(*STDERR), 'w');
-    skip "new_from_fd(fileno(*STDERR)) failed", 1 unless $fh;
+    skip "new_from_fd(fileno(*STDERR)) failed", 2 unless $fh;
     ok(openhandle($fh), "works for IO::Handle objects");
 
     ok(!openhandle(IO::Handle->new), "unopened IO::Handle");
@@ -65,14 +69,16 @@ ok(openhandle(*DATA{IO}), "works for *DATA{IO}");
     require IO::File;
     my $fh = IO::File->new;
     $fh->open("< $0")
-        or skip "could not open $0: $!", 1;
+        or skip "could not open $0: $!", 3;
     ok(openhandle($fh), "works for IO::File objects");
+    close($fh);
+    ok(!openhandle($fh), "works for IO::File objects");
 
     ok(!openhandle(IO::File->new), "unopened IO::File" );
 }
 
 SKIP: {
-    skip( "Tied handles only on 5.8 or later", 1) if $]<5.008;
+    skip( "Tied handles only on 5.8 or later", 2) if $]<5.008;
 
     use vars qw(*H);
 
@@ -84,6 +90,12 @@ SKIP: {
     package main;
     tie *H, 'My::Tie';
     ok(openhandle(*H), "tied handles are always ok");
+    ok(openhandle(\*H), "tied handle refs are always ok");
 }
 
+ok !openhandle(undef),   "undef is not a filehandle";
+ok !openhandle("STDIN"), "strings are not filehandles";
+ok !openhandle(0),       "integers are not filehandles";
+
+
 __DATA__
diff --git a/cpan/List-Util/t/p_00version.t b/cpan/List-Util/t/p_00version.t
deleted file mode 100644 (file)
index 0b64f9e..0000000
+++ /dev/null
@@ -1,26 +0,0 @@
-#!./perl
-
-BEGIN {
-    unless (-d 'blib') {
-       chdir 't' if -d 't';
-       @INC = '../lib';
-       require Config; import Config;
-       keys %Config; # Silence warning
-       if ($Config{extensions} !~ /\bList\/Util\b/) {
-           print "1..0 # Skip: List::Util was not built\n";
-           exit 0;
-       }
-    }
-}
-
-use Test::More tests => 2;
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-require Scalar::Util;
-require List::Util;
-
-is( $Scalar::Util::PP::VERSION, $List::Util::VERSION, "VERSION mismatch");
-is( $List::Util::PP::VERSION, $List::Util::VERSION, "VERSION mismatch");
-
diff --git a/cpan/List-Util/t/p_blessed.t b/cpan/List-Util/t/p_blessed.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_first.t b/cpan/List-Util/t/p_first.t
deleted file mode 100644 (file)
index cd39ec4..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-$::PERL_ONLY = $::PERL_ONLY = 1; # Mustn't use it only once!
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_lln.t b/cpan/List-Util/t/p_lln.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_max.t b/cpan/List-Util/t/p_max.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_maxstr.t b/cpan/List-Util/t/p_maxstr.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_min.t b/cpan/List-Util/t/p_min.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_minstr.t b/cpan/List-Util/t/p_minstr.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_openhan.t b/cpan/List-Util/t/p_openhan.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_readonly.t b/cpan/List-Util/t/p_readonly.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_reduce.t b/cpan/List-Util/t/p_reduce.t
deleted file mode 100644 (file)
index cd39ec4..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-$::PERL_ONLY = $::PERL_ONLY = 1; # Mustn't use it only once!
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_refaddr.t b/cpan/List-Util/t/p_refaddr.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_reftype.t b/cpan/List-Util/t/p_reftype.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_shuffle.t b/cpan/List-Util/t/p_shuffle.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_sum.t b/cpan/List-Util/t/p_sum.t
deleted file mode 100644 (file)
index 48e7ef7..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
diff --git a/cpan/List-Util/t/p_tainted.t b/cpan/List-Util/t/p_tainted.t
deleted file mode 100644 (file)
index 6a4cd22..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-#!./perl -T
-
-use File::Spec;
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-my $filename = ($^O eq 'MSWin32' || $^O eq 'VMS')
-             ? File::Spec->rel2abs(File::Spec->catfile(".", $f))
-             : File::Spec->catfile(".", $f);
-do $filename; die $@ if $@;
index 2e12575..4468ab8 100644 (file)
@@ -16,7 +16,7 @@ BEGIN {
 
 use List::Util qw(reduce min);
 use Test::More;
-plan tests => 27 + ($::PERL_ONLY ? 0 : 2);
+plan tests => 29 + ($::PERL_ONLY ? 0 : 2);
 
 my $v = reduce {};
 
@@ -151,6 +151,13 @@ if (!$::PERL_ONLY) { SKIP: {
 
 } }
 
+# XSUB callback
+use constant XSUBC => 42;
+
+is reduce(\&XSUBC, 1, 2, 3), 42, "xsub callbacks";
+
+eval { &reduce(1) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
 eval { &reduce(1,2) };
 ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
 eval { &reduce(qw(a b)) };
index a7adafb..31a5d3b 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 29;
+use Test::More tests => 32;
 
 use Scalar::Util qw(reftype);
 use vars qw($t $y $x *F);
@@ -23,12 +23,16 @@ use Symbol qw(gensym);
 tie *F, 'MyTie';
 my $RE = $] < 5.011 ? 'SCALAR' : 'REGEXP';
 
+my $s = []; # SvTYPE($s) is SVt_RV, and SvROK($s) is true
+$s = undef; # SvTYPE($s) is SVt_RV, but SvROK($s) is false
+
 @test = (
  [ undef, 1,           'number'        ],
  [ undef, 'A',         'string'        ],
  [ HASH   => {},       'HASH ref'      ],
  [ ARRAY  => [],       'ARRAY ref'     ],
  [ SCALAR => \$t,      'SCALAR ref'    ],
+ [ SCALAR => \$s,      'SCALAR ref (but SVt_RV)' ],
  [ REF    => \(\$t),   'REF ref'       ],
  [ GLOB   => \*F,      'tied GLOB ref' ],
  [ GLOB   => gensym,   'GLOB ref'      ],
index ef484f9..3615b4a 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 8;
+use Test::More tests => 13;
 
 use List::Util qw(sum);
 
@@ -58,12 +58,40 @@ use overload
   }
 }
 
-SKIP: {
-  eval { require bignum; } or skip("Need bignum for testing overloading",1);
+use Math::BigInt;
+my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65);
+my $v2 = $v1 - 1;
+$v = sum($v1,$v2);
+is($v, $v1 + $v2, 'bigint');
 
-  my $v1 = 2**65;
-  my $v2 = 2**65;
-  my $v3 = $v1 + $v2;
-  $v = sum($v1,$v2);
-  is($v, $v3, 'bignum');
+$v = sum(42, $v1);
+is($v, $v1 + 42, 'bigint + builtin int');
+
+$v = sum(42, $v1, 2);
+is($v, $v1 + 42 + 2, 'bigint + builtin int');
+
+{ package example;
+
+  use overload
+    '0+' => sub { $_[0][0] },
+    '""' => sub { my $r = "$_[0][0]"; $r = "+$r" unless $r =~ m/^\-/; $r .= " [$_[0][1]]"; $r },
+    fallback => 1;
+
+  sub new {
+    my $class = shift;
+
+    my $this = bless [@_], $class;
+
+    return $this;
+  }
+}
+
+{
+  my $e1 = example->new(7, "test");
+  $t = sum($e1, 7, 7);
+  is($t, 21, 'overload returning non-overload');
+  $t = sum(8, $e1, 8);
+  is($t, 23, 'overload returning non-overload');
+  $t = sum(9, 9, $e1);
+  is($t, 25, 'overload returning non-overload');
 }
index 09ad330..ab40aa6 100644 (file)
@@ -16,7 +16,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 4;
+use Test::More tests => 5;
 
 use Scalar::Util qw(tainted);
 
@@ -32,3 +32,12 @@ ok( tainted($ENV{$key}),     'environment variable');
 
 $var = $ENV{$key};
 ok( tainted($var),     'copy of environment variable');
+
+{
+    package Tainted;
+    sub TIESCALAR { bless {} }
+    sub FETCH { $^X }
+}
+
+tie my $tiedvar, 'Tainted';
+ok( tainted($tiedvar), 'for magic variables');
index 57b9b9e..3d5a88c 100644 (file)
@@ -7,6 +7,7 @@
 
 cpan/DB_File
 cpan/IPC-SysV
+cpan/List-Util
 cpan/Time-HiRes
 cpan/Win32API-File
 dist/Cwd
index 3b26bf5..67c5456 100644 (file)
@@ -3545,6 +3545,10 @@ Signal names
 Various warnings and error messages that mention variable names or values,
 methods, etc.
 
+=item *
+
+L<Scalar::Util> has been upgraded from version 1.23 to version 1.25.
+
 =back
 
 One side effect of these changes is that blessing into "\0" no longer