Item13897: Fixed two memory leaks. Converted RegisterTests.

Dropping some TWiki-compatibility stuff too... - Fixed real-life memory leak of Prefs::TopicRAM referencing the topic it's being read from and creating a circular dependency case. Weaking helps. - Fixed test-case runtime memory leak by weakening reference to the active app object when creating a new callback. - Added dumping of Perl's heap using Devel::MAT. - Because stderr output usually comes before stdout it was often hard to bind a error message to the test where it was generated. Enforced flushing of stdout in TestRunner. - Bug fixes...
foswiki · Jun 18, 2016 · 73f92ab · 73f92ab
1 parent b227829
commit 73f92ab
Show file tree

Hide file tree

Showing 12 changed files with 133 additions and 78 deletions.
diff --git a/UnitTestContrib/lib/Unit/TestApp.pm b/UnitTestContrib/lib/Unit/TestApp.pm
@@ -3,7 +3,9 @@
 package Unit::TestApp;
 use v5.14;
 
-use Scalar::Util qw(blessed);
+use Assert;
+
+use Scalar::Util qw(blessed weaken refaddr);
 
 use Moo;
 use namespace::clean;
@@ -89,12 +91,11 @@ sub registerCallbacks {
 
     return if $this->_cbRegistered;
 
+    my $cbData = { app => $this, };
+    weaken( $cbData->{app} );
     foreach my $cbName ( keys %{ $this->callbacks } ) {
-        $this->registerCallback(
-            $cbName,
-            $this->callbacks->{$cbName},
-            { app => $this, }
-        );
+        $this->registerCallback( $cbName, $this->callbacks->{$cbName},
+            $cbData );
     }
 
     $this->_cbRegistered(1);

diff --git a/UnitTestContrib/lib/Unit/TestRunner.pm b/UnitTestContrib/lib/Unit/TestRunner.pm
@@ -24,7 +24,7 @@ extends 'Foswiki::Object';
 
 use Assert;
 
-sub CHECKLEAK { 0 }
+sub CHECKLEAK { 1 }
 
 BEGIN {
     if (CHECKLEAK) {
@@ -605,7 +605,6 @@ sub runOne {
                 print "SKIP\t$test - $skip\n";
             }
             else {
-                local $| = 1;
                 Devel::Leak::Object::checkpoint() if CHECKLEAK;
                 print "\t$test\n";
                 $action .= "\n# $test\n    ";

diff --git a/UnitTestContrib/test/bin/TestRunner.pl b/UnitTestContrib/test/bin/TestRunner.pl
@@ -76,11 +76,15 @@ BEGIN
     $env->{FOSWIKI_ACTION} =
       'view';    # SMELL Shan't we add a 'test' action to the SwitchBoard?
     $env->{FOSWIKI_ENGINE} = 'Foswiki::Engine::Test';
-    $app = Unit::TestApp->new( env => $env );
+    $app = Unit::TestApp->new(
+        env          => $env,
+        engineParams => { initialAttributes => { action => 'view', }, },
+    );
     $cfg = $app->cfg;
 }
 catch {
-    die Foswiki::Exception::errorStr($_);
+    say STDERR Foswiki::Exception::errorStr($_);
+    exit 1;
 };
 
 my ( $stdout, $stderr, $log );    # will be destroyed at the end, if created
@@ -140,7 +144,6 @@ BEGIN
 }
 
 if ( not $options{-worker} ) {
-    require Foswiki;
     if ( defined $cfg->data->{DataDir} && $cfg->data->{DataDir} ne 'NOT SET' ) {
         testForFiles( $cfg->data->{DataDir}, '/Temp*' );
     }
@@ -161,11 +164,21 @@ BEGIN
 }
 catch {
     say STDERR Foswiki::Exception::errorStr($_);
+}
+finally {
+    undef $app;
 };
 
 print STDERR "Run was logged to $log\n" if $options{-log};
 
 Cwd::chdir($starting_root) if ($starting_root);
+if (Unit::TestRunner::CHECKLEAK) {
+    eval {
+        require Devel::MAT::Dumper;
+        Devel::MAT::Dumper::dump(
+            $starting_root . "/working/logs/FOSWIKI.pmat" );
+    };
+}
 exit $exit;
 
 sub testForFiles {

diff --git a/UnitTestContrib/test/unit/FoswikiFnTestCase.pm b/UnitTestContrib/test/unit/FoswikiFnTestCase.pm
@@ -168,8 +168,10 @@ around tear_down => sub {
         'Main', "UsersWebName equals to 'Main'" );
     $this->removeWebFixture( $cfg->data->{UsersWebName} );
     unlink( $Foswiki::cfg{Htpasswd}{FileName} );
-    $orig->( $this, @_ );
 
+    @mails = ();
+
+    $orig->( $this, @_ );
 };
 
 =begin TML
@@ -230,8 +232,10 @@ sub registerUser {
 
     $this->createNewFoswikiApp(
         requestParams => { initializer => $reqParams, },
-        engineParams =>
-          { path_info => "/" . $this->users_web . "/UserRegistration", },
+        engineParams  => {
+            initialAttributes =>
+              { path_info => "/" . $this->users_web . "/UserRegistration", },
+        },
     );
     $this->assert(
         $this->app->store->topicExists(

diff --git a/UnitTestContrib/test/unit/FoswikiTestCase.pm b/UnitTestContrib/test/unit/FoswikiTestCase.pm
@@ -62,8 +62,9 @@ has app => (
         return Unit::TestApp->new( env => \%ENV );
     },
 );
-has twiki =>
-  ( is => 'rw', clearer => 1, lazy => 1, default => sub { $_[0]->app }, );
+
+#has twiki =>
+#  ( is => 'rw', clearer => 1, lazy => 1, default => sub { $_[0]->app }, );
 has test_topicObject => (
     is        => 'rw',
     clearer   => 1,
@@ -786,6 +787,8 @@ s/((\$Foswiki::cfg\{.*?\})\s*=.*?;)(?:\n|$)/push(@moreConfig, $1) unless (eval "
         env  => $this->app->cloneEnv,
         cfg  => $this->app->cfg->clone,
     );
+    ASSERT( $tmp->cfg->app == $tmp,
+        "Object app attr doesn't point to the new app" );
     ASSERT( defined $Foswiki::app ) if SINGLE_SINGLETONS;
     undef $tmp;    # finish() will be called automatically.
     ASSERT( !defined $Foswiki::app ) if SINGLE_SINGLETONS;
@@ -827,11 +830,6 @@ s/((\$Foswiki::cfg\{.*?\})\s*=.*?;)(?:\n|$)/push(@moreConfig, $1) unless (eval "
 around tear_down => sub {
     my $orig = shift;
     my $this = shift;
-
-    if ( $this->has_app ) {
-        ASSERT( $this->app->isa('Unit::TestApp') ) if SINGLE_SINGLETONS;
-        $this->finishFoswikiSession;
-    }
     $this->_clear_tempDir;
     $this->app->cfg->data( { eval $this->__FoswikiSafe } );
     foreach my $sym ( keys %ENV ) {
@@ -857,6 +855,11 @@ around tear_down => sub {
         delete $Foswiki::Meta::VALIDATE{$thing}
           unless $Foswiki::Meta::VALIDATE{$thing}->{_default};
     }
+
+    if ( $this->has_app ) {
+        ASSERT( $this->app->isa('Unit::TestApp') ) if SINGLE_SINGLETONS;
+        $this->finishFoswikiSession;
+    }
 };
 
 sub _copy {
@@ -1099,8 +1102,8 @@ sub createNewFoswikiApp {
     $params{env} //= $this->app->cloneEnv;
     my $app = Unit::TestApp->new( cfg => $this->app->cfg->clone, %params );
 
-    $this->_fixupAppObjects;
     $this->app($app);
+    $this->_fixupAppObjects;
 
     ASSERT( defined $Foswiki::app ) if SINGLE_SINGLETONS;
 
@@ -1238,7 +1241,7 @@ sub _fixupAppObjects {
         if (
                blessed( $this->{$attr} )
             && $this->$attr->isa('Foswiki::Object')
-            && $this->$attr->does('Foswiki::AppObject')
+            && $this->$attr->can('_set_app')
             && ( !defined( $this->$attr->app )
                 || ( $this->$attr->app != $app ) )
           )

diff --git a/UnitTestContrib/test/unit/RegisterTests.pm b/UnitTestContrib/test/unit/RegisterTests.pm
@@ -567,7 +567,8 @@ BODY
 
     $this->registerAccount();
 
-    my ($meta) = Foswiki::Func::readTopic( $cfgData->{UsersWebName},
+    my ($meta) =
+      Foswiki::Func::readTopic( $this->app->cfg->data->{UsersWebName},
         $this->new_user_wikiname );
     my $text = $meta->text;
 
@@ -2418,6 +2419,7 @@ sub test_PendingRegistrationAutoCleanup {
         callbacks => { handleRequestException => \&_cbHRE },
 
     );
+    $cfgData = $this->app->cfg->data;
     $this->app->net->setMailHandler( \&FoswikiFnTestCase::sentMail );
 
     try {
@@ -2827,7 +2829,6 @@ sub registerUserException {
             },
         },
         callbacks => { handleRequestException => \&_cbHRE },
-
     );
     $this->app->net->setMailHandler( \&FoswikiFnTestCase::sentMail );
     my $exception;
@@ -2855,7 +2856,6 @@ sub registerUserException {
                 $exception = Foswiki::Exception::RTInfo->transmute($exception);
                 $exception->template('died');
             }
-
         }
         else {
             $exception = Foswiki::Exception::RTInfo->transmute($exception);

diff --git a/core/lib/Foswiki.pm b/core/lib/Foswiki.pm
@@ -59,6 +59,8 @@ use Foswiki::Exception;
 # still breaks some unicode byte strings
 $CGI::ENCODE_ENTITIES = q{&<>"'};
 
+our $app;
+
 # Site configuration constants
 our %cfg;
 

diff --git a/core/lib/Foswiki/AccessControlException.pm b/core/lib/Foswiki/AccessControlException.pm
@@ -130,10 +130,11 @@ around stringify => sub {
     my $this  = shift;
     my $topic = $this->topic
       || '';   # Access checks of Web objects causes uninitialized string errors
+    my $web = $this->web // '*UNDEF*';
     return
         "AccessControlException: Access to "
       . $this->mode . " "
-      . $this->web
+      . $web
       . ".$topic for "
       . $this->user
       . " is denied. "

diff --git a/core/lib/Foswiki/App.pm b/core/lib/Foswiki/App.pm
@@ -312,8 +312,8 @@ sub BUILD {
 
     $Foswiki::app = $this;
 
-    my $cfg = $this->cfg;
-    if ( $cfg->data->{Store}{overrideUmask} && $cfg->data->{OS} ne 'WINDOWS' ) {
+    my $cfgData = $this->cfg->data;
+    if ( $cfgData->{Store}{overrideUmask} && $cfgData->{OS} ne 'WINDOWS' ) {
 
 # Note: The addition of zero is required to force dirPermission and filePermission
 # to be numeric.   Without the additition, certain values of the permissions cause
@@ -323,8 +323,8 @@ sub BUILD {
             (
                 oct(777) - (
                     (
-                        $cfg->data->{Store}{dirPermission} + 0 |
-                          $cfg->data->{Store}{filePermission} + 0
+                        $cfgData->{Store}{dirPermission} + 0 |
+                          $cfgData->{Store}{filePermission} + 0
                     )
                 ) & oct(777)
             )
@@ -340,14 +340,14 @@ sub BUILD {
     # Enforce some shell environment variables.
     # SMELL Would it be tolerated in PSGI?
     $CGI::TMPDIRECTORY = $ENV{TMPDIR} = $ENV{TEMP} = $ENV{TMP} =
-      $cfg->data->{TempfileDir};
+      $cfgData->{TempfileDir};
 
     # Make %ENV safer, preventing hijack of the search path. The
     # environment is set per-query, so this can't be done in a BEGIN.
     # This MUST be done before any external programs are run via Sandbox.
     # or it will fail with taint errors.  See Item13237
-    if ( defined $cfg->data->{SafeEnvPath} ) {
-        $ENV{PATH} = $cfg->data->{SafeEnvPath};
+    if ( defined $cfgData->{SafeEnvPath} ) {
+        $ENV{PATH} = $cfgData->{SafeEnvPath};
     }
     else {
         # Default $ENV{PATH} must be untainted because
@@ -366,7 +366,7 @@ sub BUILD {
         Foswiki::Exception::Fatal->throw( text => "Cannot initialize engine" );
     }
 
-    unless ( $this->cfg->data->{isVALID} ) {
+    unless ( $cfgData->{isVALID} ) {
         $this->cfg->bootstrapSystemSettings;
     }
 
@@ -375,7 +375,7 @@ sub BUILD {
     # Override user to be admin if no configuration exists.
     # Do this really early, so that later changes in isBOOTSTRAPPING can't
     # change Foswiki's behavior.
-    if ( $cfg->data->{isBOOTSTRAPPING} ) {
+    if ( $cfgData->{isBOOTSTRAPPING} ) {
         $this->engine->user('admin');
     }
     else {
@@ -391,6 +391,27 @@ sub BUILD {
 
 sub DEMOLISH {
     my $this = shift;
+    my ($in_global) = @_;
+
+    # Clean up sessions before we finish.
+    if ( 0 && DEBUG ) {
+        if ($in_global) {
+            say STDERR ">>>>";
+            say STDERR Carp::longmess( ref($this) . '::DEMOLISH' );
+            say STDERR "Object from ", $this->{__orig_file}, ":",
+              $this->{__orig_line};
+            say STDERR $this->{__orig_stack};
+            say STDERR "<<<<";
+            require Devel::MAT::Dumper;
+        }
+        else {
+            say STDERR ref($this) . '::DEMOLISH';
+            say STDERR "Object from ", $this->{__orig_file}, ":",
+              $this->{__orig_line};
+            say STDERR $this->{__orig_stack};
+        }
+    }
+    $this->users->loginManager->complete;
 
 }
 
@@ -411,9 +432,8 @@ sub run {
     my %params = @_;
 
     # Do nice in shared code environment, localize ALL request-related globals.
-    local %Foswiki::app;
+    local $Foswiki::app;
     local %Foswiki::cfg;
-    local %TWiki::cfg;
 
     # Before localizing shell environment we need to preserve and restore it.
     local %ENV = %ENV;

diff --git a/core/lib/Foswiki/LoginManager.pm b/core/lib/Foswiki/LoginManager.pm
@@ -740,8 +740,12 @@ sub complete {
 
     if ( $this->_cgisession ) {
         $this->_cgisession->flush;
-        die $this->_cgisession->errstr
-          if $this->_cgisession->errstr;
+        if ( $this->_cgisession->errstr ) {
+            if (DEBUG) {
+                Carp::confess( $this->_cgisession->errstr );
+            }
+            die $this->_cgisession->errstr;
+        }
     }
 
     # SMELL When called from DEMOLISH it's not guaranteed that

diff --git a/core/lib/Foswiki/Prefs/TopicRAM.pm b/core/lib/Foswiki/Prefs/TopicRAM.pm
@@ -43,7 +43,8 @@ has local => (
     isa     => Foswiki::Object::isaHASH( 'local', noUndef => 1 ),
 );
 has topicObject => (
-    is => 'ro',
+    is       => 'ro',
+    weak_ref => 1,
     isa =>
       Foswiki::Object::isaCLASS( 'topicObject', 'Foswiki::Meta', noUndef => 1 ),
     required => 1,