On Fri Feb 21 12:54:47 2014, frew wrote:
Show quoted text> The attached test shows a leak.
That particular leak is caused by $responder accidentally being captured across closures, instead of being passed again in parameters.
Attached patch fixes it, and adds a unit test. The leak test script given above also no longer fails.
--
Paul Evans
=== modified file 'lib/Net/Async/HTTP/Connection.pm'
--- lib/Net/Async/HTTP/Connection.pm 2014-03-27 12:47:21 +0000
+++ lib/Net/Async/HTTP/Connection.pm 2014-03-27 16:20:02 +0000
@@ -352,7 +352,7 @@
$stall_reason = "receiving body chunks";
return sub {
- my ( $self, $buffref, $closed ) = @_;
+ my ( $self, $buffref, $closed, $responder ) = @_;
$stall_timer->reset if $stall_timer;
@@ -373,7 +373,7 @@
# Now the trailer
return sub {
- my ( $self, $buffref, $closed ) = @_;
+ my ( $self, $buffref, $closed, $responder ) = @_;
if( $closed ) {
$self->debug_printf( "ERROR closed" );
@@ -449,7 +449,7 @@
$stall_reason = "receiving body";
return sub {
- my ( $self, $buffref, $closed ) = @_;
+ my ( $self, $buffref, $closed, $responder ) = @_;
$stall_timer->reset if $stall_timer;
@@ -497,7 +497,7 @@
$stall_reason = "receiving body until EOF";
return sub {
- my ( $self, $buffref, $closed ) = @_;
+ my ( $self, $buffref, $closed, $responder ) = @_;
$stall_timer->reset if $stall_timer;
=== added file 't/90rt93232.t'
--- t/90rt93232.t 1970-01-01 00:00:00 +0000
+++ t/90rt93232.t 2014-03-27 16:20:02 +0000
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Refcount;
+use IO::Async::Test;
+use IO::Async::Loop;
+
+use Net::Async::HTTP;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+my $http = Net::Async::HTTP->new(
+ user_agent => "", # Don't put one in request headers
+);
+
+$loop->add( $http );
+
+my $port;
+$loop->listen(
+ host => "127.0.0.1",
+ service => 0,
+ socktype => "stream",
+
+ on_listen => sub {
+ $port = shift->sockport;
+ },
+
+ on_stream => sub {
+ my ( $stream ) = @_;
+
+ $stream->configure(
+ on_read => sub {
+ my ( $self, $buffref ) = @_;
+ return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s;
+
+ my $header = $1;
+
+ $self->write(
+ "HTTP/1.1 200 OK$CRLF" .
+ "Content-Type: text/plain$CRLF" .
+ "Content-Length: 2$CRLF" .
+ "Connection: close$CRLF" .
+ "$CRLF" .
+ "OK"
+ );
+
+ return 1;
+ },
+ );
+
+ $loop->add( $stream );
+ },
+)->get;
+
+my $on_body_chunk;
+
+$http->do_request(
+ method => "GET",
+ host => "127.0.0.1",
+ port => $port,
+ request => HTTP::Request->new(GET => "/"),
+
+ on_header => sub {
+ my ( $header ) = @_;
+ # Needs to be a real closure
+ return $on_body_chunk = sub { $header = $header; 1 };
+ },
+)->get;
+
+is_oneref( $on_body_chunk, '$on_body_chunk has refcount 1 before EOF' );
+
+done_testing;
