From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 15 Apr 2006 18:05:12 +0000 (+0000)
Subject: If the downstream caller wants block mode, and we're in line mode,
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=937b367d393d2f47eca488c9413d9e139fc7d431;p=p5sagit%2Fp5-mst-13.2.git

If the downstream caller wants block mode, and we're in line mode,
then don't return more bytes than they asked for. Hold bytes over
until next time if necessary.

p4raw-id: //depot/perl@27816
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 2c36b59..7ea62e5 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4516,7 +4516,6 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     dVAR;
     SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
-    GV * const filter_child_proc = (GV *)IoFMT_GV(datasv);
     SV * const filter_state = (SV *)IoTOP_GV(datasv);
     SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
     int len = 0;
@@ -4535,6 +4534,26 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        for PL_error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
+    if (maxlen && IoFMT_GV(datasv)) {
+	SV *const cache = (SV *)IoFMT_GV(datasv);
+	if (SvOK(cache)) {
+	    STRLEN cache_len;
+	    const char *cache_p = SvPV(cache, cache_len);
+	    /* Running in block mode and we have some cached data already.  */
+	    if (cache_len >= maxlen) {
+		/* In fact, so much data we don't even need to call
+		   filter_read.  */
+		sv_catpvn(buf_sv, cache_p, maxlen);
+		sv_chop(cache, cache_p + maxlen);
+		/* Definately not EOF  */
+		return 1;
+	    }
+	    sv_catsv(buf_sv, cache);
+	    maxlen -= cache_len;
+	    SvOK_off(cache);
+	}
+    }
+	
     if (filter_has_file) {
 	len = FILTER_READ(idx+1, upstream, maxlen);
     }
@@ -4570,12 +4589,41 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	LEAVE;
     }
 
+    if (maxlen) {
+	/* Running in block mode.  */
+	STRLEN got_len;
+	const char *got_p = SvPV(upstream, got_len);
+
+	if (got_len > maxlen) {
+	    /* Oh. Too long. Stuff some in our cache.  */
+	    SV *cache = (SV *)IoFMT_GV(datasv);
+
+	    if (!cache) {
+		IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - maxlen));
+	    } else if (SvOK(cache)) {
+		/* Cache should be empty.  */
+		assert(!SvCUR(cache));
+	    }
+
+	    sv_setpvn(cache, got_p + maxlen, got_len - maxlen);
+	    /* If you ask for block mode, you may well split UTF-8 characters.
+	       "If it breaks, you get to keep both parts"
+	       (Your code is broken if you  don't put them back together again
+	       before something notices.) */
+	    if (SvUTF8(upstream)) {
+		SvUTF8_on(cache);
+	    }
+	    SvCUR_set(upstream, maxlen);
+	}
+    }
+
+    if (upstream != buf_sv) {
+	sv_catsv(buf_sv, upstream);
+    }
+
     if (len <= 0) {
 	IoLINES(datasv) = 0;
-	if (filter_child_proc) {
-	    SvREFCNT_dec(filter_child_proc);
-	    IoFMT_GV(datasv) = NULL;
-	}
+	SvREFCNT_dec(IoFMT_GV(datasv));
 	if (filter_state) {
 	    SvREFCNT_dec(filter_state);
 	    IoTOP_GV(datasv) = NULL;
@@ -4586,10 +4634,6 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	}
 	filter_del(S_run_user_filter);
     }
-
-    if (upstream != buf_sv) {
-	sv_catsv(buf_sv, upstream);
-    }
     return len;
 }
 
diff --git a/t/op/incfilter.t b/t/op/incfilter.t
index 2ca4704..650aa15 100644
--- a/t/op/incfilter.t
+++ b/t/op/incfilter.t
@@ -14,7 +14,7 @@ BEGIN {
 use strict;
 use Filter::Util::Call;
 
-plan(tests => 19);
+plan(tests => 108);
 
 unshift @INC, sub {
     no warnings 'uninitialized';
@@ -103,8 +103,6 @@ sub prepend_rot13_filter {
 		   my $test = "fzrt!";
 		   $_ = $test;
 		   my $status = filter_read();
-		   # Sadly, doing this inside the source filter causes an
-		   # infinte loop
 		   my $got = substr $_, 0, length $test, '';
 		   is $got, $test, "Upstream didn't alter existing data";
 		   tr/A-Za-z/N-ZA-Mn-za-m/;
@@ -120,3 +118,39 @@ pass("This will rot13'ed twice");
 EOC
 
 do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/; return;}] or die;
+
+# This generates a heck of a lot of oks, but I think it's necessary.
+my $amount = 1;
+sub prepend_block_counting_filter {
+    filter_add(sub {
+		   my $output = defined $_ ? $_ : '';
+		   my $count = 256;
+		   while (--$count) {
+		       $_ = '';
+		       my $status = filter_read($amount);
+		       cmp_ok (length $_, '<=', $amount, "block mode works?");
+		       $output .= $_;
+		       if ($status <= 0 or /\n/s) {
+			   $_ = $output;
+			   return $status;
+		       }
+		   }
+		   die "Looping infinitely";
+			  
+	       })
+}
+
+open $fh, "<", \<<'EOC';
+BEGIN {prepend_block_counting_filter};
+pass("one by one");
+pass("and again");
+EOC
+
+do [$fh, sub {return;}] or die;
+
+open $fh, "<", \<<'EOC';
+BEGIN {prepend_block_counting_filter};
+pas("SSS make s fast SSS");
+EOC
+
+do [$fh, sub {s/s/ss/gs; s/([\nS])/$1$1$1/gs; return;}] or die;