Add XS::APItests for scalar variable hooks

leonerd · Feb 5, 2025 · 1d54a60 · 1d54a60
1 parent 3fac244
commit 1d54a60
Show file tree

Hide file tree

Showing 2 changed files with 64 additions and 3 deletions.
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
@@ -196,6 +196,23 @@ STATIC MGVTBL vtbl_mycopy = { 0, 0, 0, 0, 0, S_mycopy_copy, 0, 0 };
 
 /* Hooks for XS::APItest::Hooks */
 
+static void
+hook_grab_before_get(pTHX_ SV *sv, Hook *hk)
+{
+    SV *auxsv = HkAUXSV(hk);
+    sv_setsv_nomg(sv, auxsv);
+}
+
+static void
+hook_inc_after_set(pTHX_ SV *sv, Hook *hk)
+{
+    PERL_UNUSED_ARG(sv);
+
+    SV *auxsv = HkAUXSV(hk);
+    if(auxsv)
+        sv_inc(auxsv);
+}
+
 static void
 hook_inc_on_free_free(pTHX_ SV *sv, Hook *hk)
 {
@@ -243,12 +260,30 @@ static const struct HookFunctions hooks_inc_on_clone = {
     .clone = &hook_inc_on_clone_clone,
 };
 
+static const struct ScalarVarHookFunctions hooks_grab_before_get = {
+    .ver   = 12345, /* TODO */
+    .shape = HKs_SCALARVAR,
+    .flags = 0,
+
+    .pre_get = &hook_grab_before_get,
+};
+
+static const struct ScalarVarHookFunctions hooks_inc_after_set = {
+    .ver   = 12345, /* TODO */
+    .shape = HKs_SCALARVAR,
+    .flags = 0,
+
+    .post_set = &hook_inc_after_set,
+};
+
 static const struct HookFunctions *S_hookfuncs_by_name(pTHX_ SV *name)
 {
     char *namepv = SvPV_nolen(name);
-    if(strEQ(namepv, "empty"))        return &hooks_empty;
-    if(strEQ(namepv, "inc_on_free"))  return &hooks_inc_on_free;
-    if(strEQ(namepv, "inc_on_clone")) return &hooks_inc_on_clone;
+    if(strEQ(namepv, "empty"))           return &hooks_empty;
+    if(strEQ(namepv, "inc_on_free"))     return &hooks_inc_on_free;
+    if(strEQ(namepv, "inc_on_clone"))    return &hooks_inc_on_clone;
+    if(strEQ(namepv, "grab_before_get")) return (struct HookFunctions *)&hooks_grab_before_get;
+    if(strEQ(namepv, "inc_after_set"))   return (struct HookFunctions *)&hooks_inc_after_set;
     croak("Unrecognised hookfuncs name %" SVf, SVfARG(name));
 }
 

diff --git a/ext/XS-APItest/t/hooks.t b/ext/XS-APItest/t/hooks.t
@@ -35,4 +35,30 @@ use XS::APItest;
     is $counter, 1, '$counter is now 1 after SV free';
 }
 
+# Scalar Variable hooks with 'post_set' function
+{
+    my $counter;
+    my $sv = 123;
+    sv_hook_add($sv, inc_after_set => \$counter);
+    is $counter, undef, '$counter before SV modify';
+
+    $sv = 456;
+    is $counter, 1, '$counter after SV modify';
+
+    undef $sv;
+    is $counter, 2, '$counter after SV undef';
+}
+
+# Scalar Variable hooks with 'pre_get' function
+{
+    my $shadow = 456;
+    my $sv = 123;
+    sv_hook_add($sv, grab_before_get => \$shadow);
+    is $sv+0, 456, '$sv appears as a copy of $shadow';
+
+    # length is weird in magic
+    $shadow = "x" x 100;
+    is length($sv), 100, 'length($sv) from shadow';
+}
+
 done_testing;