Test 'delete' uvar magic and introduce VMG_COMPAT_HASH_DELETE_NOUVAR_VOID

diff --git a/Magic.xs b/Magic.xs
index 5dc98a6d3a9038579ade44e4eefa02856bf13bbb..0c99f2c6e2694ce1b62b3fce6d44d526c99942cd 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -133,6 +133,12 @@
 # define VMG_UVAR 0
 #endif
 
+#if VMG_HAS_PERL_MAINT(5, 11, 0, 32969) || VMG_HAS_PERL(5, 12, 0)
+# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 1
+#else
+# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 0
+#endif
+
 /* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160, partially
  * reverted to dev-5.11 as 9cdcb38b */
 #if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0)
@@ -169,10 +175,10 @@
 # define VMG_COMPAT_ARRAY_UNDEF_CLEAR 0
 #endif
 
-#if VMG_HAS_PERL_MAINT(5, 11, 0, 32969) || VMG_HAS_PERL(5, 12, 0)
-# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 1
+#if VMG_HAS_PERL(5, 11, 0)
+# define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 1
 #else
-# define VMG_COMPAT_SCALAR_LENGTH_NOLEN 0
+# define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 0
 #endif
 
 #if VMG_HAS_PERL(5, 13, 2)
@@ -1366,6 +1372,8 @@ BOOT:
  newCONSTSUB(stash, "MGf_DUP",   newSVuv(MGf_DUP));
  newCONSTSUB(stash, "MGf_LOCAL", newSVuv(MGf_LOCAL));
  newCONSTSUB(stash, "VMG_UVAR",  newSVuv(VMG_UVAR));
+ newCONSTSUB(stash, "VMG_COMPAT_SCALAR_LENGTH_NOLEN",
+                    newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN));
  newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN",
                     newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN));
  newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID",
@@ -1374,8 +1382,8 @@ BOOT:
                     newSVuv(VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID));
  newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNDEF_CLEAR",
                     newSVuv(VMG_COMPAT_ARRAY_UNDEF_CLEAR));
- newCONSTSUB(stash, "VMG_COMPAT_SCALAR_LENGTH_NOLEN",
-                    newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN));
+ newCONSTSUB(stash, "VMG_COMPAT_HASH_DELETE_NOUVAR_VOID",
+                    newSVuv(VMG_COMPAT_HASH_DELETE_NOUVAR_VOID));
  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));

diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm
index 01b1c7069223a53b2597aaf91cd542f71623832e..ebfbc7c2a621cf91853dc8e09b7f68b1f9ca2673 100644 (file)
--- a/lib/Variable/Magic.pm
+++ b/lib/Variable/Magic.pm
@@ -389,6 +389,10 @@ When this constant is true, you can use the C<fetch,store,exists,delete> callbac
 Initial VMG_UVAR capability was introduced in perl 5.9.5, with a fully functional implementation
 shipped with perl 5.10.0.
 
+=head2 C<VMG_COMPAT_SCALAR_LENGTH_NOLEN>
+
+True for perls that don't call 'len' magic when taking the C<length> of a magical scalar.
+
 =head2 C<VMG_COMPAT_ARRAY_PUSH_NOLEN>
 
 True for perls that don't call 'len' magic when you push an element in a magical array.
@@ -406,9 +410,9 @@ True for perls that don't call 'len' magic when you unshift in void context an e
 
 True for perls that call 'clear' magic when undefining magical arrays.
 
-=head2 C<VMG_COMPAT_SCALAR_LENGTH_NOLEN>
+=head2 C<VMG_COMPAT_HASH_DELETE_NOUVAR_VOID>
 
-True for perls that don't call 'len' magic when taking the C<length> of a magical scalar.
+True for perls that don't call 'delete' uvar magic when you delete an element from a hash in void context.
 
 =head2 C<VMG_COMPAT_GLOB_GET>
 
@@ -587,10 +591,11 @@ our %EXPORT_TAGS    = (
  'funcs' =>  [ qw<wizard cast getdata dispell> ],
  'consts' => [ qw<
    MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR
+   VMG_COMPAT_SCALAR_LENGTH_NOLEN
    VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
    VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID
    VMG_COMPAT_ARRAY_UNDEF_CLEAR
-   VMG_COMPAT_SCALAR_LENGTH_NOLEN
+   VMG_COMPAT_HASH_DELETE_NOUVAR_VOID
    VMG_COMPAT_GLOB_GET
    VMG_PERL_PATCHLEVEL
    VMG_THREADSAFE VMG_FORKSAFE

diff --git a/t/01-import.t b/t/01-import.t
index b7be4ce07c5140eb847d8fdadebaec46553a6fc2..17fdc46d68222b7058f7160bf270d283ccd5fd71 100644 (file)
--- a/t/01-import.t
+++ b/t/01-import.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2 * 19;
+use Test::More tests => 2 * 20;
 
 require Variable::Magic;
 
@@ -14,10 +14,11 @@ my %syms = (
  dispell  => '\[$@%&*]$',
  map { $_ => '' } qw<
   MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR
+  VMG_COMPAT_SCALAR_LENGTH_NOLEN
   VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
   VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID
   VMG_COMPAT_ARRAY_UNDEF_CLEAR
-  VMG_COMPAT_SCALAR_LENGTH_NOLEN
+  VMG_COMPAT_HASH_DELETE_NOUVAR_VOID
   VMG_COMPAT_GLOB_GET
   VMG_PERL_PATCHLEVEL
   VMG_THREADSAFE VMG_FORKSAFE

diff --git a/t/32-hash.t b/t/32-hash.t
index 8ae273e73037b3171dd35de0b4b5b5749e29519b..703bcd3df82b5f4c30e1b7495fc24accfe5f1d46 100644 (file)
--- a/t/32-hash.t
+++ b/t/32-hash.t
@@ -3,9 +3,13 @@
 use strict;
 use warnings;
 
-use Test::More tests => (2 * 24 + 7) + (2 * 5 + 5) + 1;
+use Test::More tests => (2 * 27 + 9) + (2 * 5 + 5) + 1;
 
-use Variable::Magic qw<cast dispell VMG_UVAR>;
+use Variable::Magic qw<
+ cast dispell
+ VMG_UVAR
+ VMG_COMPAT_HASH_DELETE_NOUVAR_VOID
+>;
 
 use lib 't/lib';
 use Variable::Magic::TestWatcher;
@@ -43,6 +47,21 @@ for (1 .. 2) {
  ok $s, "hash: exists correctly ($_)";
 }
 
+# delete
+
+watch { delete $h{bar} } +{
+ ((delete => 1) x !VMG_COMPAT_HASH_DELETE_NOUVAR_VOID, copy => 1) x VMG_UVAR
+}, 'delete in void context';
+
+for (1 .. 2) {
+ $s = watch { delete $h{baz} } +{ (delete => 1, copy => 1) x VMG_UVAR },
+                                                "delete in scalar context ($_)";
+ my $exp = $_ == 1 ? $n{baz} : undef;
+ is $s, $exp, "hash: delete correctly ($_)";
+}
+
+# clear
+
 watch { %h = () } { clear => 1 }, 'empty in list context';
 
 watch { $h{a} = -1; %h = (b => $h{a}) }