Add a few helpers to B for INVLIST

This commit provide some basic method
to access to internal fields from one
INVLIST: SVt_INVLIST

- prev_index
- is_offset
- array_len
- get_invlist_array

This allows B::C to be walk and save invlists.

4 files changed, 166 insertions, 5 deletions

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 551f2308c0..ef23af6baa 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -20,7 +20,7 @@ sub import {
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.81';
+    $B::VERSION = '1.82';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
@@ -559,9 +559,9 @@ The inheritance hierarchy mimics the underlying C "inheritance":
                 +------------+------------+
                 |            |            |
               B::PV        B::IV        B::NV
-                  \         /           /
-                   \       /           /
-                    B::PVIV           /
+               /  \         /           /
+              /    \       /           /
+        B::INVLIST  B::PVIV           /
                          \           /
                           \         /
                            \       /
@@ -735,6 +735,32 @@ in the MAGIC.
 
 =back
 
+=head2 B::INVLIST Methods
+
+=over 4
+
+=item prev_index
+
+Returns the cache result of previous invlist_search() (internal usage)
+
+=item is_offset
+
+Returns a boolean value (0 or 1) to know if the invlist is using an offset.
+When false the list begins with the code point U+0000.
+When true the list begins with the following elements.
+
+=item array_len
+
+Returns an integer with the size of the array used to define the invlist.
+
+=item get_invlist_array
+
+This method returns a list of integers representing the array used by the
+invlist.
+Note: this cannot be used while in middle of iterating on an invlist and croaks.
+
+=back
+
 =head2 B::PVLV Methods
 
 =over 4
diff --git a/ext/B/B.xs b/ext/B/B.xs
index ae2393efbe..e6e3fb8309 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -13,6 +13,9 @@
 #include "perl.h"
 #include "XSUB.h"
 
+/* #include "invlist_inline.h" */
+#define FROM_INTERNAL_SIZE(x) ((x)/ sizeof(UV))
+
 #ifdef PerlIO
 typedef PerlIO * InputStream;
 #else
@@ -472,6 +475,7 @@ typedef PADLIST	*B__PADLIST;
 typedef PADNAMELIST *B__PADNAMELIST;
 typedef PADNAME	*B__PADNAME;
 
+typedef INVLIST  *B__INVLIST;
 
 #ifdef MULTIPLICITY
 #  define ASSIGN_COMMON_ALIAS(prefix, var) \
@@ -1631,6 +1635,71 @@ REGEX(sv)
 		PUSHi(PTR2IV(sv));
 	}
 
+MODULE = B  PACKAGE = B::INVLIST    PREFIX = Invlist
+
+int
+prev_index(invlist)
+       B::INVLIST      invlist
+    CODE:
+        RETVAL = ((XINVLIST*) SvANY(invlist))->prev_index;
+    OUTPUT:
+       RETVAL
+
+int
+is_offset(invlist)
+       B::INVLIST      invlist
+    CODE:
+        RETVAL = ((XINVLIST*) SvANY(invlist))->is_offset == TRUE ? 1 : 0;
+    OUTPUT:
+       RETVAL
+
+unsigned int
+array_len(invlist)
+       B::INVLIST      invlist
+    CODE:
+    {
+        if (SvCUR(invlist) > 0)
+            RETVAL = FROM_INTERNAL_SIZE(SvCUR(invlist)); /* - ((XINVLIST*) SvANY(invlist))->is_offset; */ /* <- for iteration */
+        else
+            RETVAL = 0;
+    }
+    OUTPUT:
+       RETVAL
+
+void
+get_invlist_array(invlist)
+    B::INVLIST      invlist
+PPCODE:
+  {
+    /* should use invlist_is_iterating but not public for now */
+    bool is_iterating = ( (XINVLIST*) SvANY(invlist) )->iterator < (STRLEN) UV_MAX;
+
+    if (is_iterating) {
+        croak( "Can't access inversion list: in middle of iterating" );
+    }
+
+    {
+        UV pos;
+        UV len;
+
+        len = 0;
+        /* should use _invlist_len (or not) */
+        if (SvCUR(invlist) > 0)
+            len = FROM_INTERNAL_SIZE(SvCUR(invlist)); /* - ((XINVLIST*) SvANY(invlist))->is_offset; */ /* <- for iteration */
+
+        if ( len > 0 ) {
+            UV *array = (UV*) SvPVX( invlist ); /* invlist_array */
+
+            EXTEND(SP, (int) len);
+
+            for ( pos = 0; pos < len; ++pos ) {
+                PUSHs( sv_2mortal( newSVuv(array[pos]) ) );
+            }
+        }
+    }
+
+  }
+
 MODULE = B	PACKAGE = B::PV
 
 void
@@ -2206,7 +2275,7 @@ PadnameTYPE(pn)
 	B::PADLIST::outid	= PL_outid_ix
     PREINIT:
 	char *ptr;
-	SV *ret;
+	SV *ret = NULL;
     PPCODE:
 	ptr = (ix & 0xFFFF) + (char *)pn;
 	switch ((U8)(ix >> 16)) {
diff --git a/ext/B/t/invlist.t b/ext/B/t/invlist.t
new file mode 100644
index 0000000000..a719d04cd2
--- /dev/null
+++ b/ext/B/t/invlist.t
@@ -0,0 +1,65 @@
+#!./perl
+
+BEGIN {
+    unshift @INC, 't';
+    require Config;
+    if ( ( $Config::Config{'extensions'} !~ /\bB\b/ ) ) {
+        print "1..0 # Skip -- Perl configured without B module\n";
+        exit 0;
+    }
+}
+
+use strict;
+use warnings;
+use Test::More;
+
+if ( $Config::Config{useithreads} ) {
+    plan( skip_all => "Perl compiled with ithreads... no invlist in the example");
+}
+
+use_ok('B');
+
+# Somewhat minimal tests.
+
+my $found_invlist;
+
+# we are going to walk this sub
+sub check {
+    "ABCD" !~ tr/\0-\377//c;    # this is using the Latin1_invlist
+}
+
+sub B::OP::visit {
+    my $op = shift;
+
+    note ref($op) . " ; NAME: ", $op->name, " ; TYPE: ", $op->type;
+
+    return unless ref $op eq 'B::SVOP' && $op->name eq 'trans';
+
+    my $sv = $op->sv;
+
+    note "SV: ", ref $sv, " = " . $sv->LEN . " " . $sv->CUR;
+    foreach my $elt ( $sv->ARRAY ) {
+        next unless ref $elt eq 'B::INVLIST';
+        $found_invlist = 1;
+        my $invlist = $elt;
+
+        is $invlist->prev_index, 0, "prev_index=0";
+        is $invlist->is_offset,  0, "is_offset = 0 (false)";
+
+        my @array = $invlist->get_invlist_array;
+        is scalar @array, 2, "invlist array size is 2" or diag explain \@array;
+        is $array[0], 0,   "PL_Latin1 first value in the invlist array is 0"  or diag explain \@array;
+        is $array[1], 256, "PL_Latin1 second value in the invlist array is 0" or diag explain \@array;
+
+        is $invlist->array_len(), 2, "PL_Latin1 array length is 2";
+    }
+
+    return;
+}
+
+my $op = B::svref_2object( \*main::check );
+B::walkoptree( $op->CV->ROOT, 'visit' );
+
+ok $found_invlist, "visited one INVLIST";
+
+done_testing();
diff --git a/ext/B/typemap b/ext/B/typemap
index 045d6a0f71..d891f9d7d5 100644
--- a/ext/B/typemap
+++ b/ext/B/typemap
@@ -27,6 +27,7 @@ B::HV		T_SV_OBJ
 B::AV		T_SV_OBJ
 B::IO		T_SV_OBJ
 B::FM		T_SV_OBJ
+B::INVLIST	T_SV_OBJ
 
 B::MAGIC	T_MG_OBJ
 SSize_t		T_IV