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
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);
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);
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);