create SV leak test infrastructure

Add an sv_count() function to XS::APItest to allow access to PL_sv_count,
then add new test file t/op/svleak.t that allows you yo run a code
fragment a few times and test whether the number of allocated SVs has
increased

diff --git a/MANIFEST b/MANIFEST
index e01ecd7..764150e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4484,6 +4484,7 @@ t/op/study.t                      See if study works
 t/op/studytied.t               See if study works with tied scalars
 t/op/sub_lval.t                        See if lvalue subroutines work
 t/op/sub.t                     See if subroutines work
+t/op/svleak.t                  See if stuff leaks SVs
 t/op/switch.t                  See if switches (given/when) work
 t/op/symbolcache.t             See if undef/delete works on stashes with functions
 t/op/sysio.t                   See if sysread and syswrite work

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 11766f4..b176793 100644 (file)
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -24,6 +24,7 @@ our @EXPORT = qw( print_double print_int print_long
                  sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore
                  rmagical_cast rmagical_flags
                  DPeek utf16_to_utf8 utf16_to_utf8_reversed pmflag my_exit
+                 sv_count
 );
 
 our $VERSION = '0.17';
@@ -84,8 +85,8 @@ XS::APItest - Test the perl C API
 
 =head1 ABSTRACT
 
-This module tests the perl C API. Currently tests that C<printf>
-works correctly.
+This module tests the perl C API. Also exposes various bit of the perl
+internals for the use of core test scripts.
 
 =head1 DESCRIPTION
 

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index ede6994..328ddea 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -936,3 +936,10 @@ void
 my_exit(int exitcode)
         PPCODE:
         my_exit(exitcode);
+
+I32
+sv_count()
+        CODE:
+           RETVAL = PL_sv_count;
+       OUTPUT:
+           RETVAL

diff --git a/t/op/svleak.t b/t/op/svleak.t
new file mode 100644 (file)
index 0000000..028647a
--- /dev/null
+++ b/t/op/svleak.t
@@ -0,0 +1,37 @@
+#!./perl
+
+# A place to put some simple leak tests. Uses XS::APItest to make
+# PL_sv_count available, allowing us to run a bit a code multiple times and
+# see if the count increases.
+
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require './test.pl';
+
+    eval { require XS::APItest; XS::APItest->import('sv_count'); 1 }
+       or skip_all("XS::APItest not available");
+}
+
+plan tests => 3;
+
+# run some code N times. If the number of SVs at the end of loop N is
+# greater than (N-1)*delta at the end of loop 1, we've got a leak
+#
+sub leak {
+    my ($n, $delta, $code, @rest) = @_;
+    my $sv0 = 0;
+    my $sv1 = 0;
+    for my $i (1..$n) {
+       &$code();
+       $sv1 = sv_count();
+       $sv0 = $sv1 if $i == 1;
+    }
+    cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest);
+}
+
+my @a;
+
+leak(5, 0, sub {},                 "basic check 1 of leak test infrastructure");
+leak(5, 0, sub {push @a,1;pop @a}, "basic check 2 of leak test infrastructure");
+leak(5, 1, sub {push @a,1;},       "basic check 3 of leak test infrastructure");