Item13897: Experimental commit.

Two experimental changes: * Plack::Test support via Unit::PlackTestCase * get/set methods on Foswiki::Config class Both changes lacks documentation because they're moving targets. - Replaced hard-coded 'LocalSite.cfg' in Foswiki::Config with object attribute lscFile which could be initialized either from a constructor parameter or from FOSWIKI_CONFIG environment variable. Targeted at supporting PlackTestCase in a way that allows completely different pre-generated configurations for different tests. Could be used in virtual hosting environments too. - Unit::TestApp constructor now sets inUnitTestMode by default. - Added callbacks testPreHandleRequest and testPostHandleRequest to Unit::TestApp. Used by PlackTestCase to initialize and shutdown a test. - Object attribute testSuite has been moved from Unit::TestSuite to Unit::TestCase to make it always available to test code. - Fixed a problem with FormattingTests on case-insesitive file systems by replacing a web name from 'AA' to 'AAA'. - Bug fixes. Avoiding use of global $Foswiki::inUnitTest wherever possible.
foswiki · Jul 27, 2016 · aff6e75 · aff6e75
1 parent 6603b85
commit aff6e75
Show file tree

Hide file tree

Showing 18 changed files with 512 additions and 52 deletions.
diff --git a/PlainFileStoreContrib/lib/Foswiki/Store/PlainFile.pm b/PlainFileStoreContrib/lib/Foswiki/Store/PlainFile.pm
@@ -1136,7 +1136,7 @@ sub _saveDamage {
     return unless ( _e $latest );
 
     if (   $Foswiki::cfg{Extensions}{PlainFileStoreContrib}{CheckForRCS}
-        && !$Foswiki::inUnitTestMode
+        && !$this->app->inUnitTestMode
         && _e("$latest,v") )
     {
         my $path =

diff --git a/UnitTestContrib/lib/Foswiki/Contrib/UnitTestContrib/MANIFEST b/UnitTestContrib/lib/Foswiki/Contrib/UnitTestContrib/MANIFEST
@@ -16,6 +16,7 @@ lib/Unit/ExternalEngine.pm 0644
 lib/Unit/HTMLDiffer.pm 0644
 lib/Unit/Response.pm 0644
 lib/Unit/TestCase.pm 0644
+lib/Unit/PlackTestCase.pm 0644
 lib/Unit/TestRunner.pm 0644
 lib/Unit/TestSuite.pm 0644
 pub/System/UnitTestContrib/logo.gif 0644
@@ -83,6 +84,7 @@ test/unit/MergeTests.pm 0644
 test/unit/MetaTests.pm 0644
 test/unit/NetTests.pm 0644
 test/unit/PasswordTests.pm 0644
+test/unit/PlackViewTests.pm 0644
 test/unit/PluginHandlerTests.pm 0644
 test/unit/PrefsTests.pm 0644
 test/unit/QueryTests.pm 0644

diff --git a/UnitTestContrib/lib/Unit/PlackTestCase.pm b/UnitTestContrib/lib/Unit/PlackTestCase.pm
@@ -0,0 +1,197 @@
+# See bottom of file for license and copyright information
+
+package Unit::PlackTestCase;
+use v5.14;
+
+use Plack::Test;
+use FindBin;
+
+use Moo;
+use namespace::clean;
+extends qw(Unit::TestCase);
+
+BEGIN {
+    if (Unit::TestRunner::CHECKLEAK) {
+        eval "use Devel::Leak::Object qw{ GLOBAL_bless };";
+        die $@ if $@;
+        $Devel::Leak::Object::TRACKSOURCELINES = 1;
+        $Devel::Leak::Object::TRACKSTACK       = 1;
+    }
+}
+
+has app => (
+    is        => 'rw',
+    weak_ref  => 1,
+    lazy      => 1,
+    predicate => 1,
+    clearer   => 1,
+    isa => Foswiki::Object::isaCLASS( 'app', 'Unit::TestApp', noUndef => 1, ),
+);
+
+=begin TML
+
+---++ ObjectAttribute testClientList : arrayref
+
+List of hashrefs with test parameters.
+
+Keys:
+
+   * =app= 
+   * =client= - required, client sub
+
+=cut 
+
+has testClientList => (
+    is      => 'rw',
+    lazy    => 1,
+    isa     => Foswiki::Object::isaARRAY( 'testList', noUndef => 1, ),
+    builder => 'prepareTestClientList',
+);
+has defaultAppClass => (
+    is      => 'rw',
+    default => 'Unit::TestApp',
+);
+
+sub initialize {
+    my $this = shift;
+    my %args = @_;
+
+    if ( defined $args{testParams}{init} ) {
+        my $init = $args{testParams}{init};
+        $this->assert( ref($init) eq 'CODE',
+            "testParams init key must be a coderef" );
+        $init->( $this, %args );
+    }
+}
+
+sub shutdown {
+    my $this = shift;
+}
+
+around list_tests => sub {
+    my $orig = shift;
+    my $this = shift;
+
+    my @tests;
+
+    my $suite = $this->testSuite;
+    foreach my $clientHash ( @{ $this->testClientList } ) {
+
+        $this->assert_not_null( $clientHash->{name},
+            "client test name undefined" );
+
+        unless ( defined $clientHash->{app} ) {
+            $clientHash->{app} = $this->_genDefaultAppSub($clientHash);
+        }
+        my $testSubName = "test_$clientHash->{name}";
+        unless ( $suite->can($testSubName) ) {
+            no strict 'refs';
+            *{"$suite\:\:$testSubName"} = sub {
+                my $test = Plack::Test->create( $clientHash->{app} );
+                $clientHash->{client}->( $this, $test );
+            };
+            use strict 'refs';
+        }
+        push @tests, $testSubName;
+    }
+
+    return @tests;
+};
+
+sub prepareTestClientList {
+    my $this = shift;
+    my @tests;
+    my $suite = $this->testSuite;
+
+    my $clz = new Devel::Symdump($suite);
+    foreach my $method ( $clz->functions ) {
+        next unless $method =~ /^$suite\:\:(client_(.+))$/;
+        my $subName   = $1;
+        my $shortName = $2;
+        push @tests, { name => $shortName, client => $suite->can($subName), };
+    }
+    return \@tests;
+}
+
+sub _cbPreHandleRequest {
+    my $this       = shift;
+    my $app        = shift;
+    my $clientHash = shift;
+    my %args       = @_;
+
+    $this->app($app);
+    $this->initialize( %args, testParams => $clientHash, );
+}
+
+sub _cbPostHandleRequest {
+    my $this       = shift;
+    my $app        = shift;
+    my $clientHash = shift;
+    my %args       = @_;
+
+    $this->shutdown( %args, testParams => $clientHash, );
+}
+
+sub _genDefaultAppSub {
+    my $this = shift;
+    my ($clientHash) = @_;
+
+    my %runArgs;
+    foreach my $key ( grep { !/^(?:app|appClass|client)$/ } keys %$clientHash )
+    {
+        $runArgs{$key} = $clientHash->{$key};
+    }
+
+    my $appClass = $clientHash->{appClass} // $this->defaultAppClass;
+
+    # Users must not use this callback.
+    $runArgs{callbacks}{testPreHandleRequest} = sub {
+        my $app = shift;
+        $this->_cbPreHandleRequest( $app, $clientHash, @_ );
+    };
+    $runArgs{callbacks}{testPostHandleRequest} = sub {
+        my $app = shift;
+        $this->_cbPostHandleRequest( $app, $clientHash, @_ );
+    };
+
+    return sub {
+        my $env = shift;
+
+        Devel::Leak::Object::checkpoint() if Unit::TestRunner::CHECKLEAK;
+
+        $runArgs{env} //= $env;
+
+        my $rc = $appClass->run(%runArgs);
+
+        if (Unit::TestRunner::CHECKLEAK) {
+            Devel::Leak::Object::status();
+            eval {
+                require Devel::MAT::Dumper;
+                Devel::MAT::Dumper::dump( $FindBin::Bin
+                      . "/../working/logs/foswiki_debug_psgi.pmat" );
+            };
+        }
+
+        return $rc;
+    };
+}
+
+1;
+__END__
+Foswiki - The Free and Open Source Wiki, http://foswiki.org/
+
+Copyright (C) 2016 Foswiki Contributors. Foswiki Contributors
+are listed in the AUTHORS file in the root of this distribution.
+NOTE: Please extend that file, not this notice.
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+as published by the Free Software Foundation; either version 2
+of the License, or (at your option) any later version. For
+more details read LICENSE in the root of this distribution.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+As per the GPL, removal of this notice is prohibited.
diff --git a/UnitTestContrib/lib/Unit/TestApp.pm b/UnitTestContrib/lib/Unit/TestApp.pm
@@ -6,6 +6,7 @@ use v5.14;
 use Assert;
 
 use Scalar::Util qw(blessed weaken refaddr);
+use Try::Tiny;
 
 use Moo;
 use namespace::clean;
@@ -52,6 +53,16 @@ has _cbRegistered => (
     default => 0,
 );
 
+around BUILDARGS => sub {
+    my $orig = shift;
+    my $this = shift;
+
+    # SMELL The global $inUnitTestMode must be gone.
+    $Foswiki::inUnitTestMode = 1;
+
+    return $orig->( $this, inUnitTestMode => 1, @_ );
+};
+
 sub BUILD {
     my $this = shift;
 
@@ -121,7 +132,26 @@ around handleRequest => sub {
 
     $this->registerCallbacks;
 
-    return $orig->( $this, @_ );
+    my $rc;
+    try {
+        $this->callback('testPreHandleRequest');
+        $rc = $orig->( $this, @_ );
+    }
+    catch {
+        Foswiki::Exception::Fatal->rethrow($_);
+    }
+    finally {
+        $this->callback( 'testPostHandleRequest', { rc => $rc }, );
+    };
+
+    return $rc;
+};
+
+around _validCallbacks => sub {
+    my $orig = shift;
+    my $this = shift;
+
+    return $orig->($this), qw(testPreHandleRequest testPostHandleRequest);
 };
 
 1;

diff --git a/UnitTestContrib/lib/Unit/TestCase.pm b/UnitTestContrib/lib/Unit/TestCase.pm
@@ -85,6 +85,7 @@ has verify_permutations => (
     lazy    => 1,
     default => sub { {} },
 );
+has testSuite => ( is => 'ro', required => 1, );
 
 =begin TML
 

diff --git a/UnitTestContrib/lib/Unit/TestRunner.pm b/UnitTestContrib/lib/Unit/TestRunner.pm
@@ -184,7 +184,7 @@ sub start {
         print "Running $suite\n";
 
 # vrurg: To much burden to maintain compatibility with pre-Moo positional argument passing.
-        my $tester = $suite->new( testSuite => $suite );
+        my $tester = $suite->new( testSuite => $suite, );
         if ( $tester->isa('Unit::TestSuite') ) {
 
             # Get a list of included tests

diff --git a/UnitTestContrib/lib/Unit/TestSuite.pm b/UnitTestContrib/lib/Unit/TestSuite.pm
@@ -18,11 +18,7 @@ use Moo;
 use namespace::clean;
 extends qw( Unit::TestCase );
 
-# SMELL This property is a placeholder for test suite name parameter passed on
-# on object creation. Need to be reconsidered.
-has testSuite => ( is => 'rw', );
-
-our @_newParameters = qw( testSuite );
+#our @_newParameters = qw( testSuite );
 
 sub include_tests {
     return ();