if $pdl->{PDL} is code ref, pass $pdl as arg

Basic/Core/pdlcore.c

@@ -69,27 +69,22 @@ pdl* pdl_SvPDLV ( SV* sv ) {
       and allow normal PDL functions to still work so long
       as the {PDL} code returns a standard ndarray on
       demand - KGB */
-
       if (SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVCV) {
          dSP;
-         ENTER ;
-         SAVETMPS ;
-         PUSHMARK(SP) ;
-
-         int count = perl_call_sv(*svp, G_SCALAR|G_NOARGS);
-
-         SPAGAIN ;
-
+         ENTER;
+         SAVETMPS;
+         PUSHMARK(SP);
+         XPUSHs(sv);
+         PUTBACK;
+         int count = perl_call_sv(*svp, G_SCALAR);
+         SPAGAIN;
          if (count != 1)
-            croak("Execution of PDL structure failed to return one value\n") ;
-
+            croak("Execution of PDL structure failed to return one value\n");
          sv=newSVsv(POPs);
-
-         PUTBACK ;
-         FREETMPS ;
-         LEAVE ;
-      }
-      else {
+         PUTBACK;
+         FREETMPS;
+         LEAVE;
+      } else {
          sv = *svp;
       }
 

Basic/Pod/Objects.pod

@@ -51,7 +51,11 @@ blessed hash-refs that have a C<PDL> member that's a C pointer as above
 
 blessed hash-refs that have a C<PDL> member that's a Perl code-ref.
 It will be called, and is expected to return an ndarray that conforms
-to one of cases 1-2 or 4-5 above. Example from F<t/subclass.t>:
+to one of cases 1-2 or 4-5 above. As of 2.094, the original hash-ref
+will be passed as the first argument. This means you can give a
+method as shown below, rather than needing to make a closure each
+time.
+Example from F<t/subclass.t>:
 
   package PDL::Derived2;
   # This is a array of ones of dim 'Coeff'
@@ -65,7 +69,7 @@ to one of cases 1-2 or 4-5 above. Example from F<t/subclass.t>:
     my $class = shift;
     bless {
       Coeff=>shift,
-      PDL=>sub { return $_[0]->cache },
+      PDL=>\&cache,
       SomethingElse=>42,
     }, $class;
   }

Changes

@@ -13,6 +13,7 @@
 - IO::FlexRaw::mapflex stop allocating memory (#501) - thanks @vitstradal for report
 - add Primitive::approx_artol
 - get_dataref now works even with DONTTOUCHDATA which is really about allocation
+- if $pdl->{PDL} is code ref, $pdl now passed as arg
 
 2.093 2024-09-29
 - PDL.set_datatype now doesn't physicalise input, PDL.convert_type does

t/subclass.t

@@ -38,7 +38,7 @@ package PDL::Derived2;
 our @ISA = qw/PDL/;
 sub new {
   my $class = shift;
-  bless {Coeff=>shift, PDL=>sub { return $_[0]->cache }, SomethingElse=>42}, $class;
+  bless {Coeff=>shift, PDL=>\&cache, SomethingElse=>42}, $class;
 }
 # Actualize the value (demonstrating cacheing)
 # One can imagine expiring the cache if say, Coeffs change