Eliminate SVt_RV, and use SVt_IV to store plain references.

[p5sagit/p5-mst-13.2.git] / ext / B / t / b.t

diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index 4337109..0a3f245 100755 (executable)
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -22,7 +22,7 @@ BEGIN {
 $|  = 1;
 use warnings;
 use strict;
-use Test::More tests => 53;
+use Test::More tests => 57;
 
 BEGIN { use_ok( 'B' ); }
 
@@ -74,6 +74,8 @@ ok( B::svref_2object(\$.)->MAGIC->TYPE eq "\0", '$. has \0 magic' );
        '$. has no more magic' );
 }
 
+ok(B::svref_2object(qr/foo/)->MAGIC->precomp() eq 'foo', 'Get string from qr//');
+like(B::svref_2object(qr/foo/)->MAGIC->REGEX(), qr/\d+/, "REGEX() returns numeric value");
 my $iv = 1;
 my $iv_ref = B::svref_2object(\$iv);
 is(ref $iv_ref, "B::IV", "Test B:IV return from svref_2object");
@@ -124,21 +126,25 @@ my $null_ret = $nv_ref->object_2svref();
 is(ref $null_ret, "SCALAR", "Test object_2svref() return is SCALAR");
 is($$null_ret, $nv, "Test object_2svref()");
 
+my $RV_class = $] >= 5.011 ? 'B::IV' : 'B::RV';
 my $cv = sub{ 1; };
 my $cv_ref = B::svref_2object(\$cv);
-is($cv_ref->REFCNT, 1, "Test B::RV->REFCNT");
-is(ref $cv_ref, "B::RV", "Test B::RV return from svref_2object - code");
+is($cv_ref->REFCNT, 1, "Test $RV_class->REFCNT");
+is(ref $cv_ref, "$RV_class",
+   "Test $RV_class return from svref_2object - code");
 my $cv_ret = $cv_ref->object_2svref();
 is(ref $cv_ret, "REF", "Test object_2svref() return is REF");
 is($$cv_ret, $cv, "Test object_2svref()");
 
 my $av = [];
 my $av_ref = B::svref_2object(\$av);
-is(ref $av_ref, "B::RV", "Test B::RV return from svref_2object - array");
+is(ref $av_ref, "$RV_class",
+   "Test $RV_class return from svref_2object - array");
 
 my $hv = [];
 my $hv_ref = B::svref_2object(\$hv);
-is(ref $hv_ref, "B::RV", "Test B::RV return from svref_2object - hash");
+is(ref $hv_ref, "$RV_class",
+   "Test $RV_class return from svref_2object - hash");
 
 local *gv = *STDOUT;
 my $gv_ref = B::svref_2object(\*gv);
@@ -162,4 +168,22 @@ is(B::cstring("wibble"), '"wibble"', "Testing B::cstring()");
 is(B::perlstring("wibble"), '"wibble"', "Testing B::perlstring()");
 is(B::class(bless {}, "Wibble::Bibble"), "Bibble", "Testing B::class()");
 is(B::cast_I32(3.14), 3, "Testing B::cast_I32()");
-is(B::opnumber("localtime"), 294);
+is(B::opnumber("chop"), 38, "Testing opnumber with opname (chop)");
+
+{
+    no warnings 'once';
+    my $sg = B::sub_generation();
+    *UNIVERSAL::hand_waving = sub { };
+    ok( $sg < B::sub_generation, "sub_generation increments" );
+}
+
+{
+    my $ag = B::amagic_generation();
+    {
+
+        package Whatever;
+        require overload;
+        overload->import( '""' => sub {"What? You want more?!"} );
+    }
+    ok( $ag < B::amagic_generation, "amagic_generation increments" );
+}