On Thursday 11 October 2007 15:18, Torsten Foertsch wrote: > I am wondering whether the REFCNT is always right. *pnotes is a HV. If the > function is called without a key argument the else branch newRV_inc > increments the REFCNT of the HV, right? Then the return statement in the > last line increments it again? Am I wrong?
Here is a test that shows what I mean. Under 2.0.3 I get this:
Failed Test Stat Wstat Total Fail List of Failed
-------------------------------------------------------------------------------
t/modperl/pnotes2.t 12 8 2 4-6 8 10-12
The test saves an object in pnotes that on DESTROY prints a message to the
error_log. Further a CleanupHandler is installed to check if the pnotes are
destroyed after that phase.
In each failing test pnotes are accessed at least once without arguments. The
stored object is not destroyed because the REFCNT of the HV is too big.
->pnotes($key=>$value) works but has other drawbacks. (my $x=1;
$r->pnotes(x=>$x); undef $x; # undefs also $r->pnotes->{x})
Torsten
Index: t/modperl/pnotes2.t
===================================================================
--- t/modperl/pnotes2.t (revision 0)
+++ t/modperl/pnotes2.t (revision 0)
@@ -0,0 +1,32 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestRequest qw(GET_BODY);
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestUtil qw/t_start_error_log_watch t_finish_error_log_watch/;
+
+my $module = 'TestModperl::pnotes2';
+my $url = Apache::TestRequest::module2url($module);
+my ($u, $ok);
+
+t_debug("connecting to $url");
+
+plan tests => 12, need_lwp;
+
+Apache::TestRequest::user_agent(reset => 1, keep_alive => 0);
+
+for my $i (1..12) {
+ t_client_log_warn_is_expected();
+ t_start_error_log_watch;
+ $u="$url?$i"; $ok=GET_BODY $u;
+ select undef, undef, undef, 0.2; # give it time to write the logfile
+ ok t_cmp scalar(grep {
+ /pnotes are destroyed after cleanup passed/;
+ } t_finish_error_log_watch), 1, $u;
+}
+
+# Local Variables: #
+# mode: cperl #
+# cperl-indent-level: 4 #
+# End: #
Index: t/response/TestModperl/pnotes2.pm
===================================================================
--- t/response/TestModperl/pnotes2.pm (revision 0)
+++ t/response/TestModperl/pnotes2.pm (revision 0)
@@ -0,0 +1,89 @@
+package TestModperl::pnotes2;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::Log ();
+use Apache2::RequestUtil ();
+use Apache2::ConnectionUtil ();
+
+use Apache2::Const -compile => 'OK';
+
+{
+ package TestModerl::pnotes2::x;
+ use strict;
+ use warnings FATAL => 'all';
+
+ sub new {shift;bless [EMAIL PROTECTED];}
+ sub DESTROY {my $f=shift @{$_[0]}; $f->(@{$_[0]});}
+}
+
+sub line {
+ our $cleanup;
+
+ Apache2::ServerRec::warn "pnotes are destroyed after cleanup ".$cleanup;
+}
+
+sub cleanup {
+ our $cleanup;
+ $cleanup='passed';
+
+ return Apache2::Const::OK;
+}
+
+sub handler {
+ my $r = shift;
+
+ our $cleanup;
+ $cleanup='';
+
+ $r->push_handlers( PerlCleanupHandler=>__PACKAGE__.'::cleanup' );
+
+ if(!defined $r->args) {
+ } elsif($r->args == 1) {
+ $r->pnotes(x1 => TestModerl::pnotes2::x->new(\&line));
+ } elsif($r->args == 2) {
+ $r->pnotes->{x1} = TestModerl::pnotes2::x->new(\&line);
+ } elsif($r->args == 3) {
+ $r->pnotes(x1 => TestModerl::pnotes2::x->new(\&line));
+ $r->pnotes(x2 => 2);
+ } elsif($r->args == 4) {
+ $r->pnotes->{x1} = TestModerl::pnotes2::x->new(\&line);
+ $r->pnotes->{x2} = 2;
+ } elsif($r->args == 5) {
+ $r->pnotes(x1 => TestModerl::pnotes2::x->new(\&line));
+ $r->pnotes->{x2} = 2;
+ } elsif($r->args == 6) {
+ $r->pnotes->{x1} = TestModerl::pnotes2::x->new(\&line);
+ $r->pnotes(x2 => 2);
+ } elsif($r->args == 7) {
+ $r->connection->pnotes(x1 => TestModerl::pnotes2::x->new(\&line));
+ } elsif($r->args == 8) {
+ $r->connection->pnotes->{x1} = TestModerl::pnotes2::x->new(\&line);
+ } elsif($r->args == 9) {
+ $r->connection->pnotes(x1 => TestModerl::pnotes2::x->new(\&line));
+ $r->connection->pnotes(x2 => 2);
+ } elsif($r->args == 10) {
+ $r->connection->pnotes->{x1} = TestModerl::pnotes2::x->new(\&line);
+ $r->connection->pnotes->{x2} = 2;
+ } elsif($r->args == 11) {
+ $r->connection->pnotes(x1 => TestModerl::pnotes2::x->new(\&line));
+ $r->connection->pnotes->{x2} = 2;
+ } elsif($r->args == 12) {
+ $r->connection->pnotes->{x1} = TestModerl::pnotes2::x->new(\&line);
+ $r->connection->pnotes(x2 => 2);
+ }
+
+ $r->content_type('text/plain');
+ $r->print("OK");
+
+ Apache2::Const::OK;
+}
+
+1;
+__END__
+
+# Local Variables: #
+# mode: cperl #
+# cperl-indent-level: 4 #
+# End: #
pgprw6kYAORIE.pgp
Description: PGP signature
