add offset arg to new_around_datasv - #501

Basic/Core/Core.xs

@@ -1030,27 +1030,34 @@ initialize(class)
     RETVAL
 
 # undocumented for present. returns PDL still needing dims and datatype
+# offset is in bytes, not elements
 SV *
-new_around_datasv(class, datasv_pointer)
+new_around_datasv(class, datasv_pointer, offset=0)
   SV *class
   IV datasv_pointer
-  CODE:
-    HV *bless_stash = SvROK(class)
-      ? SvSTASH(SvRV(class)) /* a reference to a class */
-      : gv_stashsv(class, 0); /* a class name */
-    RETVAL = newSV(0);
-    pdl *n = pdl_pdlnew();
-    if (!n) pdl_pdl_barf("Error making null pdl");
-    pdl_SetSV_PDL(RETVAL,n);   /* set a null PDL to this SV * */
-    RETVAL = sv_bless(RETVAL, bless_stash); /* bless appropriately  */
-    /* set the datasv to what was supplied */
-    n->datasv = (void*)datasv_pointer;
-    SvREFCNT_inc((SV*)(datasv_pointer));
-    n->data = SvPV_nolen((SV*)datasv_pointer);
-    n->nbytes = SvCUR((SV*)datasv_pointer);
-    n->state |= PDL_ALLOCATED;
-  OUTPUT:
-    RETVAL
+  IV offset
+CODE:
+  if (offset < 0)
+    pdl_pdl_barf("Tried to new_around_datasv with negative offset=%" IVdf, offset);
+  STRLEN sv_len = SvCUR((SV*)datasv_pointer);
+  if (offset >= sv_len)
+    pdl_pdl_barf("Tried to new_around_datasv with offset=%" IVdf " >= %zd", offset, sv_len);
+  HV *bless_stash = SvROK(class)
+    ? SvSTASH(SvRV(class)) /* a reference to a class */
+    : gv_stashsv(class, 0); /* a class name */
+  pdl *n = pdl_pdlnew();
+  if (!n) pdl_pdl_barf("Error making null pdl");
+  RETVAL = newSV(0);
+  pdl_SetSV_PDL(RETVAL,n);   /* set a null PDL to this SV * */
+  RETVAL = sv_bless(RETVAL, bless_stash); /* bless appropriately  */
+  /* set the datasv to what was supplied */
+  n->datasv = (void*)datasv_pointer;
+  SvREFCNT_inc((SV*)(datasv_pointer));
+  n->data = SvPV_nolen((SV*)datasv_pointer) + offset;
+  n->nbytes = sv_len - offset;
+  n->state |= PDL_ALLOCATED;
+OUTPUT:
+  RETVAL
 
 SV *
 get_dataref(self)

t/core.t

@@ -33,6 +33,10 @@ is $p->datasv_refcount, 1;
 my $ref = $p->get_dataref;
 $ref = $p->get_dataref;
 is $p->datasv_refcount, 2;
+eval {PDL->new_around_datasv(0+$ref, -1)};
+like $@, qr/negative/, 'no negative offset';
+eval {PDL->new_around_datasv(0+$ref, 2000)};
+like $@, qr/>=/, 'no too-big offset';
 my $p2 = PDL->new_around_datasv(0+$ref);
 ok $p2->allocated;
 is $p2->nbytes, $p->type->howbig * $p->nelem;
@@ -46,7 +50,9 @@ is $p->datasv_refcount, 2;
 undef $ref;
 is $p->datasv_refcount, 1;
 my $datasv_ref = \(' ' x 50);
-my $p3 = PDL->new_around_datasv(0+$datasv_ref);
+my $p3 = PDL->new_around_datasv(0+$datasv_ref, 3);
+is $p3->nbytes, 47;
+$p3 = PDL->new_around_datasv(0+$datasv_ref);
 ok $p3->allocated;
 $p3->set_datatype(byte->enum);
 $p3->setdims([50]);