Properly handle delete magic in void context

This was caused by wrongly passing G_DISCARD along the uvar action flag,
which was fixed in 5.45.2.  The delete callback should now be properly
called on all perls, old and new, but may be called several times on perls
older than 5.21.4.

This fixes [RT #180372]

diff --git a/Magic.xs b/Magic.xs
index aa4af3518fc3c50dc6d35484ab3160cee3929a12..8a7773fd2bde85eb1623765c42be43e45580e9ad 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -75,11 +75,7 @@
 # define VMG_COMPAT_ARRAY_UNDEF_CLEAR 0
 #endif
 
-#if XSH_HAS_PERL(5, 11, 0)
-# define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 1
-#else
-# define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 0
-#endif
+#define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 0
 
 #if XSH_HAS_PERL(5, 17, 0)
 # define VMG_COMPAT_CODE_COPY_CLONE 1
@@ -1731,6 +1727,7 @@ static I32 vmg_svt_val(pTHX_ IV action, SV *sv) {
                                 mg->mg_obj, key);
     break;
    case HV_DELETE:
+   case (HV_DELETE|G_DISCARD):
     if (w->cb_delete)
      vmg_cb_call2(w->cb_delete, w->opinfo | VMG_CB_CALL_GUARD, sv,
                                 mg->mg_obj, key);

diff --git a/t/35-stash.t b/t/35-stash.t
index a9600bc44d3f6b1a73e6ec5282fb706fcb5166ec..3860256498b20a300608b89f0dbaa1997a15c488 100644 (file)
--- a/t/35-stash.t
+++ b/t/35-stash.t
@@ -92,7 +92,7 @@ cast %Hlagh::, $wiz;
  };
 
  my @calls = qw<eat shoot leave roam yawn roam>;
- my (@fetch, @store);
+ my (@fetch, @store, @delete);
  if ("$]" >= 5.011_002 && "$]" < 5.021_004) {
   @fetch = @calls;
   @store = map { ($_) x 2 } @calls;
@@ -100,12 +100,18 @@ cast %Hlagh::, $wiz;
   @fetch = @calls;
   @store = @calls;
  }
-
- is $@, "ok\n", 'stash: function calls compiled fine';
- is_deeply \%mg, {
+ my %expected = (
   fetch => \@fetch,
   store => \@store,
- }, 'stash: function calls';
+ );
+ if ("$]" >= 5.012 && "$]" < 5.021_004) {
+  $expected{delete} = [qw<roam yawn yawn roam>];
+ } elsif ("$]" >= 5.021_004) {
+  $expected{delete} = [qw<yawn roam>];
+ }
+
+ is $@, "ok\n", 'stash: function calls compiled fine';
+ is_deeply \%mg, \%expected, 'stash: function calls';
 }
 
 {
@@ -307,7 +313,10 @@ $_ => sub {
 CB
 } qw<fetch store exists delete>);
 
-my $uo_exp = "$]" >= 5.011_002 && "$]" < 5.021_004 ? 3 : 2;
+my $uo_exp =
+ "$]" < 5.011_002 ? 2 :
+ "$]" >= 5.012 && "$]" < 5.021_004 ? 5 :
+ 3;
 
 $code .= ', data => sub { +{ guard => 0 } }';