init
This commit is contained in:
40
bml/t/00_require.t
Executable file
40
bml/t/00_require.t
Executable file
@@ -0,0 +1,40 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Test script for Apache::BML
|
||||
# $Id: 00_require.t,v 1.1 2004/05/26 17:33:51 deveiant Exp $
|
||||
#
|
||||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl 00_require.t'
|
||||
#
|
||||
# Please do not commit any changes you make to the module without a
|
||||
# successful 'make test'!
|
||||
#
|
||||
package main;
|
||||
use strict;
|
||||
|
||||
BEGIN { $| = 1; }
|
||||
|
||||
### Load up the test framework
|
||||
use Test::SimpleUnit qw{:functions};
|
||||
|
||||
my (
|
||||
$manifest,
|
||||
@modules,
|
||||
@testSuite,
|
||||
);
|
||||
|
||||
# Read the manifest and grok the list of modules out of it
|
||||
$manifest = IO::File->new( "MANIFEST", "r" )
|
||||
or die "open: MANIFEST: $!";
|
||||
@modules = map { s{lib/(.+)\.pm$}{$1}; s{/}{::}g; $_ } grep { m{\.pm$} } $manifest->getlines;
|
||||
chomp @modules;
|
||||
|
||||
### Test suite (in the order they're run)
|
||||
@testSuite = map {
|
||||
{
|
||||
name => "require ${_}",
|
||||
test => eval qq{sub { assertNoException {require $_}; }},
|
||||
}
|
||||
} @modules;
|
||||
|
||||
runTests( @testSuite );
|
||||
210
bml/t/10_simple.t
Executable file
210
bml/t/10_simple.t
Executable file
@@ -0,0 +1,210 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Test script for Apache::BML -- Simple functions
|
||||
# $Id: 10_simple.t,v 1.1 2004/05/26 17:33:51 deveiant Exp $
|
||||
#
|
||||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl 00_require.t'
|
||||
#
|
||||
# Please do not commit any changes you make to the module without a
|
||||
# successful 'make test'!
|
||||
#
|
||||
package main;
|
||||
use strict;
|
||||
|
||||
BEGIN { $| = 1; }
|
||||
|
||||
### Load up the test framework
|
||||
use Test::SimpleUnit qw{:functions};
|
||||
use Apache::BML qw{};
|
||||
use Apache::FakeRequest qw{};
|
||||
use Fcntl qw{O_CREAT O_TRUNC O_EXCL O_WRONLY};
|
||||
use File::Spec qw{};
|
||||
|
||||
my (
|
||||
@testSuite,
|
||||
$Output,
|
||||
$Errout,
|
||||
$Pnotes,
|
||||
$Request,
|
||||
$DataPath,
|
||||
$NonExistantFile,
|
||||
$ForbiddenFile,
|
||||
$ForbiddenConfigFile,
|
||||
$EmptyFile,
|
||||
);
|
||||
|
||||
$Pnotes = {};
|
||||
$Output = '';
|
||||
$Errout = '';
|
||||
|
||||
$DataPath = File::Spec->rel2abs( "test" );
|
||||
$NonExistantFile = "$DataPath/nonexistant.bml";
|
||||
$ForbiddenFile = "$DataPath/forbidden.bml";
|
||||
$ForbiddenConfigFile = "$DataPath/_config.bml";
|
||||
$EmptyFile = "$DataPath/empty.bml";
|
||||
|
||||
|
||||
# Overload Apache::FakeRequest's print to append output to a variable.
|
||||
{
|
||||
no warnings 'redefine';
|
||||
*Apache::FakeRequest::print = sub {
|
||||
my $r = shift;
|
||||
$Output .= join('', @_)
|
||||
};
|
||||
*Apache::FakeRequest::log_error = sub {
|
||||
my $r - shift;
|
||||
print STDERR @_, "\n"; $Errout .= join('', @_)
|
||||
};
|
||||
*Apache::FakeRequest::pnotes = sub {
|
||||
my ( $r, $key ) = @_;
|
||||
return $Pnotes if !$key;
|
||||
$Pnotes->{ $key } = shift if @_;
|
||||
$Pnotes->{ $key };
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
# Define tests
|
||||
@testSuite = (
|
||||
|
||||
{
|
||||
name => 'setup',
|
||||
func => sub {
|
||||
$Output = '';
|
||||
$Errout = '';
|
||||
$Pnotes = {};
|
||||
},
|
||||
},
|
||||
|
||||
# Calling handler() with no args should error
|
||||
{
|
||||
name => 'No Args',
|
||||
test => sub {
|
||||
assertException {
|
||||
Apache::BML::handler();
|
||||
};
|
||||
},
|
||||
},
|
||||
|
||||
|
||||
# Calling with a non-existant file should 404
|
||||
{
|
||||
name => "Non-existant file",
|
||||
test => sub {
|
||||
my $request = new Apache::FakeRequest (
|
||||
filename => $NonExistantFile,
|
||||
);
|
||||
my $res;
|
||||
|
||||
assertNoException {
|
||||
$res = Apache::BML::handler( $request );
|
||||
};
|
||||
|
||||
assertEquals( 404, $res );
|
||||
assertMatches( /does not exist/, $Errout );
|
||||
},
|
||||
},
|
||||
|
||||
{
|
||||
name => 'teardown',
|
||||
func => sub {
|
||||
if ( -e $ForbiddenFile ) {
|
||||
unlink $ForbiddenFile or die "unlink: $ForbiddenFile: $!";
|
||||
}
|
||||
},
|
||||
},
|
||||
|
||||
# Calling with a file for which we have no permissions should 403
|
||||
{
|
||||
name => "Non-readable file",
|
||||
test => sub {
|
||||
# Create an unreadable file
|
||||
my $fh = new IO::File $ForbiddenFile, O_CREAT|O_WRONLY
|
||||
or die "open: $ForbiddenFile: $!";
|
||||
close $fh;
|
||||
chmod 0220, $ForbiddenFile
|
||||
or die "chmod: $ForbiddenFile: $!";
|
||||
|
||||
my $request = new Apache::FakeRequest (
|
||||
filename => $ForbiddenFile,
|
||||
);
|
||||
my $res;
|
||||
|
||||
assertNoException {
|
||||
$res = Apache::BML::handler( $request );
|
||||
};
|
||||
|
||||
assertEquals( 403, $res );
|
||||
assertMatches( /File permissions deny access/, $Errout );
|
||||
},
|
||||
},
|
||||
|
||||
{
|
||||
name => 'teardown',
|
||||
func => sub {
|
||||
if ( -e $ForbiddenConfigFile ) {
|
||||
unlink $ForbiddenConfigFile or die "unlink: $ForbiddenConfigFile: $!";
|
||||
}
|
||||
},
|
||||
},
|
||||
|
||||
# _config files are forbidden
|
||||
{
|
||||
name => "Forbidden _config file",
|
||||
test => sub {
|
||||
# Create a readable _config file
|
||||
my $fh = new IO::File $ForbiddenConfigFile, O_CREAT|O_WRONLY
|
||||
or die "open: $ForbiddenConfigFile: $!";
|
||||
$fh->print("");
|
||||
close $fh;
|
||||
|
||||
my $request = new Apache::FakeRequest (
|
||||
filename => $ForbiddenConfigFile,
|
||||
);
|
||||
my $res;
|
||||
|
||||
assertNoException {
|
||||
$res = Apache::BML::handler( $request );
|
||||
};
|
||||
|
||||
assertEquals( 403, $res );
|
||||
},
|
||||
},
|
||||
|
||||
|
||||
{
|
||||
name => 'teardown',
|
||||
func => sub {
|
||||
if ( -e $EmptyFile ) {
|
||||
unlink $EmptyFile or die "unlink: $EmptyFile: $!";
|
||||
}
|
||||
},
|
||||
},
|
||||
|
||||
|
||||
# Loading an empty file should be okay
|
||||
{
|
||||
name => "Empty file",
|
||||
test => sub {
|
||||
# Create an unreadable file
|
||||
my $fh = new IO::File $EmptyFile, O_CREAT|O_WRONLY
|
||||
or die "open: $EmptyFile: $!";
|
||||
$fh->print("");
|
||||
close $fh;
|
||||
|
||||
my $request = new Apache::FakeRequest (
|
||||
filename => $EmptyFile,
|
||||
);
|
||||
my $res;
|
||||
|
||||
assertNoException { $res = Apache::BML::handler($request) };
|
||||
assertEquals 0, $res;
|
||||
assertEquals '', $Output;
|
||||
},
|
||||
}
|
||||
|
||||
|
||||
);
|
||||
|
||||
runTests( @testSuite );
|
||||
185
bml/t/20_render.t
Executable file
185
bml/t/20_render.t
Executable file
@@ -0,0 +1,185 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# Test script for Apache::BML -- Simple functions
|
||||
# $Id: 20_render.t,v 1.3 2004/07/03 00:13:26 deveiant Exp $
|
||||
#
|
||||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl 00_require.t'
|
||||
#
|
||||
# Please do not commit any changes you make to the module without a
|
||||
# successful 'make test'!
|
||||
#
|
||||
package main;
|
||||
use strict;
|
||||
|
||||
BEGIN { $| = 1; }
|
||||
|
||||
use lib "lib";
|
||||
|
||||
### Load up the test framework
|
||||
use Test::SimpleUnit qw{:functions};
|
||||
use Apache::BML qw{};
|
||||
use Apache::FakeRequest qw{};
|
||||
use Fcntl qw{O_CREAT O_TRUNC O_EXCL O_RDONLY O_WRONLY};
|
||||
use File::Spec qw{};
|
||||
use File::Basename qw{dirname basename};
|
||||
use Text::Diff qw{diff};
|
||||
|
||||
|
||||
#####################################################################
|
||||
### G L O B A L V A R I A B L E S
|
||||
#####################################################################
|
||||
my (
|
||||
@testSuite,
|
||||
$Request,
|
||||
$TestDir,
|
||||
@TestSubdirs,
|
||||
);
|
||||
|
||||
$TestDir = File::Spec->rel2abs( "test" );
|
||||
|
||||
# The list of directories to search for .bml files. This is hard-coded instead
|
||||
# of automatic so other tests can use the test/ directory for their data, too.
|
||||
@TestSubdirs = qw[ tutorial1 tutorial2 brads recursion syntax-errors
|
||||
codeblocks fake_root comments info escape include
|
||||
tutorial-example*
|
||||
];
|
||||
|
||||
|
||||
#####################################################################
|
||||
### C U S T O M A S S E R T I O N F U N C T I O N S
|
||||
#####################################################################
|
||||
|
||||
### FUNCTION: readFile( $file )
|
||||
### Read the specified I<file> and return its contents as a single scalar.
|
||||
sub readFile {
|
||||
my ( $file ) = @_;
|
||||
|
||||
my $fh = new IO::File $file, O_RDONLY
|
||||
or die "open: $file: $!";
|
||||
return join '', $fh->getlines;
|
||||
}
|
||||
|
||||
|
||||
### FUNCTION: assertCorrect( $directory, $name, $output )
|
||||
### Load the "I<name>.correct" file from the specified testing I<directory> and
|
||||
### check that it is the same as the specified I<output> after stripping off
|
||||
### trailing whitespace from both.
|
||||
sub assertCorrect {
|
||||
my ( $dir, $name, $output ) = @_;
|
||||
|
||||
my $path = File::Spec->catfile( $dir, "$name.correct" );
|
||||
if ( ! -e $path ) {
|
||||
print "\n>>> WARNING: No .correct file for '$name': Creating one with \n",
|
||||
">>> the test output. You should verify the correctness of \n",
|
||||
">>> '$path' before trusting this test.\n\n";
|
||||
IO::File->new($path, O_WRONLY|O_CREAT)->print( $output );
|
||||
}
|
||||
|
||||
my $correct = readFile( $path );
|
||||
|
||||
# Trim trailing whitespace off of both expected and correct
|
||||
$correct =~ s{\s+$}{}; $correct .= "\n";
|
||||
$output =~ s{\s+$}{}; $output .= "\n";
|
||||
|
||||
my $diff = diff( \$correct, \$output );
|
||||
assert( $diff eq '', "Expected output from $name.correct, got:\n$diff" );
|
||||
}
|
||||
|
||||
|
||||
#####################################################################
|
||||
### A P A C H E : : F A K E R E Q U E S T M U N G I N G
|
||||
#####################################################################
|
||||
|
||||
# Overload Apache::FakeRequest's print to append output to a variable.
|
||||
{
|
||||
package Apache::FakeRequest;
|
||||
use vars qw{%Pnotes $Output $Errout};
|
||||
no warnings 'redefine';
|
||||
|
||||
%Pnotes = ();
|
||||
$Output = $Errout = '';
|
||||
|
||||
sub Reset {
|
||||
%Pnotes = ();
|
||||
$Output = $Errout = '';
|
||||
}
|
||||
|
||||
sub print {
|
||||
my $r = shift;
|
||||
$Output .= join('', @_)
|
||||
}
|
||||
sub log_error {
|
||||
my $r - shift;
|
||||
print STDERR @_, "\n"; $Errout .= join('', @_)
|
||||
}
|
||||
sub pnotes {
|
||||
my ( $r, $key ) = @_;
|
||||
$Pnotes{ $key } = shift if @_;
|
||||
return $Pnotes{ $key };
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
### T E S T S
|
||||
#####################################################################
|
||||
|
||||
# Define tests
|
||||
@testSuite = (
|
||||
|
||||
{
|
||||
name => 'setup',
|
||||
func => sub {
|
||||
Apache::FakeRequest->Reset;
|
||||
},
|
||||
},
|
||||
|
||||
);
|
||||
|
||||
# Auto-generate tests for each test subdir
|
||||
foreach my $subdir ( @TestSubdirs ) {
|
||||
my $testpat = File::Spec->catdir( $TestDir, $subdir );
|
||||
|
||||
# Find all the .bml files, skipping those which start with underscores.
|
||||
foreach my $bmlfile ( glob "$testpat/*.bml" ) {
|
||||
next if $bmlfile =~ m{/_};
|
||||
( my $name = $bmlfile ) =~ s{.*/(.*)\.bml$}{$1};
|
||||
my $testdir = dirname( $bmlfile );
|
||||
my $testname = basename( $testdir );
|
||||
|
||||
# Add a test to the suite for the .bml file
|
||||
push @testSuite,
|
||||
{
|
||||
name => "$testname $name",
|
||||
test => sub {
|
||||
|
||||
#print "Testing dir: $testdir\n";
|
||||
my $request = new Apache::FakeRequest (
|
||||
document_root => $TestDir,
|
||||
uri => "/$name.bml",
|
||||
filename => "$bmlfile",
|
||||
);
|
||||
my $res;
|
||||
|
||||
$ENV{testlookroot} = $testdir;
|
||||
|
||||
assertNoException {
|
||||
local $SIG{ALRM} = sub { die "Timeout" };
|
||||
alarm 10;
|
||||
$res = Apache::BML::handler($request)
|
||||
};
|
||||
alarm 0;
|
||||
assertEquals 0, $res;
|
||||
assertCorrect( $testdir, $name, $Apache::FakeRequest::Output );
|
||||
|
||||
print STDERR $Apache::Request::Errout, "\n";
|
||||
},
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
runTests( @testSuite );
|
||||
Reference in New Issue
Block a user