Change 29902 by [EMAIL PROTECTED] on 2007/01/20 23:57:28
Integrate:
[ 27271]
Add a test for study() on tied scalars, by Andy Lester after
Rick Delaney
[ 27272]
Mark some new study tests as TODO
[ 27273]
Avoid C<study>ing any strings that might change underneath us, such
as tied scalars and scalars with overloaded stringification.
[ 27274]
Fix typos and a missing bracket.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#293 integrate
... //depot/maint-5.8/perl/pp.c#113 integrate
... //depot/maint-5.8/perl/t/op/studytied.t#1 branch
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#293 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#292~29869~ 2007-01-18 04:25:16.000000000 -0800
+++ perl/MANIFEST 2007-01-20 15:57:28.000000000 -0800
@@ -2856,6 +2856,7 @@
t/op/stash.t See if %:: stashes work
t/op/stat.t See if stat works
t/op/study.t See if study works
+t/op/studytied.t See if study works with tied scalars
t/op/sub_lval.t See if lvalue subroutines work
t/op/subst_amp.t See if $&-related substitution works
t/op/substr.t See if substr works
==== //depot/maint-5.8/perl/pp.c#113 (text) ====
Index: perl/pp.c
--- perl/pp.c#112~29896~ 2007-01-20 09:47:00.000000000 -0800
+++ perl/pp.c 2007-01-20 15:57:28.000000000 -0800
@@ -632,13 +632,22 @@
if (SvSCREAM(sv))
RETPUSHYES;
}
- else {
- if (PL_lastscream) {
- SvSCREAM_off(PL_lastscream);
- SvREFCNT_dec(PL_lastscream);
- }
- PL_lastscream = SvREFCNT_inc(sv);
+ s = (unsigned char*)(SvPV(sv, len));
+ pos = len;
+ if (pos <= 0 || !SvPOK(sv)) {
+ /* No point in studying a zero length string, and not safe to study
+ anything that doesn't appear to be a simple scalar (and hence might
+ change between now and when the regexp engine runs without our set
+ magic ever running) such as a reference to an object with overloaded
+ stringification. */
+ RETPUSHNO;
+ }
+
+ if (PL_lastscream) {
+ SvSCREAM_off(PL_lastscream);
+ SvREFCNT_dec(PL_lastscream);
}
+ PL_lastscream = SvREFCNT_inc(sv);
s = (unsigned char*)(SvPV(sv, len));
pos = len;
==== //depot/maint-5.8/perl/t/op/studytied.t#1 (text) ====
Index: perl/t/op/studytied.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/t/op/studytied.t 2007-01-20 15:57:28.000000000 -0800
@@ -0,0 +1,50 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use strict;
+use warnings;
+
+use Test::More tests => 14;
+
+{
+ package J;
+ my $c = 0;
+ sub reset { $c = 0 }
+ sub TIESCALAR { bless [] }
+ sub FETCH { $c++ ? "next" : "first" }
+}
+
+# This test makes sure that we can't pull a fast one on study(). If we
+# study() a tied variable, perl should know that the studying isn't
+# valid on subsequent references, and should account for it.
+
+for my $do_study qw( 0 1 ) {
+ J::reset();
+ my $x;
+ tie $x, "J";
+
+ if ($do_study) {
+ study $x;
+ pass( "Studying..." );
+ } else {
+ my $first_fetch = $x;
+ pass( "Not studying..." );
+ }
+
+ # When it was studied (or first_fetched), $x was "first", but is now
"next", so
+ # should not match /f/.
+ ok( $x !~ /f/, qq{"next" doesn't match /f/} );
+ is( index( $x, 'f' ), -1, qq{"next" doesn't contain "f"} );
+
+ # Subsequent references to $x are "next", so should match /n/
+ ok( $x =~ /n/, qq{"next" matches /n/} );
+ is( index( $x, 'n' ), 0, qq{"next" contains "n" at pos 0} );
+
+ # The letter "t" is in both, but in different positions
+ ok( $x =~ /t/, qq{"next" matches /t/} );
+ is( index( $x, 't' ), 3, qq{"next" contains "t" at pos 3} );
+}
End of Patch.
