From de64752d290b57032d45d72532fb976cf2b9b2b0 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 29 Oct 2010 10:28:53 +0100
Subject: [PATCH] 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.
---
 ext/B/B.xs  | 36 +++++++++++++-----------------------
 ext/B/t/b.t | 41 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 54 insertions(+), 23 deletions(-)

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 1208c2e..1b93e7d 100644
--- 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
--- 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()");
-- 
2.7.4