stas 01/09/29 12:33:40
Modified: t/apache compat.t
t/response/TestApache compat.pm
Log:
- prepare a ground for adding many new sub-tests for Apache::compat
- add the content-type test for send_http_header($val);
- add tests for $r->header_{in|out} (5,7,9,11 are failing!)
Revision Changes Path
1.2 +58 -10 modperl-2.0/t/apache/compat.t
Index: compat.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/apache/compat.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- compat.t 2001/05/04 19:04:15 1.1
+++ compat.t 2001/09/29 19:33:39 1.2
@@ -2,22 +2,70 @@
use warnings FATAL => 'all';
use Apache::Test;
+
+use Apache::TestUtil;
use Apache::TestRequest;
-plan tests => 2, \&have_lwp;
+plan tests => 11, todo => [5,7,9,11], \&have_lwp;
my $location = "/TestApache::compat";
-my $str;
-
-my @data = (ok => '2');
-my %data = @data;
-$str = POST_BODY $location, \@data;
+# $r->send_http_header('text/plain');
+{
+ my @data = (test => 'content-type');
+ ok t_cmp(
+ "text/plain",
+ HEAD(query(@data))->content_type(),
+ q{$r->send_http_header('text/plain')}
+ );
+}
+
+# $r->content
+{
+ my @data = (test => 'content');
+ ok t_cmp(
+ "@data",
+ POST_BODY($location, \@data),
+ q{$r->content via POST}
+ );
+}
+
+# $r->Apache::args
+{
+ my @data = (test => 'args');
+ ok t_cmp(
+ "@data",
+ GET_BODY(query(@data)),
+ q{$r->Apache::args}
+ );
+}
+
+# header_in
+t_header('in','get_scalar',q{scalar ctx: $r->header_in($key)});
+t_header('in','get_list', q{list ctx: $r->header_in($key)});
+t_header('in','set', q{$r->header_in($key => $val)});
+t_header('in','unset', q{$r->header_in($key => undef)});
+
+# header_out
+t_header('out','get_scalar',q{scalar ctx: $r->header_out($key)});
+t_header('out','get_list', q{list ctx: $r->header_out($key)});
+t_header('out','set', q{$r->header_out($key => $val)});
+t_header('out','unset', q{$r->header_out($key => undef)});
-ok $str eq "@data";
-my $q = join '=', @data;
-$str = GET_BODY "$location?$q";
-ok $str eq "@data";
+### helper subs ###
+sub query {
+ my(%args) = (@_ % 2) ? %{+shift} : @_;
+ "$location?" . join '&', map { "$_=$args{$_}" } keys %args;
+}
+
+sub t_header{
+ my ($way, $what, $comment) = @_;
+ ok t_cmp(
+ "ok",
+ GET_BODY(query(test => 'header', way => $way, what => $what)),
+ $comment
+ );
+}
1.2 +51 -2 modperl-2.0/t/response/TestApache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/compat.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- compat.pm 2001/05/04 19:04:17 1.1
+++ compat.pm 2001/09/29 19:33:39 1.2
@@ -5,7 +5,8 @@
use Apache::compat ();
-use Apache::Constants qw(OK M_POST);
+use Apache::TestUtil;
+use Apache::Constants qw(OK M_POST DECLINED);
sub handler {
my $r = shift;
@@ -20,7 +21,55 @@
%data = $r->Apache::args;
}
- $r->print("ok $data{ok}");
+ return DECLINED unless exists $data{test};
+
+ if ($data{test} eq 'content' || $data{test} eq 'args') {
+ $r->print("test $data{test}");
+ }
+ elsif ($data{test} eq 'header') {
+ my $way = $data{way};
+ my $sub = "header_$way";
+ my $sub_good = "headers_$way";
+ if ($data{what} eq 'get_scalar') {
+ # get in scalar ctx
+ my $key;
+ if ($way eq 'in') {
+ $key = "user-agent"; # should exist with lwp
+ }
+ else {
+ # outgoing headers aren't set yet, so we set one
+ $key = "X-barabara";
+ $r->$sub_good->set($key, $key x 2);
+ }
+ my $exp = $r->$sub_good->get($key);
+ my $got = $r->$sub($key);
+ $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
+ }
+ elsif ($data{what} eq 'get_list') {
+ # get in list ctx
+ my $key = $data{test};
+ my @exp = qw(foo bar);
+ $r->$sub_good->add($key => $_) for @exp;
+ my @got = $r->$sub($key);
+ $r->print(t_is_equal(\@exp, \@got) ? 'ok' : 'nok');
+ }
+ elsif ($data{what} eq 'set') {
+ # set
+ my $key = $data{test};
+ my $exp = $key x 2;
+ $r->$sub($key => $exp);
+ my $got = $r->$sub($key);
+ $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
+ }
+ elsif ($data{what} eq 'unset') {
+ # unset
+ my $key = $data{test};
+ my $exp = undef;
+ $r->$sub($key => $exp);
+ my $got = $r->$sub($key);
+ $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
+ }
+ }
OK;
}
