B::SV{REFCNT,FLAGS,SvTYPE,POK,ROK,MAGICAL} can be implemented via ALIAS.

Maksing the flags directly here breaks a bit of the encapsulation of sv.h, but
saves about 4K on this platform.

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 1208c2e..1b93e7d 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1277,9 +1277,21 @@ COP_hints(o)
 
 MODULE = B     PACKAGE = B::SV
 
+#define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
+
 U32
-SvTYPE(sv)
+REFCNT(sv)
        B::SV   sv
+    ALIAS:
+       FLAGS = 0xFFFFFFFF
+       SvTYPE = SVTYPEMASK
+       POK = SVf_POK
+       ROK = SVf_ROK
+       MAGICAL = MAGICAL_FLAG_BITS
+    CODE:
+       RETVAL = ix ? (SvFLAGS(sv) & (U32)ix) : SvREFCNT(sv);
+    OUTPUT:
+       RETVAL
 
 #define object_2svref(sv)      sv
 #define SVREF SV *
@@ -1288,28 +1300,6 @@ SVREF
 object_2svref(sv)
        B::SV   sv
 
-MODULE = B     PACKAGE = B::SV         PREFIX = Sv
-
-U32
-SvREFCNT(sv)
-       B::SV   sv
-
-U32
-SvFLAGS(sv)
-       B::SV   sv
-
-U32
-SvPOK(sv)
-       B::SV   sv
-
-U32
-SvROK(sv)
-       B::SV   sv
-
-U32
-SvMAGICAL(sv)
-       B::SV   sv
-
 MODULE = B     PACKAGE = B::IV         PREFIX = Sv
 
 IV

diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index 614c8b2..afe88dd 100644 (file)
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -64,6 +64,45 @@ ok( B::svref_2object(\$.)->MAGIC->TYPE eq "\0", '$. has \0 magic' );
        '$. has no more magic' );
 }
 
+{
+    my $pie = 'Good';
+    # This needs to be a package variable, as vars in the pad have some flags.
+    my $r = B::svref_2object(\$::data2);
+    is($r->FLAGS(), 0, "uninitialised package variable has flags of 0");
+    is($r->SvTYPE(), 0, "uninitialised package variable has type 0");
+    is($r->POK(), 0, "POK false");
+    is($r->ROK(), 0, "ROK false");
+    is($r->MAGICAL(), 0, "MAGICAL false");
+    $::data2 = $pie;
+    isnt($r->FLAGS(), 0, "initialised package variable has nonzero flags");
+    isnt($r->SvTYPE(), 0, "initialised package variable has nonzero type");
+    isnt($r->POK(), 0, "POK true");
+    is($r->ROK(), 0, "ROK false");
+    is($r->MAGICAL(), 0, "MAGICAL false");
+
+    $::data2 = substr $pie, 0, 1;
+    isnt($r->FLAGS(), 0, "initialised package variable has nonzero flags");
+    isnt($r->SvTYPE(), 0, "initialised package variable has nonzero type");
+    isnt($r->POK(), 0, "POK true");
+    is($r->ROK(), 0, "ROK false");
+    is($r->MAGICAL(), 0, "MAGICAL true");
+
+    $::data2 = \$pie;
+    isnt($r->FLAGS(), 0, "initialised package variable has nonzero flags");
+    isnt($r->SvTYPE(), 0, "initialised package variable has nonzero type");
+    is($r->POK(), 0, "POK false");
+    isnt($r->ROK(), 0, "ROK true");
+    is($r->MAGICAL(), 0, "MAGICAL false");
+
+    is($r->REFCNT(), 1, "Reference count is 1");
+    {
+       my $ref = \$::data2;
+       is($r->REFCNT(), 2, "Second reference");
+    }
+    is($r->REFCNT(), 1, "Reference count is 1");
+
+}
+
 my $r = qr/foo/;
 my $obj = B::svref_2object($r);
 my $regexp =  ($] < 5.011) ? $obj->MAGIC : $obj;
@@ -146,6 +185,8 @@ ok(! $gv_ref->is_empty(), "Test is_empty()");
 is($gv_ref->NAME(), "gv", "Test NAME()");
 is($gv_ref->SAFENAME(), "gv", "Test SAFENAME()");
 like($gv_ref->FILE(), qr/b\.t$/, "Testing FILE()");
+is($gv_ref->SvTYPE(), B::SVt_PVGV, "Test SvTYPE()");
+is($gv_ref->FLAGS() & B::SVTYPEMASK, B::SVt_PVGV, "Test SVTYPEMASK");
 
 # The following return B::SPECIALs.
 is(ref B::sv_yes(), "B::SPECIAL", "B::sv_yes()");