Hello community,
here is the log from the commit of package perl-Scalar-List-Utils for
openSUSE:Factory checked in at 2014-01-22 09:44:26
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Scalar-List-Utils (Old)
and /work/SRC/openSUSE:Factory/.perl-Scalar-List-Utils.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Scalar-List-Utils"
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Scalar-List-Utils/perl-Scalar-List-Utils.changes
2013-12-16 07:08:43.000000000 +0100
+++
/work/SRC/openSUSE:Factory/.perl-Scalar-List-Utils.new/perl-Scalar-List-Utils.changes
2014-01-23 15:52:15.000000000 +0100
@@ -1,0 +2,9 @@
+Fri Jan 17 18:53:15 UTC 2014 - [email protected]
+
+- update to 1.36:
+ * Added Scalar::Util::unweaken()
+ * Various documentation changes/updates
+ * Correct uses of overload operators in unit tests (RT91969)
+- do not run weak test on SLE_11
+
+-------------------------------------------------------------------
Old:
----
Scalar-List-Utils-1.35.tar.gz
New:
----
Scalar-List-Utils-1.36.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Scalar-List-Utils.spec ++++++
--- /var/tmp/diff_new_pack.T7zHkj/_old 2014-01-23 15:52:15.000000000 +0100
+++ /var/tmp/diff_new_pack.T7zHkj/_new 2014-01-23 15:52:15.000000000 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Scalar-List-Utils
#
-# Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2014 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,7 +17,7 @@
Name: perl-Scalar-List-Utils
-Version: 1.35
+Version: 1.36
Release: 0
%define cpan_name Scalar-List-Utils
Summary: Common Scalar and List utility subroutines
@@ -28,12 +28,13 @@
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
-#BuildRequires: perl(List::Util::XS)
-#BuildRequires: perl(Tie::StdScalar)
%{perl_requires}
%description
-Common Scalar and List utility subroutines
+List::Util contains a selection of subroutines that people have expressed would
+be nice to have in the perl core, but the usage would not really be high enough
+to warrant the use of a keyword, and the size so small such that being
+individual extensions would be wasteful.
%prep
%setup -q -n %{cpan_name}-%{version}
@@ -44,6 +45,9 @@
%{__make} %{?_smp_mflags}
%check
+%if 0%{?suse_version} <= 1110
+rm t/weak.t
+%endif
%{__make} test
%install
++++++ Scalar-List-Utils-1.35.tar.gz -> Scalar-List-Utils-1.36.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/Changes
new/Scalar-List-Utils-1.36/Changes
--- old/Scalar-List-Utils-1.35/Changes 2013-10-19 03:36:41.000000000 +0200
+++ new/Scalar-List-Utils-1.36/Changes 2014-01-16 16:42:27.000000000 +0100
@@ -1,3 +1,11 @@
+1.36 -- 2014/01/16 15:40:47
+ [CHANGES]
+ * Added Scalar::Util::unweaken()
+ * Various documentation changes/updates
+
+ [BUGFIXES]
+ * Correct uses of overload operators in unit tests (RT91969)
+
1.35 -- Sat Oct 19 01:35 UTC 2013
* Added List::Util::product()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/ListUtil.xs
new/Scalar-List-Utils-1.36/ListUtil.xs
--- old/Scalar-List-Utils-1.35/ListUtil.xs 2013-10-18 14:24:32.000000000
+0200
+++ new/Scalar-List-Utils-1.36/ListUtil.xs 2014-01-16 16:36:38.000000000
+0100
@@ -62,6 +62,22 @@
# define PERL_HAS_BAD_MULTICALL_REFCOUNT
#endif
+#if PERL_VERSION < 14
+# define croak_no_modify() croak("%s", PL_no_modify)
+#endif
+
+#if PERL_VERSION < 12
+static void Perl_ck_warner(pTHX_ U32 err, const char* pat, ...)
+{
+ if (Perl_ckwarn(aTHX_ err)) {
+ va_list args;
+ va_start(args, pat);
+ vwarner(err, pat, &args);
+ va_end(args);
+ }
+}
+#endif
+
MODULE=List::Util PACKAGE=List::Util
void
@@ -920,6 +936,42 @@
#else
croak("weak references are not implemented in this release of perl");
#endif
+
+void
+unweaken(sv)
+ SV *sv
+PROTOTYPE: $
+INIT:
+ SV *tsv;
+CODE:
+#ifdef SvWEAKREF
+ /* This code stolen from core's sv_rvweaken() and modified */
+ if (!SvOK(sv))
+ return;
+ if (!SvROK(sv))
+ croak("Can't unweaken a nonreference");
+ else if (!SvWEAKREF(sv)) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Reference is not weak");
+ return;
+ }
+ else if (SvREADONLY(sv)) croak_no_modify();
+
+ tsv = SvRV(sv);
+#if PERL_VERSION >= 14
+ SvWEAKREF_off(sv); SvROK_on(sv);
+ SvREFCNT_inc_NN(tsv);
+ Perl_sv_del_backref(aTHX_ tsv, sv);
+#else
+ /* Lacking sv_del_backref() the best we can do is clear the old (weak) ref
+ * then set a new strong one
+ */
+ sv_clear(sv);
+ SvRV_set(sv, SvREFCNT_inc_NN(tsv));
+ SvROK_on(sv);
+#endif
+#else
+ croak("weak references are not implemented in this release of perl");
+#endif
void
isweak(sv)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/META.json
new/Scalar-List-Utils-1.36/META.json
--- old/Scalar-List-Utils-1.35/META.json 2013-10-19 03:38:22.000000000
+0200
+++ new/Scalar-List-Utils-1.36/META.json 2014-01-16 16:43:19.000000000
+0100
@@ -4,7 +4,7 @@
"Graham Barr <[email protected]>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter
version 2.132661",
+ "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter
version 2.133380",
"license" : [
"perl_5"
],
@@ -42,5 +42,5 @@
"url" : "https://github.com/Scalar-List-Utils/Scalar-List-Utils";
}
},
- "version" : "1.35"
+ "version" : "1.36"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/META.yml
new/Scalar-List-Utils-1.36/META.yml
--- old/Scalar-List-Utils-1.35/META.yml 2013-10-19 03:38:22.000000000 +0200
+++ new/Scalar-List-Utils-1.36/META.yml 2014-01-16 16:43:19.000000000 +0100
@@ -7,7 +7,7 @@
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version
2.132661'
+generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version
2.133380'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -21,4 +21,4 @@
Test::More: 0
resources:
repository: https://github.com/Scalar-List-Utils/Scalar-List-Utils
-version: 1.35
+version: 1.36
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/MYMETA.json
new/Scalar-List-Utils-1.36/MYMETA.json
--- old/Scalar-List-Utils-1.35/MYMETA.json 2013-10-19 03:38:05.000000000
+0200
+++ new/Scalar-List-Utils-1.36/MYMETA.json 2014-01-16 16:43:10.000000000
+0100
@@ -4,7 +4,7 @@
"Graham Barr <[email protected]>"
],
"dynamic_config" : 0,
- "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter
version 2.132661",
+ "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter
version 2.133380",
"license" : [
"perl_5"
],
@@ -42,5 +42,5 @@
"url" : "https://github.com/Scalar-List-Utils/Scalar-List-Utils";
}
},
- "version" : "1.35"
+ "version" : "1.36"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/MYMETA.yml
new/Scalar-List-Utils-1.36/MYMETA.yml
--- old/Scalar-List-Utils-1.35/MYMETA.yml 2013-10-19 03:38:05.000000000
+0200
+++ new/Scalar-List-Utils-1.36/MYMETA.yml 2014-01-16 16:43:10.000000000
+0100
@@ -7,7 +7,7 @@
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version
2.132661'
+generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version
2.133380'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -21,4 +21,4 @@
Test::More: 0
resources:
repository: https://github.com/Scalar-List-Utils/Scalar-List-Utils
-version: 1.35
+version: 1.36
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/lib/List/Util/XS.pm
new/Scalar-List-Utils-1.36/lib/List/Util/XS.pm
--- old/Scalar-List-Utils-1.35/lib/List/Util/XS.pm 2013-10-19
03:34:22.000000000 +0200
+++ new/Scalar-List-Utils-1.36/lib/List/Util/XS.pm 2014-01-16
16:39:47.000000000 +0100
@@ -2,7 +2,7 @@
use strict;
use List::Util;
-our $VERSION = "1.35"; # FIXUP
+our $VERSION = "1.36"; # FIXUP
$VERSION = eval $VERSION; # FIXUP
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/lib/List/Util.pm
new/Scalar-List-Utils-1.36/lib/List/Util.pm
--- old/Scalar-List-Utils-1.35/lib/List/Util.pm 2013-10-19 03:34:22.000000000
+0200
+++ new/Scalar-List-Utils-1.36/lib/List/Util.pm 2014-01-16 16:39:47.000000000
+0100
@@ -1,5 +1,3 @@
-# List::Util.pm
-#
# Copyright (c) 1997-2009 Graham Barr <[email protected]>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
@@ -16,7 +14,7 @@
all any first min max minstr maxstr none notall product reduce sum sum0
shuffle
pairmap pairgrep pairfirst pairs pairkeys pairvalues
);
-our $VERSION = "1.35";
+our $VERSION = "1.36";
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -50,10 +48,10 @@
=head1 DESCRIPTION
-C<List::Util> contains a selection of subroutines that people have
-expressed would be nice to have in the perl core, but the usage would
-not really be high enough to warrant the use of a keyword, and the size
-so small such that being individual extensions would be wasteful.
+C<List::Util> contains a selection of subroutines that people have expressed
+would be nice to have in the perl core, but the usage would not really be high
+enough to warrant the use of a keyword, and the size so small such that being
+individual extensions would be wasteful.
By default C<List::Util> does not export any subroutines.
@@ -65,22 +63,22 @@
=cut
-=head2 reduce BLOCK LIST
+=head2 $result = reduce { BLOCK } @list
-Reduces LIST by calling BLOCK, in a scalar context, multiple times,
-setting C<$a> and C<$b> each time. The first call will be with C<$a>
-and C<$b> set to the first two elements of the list, subsequent
-calls will be done by setting C<$a> to the result of the previous
-call and C<$b> to the next element in the list.
-
-Returns the result of the last call to BLOCK. If LIST is empty then
-C<undef> is returned. If LIST only contains one element then that
-element is returned and BLOCK is not executed.
-
-The following examples all demonstrate how C<reduce> could be used to
-implement the other list-reduction functions in this module. (They are
-not in fact implemented like this, but instead in a more efficient
-manner in individual C functions).
+Reduces C<@list> by calling C<BLOCK> in a scalar context multiple times,
+setting C<$a> and C<$b> each time. The first call will be with C<$a> and C<$b>
+set to the first two elements of the list, subsequent calls will be done by
+setting C<$a> to the result of the previous call and C<$b> to the next element
+in the list.
+
+Returns the result of the last call to the C<BLOCK>. If C<@list> is empty then
+C<undef> is returned. If C<@list> only contains one element then that element
+is returned and C<BLOCK> is not executed.
+
+The following examples all demonstrate how C<reduce> could be used to implement
+the other list-reduction functions in this module. (They are not in fact
+implemented like this, but instead in a more efficient manner in individual C
+functions).
$foo = reduce { defined($a) ? $a :
$code->(local $_ = $b) ? $b :
@@ -99,21 +97,21 @@
$foo = reduce { $a || !$code->(local $_ = $b) } 0, @bar # notall
# Note that these implementations do not fully short-circuit
-If your algorithm requires that C<reduce> produce an identity value, then
-make sure that you always pass that identity value as the first argument to
prevent
+If your algorithm requires that C<reduce> produce an identity value, then make
+sure that you always pass that identity value as the first argument to prevent
C<undef> being returned
$foo = reduce { $a + $b } 0, @values; # sum with 0 identity value
-The remaining list-reduction functions are all specialisations of this
-generic idea.
+The remaining list-reduction functions are all specialisations of this generic
+idea.
-=head2 any BLOCK LIST
+=head2 $b = any { BLOCK } @list
-Similar to C<grep> in that it evaluates BLOCK setting C<$_> to each element
-of LIST in turn. C<any> returns true if any element makes the BLOCK return a
-true value. If BLOCK never returns true or LIST was empty then it returns
-false.
+Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
+of C<@list> in turn. C<any> returns true if any element makes the C<BLOCK>
+return a true value. If C<BLOCK> never returns true or C<@list> was empty then
+it returns false.
Many cases of using C<grep> in a conditional can be written using C<any>
instead, as it can short-circuit after the first true result.
@@ -122,164 +120,170 @@
# at least one string has more than 10 characters
}
-=head2 all BLOCK LIST
+=head2 $b = all { BLOCK } @list
-Similar to C<any>, except that it requires all elements of the LIST to make
-the BLOCK return true. If any element returns false, then it returns true. If
-the BLOCK never returns false or the LIST was empty then it returns true.
+Similar to C<any>, except that it requires all elements of the C<@list> to make
+the C<BLOCK> return true. If any element returns false, then it returns false.
+If the C<BLOCK> never returns false or the C<@list> was empty then it returns
+true.
-=head2 none BLOCK LIST
+=head2 $b = none { BLOCK } @list
-=head2 notall BLOCK LIST
+=head2 $b = notall { BLOCK } @list
Similar to C<any> and C<all>, but with the return sense inverted. C<none>
-returns true if no value in the LIST causes the BLOCK to return true, and
-C<notall> returns true if not all of the values do.
+returns true only if no value in the LIST causes the BLOCK to return true, and
+C<notall> returns true only if not all of the values do.
-=head2 first BLOCK LIST
+=head2 $val = first { BLOCK } @list
-Similar to C<grep> in that it evaluates BLOCK setting C<$_> to each element
-of LIST in turn. C<first> returns the first element where the result from
-BLOCK is a true value. If BLOCK never returns true or LIST was empty then
-C<undef> is returned.
+Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
+of C<@list> in turn. C<first> returns the first element where the result from
+C<BLOCK> is a true value. If C<BLOCK> never returns true or C<@list> was empty
+then C<undef> is returned.
$foo = first { defined($_) } @list # first defined value in @list
$foo = first { $_ > $value } @list # first value in @list which
# is greater than $value
-=head2 max LIST
+=head2 $num = max @list
-Returns the entry in the list with the highest numerical value. If the
-list is empty then C<undef> is returned.
+Returns the entry in the list with the highest numerical value. If the list is
+empty then C<undef> is returned.
$foo = max 1..10 # 10
$foo = max 3,9,12 # 12
$foo = max @bar, @baz # whatever
-=head2 maxstr LIST
+=head2 $str = maxstr @list
-Similar to C<max>, but treats all the entries in the list as strings
-and returns the highest string as defined by the C<gt> operator.
-If the list is empty then C<undef> is returned.
+Similar to C<max>, but treats all the entries in the list as strings and
+returns the highest string as defined by the C<gt> operator. If the list is
+empty then C<undef> is returned.
$foo = maxstr 'A'..'Z' # 'Z'
$foo = maxstr "hello","world" # "world"
$foo = maxstr @bar, @baz # whatever
-=head2 min LIST
+=head2 $num = min @list
-Similar to C<max> but returns the entry in the list with the lowest
-numerical value. If the list is empty then C<undef> is returned.
+Similar to C<max> but returns the entry in the list with the lowest numerical
+value. If the list is empty then C<undef> is returned.
$foo = min 1..10 # 1
$foo = min 3,9,12 # 3
$foo = min @bar, @baz # whatever
-=head2 minstr LIST
+=head2 $str = minstr @list
-Similar to C<min>, but treats all the entries in the list as strings
-and returns the lowest string as defined by the C<lt> operator.
-If the list is empty then C<undef> is returned.
+Similar to C<min>, but treats all the entries in the list as strings and
+returns the lowest string as defined by the C<lt> operator. If the list is
+empty then C<undef> is returned.
$foo = minstr 'A'..'Z' # 'A'
$foo = minstr "hello","world" # "hello"
$foo = minstr @bar, @baz # whatever
-=head2 product LIST
+=head2 $num = product @list
-Returns the product of all the elements in LIST. If LIST is empty then C<1> is
-returned.
+Returns the numerical product of all the elements in C<@list>. If C<@list> is
+empty then C<1> is returned.
$foo = product 1..10 # 3628800
$foo = product 3,9,12 # 324
-=head2 sum LIST
+=head2 $num_or_undef = sum @list
-Returns the sum of all the elements in LIST. If LIST is empty then
-C<undef> is returned.
+Returns the numerical sum of all the elements in C<@list>. For backwards
+compatibility, if C<@list> is empty then C<undef> is returned.
$foo = sum 1..10 # 55
$foo = sum 3,9,12 # 24
$foo = sum @bar, @baz # whatever
-=head2 sum0 LIST
+=head2 $num = sum0 @list
-Similar to C<sum>, except this returns 0 when given an empty list, rather
-than C<undef>.
+Similar to C<sum>, except this returns 0 when given an empty list, rather than
+C<undef>.
=cut
=head1 KEY/VALUE PAIR LIST FUNCTIONS
-The following set of functions, all inspired by L<List::Pairwise>, consume
-an even-sized list of pairs. The pairs may be key/value associations from a
-hash, or just a list of values. The functions will all preserve the original
-ordering of the pairs, and will not be confused by multiple pairs having the
-same "key" value - nor even do they require that the first of each pair be a
-plain string.
+The following set of functions, all inspired by L<List::Pairwise>, consume an
+even-sized list of pairs. The pairs may be key/value associations from a hash,
+or just a list of values. The functions will all preserve the original ordering
+of the pairs, and will not be confused by multiple pairs having the same "key"
+value - nor even do they require that the first of each pair be a plain string.
=cut
-=head2 pairgrep BLOCK KVLIST
+=head2 @kvlist = pairgrep { BLOCK } @kvlist
+
+=head2 $count = pairgrep { BLOCK } @kvlist
Similar to perl's C<grep> keyword, but interprets the given list as an
-even-sized list of pairs. It invokes the BLOCK multiple times, in scalar
+even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
context, with C<$a> and C<$b> set to successive pairs of values from the
-KVLIST.
+C<@kvlist>.
-Returns an even-sized list of those pairs for which the BLOCK returned true
+Returns an even-sized list of those pairs for which the C<BLOCK> returned true
in list context, or the count of the B<number of pairs> in scalar context.
-(Note, therefore, in scalar context that it returns a number half the size
-of the count of items it would have returned in list context).
+(Note, therefore, in scalar context that it returns a number half the size of
+the count of items it would have returned in list context).
@subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist
-Similar to C<grep>, C<pairgrep> aliases C<$a> and C<$b> to elements of the
-given list. Any modifications of it by the code block will be visible to
-the caller.
+As with C<grep> aliasing C<$_> to list elements, C<pairgrep> aliases C<$a> and
+C<$b> to elements of the given list. Any modifications of it by the code block
+will be visible to the caller.
-=head2 pairfirst BLOCK KVLIST
+=head2 ( $key, $val ) = pairfirst { BLOCK } @kvlist
+
+=head2 $found = pairfirst { BLOCK } @kvlist
Similar to the C<first> function, but interprets the given list as an
-even-sized list of pairs. It invokes the BLOCK multiple times, in scalar
+even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
context, with C<$a> and C<$b> set to successive pairs of values from the
-KVLIST.
+C<@kvlist>.
-Returns the first pair of values from the list for which the BLOCK returned
+Returns the first pair of values from the list for which the C<BLOCK> returned
true in list context, or an empty list of no such pair was found. In scalar
context it returns a simple boolean value, rather than either the key or the
value found.
( $key, $value ) = pairfirst { $a =~ m/^[[:upper:]]+$/ } @kvlist
-Similar to C<grep>, C<pairfirst> aliases C<$a> and C<$b> to elements of the
-given list. Any modifications of it by the code block will be visible to
-the caller.
+As with C<grep> aliasing C<$_> to list elements, C<pairfirst> aliases C<$a> and
+C<$b> to elements of the given list. Any modifications of it by the code block
+will be visible to the caller.
+
+=head2 @list = pairmap { BLOCK } @kvlist
-=head2 pairmap BLOCK KVLIST
+=head2 $count = pairmap { BLOCK } @kvlist
Similar to perl's C<map> keyword, but interprets the given list as an
-even-sized list of pairs. It invokes the BLOCK multiple times, in list
+even-sized list of pairs. It invokes the C<BLOCK> multiple times, in list
context, with C<$a> and C<$b> set to successive pairs of values from the
-KVLIST.
+C<@kvlist>.
-Returns the concatenation of all the values returned by the BLOCK in list
-context, or the count of the number of items that would have been returned
-in scalar context.
+Returns the concatenation of all the values returned by the C<BLOCK> in list
+context, or the count of the number of items that would have been returned in
+scalar context.
@result = pairmap { "The key $a has value $b" } @kvlist
-Similar to C<map>, C<pairmap> aliases C<$a> and C<$b> to elements of the
-given list. Any modifications of it by the code block will be visible to
-the caller.
+As with C<map> aliasing C<$_> to list elements, C<pairmap> aliases C<$a> and
+C<$b> to elements of the given list. Any modifications of it by the code block
+will be visible to the caller.
-=head2 pairs KVLIST
+=head2 @pairs = pairs @kvlist
-A convenient shortcut to operating on even-sized lists of pairs, this
-function returns a list of ARRAY references, each containing two items from
-the given list. It is a more efficient version of
+A convenient shortcut to operating on even-sized lists of pairs, this function
+returns a list of ARRAY references, each containing two items from the given
+list. It is a more efficient version of
- pairmap { [ $a, $b ] } KVLIST
+ @pairs = pairmap { [ $a, $b ] } @kvlist
It is most convenient to use in a C<foreach> loop, for example:
@@ -288,21 +292,21 @@
...
}
-=head2 pairkeys KVLIST
+=head2 @keys = pairkeys @kvlist
-A convenient shortcut to operating on even-sized lists of pairs, this
-function returns a list of the the first values of each of the pairs in
-the given list. It is a more efficient version of
+A convenient shortcut to operating on even-sized lists of pairs, this function
+returns a list of the the first values of each of the pairs in the given list.
+It is a more efficient version of
- pairmap { $a } KVLIST
+ @keys = pairmap { $a } @kvlist
-=head2 pairvalues KVLIST
+=head2 @values = pairvalues @kvlist
-A convenient shortcut to operating on even-sized lists of pairs, this
-function returns a list of the the second values of each of the pairs in
-the given list. It is a more efficient version of
+A convenient shortcut to operating on even-sized lists of pairs, this function
+returns a list of the the second values of each of the pairs in the given list.
+It is a more efficient version of
- pairmap { $b } KVLIST
+ @values = pairmap { $b } @kvlist
=cut
@@ -310,9 +314,9 @@
=cut
-=head2 shuffle LIST
+=head2 @values = shuffle @values
-Returns the elements of LIST in a random order
+Returns the values of the input in a random order
@cards = shuffle 0..51 # 0..51 in a random order
@@ -320,9 +324,8 @@
=head1 KNOWN BUGS
-With perl versions prior to 5.005 there are some cases where reduce
-will return an incorrect result. This will show up as test 7 of
-reduce.t failing.
+With perl versions prior to 5.005 there are some cases where reduce will return
+an incorrect result. This will show up as test 7 of reduce.t failing.
=head1 SUGGESTED ADDITIONS
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/lib/Scalar/Util.pm
new/Scalar-List-Utils-1.36/lib/Scalar/Util.pm
--- old/Scalar-List-Utils-1.35/lib/Scalar/Util.pm 2013-10-19
03:34:22.000000000 +0200
+++ new/Scalar-List-Utils-1.36/lib/Scalar/Util.pm 2014-01-16
16:39:47.000000000 +0100
@@ -1,5 +1,3 @@
-# Scalar::Util.pm
-#
# Copyright (c) 1997-2007 Graham Barr <[email protected]>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
@@ -14,21 +12,11 @@
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
- blessed
- dualvar
- isdual
- isvstring
- isweak
- looks_like_number
- openhandle
- readonly
- refaddr
- reftype
- set_prototype
- tainted
- weaken
+ blessed refaddr reftype weaken unweaken isweak
+
+ dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
tainted
);
-our $VERSION = "1.35";
+our $VERSION = "1.36";
$VERSION = eval $VERSION;
our @EXPORT_FAIL;
@@ -74,58 +62,158 @@
=head1 DESCRIPTION
-C<Scalar::Util> contains a selection of subroutines that people have
-expressed would be nice to have in the perl core, but the usage would
-not really be high enough to warrant the use of a keyword, and the size
-so small such that being individual extensions would be wasteful.
+C<Scalar::Util> contains a selection of subroutines that people have expressed
+would be nice to have in the perl core, but the usage would not really be high
+enough to warrant the use of a keyword, and the size so small such that being
+individual extensions would be wasteful.
+
+By default C<Scalar::Util> does not export any subroutines.
+
+=cut
-By default C<Scalar::Util> does not export any subroutines. The
-subroutines defined are
+=head1 FUNCTIONS FOR REFERENCES
-=head2 blessed EXPR
+The following functions all perform some useful activity on reference values.
-If EXPR evaluates to a blessed reference the name of the package
-that it is blessed into is returned. Otherwise C<undef> is returned.
+=head2 $pkg = blessed( $ref )
- $scalar = "foo";
- $class = blessed $scalar; # undef
+If C<$ref> is a blessed reference the name of the package that it is blessed
+into is returned. Otherwise C<undef> is returned.
- $ref = [];
- $class = blessed $ref; # undef
+ $scalar = "foo";
+ $class = blessed $scalar; # undef
- $obj = bless [], "Foo";
- $class = blessed $obj; # "Foo"
+ $ref = [];
+ $class = blessed $ref; # undef
+
+ $obj = bless [], "Foo";
+ $class = blessed $obj; # "Foo"
Take care when using this function simply as a truth test (such as in
-C<if(blessed $ref)...>) because the package name C<"0"> is defined yet
-false.
+C<if(blessed $ref)...>) because the package name C<"0"> is defined yet false.
+
+=head2 $addr = refaddr( $ref )
+
+If C<$ref> is reference the internal memory address of the referenced value is
+returned as a plain integer. Otherwise C<undef> is returned.
+
+ $addr = refaddr "string"; # undef
+ $addr = refaddr \$var; # eg 12345678
+ $addr = refaddr []; # eg 23456784
+
+ $obj = bless {}, "Foo";
+ $addr = refaddr $obj; # eg 88123488
+
+=head2 $type = reftype( $ref )
+
+If C<$ref> is a reference the basic Perl type of the variable referenced is
+returned as a plain string (such as C<ARRAY> or C<HASH>). Otherwise C<undef>
+is returned.
+
+ $type = reftype "string"; # undef
+ $type = reftype \$var; # SCALAR
+ $type = reftype []; # ARRAY
+
+ $obj = bless {}, "Foo";
+ $type = reftype $obj; # HASH
+
+=head2 weaken( REF )
+
+The lvalue C<REF> will be turned into a weak reference. This means that it
+will not hold a reference count on the object it references. Also when the
+reference count on that object reaches zero, the reference will be set to
+undef. This function mutates the lvalue passed as its argument and returns no
+value.
+
+This is useful for keeping copies of references, but you don't want to prevent
+the object being DESTROY-ed at its usual time.
+
+ {
+ my $var;
+ $ref = \$var;
+ weaken($ref); # Make $ref a weak reference
+ }
+ # $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;
-=head2 dualvar NUM, STRING
+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.
+
+=head2 unweaken( REF )
+
+The lvalue C<REF> will be turned from a weak reference back into a normal
+(strong) reference again. This function mutates the lvalue passed as its
+argument and returns no value. This undoes the action performed by
+C<weaken()>.
+
+This function is slightly neater and more convenient than the
+otherwise-equivalent code
-Returns a scalar that has the value NUM in a numeric context and the
-value STRING in a string context.
+ my $tmp = $REF;
+ undef $REF;
+ $REF = $tmp;
+
+(because in particular, simply assigning a weak reference back to itself does
+not work to unweaken it; C<$REF = $REF> does not work).
+
+=head2 $weak = isweak( $ref )
+
+Returns true if C<$ref> is a weak reference.
+
+ $ref = \$foo;
+ $weak = isweak($ref); # false
+ weaken($ref);
+ $weak = isweak($ref); # true
+
+B<NOTE>: Copying a weak reference creates a normal, strong, reference.
+
+ $copy = $ref;
+ $weak = isweak($copy); # false
+
+=head1 OTHER FUNCTIONS
+
+=head2 $var = dualvar( $num, $string )
+
+Returns a scalar that has the value C<$num> in a numeric context and the value
+C<$string> in a string context.
$foo = dualvar 10, "Hello";
$num = $foo + 2; # 12
$str = $foo . " world"; # Hello world
-=head2 isdual EXPR
+=head2 $dual = isdual( $var )
-If EXPR is a scalar that is a dualvar, the result is true.
+If C<$var> is a scalar that has both numeric and string values, the result is
+true.
$foo = dualvar 86, "Nix";
$dual = isdual($foo); # true
-Note that a scalar can be made to have both string and numeric content
-through numeric operations:
+Note that a scalar can be made to have both string and numeric content through
+numeric operations:
$foo = "10";
$dual = isdual($foo); # false
$bar = $foo + 0;
$dual = isdual($foo); # true
-Note that although C<$!> appears to be dual-valued variable, it is
-actually implemented using a tied scalar:
+Note that although C<$!> appears to be dual-valued variable, it is actually
+implemented using a tied scalar:
$! = 1;
print("$!\n"); # "Operation not permitted"
@@ -136,125 +224,52 @@
$err = dualvar $!, $!;
$dual = isdual($err); # true
-=head2 isvstring EXPR
+=head2 $vstring = isvstring( $var )
-If EXPR is a scalar which was coded as a vstring the result is true.
+If C<$var> is a scalar which was coded as a vstring the result is true.
$vs = v49.46.48;
$fmt = isvstring($vs) ? "%vd" : "%s"; #true
printf($fmt,$vs);
-=head2 looks_like_number EXPR
+=head2 $isnum = looks_like_number( $var )
-Returns true if perl thinks EXPR is a number. See
+Returns true if perl thinks C<$var> is a number. See
L<perlapi/looks_like_number>.
-=head2 openhandle FH
+=head2 $fh = openhandle( $fh )
-Returns FH if FH may be used as a filehandle and is open, or FH is a tied
-handle. Otherwise C<undef> is returned.
+Returns C<$fh> itself if C<$fh> may be used as a filehandle and is open, or is
+is a tied handle. Otherwise C<undef> is returned.
$fh = openhandle(*STDIN); # \*STDIN
$fh = openhandle(\*STDIN); # \*STDIN
$fh = openhandle(*NOTOPEN); # undef
$fh = openhandle("scalar"); # undef
-=head2 readonly SCALAR
+=head2 $ro = readonly( $var )
-Returns true if SCALAR is readonly.
+Returns true if C<$var> is readonly.
sub foo { readonly($_[0]) }
$readonly = foo($bar); # false
$readonly = foo(0); # true
-=head2 refaddr EXPR
-
-If EXPR evaluates to a reference the internal memory address of
-the referenced value is returned. Otherwise C<undef> is returned.
-
- $addr = refaddr "string"; # undef
- $addr = refaddr \$var; # eg 12345678
- $addr = refaddr []; # eg 23456784
-
- $obj = bless {}, "Foo";
- $addr = refaddr $obj; # eg 88123488
-
-=head2 reftype EXPR
-
-If EXPR evaluates to a reference the type of the variable referenced
-is returned. Otherwise C<undef> is returned.
+=head2 $code = set_prototype( $code, $prototype )
- $type = reftype "string"; # undef
- $type = reftype \$var; # SCALAR
- $type = reftype []; # ARRAY
-
- $obj = bless {}, "Foo";
- $type = reftype $obj; # HASH
-
-=head2 set_prototype CODEREF, PROTOTYPE
-
-Sets the prototype of the given function, or deletes it if PROTOTYPE is
-undef. Returns the CODEREF.
+Sets the prototype of the function given by the C<$code> reference, or deletes
+it if C<$prototype> is C<undef>. Returns the C<$code> reference itself.
set_prototype \&foo, '$$';
-=head2 tainted EXPR
+=head2 $t = tainted( $var )
-Return true if the result of EXPR is tainted
+Return true if C<$var> is tainted.
$taint = tainted("constant"); # false
$taint = tainted($ENV{PWD}); # true if running under -T
-=head2 weaken REF
-
-REF will be turned into a weak reference. This means that it will not
-hold a reference count on the object it references. Also when the reference
-count on that object reaches zero, REF will be set to undef.
-
-This is useful for keeping copies of references , but you don't want to
-prevent the object being DESTROY-ed at its usual time.
-
- {
- my $var;
- $ref = \$var;
- weaken($ref); # Make $ref a weak reference
- }
- # $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.
-
-=head2 isweak EXPR
-
-If EXPR is a scalar which is a weak reference the result is true.
-
- $ref = \$foo;
- $weak = isweak($ref); # false
- weaken($ref);
- $weak = isweak($ref); # true
-
-B<NOTE>: Copying a weak reference creates a normal, strong, reference.
-
- $copy = $ref;
- $weak = isweak($copy); # false
-
=head1 DIAGNOSTICS
Module use may give one of the following errors during import.
@@ -263,8 +278,8 @@
=item Weak references are not implemented in the version of perl
-The version of perl that you are using does not implement weak references, to
use
-C<isweak> or C<weaken> you will need to use a newer release of perl.
+The version of perl that you are using does not implement weak references, to
+use C<isweak> or C<weaken> you will need to use a newer release of perl.
=item Vstrings are not implemented in the version of perl
@@ -273,9 +288,10 @@
=item C<NAME> is only available with the XS version of Scalar::Util
-C<Scalar::Util> contains both perl and C implementations of many of its
functions
-so that those without access to a C compiler may still use it. However some of
the functions
-are only available when a C compiler was available to compile the XS version
of the extension.
+C<Scalar::Util> contains both perl and C implementations of many of its
+functions so that those without access to a C compiler may still use it.
+However some of the functions are only available when a C compiler was
+available to compile the XS version of the extension.
At present that list is: weaken, isweak, dualvar, isvstring, set_prototype
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/t/max.t
new/Scalar-List-Utils-1.36/t/max.t
--- old/Scalar-List-Utils-1.35/t/max.t 2013-10-19 03:34:22.000000000 +0200
+++ new/Scalar-List-Utils-1.36/t/max.t 2014-01-16 16:39:47.000000000 +0100
@@ -50,7 +50,7 @@
use overload
'""' => sub { ${$_[0]} },
- '+0' => sub { ${$_[0]} },
+ '0+' => sub { ${$_[0]} },
'>' => sub { ${$_[0]} > ${$_[1]} },
fallback => 1;
sub new {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/t/min.t
new/Scalar-List-Utils-1.36/t/min.t
--- old/Scalar-List-Utils-1.35/t/min.t 2013-10-19 03:34:22.000000000 +0200
+++ new/Scalar-List-Utils-1.36/t/min.t 2014-01-16 16:39:47.000000000 +0100
@@ -49,7 +49,7 @@
use overload
'""' => sub { ${$_[0]} },
- '+0' => sub { ${$_[0]} },
+ '0+' => sub { ${$_[0]} },
'<' => sub { ${$_[0]} < ${$_[1]} },
fallback => 1;
sub new {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/t/product.t
new/Scalar-List-Utils-1.36/t/product.t
--- old/Scalar-List-Utils-1.35/t/product.t 2013-10-19 03:34:22.000000000
+0200
+++ new/Scalar-List-Utils-1.36/t/product.t 2014-01-16 16:39:47.000000000
+0100
@@ -49,7 +49,7 @@
use overload
'""' => sub { ${$_[0]} },
- '+0' => sub { ${$_[0]} },
+ '0+' => sub { ${$_[0]} },
fallback => 1;
sub new {
my $class = shift;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/t/refaddr.t
new/Scalar-List-Utils-1.36/t/refaddr.t
--- old/Scalar-List-Utils-1.35/t/refaddr.t 2013-10-19 03:34:22.000000000
+0200
+++ new/Scalar-List-Utils-1.36/t/refaddr.t 2014-01-16 16:39:47.000000000
+0100
@@ -73,7 +73,7 @@
use overload '0+' => sub { 10 },
'+' => sub { 10 + $_[1] },
- '"' => sub { "10" };
+ '""' => sub { "10" };
package MyTie;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/t/sum.t
new/Scalar-List-Utils-1.36/t/sum.t
--- old/Scalar-List-Utils-1.35/t/sum.t 2013-10-19 03:34:22.000000000 +0200
+++ new/Scalar-List-Utils-1.36/t/sum.t 2014-01-16 16:39:47.000000000 +0100
@@ -49,7 +49,7 @@
use overload
'""' => sub { ${$_[0]} },
- '+0' => sub { ${$_[0]} },
+ '0+' => sub { ${$_[0]} },
fallback => 1;
sub new {
my $class = shift;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.35/t/weak.t
new/Scalar-List-Utils-1.36/t/weak.t
--- old/Scalar-List-Utils-1.35/t/weak.t 2013-10-19 03:34:22.000000000 +0200
+++ new/Scalar-List-Utils-1.36/t/weak.t 2014-01-16 16:39:47.000000000 +0100
@@ -17,192 +17,163 @@
use Scalar::Util ();
use Test::More ((grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) and
!$ENV{PERL_CORE})
? (skip_all => 'weaken requires XS version')
- : (tests => 22);
+ : (tests => 27);
-if (0) {
- require Devel::Peek;
- Devel::Peek->import('Dump');
-}
-else {
- *Dump = sub {};
-}
-
-Scalar::Util->import(qw(weaken isweak));
-
-if(1) {
-
-my ($y,$z);
-
-#
-# Case 1: two references, one is weakened, the other is then undef'ed.
-#
+Scalar::Util->import(qw(weaken unweaken isweak));
+# two references, one is weakened, the other is then undef'ed.
{
- my $x = "foo";
- $y = \$x;
- $z = \$x;
-}
-print "# START\n";
-Dump($y); Dump($z);
-
-ok( ref($y) and ref($z));
+ my ($y,$z);
-print "# WEAK:\n";
-weaken($y);
-Dump($y); Dump($z);
+ {
+ my $x = "foo";
+ $y = \$x;
+ $z = \$x;
+ }
-ok( ref($y) and ref($z));
+ ok(ref($y) and ref($z));
-print "# UNDZ:\n";
-undef($z);
-Dump($y); Dump($z);
+ weaken($y);
+ ok(ref($y) and ref($z));
-ok( not (defined($y) and defined($z)) );
+ undef($z);
+ ok(not(defined($y) and defined($z)));
-print "# UNDY:\n";
-undef($y);
-Dump($y); Dump($z);
+ undef($y);
+ ok(not(defined($y) and defined($z)));
+}
-ok( not (defined($y) and defined($z)) );
+# one reference, which is weakened
+{
+ my $y;
-print "# FIN:\n";
-Dump($y); Dump($z);
+ {
+ my $x = "foo";
+ $y = \$x;
+ }
+ ok(ref($y));
-#
-# Case 2: one reference, which is weakened
-#
+ weaken($y);
+ ok(not defined $y);
+}
-print "# CASE 2:\n";
+my $flag;
+# a circular structure
{
- my $x = "foo";
- $y = \$x;
-}
+ $flag = 0;
-ok( ref($y) );
-print "# BW: \n";
-Dump($y);
-weaken($y);
-print "# AW: \n";
-Dump($y);
-ok( not defined $y );
+ {
+ my $y = bless {}, 'Dest';
+ $y->{Self} = $y;
+ $y->{Flag} = \$flag;
-print "# EXITBLOCK\n";
-}
-
-#
-# Case 3: a circular structure
-#
+ weaken($y->{Self});
+ ok( ref($y) );
+ }
-my $flag = 0;
-{
- my $y = bless {}, 'Dest';
- Dump($y);
- print "# 1: $y\n";
- $y->{Self} = $y;
- Dump($y);
- print "# 2: $y\n";
- $y->{Flag} = \$flag;
- print "# 3: $y\n";
- weaken($y->{Self});
- print "# WKED\n";
- ok( ref($y) );
- print "# VALS: HASH ",$y," SELF ",\$y->{Self}," Y ",\$y,
- " FLAG: ",\$y->{Flag},"\n";
- print "# VPRINT\n";
+ ok( $flag == 1 );
+ undef $flag;
}
-print "# OUT $flag\n";
-ok( $flag == 1 );
-print "# AFTER\n";
+# a more complicated circular structure
+{
+ $flag = 0;
-undef $flag;
+ {
+ my $y = bless {}, 'Dest';
+ my $x = bless {}, 'Dest';
+ $x->{Ref} = $y;
+ $y->{Ref} = $x;
+ $x->{Flag} = \$flag;
+ $y->{Flag} = \$flag;
+
+ weaken($x->{Ref});
+ }
+ ok( $flag == 2 );
+}
-print "# FLAGU\n";
+# deleting a weakref before the other one
+{
+ my ($y,$z);
+ {
+ my $x = "foo";
+ $y = \$x;
+ $z = \$x;
+ }
-#
-# Case 4: a more complicated circular structure
-#
+ weaken($y);
+ undef($y);
-$flag = 0;
-{
- my $y = bless {}, 'Dest';
- my $x = bless {}, 'Dest';
- $x->{Ref} = $y;
- $y->{Ref} = $x;
- $x->{Flag} = \$flag;
- $y->{Flag} = \$flag;
- weaken($x->{Ref});
+ ok(not defined $y);
+ ok(ref($z) );
}
-ok( $flag == 2 );
-
-#
-# Case 5: deleting a weakref before the other one
-#
-my ($y,$z);
+# isweakref
{
- my $x = "foo";
- $y = \$x;
- $z = \$x;
+ $a = 5;
+ ok(!isweak($a));
+ $b = \$a;
+ ok(!isweak($b));
+ weaken($b);
+ ok(isweak($b));
+ $b = \$a;
+ ok(!isweak($b));
+
+ my $x = {};
+ weaken($x->{Y} = \$a);
+ ok(isweak($x->{Y}));
+ ok(!isweak($x->{Z}));
}
-print "# CASE5\n";
-Dump($y);
+# unweaken
+{
+ my ($y,$z);
+ {
+ my $x = "foo";
+ $y = \$x;
+ $z = \$x;
+ }
-weaken($y);
-Dump($y);
-undef($y);
+ weaken($y);
-ok( not defined $y);
-ok( ref($z) );
+ ok(isweak($y), '$y is weak after weaken()');
+ is($$y, "foo", '$y points at \"foo" after weaken()');
+ unweaken($y);
-#
-# Case 6: test isweakref
-#
+ ok(!isweak($y), '$y is not weak after unweaken()');
+ is($$y, "foo", '$y points at \"foo" after unweaken()');
-$a = 5;
-ok(!isweak($a));
-$b = \$a;
-ok(!isweak($b));
-weaken($b);
-ok(isweak($b));
-$b = \$a;
-ok(!isweak($b));
+ undef $z;
+ ok(defined $y, '$y still defined after undef $z');
+}
-my $x = {};
-weaken($x->{Y} = \$a);
-ok(isweak($x->{Y}));
-ok(!isweak($x->{Z}));
+# test weaken on a read only ref
+SKIP: {
+ # Doesn't work for older perls, see bug [perl #24506]
+ skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003;
-#
-# Case 7: test weaken on a read only ref
-#
+ # in a MAD build, constants have refcnt 2, not 1
+ skip("Test does not work with MAD", 5) if exists $Config{mad};
-SKIP: {
- # Doesn't work for older perls, see bug [perl #24506]
- 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";
- # in a MAD build, constants have refcnt 2, not 1
- skip("Test does not work with MAD", 5) if exists $Config{mad};
+ $b = $a;
+ eval { weaken($b) };
+ # we didn't die
+ is($@, "");
+ ok(isweak($b));
+ is($$b, "hello");
- $a = eval '\"hello"';
- ok(ref($a)) or print "# didn't get a ref from eval\n";
- $b = $a;
- eval{weaken($b)};
- # we didn't die
- ok($@ eq "") or print "# died with $@\n";
- ok(isweak($b));
- ok($$b eq "hello") or print "# b is '$$b'\n";
- $a="";
- ok(not $b) or print "# b didn't go away\n";
+ $a="";
+ ok(not $b) or diag("b did not go away");
}
package Dest;
sub DESTROY {
- print "# INCFLAG\n";
- ${$_[0]{Flag}} ++;
+ ${$_[0]{Flag}} ++;
}
--
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
