Change 18702 by gbarr@monty on 2003/02/14 19:26:23
Update to Scalar-List-Utils 1.11
Affected files ...
... //depot/perl/MANIFEST#978 edit
... //depot/perl/ext/List/Util/ChangeLog#10 edit
... //depot/perl/ext/List/Util/Util.xs#19 edit
... //depot/perl/ext/List/Util/lib/List/Util.pm#14 edit
... //depot/perl/ext/List/Util/lib/Scalar/Util.pm#10 edit
... //depot/perl/ext/List/Util/t/isvstring.t#2 edit
... //depot/perl/ext/List/Util/t/proto.t#1 add
Differences ...
==== //depot/perl/MANIFEST#978 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#977~18692~ Mon Feb 10 23:53:26 2003
+++ perl/MANIFEST Fri Feb 14 11:26:23 2003
@@ -486,6 +486,7 @@
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/proto.t Scalar::Util
ext/List/Util/t/readonly.t Scalar::Util
ext/List/Util/t/reduce.t List::Util
ext/List/Util/t/refaddr.t Scalar::Util
==== //depot/perl/ext/List/Util/ChangeLog#10 (text) ====
Index: perl/ext/List/Util/ChangeLog
--- perl/ext/List/Util/ChangeLog#9~18654~ Tue Feb 4 06:42:51 2003
+++ perl/ext/List/Util/ChangeLog Fri Feb 14 11:26:23 2003
@@ -1,3 +1,32 @@
+Change 770 on 2003/02/14 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Release 1.11
+
+Change 769 on 2003/02/14 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Add t/proto.t to MANIFEST
+
+Change 768 on 2003/02/14 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Add set_prototype from Rafael Garcia-Suarez
+
+Change 767 on 2003/02/14 by <[EMAIL PROTECTED]> (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 <[EMAIL PROTECTED]> (Graham Barr)
+
+ Change how patchlevel.h is included and check we got what we wanted (from
+Jarkko)
+
+Change 765 on 2003/02/14 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Add -DPERL_EXT to DEFINEs, requested by Jarkko for 5.8.1
+
+Change 764 on 2003/02/04 by <[EMAIL PROTECTED]> (Graham Barr)
+
+ Release 1.10
+
Change 763 on 2003/02/04 by <[EMAIL PROTECTED]> (Graham Barr)
Fix linking error for older perls
@@ -36,7 +65,7 @@
Change 751 on 2002/10/18 by <[EMAIL PROTECTED]> (Graham Barr)
Fix context so that sub for reduce/first is always in a scalar context
- Fix sum/min/max so that they dont upgrade thier arguments to NVs
+ 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 <[EMAIL PROTECTED]> (Graham Barr)
==== //depot/perl/ext/List/Util/Util.xs#19 (text) ====
Index: perl/ext/List/Util/Util.xs
--- perl/ext/List/Util/Util.xs#18~18654~ Tue Feb 4 06:42:51 2003
+++ perl/ext/List/Util/Util.xs Fri Feb 14 11:26:23 2003
@@ -8,7 +8,10 @@
#include <XSUB.h>
#ifndef PERL_VERSION
-# include "patchlevel.h"
+# 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
@@ -478,6 +481,35 @@
OUTPUT:
RETVAL
+SV*
+set_prototype(subref, proto)
+ SV *subref
+ SV *proto
+PROTOTYPE: &$
+CODE:
+{
+ if (SvROK(subref)) {
+ SV *sv = SvRV(subref);
+ if (SvTYPE(sv) != SVt_PVCV) {
+ /* not a subroutine reference */
+ croak("set_prototype: not a subroutine reference");
+ }
+ if (SvPOK(proto)) {
+ /* set the prototype */
+ STRLEN len;
+ char *ptr = SvPV(proto, len);
+ sv_setpvn(sv, ptr, len);
+ }
+ else {
+ /* delete the prototype */
+ SvPOK_off(sv);
+ }
+ }
+ else {
+ croak("set_prototype: not a reference");
+ }
+ XSRETURN(1);
+}
BOOT:
{
==== //depot/perl/ext/List/Util/lib/List/Util.pm#14 (text) ====
Index: perl/ext/List/Util/lib/List/Util.pm
--- perl/ext/List/Util/lib/List/Util.pm#13~18654~ Tue Feb 4 06:42:51 2003
+++ perl/ext/List/Util/lib/List/Util.pm Fri Feb 14 11:26:23 2003
@@ -11,7 +11,7 @@
our @ISA = qw(Exporter DynaLoader);
our @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle);
-our $VERSION = "1.10_00";
+our $VERSION = "1.11_00";
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
==== //depot/perl/ext/List/Util/lib/Scalar/Util.pm#10 (text) ====
Index: perl/ext/List/Util/lib/Scalar/Util.pm
--- perl/ext/List/Util/lib/Scalar/Util.pm#9~18654~ Tue Feb 4 06:42:51 2003
+++ perl/ext/List/Util/lib/Scalar/Util.pm Fri Feb 14 11:26:23 2003
@@ -10,7 +10,7 @@
require List::Util; # List::Util loads the XS
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle
refaddr isvstring looks_like_number);
+our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle
+refaddr isvstring looks_like_number set_prototype);
our $VERSION = $List::Util::VERSION;
sub openhandle ($) {
@@ -41,7 +41,7 @@
=head1 SYNOPSIS
- use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
weaken isvstring looks_like_number);
+ use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
+weaken isvstring looks_like_number set_prototype);
=head1 DESCRIPTION
@@ -142,6 +142,13 @@
$obj = bless {}, "Foo";
$type = reftype $obj; # HASH
+
+=item set_prototype CODEREF, PROTOTYPE
+
+Sets the prototype of the given function, or deletes it if PROTOTYPE is
+undef. Returns the CODEREF.
+
+ set_prototype \&foo, '$$';
=item tainted EXPR
==== //depot/perl/ext/List/Util/t/isvstring.t#2 (text) ====
Index: perl/ext/List/Util/t/isvstring.t
--- perl/ext/List/Util/t/isvstring.t#1~18076~ Sun Nov 3 02:11:18 2002
+++ perl/ext/List/Util/t/isvstring.t Fri Feb 14 11:26:23 2003
@@ -11,15 +11,16 @@
exit 0;
}
}
- $|=1;
- require Scalar::Util;
- if (grep { /isvstring/ } @Scalar::Util::EXPORT_FAIL) {
- print("1..0\n");
- exit 0;
- }
}
-use Scalar::Util qw(isvstring);
+$|=1;
+require Scalar::Util;
+if (grep { /isvstring/ } @Scalar::Util::EXPORT_FAIL) {
+ print("1..0\n");
+ exit 0;
+}
+
+Scalar::Util->import(qw[isvstring]);
print "1..4\n";
==== //depot/perl/ext/List/Util/t/proto.t#1 (text) ====
Index: perl/ext/List/Util/t/proto.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/ext/List/Util/t/proto.t Fri Feb 14 11:26:23 2003
@@ -0,0 +1,75 @@
+#!./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;
+ }
+ }
+}
+
+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);
+
+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";
+}
+
+sub f { }
+proto_is 'f' => undef;
+$r = set_prototype(\&f,'$');
+proto_is 'f' => '$';
+print "not " unless ref $r eq "CODE" and $r == \&f;
+print "ok ", ++$test, " - return value\n";
+set_prototype(\&f,undef);
+proto_is 'f' => undef;
+set_prototype(\&f,'');
+proto_is 'f' => '';
+
+sub g (@) { }
+proto_is 'g' => '@';
+set_prototype(\&g,undef);
+proto_is 'g' => undef;
+
+sub non_existent;
+proto_is 'non_existent' => undef;
+set_prototype(\&non_existent,'$$$');
+proto_is 'non_existent' => '$$$';
+
+sub forward_decl ($$$$);
+proto_is 'forward_decl' => '$$$$';
+set_prototype(\&forward_decl,'\%');
+proto_is 'forward_decl' => '\%';
+
+eval { &set_prototype( 'f', '' ); };
+print "not " unless $@ =~ /^set_prototype: not a reference/;
+print "ok ", ++$test, " - error msg\n";
+eval { &set_prototype( \'f', '' ); };
+print "not " unless $@ =~ /^set_prototype: not a subroutine reference/;
+print "ok ", ++$test, " - error msg\n";
+EOT
End of Patch.
