From: David Mitchell <davem@iabyn.com>
Date: Sun, 11 Apr 2010 14:23:17 +0000 (+0100)
Subject: create SV leak test infrastructure
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d97c33b505dd45c052a8bf42014917701b4502a5;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
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");