Hello community,
here is the log from the commit of package perl-Variable-Magic for openSUSE:Factory checked in at 2012-03-01 17:25:23
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Variable-Magic (Old)
and /work/SRC/openSUSE:Factory/.perl-Variable-Magic.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Variable-Magic", Maintainer is ""
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Variable-Magic/perl-Variable-Magic.changes 2011-12-21 10:02:55.000000000 +0100
+++ /work/SRC/openSUSE:Factory/.perl-Variable-Magic.new/perl-Variable-Magic.changes 2012-03-01 17:25:27.000000000 +0100
@@ -1,0 +2,8 @@
+Sat Feb 25 06:32:19 UTC 2012 - coolo@suse.com
+
+- updated to 0.48
+ + Add : You can now pass a reference to undef as the magic callback in
+ order to install a no-op callback.
+ Thanks Florian Ragwitz for the suggestion.
+
+-------------------------------------------------------------------
Old:
----
Variable-Magic-0.47.tar.gz
New:
----
Variable-Magic-0.48.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Variable-Magic.spec ++++++
--- /var/tmp/diff_new_pack.GUVjI3/_old 2012-03-01 17:25:28.000000000 +0100
+++ /var/tmp/diff_new_pack.GUVjI3/_new 2012-03-01 17:25:28.000000000 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Variable-Magic
#
-# Copyright (c) 2011 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2012 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
@@ -16,28 +16,26 @@
#
-%bcond_with test
-
Name: perl-Variable-Magic
+Version: 0.48
+Release: 0
%define cpan_name Variable-Magic
Summary: Associate user-defined magic to variables from Perl
-License: GPL-1.0+ or Artistic-1.0
+License: Artistic-1.0 or GPL-1.0+
Group: Development/Libraries/Perl
-Version: 0.47
-Release: 0
Url: http://search.cpan.org/dist/Variable-Magic/
-Source: http://search.cpan.org/CPAN/authors/id/V/VP/VPIT/%{cpan_name}-%{version}.tar.gz
+Source: http://www.cpan.org/authors/id/V/VP/VPIT/%{cpan_name}-%{version}.tar.gz
BuildRoot: %{_tmppath}/%{name}-%{version}-build
-%{perl_requires}
BuildRequires: perl
BuildRequires: perl-macros
-# for testsuite
-%if %{with test}
-BuildRequires: perl(Test::Pod) >= 1.14
-BuildRequires: perl(Test::Pod::Coverage) >= 1.04
-#BuildRequires: perl(Test::Portability::Files)
+#BuildRequires: perl(ActivePerl)
+#BuildRequires: perl(Hash::Util::FieldHash)
#BuildRequires: perl(Test::Kwalitee)
-%endif
+#BuildRequires: perl(Variable::Magic)
+#BuildRequires: perl(Variable::Magic::TestThreads)
+#BuildRequires: perl(Variable::Magic::TestValue)
+#BuildRequires: perl(Variable::Magic::TestWatcher)
+%{perl_requires}
%description
Magic is Perl's way of enhancing variables. This mechanism lets the user
@@ -46,16 +44,18 @@
module, you can add your own magic to any variable without having to write
a single line of XS.
-
-Authors:
---------
- Vincent Pit
+You'll realize that these magic variables look a lot like tied variables.
+It's not surprising, as tied variables are implemented as a special kind of
+magic, just like any 'irregular' Perl variable : scalars like '$!', '$(' or
+'$^W', the '%ENV' and '%SIG' hashes, the '@ISA' array, 'vec()' and
+'substr()' lvalues, the threads::shared manpage variables... They all share
+the same underlying C API, and this module gives you direct access to it.
%prep
%setup -q -n %{cpan_name}-%{version}
%build
-%{__perl} Makefile.PL INSTALLDIRS=vendor OPTIMIZE="$RPM_OPT_FLAGS -Wall"
+%{__perl} Makefile.PL INSTALLDIRS=vendor OPTIMIZE="%{optflags}"
%{__make} %{?_smp_mflags}
%check
@@ -66,11 +66,8 @@
%perl_process_packlist
%perl_gen_filelist
-%clean
-%{__rm} -rf $RPM_BUILD_ROOT
-
%files -f %{name}.files
-%defattr(-,root,root,-)
+%defattr(-,root,root,755)
%doc Changes README
%changelog
++++++ Variable-Magic-0.47.tar.gz -> Variable-Magic-0.48.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/Changes new/Variable-Magic-0.48/Changes
--- old/Variable-Magic-0.47/Changes 2011-10-27 18:38:36.000000000 +0200
+++ new/Variable-Magic-0.48/Changes 2012-02-18 00:30:16.000000000 +0100
@@ -1,5 +1,10 @@
Revision history for Variable-Magic
+0.48 2012-02-17 23:40 UTC
+ + Add : You can now pass a reference to undef as the magic callback in
+ order to install a no-op callback.
+ Thanks Florian Ragwitz for the suggestion.
+
0.47 2011-10-27 16:55 UTC
+ Add : The new constant VMG_COMPAT_HASH_DELETE_NOUVAR_VOID evaluates
to true when "delete $hash{key}" does not call 'delete' uvar
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/META.json new/Variable-Magic-0.48/META.json
--- old/Variable-Magic-0.47/META.json 2011-10-27 18:39:32.000000000 +0200
+++ new/Variable-Magic-0.48/META.json 2012-02-18 00:31:41.000000000 +0100
@@ -4,7 +4,7 @@
"Vincent Pit "
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.59, CPAN::Meta::Converter version 2.112621",
+ "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120351",
"license" : [
"perl_5"
],
@@ -22,27 +22,27 @@
"prereqs" : {
"build" : {
"requires" : {
- "Carp" : 0,
- "Config" : 0,
- "Exporter" : 0,
- "ExtUtils::MakeMaker" : 0,
- "Test::More" : 0,
- "XSLoader" : 0,
- "base" : 0
+ "Carp" : "0",
+ "Config" : "0",
+ "Exporter" : "0",
+ "ExtUtils::MakeMaker" : "0",
+ "Test::More" : "0",
+ "XSLoader" : "0",
+ "base" : "0"
}
},
"configure" : {
"requires" : {
- "Config" : 0,
- "ExtUtils::MakeMaker" : 0
+ "Config" : "0",
+ "ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
- "Carp" : 0,
- "Exporter" : 0,
- "XSLoader" : 0,
- "base" : 0,
+ "Carp" : "0",
+ "Exporter" : "0",
+ "XSLoader" : "0",
+ "base" : "0",
"perl" : "5.008"
}
}
@@ -60,5 +60,5 @@
"url" : "http://git.profvince.com/?p=perl%2Fmodules%2FVariable-Magic.git"
}
},
- "version" : "0.47"
+ "version" : "0.48"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/META.yml new/Variable-Magic-0.48/META.yml
--- old/Variable-Magic-0.47/META.yml 2011-10-27 18:39:32.000000000 +0200
+++ new/Variable-Magic-0.48/META.yml 2012-02-18 00:31:40.000000000 +0100
@@ -14,7 +14,7 @@
Config: 0
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.59, CPAN::Meta::Converter version 2.112621'
+generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120351'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -35,4 +35,4 @@
homepage: http://search.cpan.org/dist/Variable-Magic/
license: http://dev.perl.org/licenses/
repository: http://git.profvince.com/?p=perl%2Fmodules%2FVariable-Magic.git
-version: 0.47
+version: 0.48
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/Magic.xs new/Variable-Magic-0.48/Magic.xs
--- old/Variable-Magic-0.47/Magic.xs 2011-10-26 23:56:46.000000000 +0200
+++ new/Variable-Magic-0.48/Magic.xs 2012-02-17 19:46:19.000000000 +0100
@@ -435,9 +435,7 @@
#define vmg_vtable_vtbl(T) (T)->vtbl
-#if VMG_THREADSAFE
STATIC perl_mutex vmg_vtable_refcount_mutex;
-#endif
STATIC vmg_vtable *vmg_vtable_dup(pTHX_ vmg_vtable *t) {
#define vmg_vtable_dup(T) vmg_vtable_dup(aTHX_ (T))
@@ -1016,7 +1014,7 @@
return &PL_sv_undef;
}
-/* ... svt callbacks ....................................................... */
+/* --- svt callbacks ------------------------------------------------------- */
#define VMG_CB_CALL_ARGS_MASK 15
#define VMG_CB_CALL_ARGS_SHIFT 4
@@ -1074,18 +1072,44 @@
#define vmg_cb_call3(I, OI, S, A1, A2, A3) \
vmg_cb_call(aTHX_ (I), VMG_CB_FLAGS((OI), 3), (S), (A1), (A2), (A3))
+STATIC int vmg_svt_default_noop(pTHX_ SV *sv, MAGIC *mg) {
+ return 0;
+}
+
+/* ... get magic ........................................................... */
+
STATIC int vmg_svt_get(pTHX_ SV *sv, MAGIC *mg) {
const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
return vmg_cb_call1(w->cb_get, w->opinfo, sv, mg->mg_obj);
}
+#define vmg_svt_get_noop vmg_svt_default_noop
+
+/* ... set magic ........................................................... */
+
STATIC int vmg_svt_set(pTHX_ SV *sv, MAGIC *mg) {
const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
return vmg_cb_call1(w->cb_set, w->opinfo, sv, mg->mg_obj);
}
+#define vmg_svt_set_noop vmg_svt_default_noop
+
+/* ... len magic ........................................................... */
+
+STATIC U32 vmg_sv_len(pTHX_ SV *sv) {
+#define vmg_sv_len(S) vmg_sv_len(aTHX_ (S))
+ STRLEN len;
+#if VMG_HAS_PERL(5, 9, 3)
+ const U8 *s = VOID2(const U8 *, VOID2(const void *, SvPV_const(sv, len)));
+#else
+ U8 *s = SvPV(sv, len);
+#endif
+
+ return DO_UTF8(sv) ? utf8_length(s, s + len) : len;
+}
+
STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
unsigned int opinfo = w->opinfo;
@@ -1103,16 +1127,7 @@
PUSHs(sv_2mortal(newRV_inc(sv)));
PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
if (t < SVt_PVAV) {
- STRLEN l;
-#if VMG_HAS_PERL(5, 9, 3)
- const U8 *s = VOID2(const U8 *, VOID2(const void *, SvPV_const(sv, l)));
-#else
- U8 *s = SvPV(sv, l);
-#endif
- if (DO_UTF8(sv))
- len = utf8_length(s, s + l);
- else
- len = l;
+ len = vmg_sv_len(sv);
mPUSHu(len);
} else if (t == SVt_PVAV) {
len = av_len((AV *) sv) + 1;
@@ -1140,12 +1155,31 @@
return ret;
}
+STATIC U32 vmg_svt_len_noop(pTHX_ SV *sv, MAGIC *mg) {
+ U32 len = 0;
+ svtype t = SvTYPE(sv);
+
+ if (t < SVt_PVAV) {
+ len = vmg_sv_len(sv);
+ } else if (t == SVt_PVAV) {
+ len = (U32) av_len((AV *) sv);
+ }
+
+ return len;
+}
+
+/* ... clear magic ......................................................... */
+
STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
return vmg_cb_call1(w->cb_clear, w->opinfo, sv, mg->mg_obj);
}
+#define vmg_svt_clear_noop vmg_svt_default_noop
+
+/* ... free magic .......................................................... */
+
STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
const vmg_wizard *w;
int ret = 0;
@@ -1201,12 +1235,16 @@
return ret;
}
+#define vmg_svt_free_noop vmg_svt_default_noop
+
#if VMG_HAS_PERL_MAINT(5, 11, 0, 33256) || VMG_HAS_PERL(5, 12, 0)
# define VMG_SVT_COPY_KEYLEN_TYPE I32
#else
# define VMG_SVT_COPY_KEYLEN_TYPE int
#endif
+/* ... copy magic .......................................................... */
+
STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_SVT_COPY_KEYLEN_TYPE keylen) {
const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
SV *keysv;
@@ -1227,20 +1265,35 @@
return ret;
}
+STATIC int vmg_svt_copy_noop(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_SVT_COPY_KEYLEN_TYPE keylen) {
+ return 0;
+}
+
+/* ... dup magic ........................................................... */
+
#if 0
STATIC int vmg_svt_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) {
return 0;
}
+#define vmg_svt_dup_noop vmg_svt_dup
#endif
+/* ... local magic ......................................................... */
+
#if MGf_LOCAL
+
STATIC int vmg_svt_local(pTHX_ SV *nsv, MAGIC *mg) {
const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
return vmg_cb_call1(w->cb_local, w->opinfo, nsv, mg->mg_obj);
}
+
+#define vmg_svt_local_noop vmg_svt_default_noop
+
#endif /* MGf_LOCAL */
+/* ... uvar magic .......................................................... */
+
#if VMG_UVAR
STATIC OP *vmg_pp_resetuvar(pTHX) {
SvRMAGICAL_on(cSVOP_sv);
@@ -1336,19 +1389,46 @@
/* --- Macros for the XS section ------------------------------------------- */
-#define VMG_SET_CB(S, N) \
- cb = (S); \
- w->cb_ ## N = (SvOK(cb) && SvROK(cb)) ? SvREFCNT_inc(SvRV(cb)) : NULL;
-
-#define VMG_SET_SVT_CB(S, N) \
- cb = (S); \
- if (SvOK(cb) && SvROK(cb)) { \
- t->svt_ ## N = vmg_svt_ ## N; \
- w->cb_ ## N = SvREFCNT_inc(SvRV(cb)); \
- } else { \
- t->svt_ ## N = NULL; \
- w->cb_ ## N = NULL; \
- }
+#ifdef CvISXSUB
+# define VMG_CVOK(C) \
+ ((CvISXSUB(C) ? (void *) CvXSUB(C) : (void *) CvROOT(C)) ? 1 : 0)
+#else
+# define VMG_CVOK(C) (CvROOT(C) || CvXSUB(C))
+#endif
+
+#define VMG_CBOK(S) ((SvTYPE(S) == SVt_PVCV) ? VMG_CVOK(S) : SvOK(S))
+
+#define VMG_SET_CB(S, N) { \
+ SV *cb = (S); \
+ if (SvOK(cb) && SvROK(cb)) { \
+ cb = SvRV(cb); \
+ if (VMG_CBOK(cb)) \
+ SvREFCNT_inc_simple_void(cb); \
+ else \
+ cb = NULL; \
+ } else { \
+ cb = NULL; \
+ } \
+ w->cb_ ## N = cb; \
+}
+
+#define VMG_SET_SVT_CB(S, N) { \
+ SV *cb = (S); \
+ if (SvOK(cb) && SvROK(cb)) { \
+ cb = SvRV(cb); \
+ if (VMG_CBOK(cb)) { \
+ t->svt_ ## N = vmg_svt_ ## N; \
+ SvREFCNT_inc_simple_void(cb); \
+ } else { \
+ t->svt_ ## N = vmg_svt_ ## N ## _noop; \
+ cb = NULL; \
+ } \
+ } else { \
+ t->svt_ ## N = NULL; \
+ cb = NULL; \
+ } \
+ w->cb_ ## N = cb; \
+}
/* --- XS ------------------------------------------------------------------ */
@@ -1424,7 +1504,7 @@
PREINIT:
vmg_wizard *w;
MGVTBL *t;
- SV *cb, *op_info, *copy_key;
+ SV *op_info, *copy_key;
I32 i = 0;
CODE:
if (items != 9
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/README new/Variable-Magic-0.48/README
--- old/Variable-Magic-0.47/README 2011-10-27 18:39:32.000000000 +0200
+++ new/Variable-Magic-0.48/README 2012-02-18 00:31:41.000000000 +0100
@@ -2,7 +2,7 @@
Variable::Magic - Associate user-defined magic to variables from Perl.
VERSION
- Version 0.47
+ Version 0.48
SYNOPSIS
use Variable::Magic qw<wizard cast VMG_OP_INFO_NAME>;
@@ -234,8 +234,19 @@
straight to the perl magic API. However, only the return value of
the "len" callback currently holds a meaning.
- Each callback can be specified as a code or a string reference, in which
- case the function denoted by the string will be used as the callback.
+ Each callback can be specified as :
+
+ * a code reference, which will be called as a subroutine.
+
+ * a string reference, where the string denotes which subroutine is to
+ be called when magic is triggered. If the subroutine name is not
+ fully qualified, then the current package at the time the magic is
+ invoked will be used instead.
+
+ * a reference to "undef", in which case a no-op magic callback is
+ installed instead of the default one. This may especially be helpful
+ for 'local' magic, where an empty callback prevents magic from being
+ copied during localization.
Note that "free" callbacks are *never* called during global destruction,
as there's no way to ensure that the wizard and the "free" callback
@@ -550,7 +561,8 @@
http://www.profvince.com/perl/cover/Variable-Magic.
COPYRIGHT & LICENSE
- Copyright 2007,2008,2009,2010,2011 Vincent Pit, all rights reserved.
+ Copyright 2007,2008,2009,2010,2011,2012 Vincent Pit, all rights
+ reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/lib/Variable/Magic.pm new/Variable-Magic-0.48/lib/Variable/Magic.pm
--- old/Variable-Magic-0.47/lib/Variable/Magic.pm 2011-10-27 18:38:40.000000000 +0200
+++ new/Variable-Magic-0.48/lib/Variable/Magic.pm 2012-02-18 00:30:23.000000000 +0100
@@ -11,13 +11,13 @@
=head1 VERSION
-Version 0.47
+Version 0.48
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.47';
+ $VERSION = '0.48';
}
=head1 SYNOPSIS
@@ -285,7 +285,25 @@
=back
-Each callback can be specified as a code or a string reference, in which case the function denoted by the string will be used as the callback.
+Each callback can be specified as :
+
+=over 4
+
+=item *
+
+a code reference, which will be called as a subroutine.
+
+=item *
+
+a string reference, where the string denotes which subroutine is to be called when magic is triggered.
+If the subroutine name is not fully qualified, then the current package at the time the magic is invoked will be used instead.
+
+=item *
+
+a reference to C<undef>, in which case a no-op magic callback is installed instead of the default one.
+This may especially be helpful for 'local' magic, where an empty callback prevents magic from being copied during localization.
+
+=back
Note that C<free> callbacks are I<never> called during global destruction, as there's no way to ensure that the wizard and the C<free> callback weren't destroyed before the variable.
@@ -657,7 +675,7 @@
=head1 COPYRIGHT & LICENSE
-Copyright 2007,2008,2009,2010,2011 Vincent Pit, all rights reserved.
+Copyright 2007,2008,2009,2010,2011,2012 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/t/14-callbacks.t new/Variable-Magic-0.48/t/14-callbacks.t
--- old/Variable-Magic-0.47/t/14-callbacks.t 2011-09-04 17:19:53.000000000 +0200
+++ new/Variable-Magic-0.48/t/14-callbacks.t 2012-02-16 23:01:30.000000000 +0100
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More tests => 26;
use Variable::Magic qw<wizard cast>;
@@ -31,18 +31,53 @@
my $c = 0;
sub X::wat { ++$c }
my $wiz = eval { wizard get => \'X::wat' };
- is($@, '', 'wizard with a string callback doesn\'t croak');
+ is($@, '', 'wizard with a qualified string callback doesn\'t croak');
my $b = $n;
my $res = eval { cast $b, $wiz };
- is($@, '', 'cast a wizard with a string callback doesn\'t croak');
+ is($@, '', 'cast a wizard with a qualified string callback doesn\'t croak');
my $x;
eval {
local $SIG{__WARN__} = sub { die };
$x = $b;
};
- is($@, '', 'string callback doesn\'t warn/croak');
- is($c, 1, 'string callback is called');
- is($x, $n, 'string callback returns the right thing');
+ is($@, '', 'qualified string callback doesn\'t warn/croak');
+ is($c, 1, 'qualified string callback is called');
+ is($x, $n, 'qualified string callback returns the right thing');
+}
+
+{
+ my $c = 0;
+ sub wut { fail 'main::wut was called' }
+ sub Y::wut { ++$c }
+ my $wiz = eval { wizard get => \'wut' };
+ is($@, '', 'wizard with a short string callback doesn\'t croak');
+ my $b = $n;
+ my $res = eval { cast $b, $wiz };
+ is($@, '', 'cast a wizard with a short string callback doesn\'t croak');
+ my $x;
+ eval {
+ local $SIG{__WARN__} = sub { die };
+ package Y;
+ $x = $b;
+ };
+ is($@, '', 'short string callback doesn\'t warn/croak');
+ is($c, 1, 'short string callback is called');
+ is($x, $n, 'short string callback returns the right thing');
+}
+
+{
+ my $wiz = eval { wizard get => \undef };
+ is($@, '', 'wizard with a ref-to-undef callback doesn\'t croak');
+ my $b = $n;
+ my $res = eval { cast $b, $wiz };
+ is($@, '', 'cast a wizard with a ref-to-undef callback doesn\'t croak');
+ my $x;
+ eval {
+ local $SIG{__WARN__} = sub { die };
+ $x = $b;
+ };
+ is($@, '', 'ref-to-undef callback doesn\'t warn/croak');
+ is($x, $n, 'ref-to-undef callback returns the right thing');
}
my @callers;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/t/22-len.t new/Variable-Magic-0.48/t/22-len.t
--- old/Variable-Magic-0.47/t/22-len.t 2011-09-04 17:19:53.000000000 +0200
+++ new/Variable-Magic-0.48/t/22-len.t 2012-02-17 19:09:07.000000000 +0100
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 39 + (2 * 2 + 1);
+use Test::More tests => 39 + (2 * 2 + 1) + (5 + 2 * 3);
use Variable::Magic qw<wizard cast dispell VMG_COMPAT_SCALAR_LENGTH_NOLEN>;
@@ -70,8 +70,8 @@
$c = 0;
$n = 1 + int rand 1000;
# length magic on scalars needs also get magic to be triggered.
- $wiz = wizard get => sub { return 'anything' },
- len => sub { $d = $_[2]; ++$c; return $n };
+ my $wiz = wizard get => sub { return 'anything' },
+ len => sub { $d = $_[2]; ++$c; return $n };
my $x = 6789;
@@ -167,3 +167,35 @@
dispell @val, $wv;
is_deeply \@val, [ 4, 5, 8 ], 'len: after value';
}
+
+{
+ local $@;
+
+ my $wua = eval { wizard len => \undef };
+ is $@, '', 'len: noop wizard (for arrays) creation does not croak';
+
+ my @a = ('a' .. 'z');
+ eval { cast @a, $wua };
+ is $@, '', 'len: noop wizard (for arrays) cast does not croak';
+
+ my $l;
+ eval { $l = $#a };
+ is $@, '', 'len: noop wizard (for arrays) invocation does not croak';
+ is $l, 25, 'len: noop magic on an array returns the previous length';
+
+ my $wus = eval { wizard get => \undef, len => \undef };
+ is $@, '', 'len: noop wizard (for strings) creation does not croak';
+
+ for ([ 'euro', 'string' ], [ "\x{20AC}uro", 'unicode string' ]) {
+ my ($euro, $desc) = @$_;
+
+ eval { cast $euro, $wus };
+ is $@, '', 'len: noop wizard (for strings) cast does not croak';
+
+ eval { pos($euro) = 2 };
+ is $@, '', 'len: noop wizard (for strings) invocation does not croak';
+
+ my ($rest) = ($euro =~ /(.*)/g);
+ is $rest, 'ro', "len: noop magic on a $desc returns the previous length";
+ }
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/t/27-local.t new/Variable-Magic-0.48/t/27-local.t
--- old/Variable-Magic-0.47/t/27-local.t 2011-09-04 17:19:53.000000000 +0200
+++ new/Variable-Magic-0.48/t/27-local.t 2012-02-17 18:01:52.000000000 +0100
@@ -5,10 +5,10 @@
use Test::More;
-use Variable::Magic qw<cast MGf_LOCAL>;
+use Variable::Magic qw<wizard cast getdata MGf_LOCAL>;
if (MGf_LOCAL) {
- plan tests => 2 * 3 + 1 + 1;
+ plan tests => 2 * 3 + 1 + (2 + 2 * 7) + 1;
} else {
plan skip_all => 'No local magic for this perl';
}
@@ -24,3 +24,50 @@
ok $res, 'local: cast succeeded';
watch { local $a } { local => 1 }, 'localized';
+
+{
+ local $@;
+
+ my $w1 = eval { wizard local => \undef, data => sub { 'w1' } };
+ is $@, '', 'local: noop wizard creation does not croak';
+ my $w2 = eval { wizard data => sub { 'w2' } };
+ is $@, '', 'local: dummy wizard creation does not croak';
+
+ {
+ our $u;
+ eval { cast $u, $w1 };
+ is $@, '', 'local: noop magic (first) cast does not croak';
+ is getdata($u, $w1), 'w1', 'local: noop magic (first) cast succeeded';
+ eval { cast $u, $w2 };
+ is $@, '', 'local: dummy magic (second) cast does not croak';
+ is getdata($u, $w2), 'w2', 'local: dummy magic (second) cast succeeded';
+ my ($z1, $z2);
+ eval {
+ local $u = '';
+ $z1 = getdata $u, $w1;
+ $z2 = getdata $u, $w2;
+ };
+ is $@, '', 'local: noop/dummy magic invocation does not croak';
+ is $z1, undef, 'local: noop magic (first) prevented magic copy';
+ is $z2, 'w2', 'local: dummy magic (second) was copied';
+ }
+
+ {
+ our $v;
+ eval { cast $v, $w2 };
+ is $@, '', 'local: dummy magic (first) cast does not croak';
+ is getdata($v, $w2), 'w2', 'local: dummy magic (first) cast succeeded';
+ eval { cast $v, $w1 };
+ is $@, '', 'local: noop magic (second) cast does not croak';
+ is getdata($v, $w1), 'w1', 'local: noop magic (second) cast succeeded';
+ my ($z1, $z2);
+ eval {
+ local $v = '';
+ $z1 = getdata $v, $w1;
+ $z2 = getdata $v, $w2;
+ };
+ is $@, '', 'local: dummy/noop magic invocation does not croak';
+ is $z2, 'w2', 'local: dummy magic (first) was copied';
+ is $z1, undef, 'local: noop magic (second) prevented magic copy';
+ }
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Variable-Magic-0.47/t/lib/Variable/Magic/TestWatcher.pm new/Variable-Magic-0.48/t/lib/Variable/Magic/TestWatcher.pm
--- old/Variable-Magic-0.47/t/lib/Variable/Magic/TestWatcher.pm 2011-10-26 19:58:10.000000000 +0200
+++ new/Variable-Magic-0.48/t/lib/Variable/Magic/TestWatcher.pm 2012-02-16 23:08:12.000000000 +0100
@@ -28,6 +28,7 @@
croak 'can\'t initialize twice' if defined $wiz;
my $types = _types shift;
$prefix = (defined) ? "$_: " : '' for shift;
+ local $@;
%mg = ();
$wiz = eval 'wizard ' . join(', ', map {
"$_ => sub { \$mg{$_}++;" . ($_ eq 'len' ? '$_[2]' : '0') . '}'
--
To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org
