dougm at hyperreal
May 13, 1998, 8:01 PM
Post #1 of 1
(298 views)
Permalink
|
|
cvs commit: modperl/t/net/perl tie_table.pl
|
|
dougm 98/05/13 20:01:29
Added: t/internal tie.t
t/net/perl tie_table.pl
Log:
tests for tie table stuff
Revision Changes Path
1.1 modperl/t/internal/tie.t
Index: tie.t
===================================================================
use Apache::test;
skip_test unless $net::callback_hooks{PERL_TIE_TABLES};
print fetch "/perl/tie_table.pl";
1.1 modperl/t/net/perl/tie_table.pl
Index: tie_table.pl
===================================================================
use Apache::test;
use strict;
my $r = shift;
$r->send_http_header("text/plain");
my $i = 0;
my $tests = 23;
print "1..$tests\n";
my $headers_in = $r->headers_in;
my $table = tied %$headers_in;
test ++$i, UNIVERSAL::isa($headers_in, 'HASH');
test ++$i, $table->isa('Apache::TieHashTable');
test ++$i, $table->get('User-Agent');
test ++$i, $headers_in->{'User-Agent'};
test ++$i, $table->get('User-Agent') eq $headers_in->{'User-Agent'};
$table->merge(Accept => "application/x-perl");
test ++$i, $table->get("Accept") =~ /x-perl/;
test ++$i, not $table->get("NoChance");
test ++$i, not $headers_in->{"NoChance"};
test ++$i, keys %$headers_in > 0;
my %save = %$headers_in;
delete $headers_in->{'User-Agent'};
test ++$i, not $table->get('User-Agent');
%$headers_in = ();
test ++$i, scalar keys %$headers_in == 0;
%$headers_in = %save;
print "headers_in:\n";
while(my($k,$v) = each %$headers_in) {
print "$k = $v\n";
}
print "TOTAL: ", scalar keys %$headers_in, "\n\n";
my $dir_config = $r->dir_config;
print "dir_config:\n";
while(my($k,$v) = each %$dir_config) {
print "$k = $v\n";
}
print "TOTAL: ", scalar keys %$dir_config, "\n\n";
for my $meth (qw{
headers_in headers_out err_headers_out notes dir_config subprocess_env
})
{
my $hash_ref = $r->$meth();
my $tab = tied %$hash_ref;
test ++$i, UNIVERSAL::isa($hash_ref, 'HASH');
test ++$i, $tab->isa('Apache::TieHashTable');
}
|
