Author: stas Date: Fri Dec 24 17:22:17 2004 New Revision: 123309 URL: http://svn.apache.org/viewcvs?view=rev&rev=123309 Log: test the $| behavior under tied STDOUT
Modified: perl/modperl/trunk/t/api/rflush.t perl/modperl/trunk/t/response/TestAPI/rflush.pm perl/modperl/trunk/todo/release Modified: perl/modperl/trunk/t/api/rflush.t Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/api/rflush.t?view=diff&rev=123309&p1=perl/modperl/trunk/t/api/rflush.t&r1=123308&p2=perl/modperl/trunk/t/api/rflush.t&r2=123309 ============================================================================== --- perl/modperl/trunk/t/api/rflush.t (original) +++ perl/modperl/trunk/t/api/rflush.t Fri Dec 24 17:22:17 2004 @@ -5,9 +5,19 @@ use Apache::TestRequest; use Apache::TestUtil; -plan tests => 1; - -my $expected = "[<foo][bar>][<who][ah>]"; my $location = '/TestAPI__rflush'; -my $response = GET_BODY $location; -ok t_cmp($response, $expected, "rflush creates bucket brigades"); + +plan tests => 2; + +{ + my $response = GET_BODY "$location?nontied"; + ok t_cmp($response, "[1][2][3][4][56]", + "non-tied rflush creates bucket brigades"); +} + +{ + my $response = GET_BODY "$location?tied"; + ok t_cmp($response, "[1][2][3456]", + "tied STDOUT internal rflush creates bucket brigades"); +} + Modified: perl/modperl/trunk/t/response/TestAPI/rflush.pm Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestAPI/rflush.pm?view=diff&rev=123309&p1=perl/modperl/trunk/t/response/TestAPI/rflush.pm&r1=123308&p2=perl/modperl/trunk/t/response/TestAPI/rflush.pm&r2=123309 ============================================================================== --- perl/modperl/trunk/t/response/TestAPI/rflush.pm (original) +++ perl/modperl/trunk/t/response/TestAPI/rflush.pm Fri Dec 24 17:22:17 2004 @@ -36,17 +36,37 @@ $r->content_type('text/plain'); - # print is now unbuffered - local $| = 1; - $r->print("<foo"); # this sends the data in the buffer + flush bucket + my $args = $r->args || ''; + if ($args eq 'nontied') { + # print is now unbuffered + local $| = 1; + $r->print("1"); # send the data in the buffer + flush bucket + $r->print("2"); # send the data in the buffer + flush bucket - # print is now buffered - local $| = 0; - $r->print("bar>"); - $r->rflush; # this sends the data in the buffer + flush bucket - $r->print("<who"); - $r->rflush; # this sends the data in the buffer + flush bucket - $r->print("ah>"); + # print is now buffered + local $| = 0; + $r->print("3"); + $r->rflush; # send the data in the buffer + flush bucket + $r->print("4"); + $r->rflush; # send the data in the buffer + flush bucket + $r->print("5"); + $r->print("6"); # send the data in the buffer (end of handler) + } + elsif ($args eq 'tied') { + my $oldfh; + # print is now unbuffered ("rflush"-like functionality is + # called internally) + $oldfh = select(STDOUT); $| = 1; select($oldfh); + print "1"; # send the data in the buffer + flush bucket + print "2"; + + # print is now buffered + $oldfh = select(STDOUT); $| = 0; select($oldfh); + print "3"; + print "4"; + print "5"; + print "6"; # send the data in the buffer (end of handler) + } Apache::OK; } Modified: perl/modperl/trunk/todo/release Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/todo/release?view=diff&rev=123309&p1=perl/modperl/trunk/todo/release&r1=123308&p2=perl/modperl/trunk/todo/release&r2=123309 ============================================================================== --- perl/modperl/trunk/todo/release (original) +++ perl/modperl/trunk/todo/release Fri Dec 24 17:22:17 2004 @@ -9,25 +9,6 @@ ModPerl::Util::unload_package() which perfectly fits the timing when the leak was introduced (when PerlRun started to use unload_package). -* take a look at this: -Index: t/response/TestAPI/rflush.pm -=================================================================== ---- t/response/TestAPI/rflush.pm (revision 122914) -+++ t/response/TestAPI/rflush.pm (working copy) -@@ -36,6 +36,10 @@ - - $r->content_type('text/plain'); - -+# XXX: perlio needs to be tested with cases: -+# my $oldfh = select(STDOUT); $| = 1; select($oldfh); -+# and see if the print is unbuffered -+ - # print is now unbuffered - local $| = 1; - $r->print("<foo"); # this sends the data in the buffer + flush bucket - - - * we need to deal with a situation where an object is used to construct another object, but it's then auto-DESTROYed by perl rendering the object that used it corrupted.
