The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
Changes 013
META.json 22
META.yml 1717
Magic.xs 011
README 923
lib/Variable/Magic.pm 617
t/01-import.t 12
t/17-ctl.t 113
t/25-copy.t 222
t/35-stash.t 311
t/lib/VPIT/TestHelpers.pm 018
11 files changed (This is a version diff) 51139
@@ -1,5 +1,18 @@
 Revision history for Variable-Magic
 
+0.54    2014-09-22 17:30 UTC
+        + Add : The new constant VMG_COMPAT_CODE_COPY_CLONE evaluates to true
+                if your perl calls 'copy' magic when a magical code prototype
+                is cloned, which is currently the case for perl 5.17.0 and
+                above.
+        + Fix : [RT #90205] : copy magic on subs puts raw CV in $_[3]
+                $_[3] will now contain a reference to the cloned code when
+                'copy' magic is called for a coderef.
+                Thanks Lukas Mai for reporting.
+        + Fix : t/35-stash.t has been taught about perl 5.21.4.
+        + Fix : Tests using run_perl() in t/17-ctl.t will no longer fail on
+                Android.
+
 0.53    2013-09-01 17:50 UTC
         This is a maintenance release. The code contains no functional change.
         Satisfied users of version 0.52 can skip this update.
@@ -4,7 +4,7 @@
       "Vincent Pit <perl@profvince.com>"
    ],
    "dynamic_config" : 1,
-   "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
+   "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060",
    "license" : [
       "perl_5"
    ],
@@ -60,5 +60,5 @@
          "url" : "http://git.profvince.com/?p=perl%2Fmodules%2FVariable-Magic.git"
       }
    },
-   "version" : "0.53"
+   "version" : "0.54"
 }
@@ -3,36 +3,36 @@ abstract: 'Associate user-defined magic to variables from Perl.'
 author:
   - 'Vincent Pit <perl@profvince.com>'
 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'
 dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
-  version: 1.4
+  version: '1.4'
 name: Variable-Magic
 no_index:
   directory:
     - t
     - inc
 requires:
-  Carp: 0
-  Exporter: 0
-  XSLoader: 0
-  base: 0
-  perl: 5.008
+  Carp: '0'
+  Exporter: '0'
+  XSLoader: '0'
+  base: '0'
+  perl: '5.008'
 resources:
   bugtracker: http://rt.cpan.org/Dist/Display.html?Name=Variable-Magic
   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.53
+version: '0.54'
@@ -187,6 +187,12 @@
 # define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 0
 #endif
 
+#if VMG_HAS_PERL(5, 17, 0)
+# define VMG_COMPAT_CODE_COPY_CLONE 1
+#else
+# define VMG_COMPAT_CODE_COPY_CLONE 0
+#endif
+
 #if VMG_HAS_PERL(5, 13, 2)
 # define VMG_COMPAT_GLOB_GET 1
 #else
@@ -1560,6 +1566,9 @@ STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_S
   keysv = newSVpvn(key, keylen);
  }
 
+ if (SvTYPE(sv) >= SVt_PVCV)
+  nsv = sv_2mortal(newRV_inc(nsv));
+
  ret = vmg_cb_call3(w->cb_copy, w->opinfo, sv, mg->mg_obj, keysv, nsv);
 
  if (keylen != HEf_SVKEY) {
@@ -1817,6 +1826,8 @@ BOOT:
                     newSVuv(VMG_COMPAT_ARRAY_UNDEF_CLEAR));
  newCONSTSUB(stash, "VMG_COMPAT_HASH_DELETE_NOUVAR_VOID",
                     newSVuv(VMG_COMPAT_HASH_DELETE_NOUVAR_VOID));
+ newCONSTSUB(stash, "VMG_COMPAT_CODE_COPY_CLONE",
+                    newSVuv(VMG_COMPAT_CODE_COPY_CLONE));
  newCONSTSUB(stash, "VMG_COMPAT_GLOB_GET", newSVuv(VMG_COMPAT_GLOB_GET));
  newCONSTSUB(stash, "VMG_PERL_PATCHLEVEL", newSVuv(VMG_PERL_PATCHLEVEL));
  newCONSTSUB(stash, "VMG_THREADSAFE",      newSVuv(VMG_THREADSAFE));
@@ -2,7 +2,7 @@ NAME
     Variable::Magic - Associate user-defined magic to variables from Perl.
 
 VERSION
-    Version 0.53
+    Version 0.54
 
 SYNOPSIS
         use Variable::Magic qw<wizard cast VMG_OP_INFO_NAME>;
@@ -132,8 +132,13 @@ DESCRIPTION
 
     *   *copy*
 
-        This magic only applies to tied arrays and hashes, and fires when
-        you try to access or change their elements.
+        When applied to tied arrays and hashes, this magic fires when you
+        try to access or change their elements.
+
+        Starting from perl 5.17.0, it can also be applied to closure
+        prototypes, in which case the magic will be called when the
+        prototype is cloned. The "VMG_COMPAT_CODE_COPY_CLONE" constant is
+        true when your perl support this feature.
 
     *   *dup*
 
@@ -225,10 +230,15 @@ FUNCTIONS
 
         *       *copy*
 
-                $_[2] is a either an alias or a copy of the current key, and
-                $_[3] is an alias to the current element (i.e. the value).
-                Because $_[2] might be a copy, it is useless to try to
-                change it or cast magic on it.
+                When the variable for which the magic is invoked is an array
+                or an hash, $_[2] is a either an alias or a copy of the
+                current key, and $_[3] is an alias to the current element
+                (i.e. the value). Since $_[2] might be a copy, it is useless
+                to try to change it or cast magic on it.
+
+                Starting from perl 5.17.0, this magic can also be called for
+                code references. In this case, $_[2] is always "undef" and
+                $_[3] is a reference to the cloned anonymous subroutine.
 
         *       *fetch*, *store*, *exists* and *delete*
 
@@ -385,6 +395,10 @@ CONSTANTS
     True for perls that don't call *delete* magic when you delete an element
     from a hash in void context.
 
+  "VMG_COMPAT_CODE_COPY_CLONE"
+    True for perls that call *copy* magic when a magical closure prototype
+    is cloned.
+
   "VMG_COMPAT_GLOB_GET"
     True for perls that call *get* magic for operations on globs.
 
@@ -593,8 +607,8 @@ SUPPORT
     <http://www.profvince.com/perl/cover/Variable-Magic>.
 
 COPYRIGHT & LICENSE
-    Copyright 2007,2008,2009,2010,2011,2012,2013 Vincent Pit, all rights
-    reserved.
+    Copyright 2007,2008,2009,2010,2011,2012,2013,2014 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.
@@ -11,13 +11,13 @@ Variable::Magic - Associate user-defined magic to variables from Perl.
 
 =head1 VERSION
 
-Version 0.53
+Version 0.54
 
 =cut
 
 our $VERSION;
 BEGIN {
- $VERSION = '0.53';
+ $VERSION = '0.54';
 }
 
 =head1 SYNOPSIS
@@ -152,7 +152,10 @@ It behaves roughly like Perl object destructors (i.e. C<DESTROY> methods), excep
 
 I<copy>
 
-This magic only applies to tied arrays and hashes, and fires when you try to access or change their elements.
+When applied to tied arrays and hashes, this magic fires when you try to access or change their elements.
+
+Starting from perl 5.17.0, it can also be applied to closure prototypes, in which case the magic will be called when the prototype is cloned.
+The L</VMG_COMPAT_CODE_COPY_CLONE> constant is true when your perl support this feature.
 
 =item *
 
@@ -269,8 +272,11 @@ The callback is expected to return the new scalar or array length to use, or C<u
 
 I<copy>
 
-C<$_[2]> is a either an alias or a copy of the current key, and C<$_[3]> is an alias to the current element (i.e. the value).
-Because C<$_[2]> might be a copy, it is useless to try to change it or cast magic on it.
+When the variable for which the magic is invoked is an array or an hash, C<$_[2]> is a either an alias or a copy of the current key, and C<$_[3]> is an alias to the current element (i.e. the value).
+Since C<$_[2]> might be a copy, it is useless to try to change it or cast magic on it.
+
+Starting from perl 5.17.0, this magic can also be called for code references.
+In this case, C<$_[2]> is always C<undef> and C<$_[3]> is a reference to the cloned anonymous subroutine.
 
 =item *
 
@@ -463,6 +469,10 @@ True for perls that call I<clear> magic when undefining magical arrays.
 
 True for perls that don't call I<delete> magic when you delete an element from a hash in void context.
 
+=head2 C<VMG_COMPAT_CODE_COPY_CLONE>
+
+True for perls that call I<copy> magic when a magical closure prototype is cloned.
+
 =head2 C<VMG_COMPAT_GLOB_GET>
 
 True for perls that call I<get> magic for operations on globs.
@@ -646,6 +656,7 @@ our %EXPORT_TAGS    = (
    VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID
    VMG_COMPAT_ARRAY_UNDEF_CLEAR
    VMG_COMPAT_HASH_DELETE_NOUVAR_VOID
+   VMG_COMPAT_CODE_COPY_CLONE
    VMG_COMPAT_GLOB_GET
    VMG_PERL_PATCHLEVEL
    VMG_THREADSAFE VMG_FORKSAFE
@@ -705,7 +716,7 @@ Tests code coverage report is available at L<http://www.profvince.com/perl/cover
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2007,2008,2009,2010,2011,2012,2013 Vincent Pit, all rights reserved.
+Copyright 2007,2008,2009,2010,2011,2012,2013,2014 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.
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2 * 21;
+use Test::More tests => 2 * 22;
 
 require Variable::Magic;
 
@@ -20,6 +20,7 @@ my %syms = (
   VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID
   VMG_COMPAT_ARRAY_UNDEF_CLEAR
   VMG_COMPAT_HASH_DELETE_NOUVAR_VOID
+  VMG_COMPAT_CODE_COPY_CLONE
   VMG_COMPAT_GLOB_GET
   VMG_PERL_PATCHLEVEL
   VMG_THREADSAFE VMG_FORKSAFE
@@ -5,6 +5,9 @@ use warnings;
 
 use Test::More tests => 4 * 8 + 4 * (2 * 6 + 1) + 10 + 1 + 1;
 
+use lib 't/lib';
+use VPIT::TestHelpers;
+
 use Variable::Magic qw<wizard cast VMG_UVAR>;
 
 sub expect {
@@ -342,17 +345,6 @@ eval q{BEGIN {
 like $@, expect('tomato', undef, "\nBEGIN.*"),
                           'die in BEGIN in eval triggers hints hash destructor';
 
-sub run_perl {
- my $code = shift;
-
- my ($SystemRoot, $PATH) = @ENV{qw<SystemRoot PATH>};
- local %ENV;
- $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
- $ENV{PATH}       = $PATH       if $^O eq 'cygwin'  and defined $PATH;
-
- system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
-}
-
 my $has_capture_tiny = do {
  local $@;
  eval {
@@ -8,9 +8,9 @@ use Test::More;
 use lib 't/lib';
 use VPIT::TestHelpers;
 
-use Variable::Magic qw<cast dispell>;
+use Variable::Magic qw<wizard cast dispell VMG_COMPAT_CODE_COPY_CLONE>;
 
-plan tests => 2 + ((2 * 5 + 3) + (2 * 2 + 1)) + (2 * 9 + 6) + 1;
+plan tests => 2 + ((2 * 5 + 3) + (2 * 2 + 1)) + (2 * 9 + 6) + 3 + 1;
 
 use lib 't/lib';
 use Variable::Magic::TestWatcher;
@@ -80,3 +80,23 @@ SKIP: {
 
  watch { undef %h } { }, 'tied hash undef';
 }
+
+SKIP: {
+ skip 'copy magic not called for cloned prototypes before perl 5.17.0' => 3
+                                              unless VMG_COMPAT_CODE_COPY_CLONE;
+ my $w = wizard copy => sub {
+  is ref($_[0]), 'CODE', 'first arg in copy on clone is a code ref';
+  is $_[2],      undef,  'third arg in copy on clone is undef';
+  is ref($_[3]), 'CODE', 'fourth arg in copy on clone is a code ref';
+ };
+ eval <<'TEST_COPY';
+  package X;
+  sub MODIFY_CODE_ATTRIBUTES {
+   my ($pkg, $sub) = @_;
+   &Variable::Magic::cast($sub, $w);
+   return;
+  }
+  my $i;
+  my $f = sub : Hello { $i };
+TEST_COPY
+}
@@ -92,11 +92,19 @@ cast %Hlagh::, $wiz;
  };
 
  my @calls = qw<eat shoot leave roam yawn roam>;
+ my (@fetch, @store);
+ if ("$]" >= 5.011_002 && "$]" < 5.021_004) {
+  @fetch = @calls;
+  @store = map { ($_) x 2 } @calls;
+ } else {
+  @fetch = @calls;
+  @store = @calls;
+ }
 
  is $@, "ok\n", 'stash: function calls compiled fine';
  is_deeply \%mg, {
-  fetch => \@calls,
-  store => ("$]" < 5.011_002 ? \@calls : [ map { ($_) x 2 } @calls ]),
+  fetch => \@fetch,
+  store => \@store,
  }, 'stash: function calls';
 }
 
@@ -296,7 +304,7 @@ $_ => sub {
 CB
 } qw<fetch store exists delete>);
 
-my $uo_exp = "$]" < 5.011_002 ? 2 : 3;
+my $uo_exp = "$]" >= 5.011_002 && "$]" < 5.021_004 ? 3 : 2;
 
 $code .= ', data => sub { +{ guard => 0 } }';
 
@@ -3,9 +3,12 @@ package VPIT::TestHelpers;
 use strict;
 use warnings;
 
+use Config ();
+
 my %exports = (
  load_or_skip     => \&load_or_skip,
  load_or_skip_all => \&load_or_skip_all,
+ run_perl         => \&run_perl,
  skip_all         => \&skip_all,
 );
 
@@ -102,6 +105,21 @@ sub load_or_skip_all {
  return $loaded;
 }
 
+sub run_perl {
+ my $code = shift;
+
+ my ($SystemRoot, $PATH) = @ENV{qw<SystemRoot PATH>};
+ my $ld_name  = $Config::Config{ldlibpthname};
+ my $ldlibpth = $ENV{$ld_name};
+
+ local %ENV;
+ $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
+ $ENV{PATH}       = $PATH       if $^O eq 'cygwin'  and defined $PATH;
+ $ENV{$ld_name}   = $ldlibpth   if $^O eq 'android' and defined $ldlibpth;
+
+ system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
+}
+
 package VPIT::TestHelpers::Guard;
 
 sub new {