thread results from the CPAN

Apache-Test

# 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

    else {
        return 1;
    }
}

sub need_apache_mpm {
    my $wanted = shift;
    my $cfg = Apache::Test::config();
    my $current = $cfg->{server}->{mpm};

    if ($current ne $wanted) {
        push @SkipReasons,
          "apache $wanted mpm is required," .
          " this is the $current mpm";
        return 0;
    }
    else {
        return 1;
    }
}

sub config_enabled {
    my $key = shift;
    defined $Config{$key} and $Config{$key} eq 'define';
}

sub need_perl_iolayers {
    if (my $ext = $Config{extensions}) {
        #XXX: better test?  might need to test patchlevel
        #if support depends bugs fixed in bleedperl
        return $ext =~ m:PerlIO/scalar:;
    }
    0;
}

sub need_perl {
    my $thing = shift;
    #XXX: $thing could be a version
    my $config;

    my $have = \&{"need_perl_$thing"};
    if (defined &$have) {
        return 1 if $have->();
    }
    else {
        for my $key ($thing, "use$thing") {
            if (exists $Config{$key}) {
                $config = $key;
                return 1 if config_enabled($key);
            }
        }
    }

    push @SkipReasons, $config ?
      "Perl was not built with $config enabled" :
        "$thing is not available with this version of Perl";

    return 0;
}

sub need_threads {
    my $status = 1;

    # check APR support
    my $build_config = Apache::TestConfig->modperl_build_config;

    if ($build_config) {
        my $apr_config = $build_config->get_apr_config();
        unless ($apr_config->{HAS_THREADS}) {
            $status = 0;
            push @SkipReasons, "Apache/APR was built without threads support";
        }
    }

    # check Perl's useithreads
    my $key = 'useithreads';
    unless (exists $Config{$key} and config_enabled($key)) {
        $status = 0;
        push @SkipReasons, "Perl was not built with 'ithreads' enabled";
    }

    return $status;
}

sub need_fork {
    my $have_fork = $Config{d_fork} ||
                    $Config{d_pseudofork} ||
                    (($^O eq 'MSWin32' || $^O eq 'NetWare') &&
                     $Config{useithreads} &&
                     $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);

     if (!$have_fork) {
         push @SkipReasons, 'The fork function is unimplemented';
         return 0;
     }
     else {
         return 1;
     }
}

sub under_construction {
    push @SkipReasons, "This test is under construction";
    return 0;
}

sub skip_reason {
    my $reason = shift || 'no reason specified';
    push @SkipReasons, $reason;
    return 0;
}

# normalize Apache-style version strings (2.0.48, 0.9.4)
# for easy numeric comparison.  note that 2.1 and 2.1.0
# are considered equivalent.
sub normalize_vstring {

    my @digits = shift =~ m/(\d+)\.?(\d*)\.?(\d*)/;

    return join '', map { sprintf("%03d", $_ || 0) } @digits;
}

# have_ functions are the same as need_ but they don't populate
# @SkipReasons
for my $func (@have) {
    no strict 'refs';
    (my $real_func = $func) =~ s/^have_/need_/;
    *$func = sub {
        # be nice to poor souls calling functions with $_ argument in
        # the foreach loop, etc.!
        local $_;
        local @SkipReasons;
        return $real_func->(@_);
    };
}

package Apache::TestToString;

Apache::Test->import('!:DEFAULT');

sub TIEHANDLE {
    my $string = "";
    bless \$string;
}

sub PRINT {
    my $string = shift;
    $$string .= join '', @_;
}

lib/Apache/Test.pm view on Meta::CPAN


  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:

  plan tests => 5, need_min_apache_version("2.0.40");

requires Apache 2.0.40 or higher.

=item need_apache_version

Used to require a specific version of Apache.

For example:

  plan tests => 5, need_apache_version("2.0.40");

requires Apache 2.0.40.

=item need_min_apache_fix

Used to require a particular micro version from corresponding minor release

For example:

  plan tests => 5, need_min_apache_fix("2.0.40", "2.2.30", "2.4.18");

requires Apache 2.0.40 or higher.

=item need_apache_mpm

Used to require a specific Apache Multi-Processing Module.

For example:

  plan tests => 5, need_apache_mpm('prefork');

requires the prefork MPM.

=item need_perl

  plan tests => 5, need_perl 'iolayers';
  plan tests => 5, need_perl 'ithreads';

Requires a perl extension to be present, or perl compiled with certain
capabilities.

The first example tests whether C<PerlIO> is available, the second
whether:

  $Config{useithread} eq 'define';

=item need_min_perl_version

Used to require a minimum version of Perl.

For example:

  plan tests => 5, need_min_perl_version("5.008001");

requires Perl 5.8.1 or higher.

=item need_fork

Requires the perl built-in function C<fork> to be implemented.

=item need_module

  plan tests => 5, need_module 'CGI';
  plan tests => 5, need_module qw(CGI Find::File);
  plan tests => 5, need_module ['CGI', 'Find::File', 'cgid'];

Requires Apache C and Perl modules. The function accept a list of
arguments or a reference to a list.

In case of C modules, depending on how the module name was passed it
may pass through the following completions:

=over

=item 1 need_module 'proxy_http.c'

If there is the I<.c> extension, the module name will be looked up as
is, i.e. I<'proxy_http.c'>.

=item 2 need_module 'mod_cgi'

The I<.c> extension will be appended before the lookup, turning it into
I<'mod_cgi.c'>.

=item 3 need_module 'cgi'

The I<.c> extension and I<mod_> prefix will be added before the
lookup, turning it into I<'mod_cgi.c'>.

=back

=item need_min_module_version

Used to require a minimum version of a module

For example:

  plan tests => 5, need_min_module_version(CGI => 2.81);

requires C<CGI.pm> version 2.81 or higher.

Currently works only for perl modules.

=item need

  plan tests => 5,
      need 'LWP',
           { "perl >= 5.8.0 and w/ithreads is required" =>
             ($Config{useperlio} && $] >= 5.008) },
           { "not Win32"                 => sub { $^O eq 'MSWin32' },
             "foo is disabled"           => \&is_foo_enabled,
           },
           'cgid';

need() is more generic function which can impose multiple requirements
at once. All requirements must be satisfied.

need()'s argument is a list of things to test. The list can include
scalars, which are passed to need_module(), and hash references. If
hash references are used, the keys, are strings, containing a reason
for a failure to satisfy this particular entry, the values are the
condition, which are satisfaction if they return true. If the value is
0 or 1, it used to decide whether the requirements very satisfied, so
you can mix special C<need_*()> functions that return 0 or 1. For
example:

  plan tests => 1, need 'Compress::Zlib', 'deflate',
      need_min_apache_version("2.0.49");

If the scalar value is a string, different from 0 or 1, it's passed to
I<need_module()>.  If the value is a code reference, it gets executed
at the time of check and its return value is used to check the
condition. If the condition check fails, the provided (in a key)
reason is used to tell user why the test was skipped.

In the presented example, we require the presence of the C<LWP> Perl
module, C<mod_cgid>, that we run under perl E<gt>= 5.7.3 on Win32.

It's possible to put more than one requirement into a single hash
reference, but be careful that the keys will be different.

It's also important to mention to avoid using:

  plan tests => 1, requirement1 && requirement2;

technique. While test-wise that technique is equivalent to:

  plan tests => 1, need requirement1, requirement2;

since the test will be skipped, unless all the rules are satisfied,
it's not equivalent for the end users. The second technique, deploying
C<need()> and a list of requirements, always runs all the requirement
checks and reports all the missing requirements. In the case of the
first technique, if the first requirement fails, the second is not
run, and the missing requirement is not reported. So let's say all the
requirements are missing Apache modules, and a user wants to satisfy
all of these and run the test suite again. If all the unsatisfied
requirements are reported at once, she will need to rebuild Apache
once. If only one requirement is reported at a time, she will have to
rebuild Apache as many times as there are elements in the C<&&>
statement.

Also see plan().

=item under_construction

  plan tests => 5, under_construction;

( run in 0.441 second using v1.01-cache-2.11-cpan-df04353d9ac )