Change 27816 by [EMAIL PROTECTED] on 2006/04/15 18:05:12
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.
Affected files ...
... //depot/perl/pp_ctl.c#549 edit
... //depot/perl/t/op/incfilter.t#4 edit
Differences ...
==== //depot/perl/pp_ctl.c#549 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#548~27815~ 2006-04-15 10:00:54.000000000 -0700
+++ perl/pp_ctl.c 2006-04-15 11:05:12.000000000 -0700
@@ -4516,7 +4516,6 @@
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 @@
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 @@
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 @@
}
filter_del(S_run_user_filter);
}
-
- if (upstream != buf_sv) {
- sv_catsv(buf_sv, upstream);
- }
return len;
}
==== //depot/perl/t/op/incfilter.t#4 (text) ====
Index: perl/t/op/incfilter.t
--- perl/t/op/incfilter.t#3~27814~ 2006-04-15 09:43:22.000000000 -0700
+++ perl/t/op/incfilter.t 2006-04-15 11:05:12.000000000 -0700
@@ -14,7 +14,7 @@
use strict;
use Filter::Util::Call;
-plan(tests => 19);
+plan(tests => 108);
unshift @INC, sub {
no warnings 'uninitialized';
@@ -103,8 +103,6 @@
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 @@
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;
End of Patch.
