You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2004/01/29 11:46:40 UTC
cvs commit: modperl-2.0/t/response/TestModperl printf.pm
stas 2004/01/29 02:46:40
Modified: t/response/TestModperl printf.pm
Log:
check that printf function fail to print before the response phase (which
also tests for print()/puts())
Revision Changes Path
1.3 +34 -4 modperl-2.0/t/response/TestModperl/printf.pm
Index: printf.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestModperl/printf.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -u -r1.2 -r1.3
--- printf.pm 11 Apr 2002 11:08:44 -0000 1.2
+++ printf.pm 29 Jan 2004 10:46:40 -0000 1.3
@@ -4,29 +4,59 @@
use warnings FATAL => 'all';
use Apache::RequestIO ();
+use Apache::RequestRec ();
+use APR::Table ();
-use Apache::Const -compile => 'OK';
+use Apache::Const -compile => qw(OK LOG_ERR);
sub handler {
my $r = shift;
- my $tests = 3;
+ my $tests = 4;
$r->printf("1..%d\n", $tests);
+ # ok 1
$r->printf("ok");
-
$r->printf(" %d\n", 1);
+ # ok 2
my $fmt = "%s%s %d\n";
$r->printf($fmt, qw(o k), 2);
+ # ok 3
my @a = ("ok %d%c", 3, ord("\n"));
$r->PRINTF(@a);
+ # ok 4 (gets input from the fixup handler via notes)
+ {
+ my $note = $r->notes->get("fixup") || '';
+ my $ok = $note =~
+ /\$r->printf can't be called before the response phase/;
+ $r->print("not ") unless $ok;
+ $r->print("ok 4\n");
+ $r->print("# either fixup was successful at printing to the\n",
+ "# client (which shouldn't happen before the\n",
+ "# response phase), or the note was lost/never set\n")
+ unless $ok;
+ $r->notes->clear;
+ }
+
+ Apache::OK;
+}
+
+sub fixup {
+ my $r = shift;
+
+ # it's not possible to send a response body before the response
+ # phase
+ eval { $r->printf("whatever") };
+ $r->notes->set(fixup => "$@") if $@;
+
Apache::OK;
}
1;
__END__
-
+PerlModule TestModperl::printf
+PerlFixupHandler TestModperl::printf::fixup