Apache-Test
view release on metacpan or search on metacpan
lib/Apache/Test.pm view on Meta::CPAN
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements. See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
package Apache::Test;
use strict;
use warnings FATAL => 'all';
use Exporter ();
use Config;
use Apache::TestConfig ();
use Test qw/ok skip/;
BEGIN {
# Apache::Test loads a bunch of mp2 stuff while getting itself
# together. because we need to choose one of mp1 or mp2 to load
# check first (and we choose mp2) $mod_perl::VERSION == 2.0
# just because someone loaded Apache::Test. This Is Bad. so,
# let's try to correct for that here by removing mod_perl from
# %INC after the above use() statements settle in. nobody
# should be relying on us loading up mod_perl.pm anyway...
delete $INC{'mod_perl.pm'};
}
use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION %SubTests @SkipReasons);
$VERSION = '1.43';
my @need = qw(need_lwp need_http11 need_cgi need_access need_auth
need_module need_apache need_min_apache_version need_min_apache_fix
need_apache_version need_perl need_min_perl_version
need_min_module_version need_threads need_fork need_apache_mpm
need_php need_php4 need_ssl need_imagemap need_cache_disk);
my @have = map { (my $need = $_) =~ s/need/have/; $need } @need;
@ISA = qw(Exporter);
@EXPORT = (qw(sok plan skip_reason under_construction need),
@need, @have);
%SubTests = ();
@SkipReasons = ();
sub cp {
my @l;
for( my $i=1; (@l=caller $i)[0] eq __PACKAGE__; $i++ ) {};
return wantarray ? @l : $l[0];
}
my $Config;
my %wtm;
sub import {
my $class=$_[0];
my $wtm=0;
my @base_exp;
my @exp;
my %my_exports;
undef @my_exports{@EXPORT};
my ($caller,$f,$l)=cp;
for( my $i=1; $i<@_; $i++ ) {
if( $_[$i] eq '-withtestmore' ) {
$wtm=1;
}
elsif( $_[$i] eq ':DEFAULT' ) {
push @exp, $_[$i];
push @base_exp, $_[$i];
}
elsif( $_[$i] eq '!:DEFAULT' ) {
push @exp, $_[$i];
push @base_exp, $_[$i];
}
elsif( $_[$i]=~m@^[:/!]@ ) {
warn("Ignoring import spec $_[$i] ".
"at $f line $l\n")
}
elsif( exists $my_exports{$_[$i]} ) {
push @exp, $_[$i];
}
else {
push @base_exp, $_[$i];
}
}
if (!@exp and @base_exp) {
@exp=('!:DEFAULT');
}
elsif (@exp and !@base_exp) {
@base_exp=('!:DEFAULT');
}
$wtm{$caller}=[$wtm,$f,$l] unless exists $wtm{$caller};
lib/Apache/Test.pm view on Meta::CPAN
$meets_condition = $condition->();
}
elsif ($ref eq 'ARRAY') {
#plan tests $n, [qw(php4 rewrite)];
$meets_condition = need_module($condition);
}
else {
die "don't know how to handle a condition of type $ref";
}
}
else {
# we have the verdict already: true/false
$meets_condition = $condition ? 1 : 0;
}
# trying to emulate a dual variable (ala errno)
unless ($meets_condition) {
my $reason = join ', ',
@SkipReasons ? @SkipReasons : "no reason given";
print "1..0 # skipped: $reason\n";
@SkipReasons = (); # reset
exit; #XXX: Apache->exit
}
}
@SkipReasons = (); # reset
my ($caller,$f,$l)=cp;
%SubTests=();
if (my $subtests=$ENV{HTTPD_TEST_SUBTESTS}) {
%SubTests=map { $_, 1 } split /\s+/, $subtests;
}
if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
Test::More::plan(@_);
}
else { # -withouttestmore
unless (exists $wtm{$caller}) {
warn "You forgot to 'use Apache::Test' in package $caller\n";
$wtm{$caller}=[0,$f,$l];
}
Test::plan(@_);
}
# add to Test.pm verbose output
print "# Using Apache/Test.pm version $VERSION\n";
}
sub need_http11 {
require Apache::TestRequest;
if (Apache::TestRequest::install_http11()) {
return 1;
}
else {
push @SkipReasons,
"LWP version 5.60+ required for HTTP/1.1 support";
return 0;
}
}
sub need_ssl {
my $vars = vars();
need_module([$vars->{ssl_module_name}, 'IO::Socket::SSL']);
}
sub need_lwp {
require Apache::TestRequest;
if (Apache::TestRequest::has_lwp()) {
return 1;
}
else {
push @SkipReasons, "libwww-perl is not installed";
return 0;
}
}
sub need {
my $need_all = 1;
for my $cond (@_) {
if (ref $cond eq 'HASH') {
while (my($reason, $value) = each %$cond) {
$value = $value->() if ref $value eq 'CODE';
next if $value;
push @SkipReasons, $reason;
$need_all = 0;
}
}
elsif ($cond =~ /^(0|1)$/) {
$need_all = 0 if $cond == 0;
}
else {
$need_all = 0 unless need_module($cond);
}
}
return $need_all;
}
sub need_module {
my $cfg = config();
my @modules = grep defined $_,
ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
my @reasons = ();
for (@modules) {
if (/^[a-z0-9_.]+$/) {
my $mod = $_;
$mod .= '.c' unless $mod =~ /\.c$/;
next if $cfg->{modules}->{$mod};
$mod = 'mod_' . $mod unless $mod =~ /^mod_/;
next if $cfg->{modules}->{$mod};
if (exists $cfg->{cmodules_disabled}->{$mod}) {
push @reasons, $cfg->{cmodules_disabled}->{$mod};
next;
}
}
die "bogus module name $_" unless /^[\w:.]+$/;
# if the module was explicitly passed with a .c extension,
# do not try to eval it as a Perl module
my $not_found = 1;
unless (/\.c$/) {
lib/Apache/Test.pm view on Meta::CPAN
=item * a C<CODE> reference
the tests will be skipped if the function returns a false value. For
example:
plan tests => 5, need_lwp;
the test will be skipped if LWP is not available
=back
All other arguments are passed through to I<Test::plan> as is.
=item ok
Same as I<Test::ok>, see I<Test.pm> documentation.
=item sok
Allows to skip a sub-test, controlled from the command line. The
argument to sok() is a CODE reference or a BLOCK whose return value
will be passed to ok(). By default behaves like ok(). If all sub-tests
of the same test are written using sok(), and a test is executed as:
% ./t/TEST -v skip_subtest 1 3
only sub-tests 1 and 3 will be run, the rest will be skipped.
=item skip
Same as I<Test::skip>, see I<Test.pm> documentation.
=item test_pm_refresh
Normally called by I<Apache::Test::plan>, this function will refresh
the global state maintained by I<Test.pm>, allowing C<plan> and
friends to be called more than once per-process. This function is not
exported.
=back
Functions that can be used as a last argument to the extended plan().
Note that for each C<need_*> function there is a C<have_*> equivalent
that performs the exact same function except that it is designed to
be used outside of C<plan()>. C<need_*> functions have the side effect
of generating skip messages, if the test is skipped. C<have_*> functions
don't have this side effect. In other words, use C<need_apache()>
with C<plan()> to decide whether a test will run, but C<have_apache()>
within test logic to adjust expectations based on older or newer
server versions.
=over
=item need_http11
plan tests => 5, need_http11;
Require HTTP/1.1 support.
=item need_ssl
plan tests => 5, need_ssl;
Require SSL support.
Not exported by default.
=item need_lwp
plan tests => 5, need_lwp;
Require LWP support.
=item need_cgi
plan tests => 5, need_cgi;
Requires mod_cgi or mod_cgid to be installed.
=item need_cache_disk
plan tests => 5, need_cache_disk
Requires mod_cache_disk or mod_disk_cache to be installed.
=item need_php
plan tests => 5, need_php;
Requires a PHP module to be installed (version 4 or 5).
=item need_php4
plan tests => 5, need_php4;
Requires a PHP version 4 module to be installed.
=item need_imagemap
plan tests => 5, need_imagemap;
Requires a mod_imagemap or mod_imap be installed
=item need_apache
plan tests => 5, need_apache 2;
Requires Apache 2nd generation httpd-2.x.xx
plan tests => 5, need_apache 1;
Requires Apache 1st generation (apache-1.3.xx)
See also C<need_min_apache_version()>.
=item need_min_apache_version
Used to require a minimum version of Apache.
For example:
( run in 0.448 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )