[PATCH 6/7] support Devel::Mwrap::each with callback

[Eric Wong <e@80x24.org>]

We need to hold the RCU lock while we run this, so we
can't rely on the "tie" interface and use the standard
"each" function.
---
 Mwrap.xs  | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 t/mwrap.t | 32 ++++++++++++++++++++++++++++++++
 2 files changed, 83 insertions(+)

diff --git a/Mwrap.xs b/Mwrap.xs
index a89578a..b81dfc0 100644
--- a/Mwrap.xs
+++ b/Mwrap.xs
@@ -765,6 +765,57 @@ CODE:
 OUTPUT:
 	RETVAL
 
+void
+mwrap_each(min, cb)
+	size_t min;
+	SV *cb;
+PREINIT:
+	struct cds_lfht *t;
+	struct cds_lfht_iter iter;
+	struct src_loc *l;
+CODE:
+	++locating;
+	rcu_read_lock();
+	t = rcu_dereference(totals);
+	if (t) {
+		bool err = false;
+
+		cds_lfht_for_each_entry(t, &iter, l, hnode) {
+			size_t total = uatomic_read(&l->total);
+
+			if (total > min) {
+				SV *loc;
+				dSP;
+				ENTER;
+				SAVETMPS;
+
+				PUSHMARK(SP);
+				loc = sv_newmortal();
+				sv_setref_pv(loc, "Devel::Mwrap::SrcLoc", l);
+				XPUSHs(loc);
+				PUTBACK;
+
+				call_sv(cb, G_DISCARD|G_EVAL);
+
+				SPAGAIN;
+				if (SvTRUE(ERRSV))
+					err = true;
+
+				FREETMPS;
+				LEAVE;
+			}
+			if (err)
+				break;
+			assert(rcu_read_ongoing());
+		}
+	}
+	if (SvTRUE(ERRSV))
+		croak(NULL);
+CLEANUP:
+	rcu_read_unlock();
+	--locating;
+
+
 void
 mwrap_reset()
 PREINIT:
diff --git a/t/mwrap.t b/t/mwrap.t
index eabc68a..3dd3d57 100644
--- a/t/mwrap.t
+++ b/t/mwrap.t
@@ -61,6 +61,38 @@ E1
 		'-d:Mwrap', 't/source_location.perl');
 }
 
+mwrap_run('Devel::Mwrap::each', {}, '-e', <<'EOF');
+open my $zero, '<', '/dev/zero' or die "open /dev/zero: $!";
+my $nbytes = 1024 * 512;
+sysread($zero, my $before, $nbytes);
+my @keep;
+eval { Devel::Mwrap::each(0, sub { die "died in each"; push @keep, @_; }) };
+"$@" =~ /died in each at -e line 5/ or die "did not propagate die in each";
+scalar(@keep) == 0 or die "nothing if died in sub";
+my %h;
+my $iter;
+Devel::Mwrap::each(1, sub {
+	my ($src_loc, @more) = @_;
+	my $name = $src_loc->name;
+	$h{$name} = $src_loc;
+	sysread($zero, my $iter, $nbytes);
+	die 'extra args from ::each' if @more;
+});
+my $src_loc = $h{"-e:3"} or die "missing src_loc for -e:3";
+$src_loc->total >= $nbytes or die "allocated <= $nbytes";
+$src_loc = Devel::Mwrap::get("-e:8");
+if ($src_loc && $src_loc->total >= $nbytes) {
+	die "large allocation inside :each should not be tracked";
+}
+Devel::Mwrap::each($nbytes, sub { push @keep, @_ });
+scalar(@keep) == 1 or die "got multiple matches for > $nbytes";
+$keep[0]->name eq '-e:3' or die "unexpected location for > $nbytes";
+@keep = ();
+Devel::Mwrap::reset();
+Devel::Mwrap::each($nbytes, sub { push @keep, @_ });
+scalar(@keep) == 0 or die "::reset did not work";
+EOF
+
 done_testing();
 
 sub slurp {