From 6d015dce73104773391770439c8d9462e76b9807 Mon Sep 17 00:00:00 2001
From: Ed J <mohawk2@users.noreply.github.com>
Date: Sat, 17 Feb 2024 18:37:21 +0000
Subject: [PATCH] XS topdl - #451

---
 Basic/Core/Core.pm | 12 ------------
 Basic/Core/Core.xs | 23 +++++++++++++++++++++++
 t/core.t           |  2 ++
 3 files changed, 25 insertions(+), 12 deletions(-)

diff --git a/Basic/Core/Core.pm b/Basic/Core/Core.pm
index 1383ee203..9ffb5a641 100644
--- a/Basic/Core/Core.pm
+++ b/Basic/Core/Core.pm
@@ -656,18 +656,6 @@ below for usage).
  $y = topdl $ndarray;       # fall through
  $x = topdl (1,2,3,4);      # Convert 1D array
 
-=cut
-
-# Convert numbers to PDL if not already
-sub PDL::topdl {
-    return $_[0]->new(@_[1..$#_]) if
-      @_ > 2 # PDLify a list
-      or ref(\$_[1]) eq 'SCALAR'
-      or ref($_[1]) eq 'ARRAY';
-    return $_[1] if blessed($_[1]); # Fall through
-    barf("Can not convert a ".ref($_[1])." to a ".$_[0]);
-0;}
-
 =head2 set_datatype
 
 =for ref
diff --git a/Basic/Core/Core.xs b/Basic/Core/Core.xs
index a32e5a6ff..98a61bad7 100644
--- a/Basic/Core/Core.xs
+++ b/Basic/Core/Core.xs
@@ -81,6 +81,29 @@ inplace(self, ...)
   OUTPUT:
     RETVAL
 
+SV *
+topdl(klass, arg1, ...)
+  SV *klass;
+  SV *arg1;
+  CODE:
+    if (items > 2 ||
+      (!SvROK(arg1) && SvTYPE(arg1) < SVt_PVAV) ||
+      (SvROK(arg1) && SvTYPE(SvRV(arg1)) == SVt_PVAV)
+    ) {
+      SP -= items; PUSHMARK(SP); SPAGAIN; /* these pass this set of args on */
+      int retvals = perl_call_method("new", G_SCALAR);
+      SPAGAIN;
+      if (retvals != 1) barf("new returned no values");
+      RETVAL = POPs;
+    } else if (SvROK(arg1) && SvOBJECT(SvRV(arg1))) {
+      RETVAL = arg1;
+    } else {
+      barf("Can not convert a %s to a %s", sv_reftype(arg1, 1), SvPV_nolen(klass));
+    }
+    SvREFCNT_inc(RETVAL);
+  OUTPUT:
+    RETVAL
+
 # Return the transformation object or an undef otherwise.
 pdl_trans *
 trans_parent(self)
diff --git a/t/core.t b/t/core.t
index 3a4f5a262..ee9c6d05f 100644
--- a/t/core.t
+++ b/t/core.t
@@ -144,6 +144,8 @@ isa_ok( PDL->topdl([1,2,3]), "PDL", "topdl([1,2,3]) returns an ndarray" );
 isa_ok( PDL->topdl(1,2,3),   "PDL", "topdl(1,2,3) returns an ndarray" );
 $x=PDL->topdl(1,2,3);
 ok (($x->nelem == 3  and  all($x == pdl(1,2,3))), "topdl(1,2,3) returns a 3-ndarray containing (1,2,3)");
+eval {PDL->topdl({})};
+isnt $@, '', 'topdl({}) no segfault';
 
 # stringification
 {