1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
use Apache::ASP::CGI::Test;
use strict;
use File::Basename qw(basename dirname);
sub my::null {};
my $dir = dirname($0);
if($dir) {
chdir($dir) || die "can't chdir to $dir";
}
my %args = (
NoState => 1,
XMLSubsMatch => 'my:\w+',
Global => 'null',
UseStrict => 1,
# Debug => -1,
);
my @tests = (
[ 'end_basic.inc', sub { $_->test_body_out eq '1' } ],
[ 'end_clear.inc', sub { $_->test_body_out eq '' }, ],
[ 'end_redirect_basic.inc', sub {
$_->test_header_out =~ /Location: NULL/
and $_->test_body_out eq ''
} ],
[ 'end_redirect_soft.inc', sub {
$_->test_header_out =~ /Location: NULL/
and $_->test_body_out =~ /^12/
},
{ SoftRedirect => 1 } ],
[ 'end_xmlsubs_basic.inc', sub { $_->test_body_out eq '1' } ],
[ 'end_xmlsubs_redirect.inc', sub {
$_->test_header_out =~ /Location: NULL/
and $_->test_body_out eq ''
} ],
);
print "1..".scalar(@tests)."\n";
for my $tester (@tests) {
my($file, $test, $args) = @$tester;
$args ||= {};
my $r = Apache::ASP::CGI::Test->init($file);
$r->init_dir_config( %args, %$args );
my $status = Apache::ASP->handler($r);
unless($status == 0) {
$r->log_error("[failure] error status $status for $file");
next;
}
# print $r->test_header_out."\n\n";
# print $r->test_body_out."\n\n";
local $_ = $r;
if(eval { &$test }) {
print "ok\n";
} else {
$r->log_error("[failure] $0 subtest $file failed, output:\n---\n".$r->OUT."\n---\n");
print "not ok\n";
}
}
|
