From: Lukas Mai <mauke@cpan.org>
Date: Thu, 20 Aug 2026 13:15:47 +0000 (+0200)
Subject: Properly handle delete magic in void context
X-Git-Tag: rt180372^0
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=bb90014e0c837b76bbcb8c635ed15840104e6ed6;p=perl%2Fmodules%2FVariable-Magic.git

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 aa4af35..8a7773f 100644
--- 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 a9600bc..3860256 100644
--- 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 } }';