Use the same XS body for B::IV::RV and B::PV::RV.

This reduces the object code size by about 600 bytes on this platform.

The input typemap checking makes no distinction between different SV types,
so the XS body will generate the same C code, despite the different XS
"types". So there is no change in behaviour from doing newXS like this,
compared with the old approach of having a (near) duplicate XS body.
We should fix the typemap checking.

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 6f1e17e..70a3e0b 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1349,21 +1349,15 @@ packiv(sv)
            ST(0) = newSVpvn_flags((char *)&w, 4, SVs_TEMP);
        }
 
-
 #if PERL_VERSION >= 11
+#  The input typemap checking makes no distinction between different SV types,
+#  so the XS body will generate the same C code, despite the different XS
+#  "types". So there is no change in behaviour from doing newXS like this,
+#  compared with the old approach of having a (near) duplicate XS body.
+#  We should fix the typemap checking.
 
-B::SV
-RV(sv)
-        B::IV   sv
-    CODE:
-        if( SvROK(sv) ) {
-            RETVAL = SvRV(sv);
-        }
-        else {
-            croak( "argument is not SvROK" );
-        }
-    OUTPUT:
-        RETVAL
+BOOT:
+        newXS("B::IV::RV", XS_B__PV_RV, __FILE__);
 
 #endif
 

diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index afe88dd..228daa2 100644 (file)
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -121,6 +121,13 @@ is($iv_ref->int_value, $iv, "Test int_value()");
 is($iv_ref->IV, $iv, "Test IV()");
 is($iv_ref->IVX(), $iv, "Test IVX()");
 is($iv_ref->UVX(), $iv, "Test UVX()");
+is(eval { $iv_ref->RV() }, undef, 'Test RV() on IV');
+like($@, qr/argument is not SvROK/, 'Test RV() IV');
+$iv = \"Pie";
+my $val = eval { $iv_ref->RV() };
+is(ref $val, 'B::PV', 'Test RV() on a reference');
+is($val->PV(), 'Pie', 'Value expected');
+is($@, '', "Test RV()");
 
 my $pv = "Foo";
 my $pv_ref = B::svref_2object(\$pv);
@@ -132,9 +139,14 @@ my $pv_ret = $pv_ref->object_2svref();
 is(ref $pv_ret, "SCALAR", "Test object_2svref() return is SCALAR");
 is($$pv_ret, $pv, "Test object_2svref()");
 is($pv_ref->PV(), $pv, "Test PV()");
-eval { is($pv_ref->RV(), $pv, "Test RV()"); };
-ok($@, "Test RV()");
+is(eval { $pv_ref->RV() }, undef, 'Test RV() on PV');
+like($@, qr/argument is not SvROK/, 'Test RV() on PV');
 is($pv_ref->PVX(), $pv, "Test PVX()");
+$pv = \"Pie";
+$val = eval { $pv_ref->RV() };
+is(ref $val, 'B::PV', 'Test RV() on a reference');
+is($val->PV(), 'Pie', 'Value expected');
+is($@, '', "Test RV()");
 
 my $nv = 1.1;
 my $nv_ref = B::svref_2object(\$nv);
@@ -147,6 +159,9 @@ is(ref $nv_ret, "SCALAR", "Test object_2svref() return is SCALAR");
 is($$nv_ret, $nv, "Test object_2svref()");
 is($nv_ref->NV, $nv, "Test NV()");
 is($nv_ref->NVX(), $nv, "Test NVX()");
+is(eval { $nv_ref->RV() }, undef, 'Test RV() on NV');
+like($@, qr/Can't locate object method "RV" via package "B::NV"/,
+     'Test RV() on NV');
 
 my $null = undef;
 my $null_ref = B::svref_2object(\$null);