This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update to Scalar-List-Utils-1.15
authorGraham Barr <gbarr@pobox.com>
Fri, 13 May 2005 20:42:53 +0000 (20:42 +0000)
committerGraham Barr <gbarr@pobox.com>
Fri, 13 May 2005 20:42:53 +0000 (20:42 +0000)
p4raw-id: //depot/perl@24465

39 files changed:
MANIFEST
ext/List/Util/Changes
ext/List/Util/Util.xs
ext/List/Util/lib/List/Util.pm
ext/List/Util/lib/Scalar/Util.pm
ext/List/Util/t/blessed.t
ext/List/Util/t/dualvar.t
ext/List/Util/t/first.t
ext/List/Util/t/isvstring.t
ext/List/Util/t/lln.t
ext/List/Util/t/max.t
ext/List/Util/t/maxstr.t
ext/List/Util/t/min.t
ext/List/Util/t/minstr.t
ext/List/Util/t/openhan.t
ext/List/Util/t/p_blessed.t [new file with mode: 0644]
ext/List/Util/t/p_first.t [new file with mode: 0644]
ext/List/Util/t/p_lln.t [new file with mode: 0644]
ext/List/Util/t/p_max.t [new file with mode: 0644]
ext/List/Util/t/p_maxstr.t [new file with mode: 0644]
ext/List/Util/t/p_min.t [new file with mode: 0644]
ext/List/Util/t/p_minstr.t [new file with mode: 0644]
ext/List/Util/t/p_openhan.t [new file with mode: 0644]
ext/List/Util/t/p_readonly.t [new file with mode: 0644]
ext/List/Util/t/p_reduce.t [new file with mode: 0644]
ext/List/Util/t/p_refaddr.t [new file with mode: 0644]
ext/List/Util/t/p_reftype.t [new file with mode: 0644]
ext/List/Util/t/p_shuffle.t [new file with mode: 0644]
ext/List/Util/t/p_sum.t [new file with mode: 0644]
ext/List/Util/t/p_tainted.t [new file with mode: 0644]
ext/List/Util/t/proto.t
ext/List/Util/t/readonly.t
ext/List/Util/t/reduce.t
ext/List/Util/t/refaddr.t
ext/List/Util/t/reftype.t
ext/List/Util/t/shuffle.t
ext/List/Util/t/sum.t
ext/List/Util/t/tainted.t
ext/List/Util/t/weak.t

index 250c4c1..d2f1464 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -634,11 +634,26 @@ ext/List/Util/t/dualvar.t Scalar::Util
 ext/List/Util/t/first.t                List::Util
 ext/List/Util/t/isvstring.t    Scalar::Util
 ext/List/Util/t/lln.t          Scalar::Util
-ext/List/Util/t/maxstr.t       List::Util
 ext/List/Util/t/max.t          List::Util
-ext/List/Util/t/minstr.t       List::Util
+ext/List/Util/t/maxstr.t       List::Util
 ext/List/Util/t/min.t          List::Util
+ext/List/Util/t/minstr.t       List::Util
 ext/List/Util/t/openhan.t      Scalar::Util
+ext/List/Util/t/p_blessed.t    Scalar::Util
+ext/List/Util/t/p_first.t      List::Util
+ext/List/Util/t/p_lln.t                Scalar::Util
+ext/List/Util/t/p_max.t                List::Util
+ext/List/Util/t/p_maxstr.t     List::Util
+ext/List/Util/t/p_min.t                List::Util
+ext/List/Util/t/p_minstr.t     List::Util
+ext/List/Util/t/p_openhan.t    Scalar::Util
+ext/List/Util/t/p_readonly.t   Scalar::Util
+ext/List/Util/t/p_reduce.t     List::Util
+ext/List/Util/t/p_refaddr.t    Scalar::Util
+ext/List/Util/t/p_reftype.t    Scalar::Util
+ext/List/Util/t/p_shuffle.t    List::Util
+ext/List/Util/t/p_sum.t                List::Util
+ext/List/Util/t/p_tainted.t    Scalar::Util
 ext/List/Util/t/proto.t                Scalar::Util
 ext/List/Util/t/readonly.t     Scalar::Util
 ext/List/Util/t/reduce.t       List::Util
index 6d787c4..bbf8abe 100644 (file)
@@ -1,3 +1,16 @@
+1.15 -- Fri May 13 11:01:15 CDT 2005
+
+Bug Fixes
+  * Fixed memory leak in first()
+
+Enhancements
+  * Converted tests to use Test::More
+  * Improved test coverage
+  * Changed Makefile.PL to use Module::Install
+  * Refactor use of Sv..X() macros to be Sv.._set()
+  * Changes from Jarkko for Symbian port of Perl
+  * Documentation updates to weaken()
+
 1.14 -- Sat May 22 08:01:19 BST 2004
 
 Bug Fixes
@@ -6,5 +19,293 @@ Bug Fixes
   * Fixed looks_like_number(undef) to return false for perl >= 5.009002
   * Fixed bug in refaddr() when passed a tied variable
 
-ChangeLogs for releases prior to 1.14 may be found at
-http://svn.mutatus.co.uk/browse/Scalar-List-Utils/tags/Scalar-List-Utils-1.13/ChangeLog
+Switch to svn repository at http://svn.mutatus.co.uk/wsvn/Scalar-List-Utils/trunk/
+Old perforce revision log below
+
+Change 827 on 2003/09/25 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.13
+
+Change 826 on 2003/09/25 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix NV casting issue with some compilers
+
+Change 825 on 2003/08/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.12
+
+Change 824 on 2003/08/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Don't directly use the SV returned as $a in the next iteration,
+       take a copy instead. Fixes problem if the code block result was from
+       an eval or sub call
+
+Change 823 on 2003/08/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Install into the 'perl' installdirs for >= 5.008
+
+Change 822 on 2003/08/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix test for EBCDIC portability
+
+Change 771 on 2003/03/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Get path for make from $Config
+
+Change 770 on 2003/02/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.11
+
+Change 769 on 2003/02/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Add t/proto.t to MANIFEST
+
+Change 768 on 2003/02/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Add set_prototype from Rafael Garcia-Suarez
+
+Change 767 on 2003/02/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix t/isvstring.t so it does not cause perl5.004 to segv
+       because of the exit from within BEGIN
+
+Change 766 on 2003/02/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Change how patchlevel.h is included and check we got what we wanted (from Jarkko)
+
+Change 765 on 2003/02/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Add -DPERL_EXT to DEFINEs, requested by Jarkko for 5.8.1
+
+Change 764 on 2003/02/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.10
+
+Change 763 on 2003/02/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix linking error for older perls
+
+Change 762 on 2003/02/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Make lln tests and perl implementation mimic changes to looks_like_number
+       in different perl versions
+
+Change 761 on 2003/02/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Add looks_like_number
+
+Change 760 on 2003/02/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Ensure PERL_DL_NONLAZY is false so we don't catch link errors during
+       bootstrap and then test the perl only version
+
+Change 759 on 2002/12/12 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.09
+
+Change 758 on 2002/12/12 by <gbarr@pobox.com> (Graham Barr)
+
+       Use UV to return refaddr
+
+Change 757 on 2002/11/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Add XS_VERSION
+
+Change 756 on 2002/11/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Use PAD_* macros in 5.9
+       Reuse our own target when calling pp_rand in shuffle() so we dont need to create a fake pad
+
+Change 751 on 2002/10/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix context so that sub for reduce/first  is always in a scalar context
+       Fix sum/min/max so that they don't upgrade their arguments to NVs
+       if they are IV or UV
+
+Change 750 on 2002/10/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Add isvstring()
+
+Change 745 on 2002/09/23 by <gbarr@pobox.com> (Graham Barr)
+
+       Scalar::Util
+       - Add refaddr()
+
+Change 722 on 2002/04/29 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.0701
+
+Change 721 on 2002/04/29 by <gbarr@pobox.com> (Graham Barr)
+
+       Add comment to README about failing tests on perl5.6.0
+
+Change 714 on 2002/03/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.07
+
+Change 713 on 2002/03/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Add Scalar::Util::openhandle()
+
+Change 647 on 2001/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.06
+
+Change 645 on 2001/09/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Some platforms require the main executable to export symbols
+       needed by modules. In 5.7.2 and prior releases of perl
+       Perl_cxinc was not exported so we need to duplicate its
+       functionality
+
+Change 644 on 2001/09/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Generate a typemap for NV for all perl version up to and
+       including 5.006
+
+Change 643 on 2001/09/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Document problems known with specific versions of perl
+
+Change 642 on 2001/09/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.05
+
+Change 641 on 2001/09/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix shuffle() to compile with threaded perl
+
+Change 640 on 2001/09/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.04
+
+Change 639 on 2001/09/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix context type (caused a core on Tru64)
+       Call pp_rand via *(PL_ppaddr[OP_RAND])
+
+Change 638 on 2001/09/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Documentation updates
+
+Change 637 on 2001/09/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.03
+
+Change 636 on 2001/09/03 by <gbarr@pobox.com> (Graham Barr)
+
+       More changes to help merging with core dist
+
+Change 635 on 2001/09/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Added List::Util::shuffle() similar to that described in
+       the perl FAQ except it returns a shuffled list instead of
+       modifying an array passed by reference
+
+Change 632 on 2001/09/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Handle tied variables passed for the number to dualvar()
+       Preserve number type (IV/UV/NV) in dualvar()
+
+Change 631 on 2001/08/31 by <gbarr@pobox.com> (Graham Barr)
+
+       Handle eval{} inside of the code blocks for first and reduce
+
+Change 629 on 2001/08/22 by <gbarr@pobox.com> (Graham Barr)
+
+       perl5.004 does not like exit from within a BEGIN, it core dumps
+
+Change 628 on 2001/08/22 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix stack problem in first() and reduce()
+       Align with core dist
+
+Change 483 on 2000/04/10 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.02
+
+Change 482 on 2000/04/10 by <gbarr@pobox.com> (Graham Barr)
+
+       Check for SvMAGICAL on argument for reftype and blessed
+
+Change 366 on 2000/03/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.01
+
+Change 365 on 2000/03/03 by <gbarr@pobox.com> (Graham Barr)
+
+       - Added auto-detection for a compiler and install the perl version
+         if not found
+       - Better perl implemenation of reftype, should be thread-safe now
+
+Change 364 on 2000/03/03 by <gbarr@pobox.com> (Graham Barr)
+
+       - Added some examples of simple subs that have been requested
+         but not added
+       - Updated copyright dates
+
+Change 344 on 1999/11/10 by <gbarr@pobox.com> (Graham Barr)
+
+       - Better testcase for reftype
+
+Change 343 on 1999/11/10 by <gbarr@pobox.com> (Graham Barr)
+
+       - Modules are now called List::Util & Scalar::Util
+       - Supports non-XS install
+       - perl version of reftype now returns "REF" when it should
+
+Change 311 on 1999/06/01 by <gbarr@pobox.com> (Graham Barr)
+
+       Updated README
+
+Change 275 on 1999/03/22 by <gbarr@pobox.com> (Graham Barr)
+
+       Removed forall as it is very broken
+
+Change 274 on 1999/03/22 by <gbarr@pobox.com> (Graham Barr)
+
+       Added List::Util::forall
+
+Change 273 on 1999/03/21 by <gbarr@pobox.com> (Graham Barr)
+
+       Added weaken and isweak to Ref::Util
+
+Change 272 on 1999/03/21 by <gbarr@pobox.com> (Graham Barr)
+
+       Add new .pm files to repository
+
+Change 271 on 1999/03/21 by <gbarr@pobox.com> (Graham Barr)
+
+       - Split into three packages Ref::Util, List::Util and Scalar::DualVar
+       - readonly and clock were removed in favor of other modules
+
+Change 270 on 1999/03/21 by <gbarr@pobox.com> (Graham Barr)
+
+       Rename package
+
+Change 269 on 1999/03/21 by <gbarr@pobox.com> (Graham Barr)
+
+       - Added reftype
+       - improved reduce by not doing a sub call
+       - reduce now uses $a and $b
+       - now compiles with 5.005_5x
+
+Change 178 on 1998/07/26 by <gbarr@pobox.com> (Graham Barr)
+
+       Modified XS code so it will compile with 5.004 and 5.005
+
+Change 115 on 1998/02/21 by <gbarr@pobox.com> (Graham Barr)
+
+       Fri Feb 20 1998 Graham Barr <gbarr@pobox.com>
+       
+       t/min.t, t/max.t
+       - Change sor to do a numerical sort
+       
+       Fri Dec 19 1997 Graham Barr <gbarr@pobox.com>
+       
+       - Added readonly()
+       
+       Wed Nov 19 1997 Graham Barr <gbarr@pobox.com>
+       
+       - Initial release
+
index 790a2b9..45aa92d 100644 (file)
@@ -103,6 +103,10 @@ sv_tainted(SV *sv)
 #  define PTR2UV(ptr) (UV)(ptr)
 #endif
 
+#ifndef SvUV_set
+#  define SvUV_set(sv, val) (((XPVUV*)SvANY(sv))->xuv_uv = (val))
+#endif
+
 #ifdef HASATTRIBUTE
 #  if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
 #    define PERL_UNUSED_DECL
@@ -269,7 +273,6 @@ CODE:
     }
     ST(0) = ret;
     POPBLOCK(cx,PL_curpm);
-    LEAVESUB(cv);
     CATCH_SET(oldcatch);
     XSRETURN(1);
 }
@@ -319,13 +322,11 @@ CODE:
        if (SvTRUE(*PL_stack_sp)) {
          ST(0) = ST(index);
          POPBLOCK(cx,PL_curpm);
-         LEAVESUB(cv);
          CATCH_SET(oldcatch);
          XSRETURN(1);
        }
     }
     POPBLOCK(cx,PL_curpm);
-    LEAVESUB(cv);
     CATCH_SET(oldcatch);
     XSRETURN_UNDEF;
 }
index a9f8b46..fc69ea2 100644 (file)
@@ -1,6 +1,6 @@
 # List::Util.pm
 #
-# Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1997-2005 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.
 
@@ -10,7 +10,7 @@ require Exporter;
 
 @ISA        = qw(Exporter);
 @EXPORT_OK  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION    = "1.14_01";
+$VERSION    = "1.15";
 $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
@@ -250,7 +250,7 @@ to add due to them being very simple to implement in perl
 
 =head1 COPYRIGHT
 
-Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
+Copyright (c) 1997-2005 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.
 
index 089a436..d8b1625 100644 (file)
@@ -1,6 +1,6 @@
 # Scalar::Util.pm
 #
-# Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1997-2005 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.
 
@@ -11,7 +11,7 @@ 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.14_1";
+$VERSION    = "1.15";
 $VERSION   = eval $VERSION;
 
 sub export_fail {
@@ -274,6 +274,25 @@ prevent the object being DESTROY-ed at its usual time.
     }
     # $ref is now undef
 
+Note that if you take a copy of a scalar with a weakened reference,
+the copy will be a strong reference.
+
+    my $var;
+    my $foo = \$var;
+    weaken($foo);                       # Make $foo a weak reference
+    my $bar = $foo;                     # $bar is now a strong reference
+
+This may be less obvious in other situations, such as C<grep()>, for instance
+when grepping through a list of weakened references to objects that may have
+been destroyed already:
+
+    @object = grep { defined } @object;
+
+This will indeed remove all references to destroyed objects, but the remaining
+references to objects will be strong, causing the remaining objects to never
+be destroyed because there is now always a strong reference to them in the
+@object array.
+
 =back
 
 =head1 KNOWN BUGS
@@ -283,7 +302,7 @@ show up as tests 8 and 9 of dualvar.t failing
 
 =head1 COPYRIGHT
 
-Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
+Copyright (c) 1997-2005 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.
 
index 84e29da..8002404 100755 (executable)
@@ -13,32 +13,19 @@ BEGIN {
     }
 }
 
+use Test::More tests => 8;
 use Scalar::Util qw(blessed);
-use vars qw($t $y $x);
+use vars qw($t $x);
 
-print "1..7\n";
-
-print "not " if blessed(1);
-print "ok 1\n";
-
-print "not " if blessed('A');
-print "ok 2\n";
-
-print "not " if blessed({});
-print "ok 3\n";
-
-print "not " if blessed([]);
-print "ok 4\n";
-
-$y = \$t;
-
-print "not " if blessed($y);
-print "ok 5\n";
+ok(!blessed(undef),    'undef is not blessed');
+ok(!blessed(1),                'Numbers are not blessed');
+ok(!blessed('A'),      'Strings are not blessed');
+ok(!blessed({}),       'Unblessed HASH-ref');
+ok(!blessed([]),       'Unblessed ARRAY-ref');
+ok(!blessed(\$t),      'Unblessed SCALAR-ref');
 
 $x = bless [], "ABC";
+is(blessed($x), "ABC", 'blessed ARRAY-ref');
 
-print "not " unless blessed($x);
-print "ok 6\n";
-
-print "not " unless blessed($x) eq 'ABC';
-print "ok 7\n";
+$x = bless {}, "DEF";
+is(blessed($x), "DEF", 'blessed HASH-ref');
index 4b17354..652f22e 100755 (executable)
@@ -13,66 +13,43 @@ BEGIN {
     }
 }
 
-use vars qw($skip);
+use Scalar::Util ();
+use Test::More  (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL)
+                       ? (skip_all => 'dualvar requires XS version')
+                       : (tests => 11);
 
-BEGIN {
-  require Scalar::Util;
-
-  if (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) {
-    print "1..0\n";
-    $skip=1;
-  }
-}
-
-eval <<'EOT' unless $skip;
-use Scalar::Util qw(dualvar);
-
-print "1..11\n";
-
-$var = dualvar 2.2,"string";
+Scalar::Util->import('dualvar');
 
-print "not " unless $var == 2.2;
-print "ok 1\n";
+$var = dualvar( 2.2,"string");
 
-print "not " unless $var eq "string";
-print "ok 2\n";
+ok( $var == 2.2,       'Numeric value');
+ok( $var eq "string",  'String value');
 
 $var2 = $var;
 
+ok( $var2 == 2.2,      'copy Numeric value');
+ok( $var2 eq "string", 'copy String value');
+
 $var++;
 
-print "not " unless $var == 3.2;
-print "ok 3\n";
+ok( $var == 3.2,       'inc Numeric value');
+ok( $var ne "string",  'inc String value');
 
-print "not " unless $var ne "string";
-print "ok 4\n";
+my $numstr = "10.2";
+my $numtmp = int($numstr); # use $numstr as an int
 
-print "not " unless $var2 == 2.2;
-print "ok 5\n";
+$var = dualvar($numstr, "");
 
-print "not " unless $var2 eq "string";
-print "ok 6\n";
+ok( $var == $numstr,   'NV');
 
-my $numstr = "10.2";
-my $numtmp = sprintf("%d", $numstr);
-$var = dualvar $numstr, "";
-print "not " unless $var == $numstr;
-print "ok 7\n";
-
-$var = dualvar 1<<31, "";
-print "not " unless $var == 1<<31;
-print "ok 8\n";
-print "not " unless $var > 0;
-print "ok 9\n";
+$var = dualvar(1<<31, "");
+ok( $var == (1<<31),   'UV 1');
+ok( $var > 0,          'UV 2');
 
 tie my $tied, 'Tied';
-$var = dualvar $tied, "ok";
-print "not " unless $var == 7.5;
-print "ok 10\n";
-print "not " unless $var eq "ok";
-print "ok 11\n";
-
-EOT
+$var = dualvar($tied, "ok");
+ok($var == 7.5,                'Tied num');
+ok($var eq 'ok',       'Tied str');
 
 package Tied;
 
index d6a919d..784437c 100755 (executable)
@@ -13,38 +13,36 @@ BEGIN {
     }
 }
 
+use Test::More tests => 8;
 use List::Util qw(first);
+my $v;
 
-print "1..8\n";
+ok(defined &first,     'defined');
 
-print "not " unless defined &first;
-print "ok 1\n";
+$v = first { 8 == ($_ - 1) } 9,4,5,6;
+is($v, 9, 'one more than 8');
 
-print "not " unless 9 == first { 8 == ($_ - 1) } 9,4,5,6;
-print "ok 2\n";
+$v = first { 0 } 1,2,3,4;
+is($v, undef, 'none match');
 
-print "not " if defined(first { 0 } 1,2,3,4);
-print "ok 3\n";
+$v = first { 0 };
+is($v, undef, 'no args');
 
-print "not " if defined(first { 0 });
-print "ok 4\n";
-
-my $foo = first { $_->[1] le "e" and "e" le $_->[2] }
+$v = first { $_->[1] le "e" and "e" le $_->[2] }
                [qw(a b c)], [qw(d e f)], [qw(g h i)];
-print "not " unless $foo->[0] eq 'd';
-print "ok 5\n";
+is_deeply($v, [qw(d e f)], 'reference args');
 
 # Check that eval{} inside the block works correctly
 my $i = 0;
-print "not " unless 5 == first { eval { die }; ($i == 5, $i = $_)[0] } 0,1,2,3,4,5,5;
-print "ok 6\n";
-
-print "not " if defined eval { first { die if $_ } 0,0,1 };
-print "ok 7\n";
+$v = first { eval { die }; ($i == 5, $i = $_)[0] } 0,1,2,3,4,5,5;
+is($v, 5, 'use of eval');
 
-($x) = foobar();
-$x = '' unless defined $x;
-print "${x}ok 8\n";
+$v = eval { first { die if $_ } 0,0,1 };
+is($v, undef, 'use of die');
 
 sub foobar {  first { !defined(wantarray) || wantarray } "not ","not ","not " }
 
+($v) = foobar();
+is($v, undef, 'wantarray');
+
+
index 9f05a67..860113e 100644 (file)
@@ -14,29 +14,20 @@ BEGIN {
 }
 
 $|=1;
-require Scalar::Util;
-if (grep { /isvstring/ } @Scalar::Util::EXPORT_FAIL) {
-    print("1..0\n");
-    exit 0;
-}
+use Scalar::Util ();
+use Test::More  (grep { /isvstring/ } @Scalar::Util::EXPORT_FAIL)
+                       ? (skip_all => 'isvstring requires XS version')
+                       : (tests => 3);
 
 Scalar::Util->import(qw[isvstring]);
 
-print "1..4\n";
-
-print "ok 1\n";
-
 $vs = ord("A") == 193 ? 241.75.240 : 49.46.48;
 
-print "not " unless $vs == "1.0";
-print "ok 2\n";
-
-print "not " unless isvstring($vs);
-print "ok 3\n";
+ok( $vs == "1.0",      'dotted num');
+ok( isvstring($vs),    'isvstring');
 
 $sv = "1.0";
-print "not " if isvstring($sv);
-print "ok 4\n";
+ok( !isvstring($sv),   'not isvstring');
 
 
 
index 80b0996..0324d7b 100644 (file)
@@ -1,14 +1,4 @@
 #!/usr/bin/perl -w
-# -*- perl -*-
-
-
-#
-# $Id: $
-# Author: Slaven Rezic
-#
-
-use strict;
-use vars qw(%Config);
 
 BEGIN {
     unless (-d 'blib') {
@@ -23,25 +13,18 @@ BEGIN {
     }
 }
 
+use strict;
+use Test::More tests => 12;
 use Scalar::Util qw(looks_like_number);
 
-my $i;
-sub ok { print +(($_[0] eq $_[1]) ? "": "not "), "ok ",++$i,"\n" }
-
-print "1..12\n";
+foreach my $num (qw(1 -1 +1 1.0 +1.0 -1.0 -1.0e-12)) {
+  ok(looks_like_number($num), "'$num'");
+}
 
-ok(!!looks_like_number("1"),       1);
-ok(!!looks_like_number("-1"),      1);
-ok(!!looks_like_number("+1"),      1);
-ok(!!looks_like_number("1.0"),     1);
-ok(!!looks_like_number("+1.0"),            1);
-ok(!!looks_like_number("-1.0"),            1);
-ok(!!looks_like_number("-1.0e-12"), 1);
-ok(!!looks_like_number("Inf"),     $] >= 5.006001);
-ok(!!looks_like_number("Infinity"), $] >= 5.008);
-ok(!!looks_like_number("NaN"),     $] >= 5.008);
-ok(!!looks_like_number("foo"),     '');
-ok(!!looks_like_number(undef),     $] < 5.009002);
-# That's enough - we trust the perl core tests like t/base/num.t
+is(!!looks_like_number("Inf"),     $] >= 5.006001,     'Inf');
+is(!!looks_like_number("Infinity"), $] >= 5.008,       'Infinity');
+is(!!looks_like_number("NaN"),     $] >= 5.008,        'NaN');
+is(!!looks_like_number("foo"),     '',                 'foo');
+is(!!looks_like_number(undef),     $] < 5.009002,      'undef');
 
-__END__
+# We should copy some of perl core tests like t/base/num.t here
index 2e0193a..dd25a13 100755 (executable)
@@ -13,24 +13,24 @@ BEGIN {
     }
 }
 
-
+use strict;
+use Test::More tests => 5;
 use List::Util qw(max);
 
-print "1..5\n";
+my $v;
 
-print "not " unless defined &max;
-print "ok 1\n";
+ok(defined &max, 'defined');
 
-print "not " unless max(1) == 1;
-print "ok 2\n";
+$v = max(1);
+is($v, 1, 'single arg');
 
-print "not " unless max(1,2) == 2;
-print "ok 3\n";
+$v = max (1,2);
+is($v, 2, '2-arg ordered');
 
-print "not " unless max(2,1) == 2;
-print "ok 4\n";
+$v = max(2,1);
+is($v, 2, '2-arg reverse ordered');
 
 my @a = map { rand() } 1 .. 20;
 my @b = sort { $a <=> $b } @a;
-print "not " unless max(@a) == $b[-1];
-print "ok 5\n";
+$v = max(@a);
+is($v, $b[-1], '20-arg random order');
index c2725a2..11d98ff 100755 (executable)
@@ -13,24 +13,24 @@ BEGIN {
     }
 }
 
-
+use strict;
+use Test::More tests => 5;
 use List::Util qw(maxstr);
 
-print "1..5\n";
+my $v;
 
-print "not " unless defined &maxstr;
-print "ok 1\n";
+ok(defined &maxstr, 'defined');
 
-print "not " unless maxstr('a') eq 'a';
-print "ok 2\n";
+$v = maxstr('a');
+is($v, 'a', 'single arg');
 
-print "not " unless maxstr('a','b') eq 'b';
-print "ok 3\n";
+$v = maxstr('a','b');
+is($v, 'b', '2-arg ordered');
 
-print "not " unless maxstr('B','A') eq 'B';
-print "ok 4\n";
+$v = maxstr('B','A');
+is($v, 'B', '2-arg reverse ordered');
 
 my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2)))) } 0 .. 20;
 my @b = sort { $a cmp $b } @a;
-print "not " unless maxstr(@a) eq $b[-1];
-print "ok 5\n";
+$v = maxstr(@a);
+is($v, $b[-1], 'random ordered');
index 6f2d0e8..5e8c234 100755 (executable)
@@ -13,24 +13,24 @@ BEGIN {
     }
 }
 
-
+use strict;
+use Test::More tests => 5;
 use List::Util qw(min);
 
-print "1..5\n";
+my $v;
 
-print "not " unless defined &min;
-print "ok 1\n";
+ok(defined &min, 'defined');
 
-print "not " unless min(9) == 9;
-print "ok 2\n";
+$v = min(9);
+is($v, 9, 'single arg');
 
-print "not " unless min(1,2) == 1;
-print "ok 3\n";
+$v = min (1,2);
+is($v, 1, '2-arg ordered');
 
-print "not " unless min(2,1) == 1;
-print "ok 4\n";
+$v = min(2,1);
+is($v, 1, '2-arg reverse ordered');
 
 my @a = map { rand() } 1 .. 20;
 my @b = sort { $a <=> $b } @a;
-print "not " unless min(@a) == $b[0];
-print "ok 5\n";
+$v = min(@a);
+is($v, $b[0], '20-arg random order');
index 31f69a9..021b309 100755 (executable)
@@ -13,24 +13,24 @@ BEGIN {
     }
 }
 
-
+use strict;
+use Test::More tests => 5;
 use List::Util qw(minstr);
 
-print "1..5\n";
+my $v;
 
-print "not " unless defined &minstr;
-print "ok 1\n";
+ok(defined &minstr, 'defined');
 
-print "not " unless minstr('a') eq 'a';
-print "ok 2\n";
+$v = minstr('a');
+is($v, 'a', 'single arg');
 
-print "not " unless minstr('a','b') eq 'a';
-print "ok 3\n";
+$v = minstr('a','b');
+is($v, 'a', '2-arg ordered');
 
-print "not " unless minstr('B','A') eq 'A';
-print "ok 4\n";
+$v = minstr('B','A');
+is($v, 'A', '2-arg reverse ordered');
 
 my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2)))) } 0 .. 20;
 my @b = sort { $a cmp $b } @a;
-print "not " unless minstr(@a) eq $b[0];
-print "ok 5\n";
+$v = minstr(@a);
+is($v, $b[0], 'random ordered');
index 9eed5b9..0c84074 100644 (file)
@@ -13,21 +13,17 @@ BEGIN {
     }
 }
 
-
+use strict;
+use vars qw(*CLOSED);
+use Test::More tests => 4;
 use Scalar::Util qw(openhandle);
 
-print "1..4\n";
-
-print "not " unless defined &openhandle;
-print "ok 1\n";
+ok(defined &openhandle, 'defined');
 
 my $fh = \*STDERR;
-print "not " unless openhandle($fh) == $fh;
-print "ok 2\n";
+is(openhandle($fh), $fh, 'STDERR');
 
-print "not " unless fileno(openhandle(*STDERR)) == fileno(STDERR);
-print "ok 3\n";
+is(fileno(openhandle(*STDERR)), fileno(STDERR), 'fileno(STDERR)');
 
-print "not " if openhandle(CLOSED);
-print "ok 4\n";
+is(openhandle(*CLOSED), undef, 'closed');
 
diff --git a/ext/List/Util/t/p_blessed.t b/ext/List/Util/t/p_blessed.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_first.t b/ext/List/Util/t/p_first.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_lln.t b/ext/List/Util/t/p_lln.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_max.t b/ext/List/Util/t/p_max.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_maxstr.t b/ext/List/Util/t/p_maxstr.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_min.t b/ext/List/Util/t/p_min.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_minstr.t b/ext/List/Util/t/p_minstr.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_openhan.t b/ext/List/Util/t/p_openhan.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_readonly.t b/ext/List/Util/t/p_readonly.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_reduce.t b/ext/List/Util/t/p_reduce.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_refaddr.t b/ext/List/Util/t/p_refaddr.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_reftype.t b/ext/List/Util/t/p_reftype.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_shuffle.t b/ext/List/Util/t/p_shuffle.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_sum.t b/ext/List/Util/t/p_sum.t
new file mode 100644 (file)
index 0000000..2fd67b0
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
diff --git a/ext/List/Util/t/p_tainted.t b/ext/List/Util/t/p_tainted.t
new file mode 100644 (file)
index 0000000..9f2e33f
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl -T
+
+# force perl-only version to be tested
+sub List::Util::bootstrap {}
+
+(my $f = __FILE__) =~ s/p_//;
+do $f;
index 91541cb..50e401b 100644 (file)
@@ -13,63 +13,47 @@ BEGIN {
     }
 }
 
-BEGIN {
-  require Scalar::Util;
-
-  if (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL) {
-    print "1..0\n";
-    $skip=1;
-  }
-}
-
-eval <<'EOT' unless $skip;
-use Scalar::Util qw(set_prototype);
+use Scalar::Util ();
+use Test::More  (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL)
+                       ? (skip_all => 'set_prototype requires XS version')
+                       : (tests => 13);
 
-print "1..13\n";
-$test = 0;
-
-sub proto_is ($$) {
-    $proto = prototype shift;
-    $expected = shift;
-    if (defined $expected) {
-       print "# Got $proto, expected $expected\nnot " if $expected ne $proto;
-    }
-    else {
-       print "# Got $proto, expected undef\nnot " if defined $proto;
-    }
-    print "ok ", ++$test, "\n";
-}
+Scalar::Util->import('set_prototype');
 
 sub f { }
-proto_is 'f' => undef;
+is( prototype('f'),    undef,  'no prototype');
+
 $r = set_prototype(\&f,'$');
-proto_is 'f' => '$';
-print "not " unless ref $r eq "CODE" and $r == \&f;
-print "ok ", ++$test, " - return value\n";
+is( prototype('f'),    '$',    'set prototype');
+is( $r,                        \&f,    'return value');
+
 set_prototype(\&f,undef);
-proto_is 'f' => undef;
+is( prototype('f'),    undef,  'remove prototype');
+
 set_prototype(\&f,'');
-proto_is 'f' => '';
+is( prototype('f'),    '',     'empty prototype');
 
 sub g (@) { }
-proto_is 'g' => '@';
+is( prototype('g'),    '@',    '@ prototype');
+
 set_prototype(\&g,undef);
-proto_is 'g' => undef;
+is( prototype('g'),    undef,  'remove prototype');
 
-sub non_existent;
-proto_is 'non_existent' => undef;
-set_prototype(\&non_existent,'$$$');
-proto_is 'non_existent' => '$$$';
+sub stub;
+is( prototype('stub'), undef,  'non existing sub');
 
-sub forward_decl ($$$$);
-proto_is 'forward_decl' => '$$$$';
-set_prototype(\&forward_decl,'\%');
-proto_is 'forward_decl' => '\%';
+set_prototype(\&stub,'$$$');
+is( prototype('stub'), '$$$',  'change non existing sub');
+
+sub f_decl ($$$$);
+is( prototype('f_decl'),       '$$$$', 'forward declaration');
+
+set_prototype(\&f_decl,'\%');
+is( prototype('f_decl'),       '\%',   'change forward declaration');
 
 eval { &set_prototype( 'f', '' ); };
-print "not " unless $@ =~ /^set_prototype: not a reference/;
-print "ok ", ++$test, " - error msg\n";
+print "not " unless 
+ok($@ =~ /^set_prototype: not a reference/,    'not a reference');
+
 eval { &set_prototype( \'f', '' ); };
-print "not " unless $@ =~ /^set_prototype: not a subroutine reference/;
-print "ok ", ++$test, " - error msg\n";
-EOT
+ok($@ =~ /^set_prototype: not a subroutine reference/, 'not a sub reference');
index a72d788..a515f2e 100644 (file)
@@ -14,39 +14,25 @@ BEGIN {
 }
 
 use Scalar::Util qw(readonly);
+use Test::More tests => 9;
 
-
-print "1..9\n";
-
-print "not " unless readonly(1);
-print "ok 1\n";
+ok( readonly(1),       'number constant');
 
 my $var = 2;
 
-print "not " if readonly($var);
-print "ok 2\n";
-
-print "not " unless $var == 2;
-print "ok 3\n";
+ok( !readonly($var),   'number variable');
+is( $var,      2,      'no change to number variable');
 
-print "not " unless readonly("fred");
-print "ok 4\n";
+ok( readonly("fred"),  'string constant');
 
 $var = "fred";
 
-print "not " if readonly($var);
-print "ok 5\n";
-
-print "not " unless $var eq "fred";
-print "ok 6\n";
+ok( !readonly($var),   'string variable');
+is( $var,      'fred', 'no change to string variable');
 
 $var = \2;
 
-print "not " if readonly($var);
-print "ok 7\n";
-
-print "not " unless readonly($$var);
-print "ok 8\n";
+ok( !readonly($var),   'reference to constant');
+ok( readonly($$var),   'de-reference to constant');
 
-print "not " if readonly(*STDOUT);
-print "ok 9\n";
+ok( !readonly(*STDOUT),        'glob');
index d6128f6..689ff52 100755 (executable)
@@ -15,62 +15,58 @@ BEGIN {
 
 
 use List::Util qw(reduce min);
+use Test::More tests => 14;
 
-print "1..13\n";
+my $v = reduce {};
 
-print "not " if defined reduce {};
-print "ok 1\n";
+is( $v,        undef,  'no args');
 
-print "not " unless 9 == reduce { $a / $b } 756,3,7,4;
-print "ok 2\n";
+$v = reduce { $a / $b } 756,3,7,4;
+is( $v,        9,      '4-arg divide');
 
-print "not " unless 9 == reduce { $a / $b } 9;
-print "ok 3\n";
+$v = reduce { $a / $b } 6;
+is( $v,        6,      'one arg');
 
 @a = map { rand } 0 .. 20;
-print "not " unless min(@a) == reduce { $a < $b ? $a : $b } @a;
-print "ok 4\n";
+$v = reduce { $a < $b ? $a : $b } @a;
+is( $v,        min(@a),        'min');
 
 @a = map { pack("C", int(rand(256))) } 0 .. 20;
-print "not " unless join("",@a) eq reduce { $a . $b } @a;
-print "ok 5\n";
+$v = reduce { $a . $b } @a;
+is( $v,        join("",@a),    'concat');
 
 sub add {
   my($aa, $bb) = @_;
   return $aa + $bb;
 }
 
-my $sum = reduce { my $t="$a $b\n"; 0+add($a, $b) } 3, 2, 1;
-print "not " unless $sum == 6;
-print "ok 6\n";
+$v = reduce { my $t="$a $b\n"; 0+add($a, $b) } 3, 2, 1;
+is( $v,        6,      'call sub');
 
 # Check that eval{} inside the block works correctly
-print "not " unless 10 == reduce { eval { die }; $a + $b } 0,1,2,3,4;
-print "ok 7\n";
+$v = reduce { eval { die }; $a + $b } 0,1,2,3,4;
+is( $v,        10,     'use eval{}');
 
-print "not " if defined eval { reduce { die if $b > 2; $a + $b } 0,1,2,3,4 };
-print "ok 8\n";
+$v = !defined eval { reduce { die if $b > 2; $a + $b } 0,1,2,3,4 };
+ok($v, 'die');
 
-($x) = foobar();
-print "${x}ok 9\n";
-
-sub foobar { reduce { (defined(wantarray) && !wantarray) ? '' : 'not ' } 0,1,2,3 }
+sub foobar { reduce { (defined(wantarray) && !wantarray) ? $a+1 : 0 } 0,1,2,3 }
+($v) = foobar();
+is( $v,        3,      'scalar context');
 
 sub add2 { $a + $b }
 
-print "not " unless 6 == reduce \&add2, 1,2,3;
-print "ok 10\n";
-
-print "not " unless 6 == reduce { add2() } 1,2,3;
-print "ok 11\n";
-
+$v = reduce \&add2, 1,2,3;
+is( $v,        6,      'sub reference');
 
-print "not " unless 6 == reduce { eval "$a + $b" } 1,2,3;
-print "ok 12\n";
+$v = reduce { add2() } 3,4,5;
+is( $v, 12,    'call sub');
 
-$a = $b = 9;
-reduce { $a * $b } 1,2,3;
-print "not " unless $a == 9 and $b == 9;
-print "ok 13\n";
 
+$v = reduce { eval "$a + $b" } 1,2,3;
+is( $v, 6, 'eval string');
 
+$a = 8; $b = 9;
+$v = reduce { $a * $b } 1,2,3;
+is( $a, 8, 'restore $a');
+is( $b, 9, 'restore $b');
index 424b002..448a53d 100755 (executable)
@@ -14,6 +14,8 @@ BEGIN {
 }
 
 
+use Test::More tests => 19;
+
 use Scalar::Util qw(refaddr);
 use vars qw($t $y $x *F $v $r);
 use Symbol qw(gensym);
@@ -21,21 +23,18 @@ use Symbol qw(gensym);
 # Ensure we do not trigger and tied methods
 tie *F, 'MyTie';
 
-print "1..19\n";
-
 my $i = 1;
 foreach $v (undef, 10, 'string') {
-  print "not " if defined refaddr($v);
-  print "ok ",$i++,"\n";
+  is(refaddr($v), undef, "not " . (defined($v) ? "'$v'" : "undef"));
 }
 
 foreach $r ({}, \$t, [], \*F, sub {}) {
   my $addr = $r + 0;
-  print "not " unless refaddr($r) == $addr;
-  print "ok ",$i++,"\n";
+  my $n = "$r";
+  is( refaddr($r), $addr, $n);
+
   my $obj = bless $r, 'FooBar';
-  print "not " unless refaddr($r) == $addr;
-  print "ok ",$i++,"\n";
+  is( refaddr($r), $addr, "blessed with overload $n");
 }
 
 {
@@ -48,18 +47,12 @@ foreach $r ({}, \$t, [], \*F, sub {}) {
   $x{$b} = 23;
   my $xy = $x{$y};
   my $xb = $x{$b}; 
-  print "not " unless ref($x{$y});
-  print "ok ",$i++,"\n";
-  print "not " unless ref($x{$b});
-  print "ok ",$i++,"\n";
-  print "not " unless refaddr($xy) == refaddr($y);
-  print "ok ",$i++,"\n";
-  print "not " unless refaddr($xb) == refaddr($b);
-  print "ok ",$i++,"\n";
-  print "not " unless refaddr($x{$y});
-  print "ok ",$i++,"\n";
-  print "not " unless refaddr($x{$b});
-  print "ok ",$i++,"\n";
+  ok(ref($x{$y}));
+  ok(ref($x{$b}));
+  ok(refaddr($xy) == refaddr($y));
+  ok(refaddr($xb) == refaddr($b));
+  ok(refaddr($x{$y}));
+  ok(refaddr($x{$b}));
 }
 
 package FooBar;
index 470b72a..6cbc6d0 100755 (executable)
@@ -13,6 +13,7 @@ BEGIN {
     }
 }
 
+use Test::More tests => 23;
 
 use Scalar::Util qw(reftype);
 use vars qw($t $y $x *F);
@@ -22,32 +23,29 @@ use Symbol qw(gensym);
 tie *F, 'MyTie';
 
 @test = (
- [ undef, 1],
- [ undef, 'A'],
- [ HASH => {} ],
- [ ARRAY => [] ],
- [ SCALAR => \$t ],
- [ REF    => \(\$t) ],
- [ GLOB   => \*F ],
- [ GLOB   => gensym ],
- [ CODE   => sub {} ],
+ [ undef, 1,           'number'        ],
+ [ undef, 'A',         'string'        ],
+ [ HASH   => {},       'HASH ref'      ],
+ [ ARRAY  => [],       'ARRAY ref'     ],
+ [ SCALAR => \$t,      'SCALAR ref'    ],
+ [ REF    => \(\$t),   'REF ref'       ],
+ [ GLOB   => \*F,      'tied GLOB ref' ],
+ [ GLOB   => gensym,   'GLOB ref'      ],
+ [ CODE   => sub {},   'CODE ref'      ],
 # [ IO => *STDIN{IO} ] the internal sv_reftype returns UNKNOWN
 );
 
-print "1..", @test*4, "\n";
-
-my $i = 1;
 foreach $test (@test) {
-  my($type,$what) = @$test;
-  my $pack;
-  foreach $pack (undef,"ABC","0",undef) {
-    print "# $what\n";
-    my $res = reftype($what);
-    printf "# %s - %s\n", map { defined($_) ? $_ : 'undef' } $type,$res;
-    print "not " if $type ? $res ne $type : defined($res);
-    bless $what, $pack if $type && defined $pack;
-    print "ok ",$i++,"\n";
-  }
+  my($type,$what, $n) = @$test;
+
+  is( reftype($what), $type, $n);
+  next unless ref($what);
+
+  bless $what, "ABC";
+  is( reftype($what), $type, $n);
+
+  bless $what, "0";
+  is( reftype($what), $type, $n);
 }
 
 package MyTie;
index e416415..d3fbd6c 100755 (executable)
@@ -13,28 +13,24 @@ BEGIN {
     }
 }
 
+use Test::More tests => 6;
 
 use List::Util qw(shuffle);
 
-print "1..5\n";
-
 my @r;
 
 @r = shuffle();
-print "not " if @r;
-print "ok 1\n";
+ok( !@r,       'no args');
 
 @r = shuffle(9);
-print "not " unless @r == 1 and $r[0] = 9;
-print "ok 2\n";
+is( 0+@r,      1,      '1 in 1 out');
+is( $r[0],     9,      'one arg');
 
 my @in = 1..100;
 @r = shuffle(@in);
-print "not " unless @r == @in;
-print "ok 3\n";
+is( 0+@r,      0+@in,  'arg count');
 
-print "not " if join("",@r) eq join("",@in);
-print "ok 4\n";
+isnt( "@r",    "@in",  'result different to args');
 
-print "not " if join("",sort { $a <=> $b } @r) ne join("",@in);
-print "ok 5\n";
+my @s = sort { $a <=> $b } @r;
+is( "@in",     "@s",   'values');
index f75679d..4860eeb 100755 (executable)
@@ -13,28 +13,27 @@ BEGIN {
     }
 }
 
+use Test::More tests => 6;
 
 use List::Util qw(sum);
 
-print "1..6\n";
+my $v = sum;
+is( $v,        undef,  'no args');
 
-print "not " if defined sum;
-print "ok 1\n";
+$v = sum(9);
+is( $v, 9, 'one arg');
 
-print "not " unless sum(9) == 9;
-print "ok 2\n";
+$v = sum(1,2,3,4);
+is( $v, 10, '4 args');
 
-print "not " unless sum(1,2,3,4) == 10;
-print "ok 3\n";
-
-print "not " unless sum(-1) == -1;
-print "ok 4\n";
+$v = sum(-1);
+is( $v, -1, 'one -1');
 
 my $x = -3;
 
-print "not " unless sum($x,3) == 0;
-print "ok 5\n";
+$v = sum($x, 3);
+is( $v, 0, 'variable arg');
 
-print "not " unless sum(-3.5,3) == -0.5;
-print "ok 6\n";
+$v = sum(-3.5,3);
+is( $v, -0.5, 'real numbers');
 
index a330b1f..2e9c641 100644 (file)
@@ -13,26 +13,19 @@ BEGIN {
     }
 }
 
-use lib qw(blib/lib blib/arch);
-use Scalar::Util qw(tainted);
-use Config;
+use Test::More tests => 4;
 
-print "1..4\n";
+use Scalar::Util qw(tainted);
 
-print "not " if tainted(1);
-print "ok 1\n";
+ok( !tainted(1), 'constant number');
 
 my $var = 2;
 
-print "not " if tainted($var);
-print "ok 2\n";
+ok( !tainted($var), 'known variable');
 
 my $key = (keys %ENV)[0];
 
-$var = $ENV{$key};
+ok( tainted($ENV{$key}),       'environment variable');
 
-print "not " unless tainted($var);
-print "ok 3\n";
-
-print "not " unless tainted($ENV{$key});
-print "ok 4\n";
+$var = $ENV{$key};
+ok( tainted($var),     'copy of environment variable');
index 1096e9e..58745c7 100755 (executable)
@@ -13,41 +13,20 @@ BEGIN {
     }
 }
 
-use vars qw($skip);
-
-BEGIN {
-  $|=1;
-  require Scalar::Util;
-  if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
-    print("1..0\n");
-    $skip=1;
-  }
-
-  $DEBUG = 0;
-
-  if ($DEBUG && eval { require Devel::Peek } ) {
-    Devel::Peek->import('Dump');
-  }
-  else {
-    *Dump = sub {};
-  }
+use Scalar::Util ();
+use Test::More  (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL)
+                       ? (skip_all => 'weaken requires XS version')
+                       : (tests => 22);
+
+if (0) {
+  require Devel::Peek;
+  Devel::Peek->import('Dump');
 }
-
-eval <<'EOT' unless $skip;
-use Scalar::Util qw(weaken isweak);
-print "1..22\n";
-
-######################### End of black magic.
-
-$cnt = 0;
-
-sub ok {
-       ++$cnt;
-       if($_[0]) { print "ok $cnt\n"; } else {print "not ok $cnt\n"; }
-       return $_[0];
+else {
+  *Dump = sub {};
 }
 
-$| = 1;
+Scalar::Util->import(qw(weaken isweak));
 
 if(1) {
 
@@ -62,25 +41,25 @@ my ($y,$z);
        $y = \$x;
        $z = \$x;
 }
-print "# START:\n";
+print "# START\n";
 Dump($y); Dump($z);
 
-ok( $y ne "" and $z ne "" );
-weaken($y);
+ok( ref($y) and ref($z));
 
 print "# WEAK:\n";
+weaken($y);
 Dump($y); Dump($z);
 
-ok( $y ne "" and $z ne "" );
-undef($z);
+ok( ref($y) and ref($z));
 
 print "# UNDZ:\n";
+undef($z);
 Dump($y); Dump($z);
 
 ok( not (defined($y) and defined($z)) );
-undef($y);
 
 print "# UNDY:\n";
+undef($y);
 Dump($y); Dump($z);
 
 ok( not (defined($y) and defined($z)) );
@@ -88,17 +67,11 @@ ok( not (defined($y) and defined($z)) );
 print "# FIN:\n";
 Dump($y); Dump($z);
 
-# exit(0);
-
-# }
-# {
 
 # 
 # Case 2: one reference, which is weakened
 #
 
-# kill 5,$$;
-
 print "# CASE 2:\n";
 
 {
@@ -106,7 +79,7 @@ print "# CASE 2:\n";
        $y = \$x;
 }
 
-ok( $y ne "" );
+ok( ref($y) );
 print "# BW: \n";
 Dump($y);
 weaken($y);
@@ -117,14 +90,10 @@ ok( not defined $y  );
 print "# EXITBLOCK\n";
 }
 
-# exit(0);
-
 # 
 # Case 3: a circular structure
 #
 
-# kill 5, $$;
-
 $flag = 0;
 {
        my $y = bless {}, Dest;
@@ -137,7 +106,7 @@ $flag = 0;
        print "# 3: $y\n";
        weaken($y->{Self});
        print "# WKED\n";
-       ok( $y ne "" );
+       ok( ref($y) );
        print "# VALS: HASH ",$y,"   SELF ",\$y->{Self},"  Y ",\$y, 
                "    FLAG: ",\$y->{Flag},"\n";
        print "# VPRINT\n";
@@ -185,7 +154,7 @@ Dump($y);
 undef($y);
 
 ok( not defined $y);
-ok($z ne "");
+ok( ref($z) );
 
 
 #
@@ -210,14 +179,10 @@ ok(!isweak($x->{Z}));
 # Case 7: test weaken on a read only ref
 #
 
-if ($] < 5.008003) {
+SKIP: {
     # Doesn't work for older perls, see bug [perl #24506]
-    print "# Skip next 5 tests on perl $]\n";
-    for (1..5) {
-       ok(1);
-    }
-}
-else {
+    skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003;
+
     $a = eval '\"hello"';
     ok(ref($a)) or print "# didn't get a ref from eval\n";
     $b = $a;
@@ -236,4 +201,3 @@ sub DESTROY {
        print "# INCFLAG\n";
        ${$_[0]{Flag}} ++;
 }
-EOT