From: Ilya Zakharevich Date: Sun, 11 Jan 1998 20:34:05 +0000 (-0500) Subject: 5.004_56: Patch to Tie::Hash and docs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc6b73957505a73b130c87add7bf3d534f129041;p=p5sagit%2Fp5-mst-13.2.git 5.004_56: Patch to Tie::Hash and docs Date: Sun, 11 Jan 1998 20:34:05 -0500 (EST) Subject: 5.004_56: Patch to (?{}) quoting + cosmetic Date: Mon, 2 Feb 1998 01:28:46 -0500 (EST) p4raw-id: //depot/perl@470 --- diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm index 2117c54..89fd61d 100644 --- a/lib/Tie/Hash.pm +++ b/lib/Tie/Hash.pm @@ -110,7 +110,7 @@ sub new { sub TIEHASH { my $pkg = shift; - if (defined &{"{$pkg}::new"}) { + if (defined &{"${pkg}::new"}) { carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing" if $^W; $pkg->new(@_); diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index bae135b..0570c8f 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3695,6 +3695,8 @@ Unlike dbmopen(), the tie() function will not use or require a module for you--you need to do that explicitly yourself. See L or the F module for interesting tie() implementations. +For further details see L, L. + =item tied VARIABLE Returns a reference to the object underlying VARIABLE (the same value diff --git a/pod/perlre.pod b/pod/perlre.pod index 7d0ba54..373e1ca 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -251,12 +251,12 @@ function of the extension. Several extensions are already supported: =over 10 -=item (?#text) +=item C<(?#text)> A comment. The text is ignored. If the C switch is used to enable whitespace formatting, a simple C<#> will suffice. -=item (?:regexp) +=item C<(?:regexp)> This groups things like "()" but doesn't make backreferences like "()" does. So @@ -268,12 +268,12 @@ is like but doesn't spit out extra fields. -=item (?=regexp) +=item C<(?=regexp)> A zero-width positive lookahead assertion. For example, C matches a word followed by a tab, without including the tab in C<$&>. -=item (?!regexp) +=item C<(?!regexp)> A zero-width negative lookahead assertion. For example C matches any occurrence of "foo" that isn't followed by "bar". Note @@ -291,24 +291,23 @@ easier just to say: For lookbehind see below. -=item (?<=regexp) +=item C<(?<=regexp)> A zero-width positive lookbehind assertion. For example, C matches a word following a tab, without including the tab in C<$&>. Works only for fixed-width lookbehind. -=item (? A zero-width negative lookbehind assertion. For example C matches any occurrence of "foo" that isn't following "bar". Works only for fixed-width lookbehind. -=item (?{ code }) +=item C<(?{ code })> Experimental "evaluate any Perl code" zero-width assertion. Always -succeeds. Currently the quoting rules are somewhat convoluted, as is the -determination where the C ends. - +succeeds. C is not interpolated. Currently the rules to +determine where the C ends are somewhat convoluted. =item C<(?Eregexp)> @@ -371,9 +370,9 @@ Note that on simple groups like the above C<(?> [^()]+ )> a similar effect may be achieved by negative lookahead, as in C<[^()]+ (?! [^()] )>. This was only 4 times slower on a string with 1000000 Cs. -=item (?(condition)yes-regexp|no-regexp) +=item C<(?(condition)yes-regexp|no-regexp)> -=item (?(condition)yes-regexp) +=item C<(?(condition)yes-regexp)> Conditional expression. C<(condition)> should be either an integer in parentheses (which is valid if the corresponding pair of parentheses @@ -388,7 +387,7 @@ Say, matches a chunk of non-parentheses, possibly included in parentheses themselves. -=item (?imsx) +=item C<(?imsx)> One or more embedded pattern-match modifiers. This is particularly useful for patterns that are specified in a table somewhere, some of diff --git a/regcomp.c b/regcomp.c index bb1b86a..aa713bc 100644 --- a/regcomp.c +++ b/regcomp.c @@ -1065,11 +1065,12 @@ reg(I32 paren, I32 *flagp) rx->data->data[n+1] = (void*)av; rx->data->data[n+2] = (void*)sop; SvREFCNT_dec(sv); + } else { /* First pass */ + if (tainted) + FAIL("Eval-group in insecure regular expression"); } nextchar(); - if (tainted) - FAIL("Eval-group in insecure regular expression"); return reganode(EVAL, n); } case '(': diff --git a/t/op/misc.t b/t/op/misc.t index 326273a..7a7fc33 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -338,6 +338,7 @@ print "you die joe!\n" unless "@x" eq 'x y z'; ######## /(?{"{"})/ # Check it outside of eval too EXPECT +Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern /(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1. ######## /(?{"{"}})/ # Check it outside of eval too diff --git a/t/op/pat.t b/t/op/pat.t index a9e6869..5d8bf8a 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -2,7 +2,7 @@ # $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $ -print "1..100\n"; +print "1..101\n"; $x = "abc\ndef\n"; @@ -274,7 +274,7 @@ $_ = " a (bla()) and x(y b((l)u((e))) and b(l(e)e)e"; $expect = "(bla()) ((l)u((e))) (l(e)e)"; sub matchit { - m' + m/ ( \( (?{ $c = 1 }) # Initialize @@ -301,7 +301,7 @@ sub matchit { (?! ) # Fail ) # Otherwise the chunk 1 may succeed with $c>0 - 'xg; + /xg; } push @ans, $res while $res = matchit; @@ -321,9 +321,15 @@ print "not " if "@ans" ne 'a/ b'; print "ok $test\n"; $test++; -$code = '$blah = 45'; +$code = '{$blah = 45}'; $blah = 12; -/(?{$code})/; +/(?$code)/; +print "not " if $blah != 45; +print "ok $test\n"; +$test++; + +$blah = 12; +/(?{$blah = 45})/; print "not " if $blah != 45; print "ok $test\n"; $test++; diff --git a/toke.c b/toke.c index 2317422..28c5a42 100644 --- a/toke.c +++ b/toke.c @@ -802,9 +802,31 @@ scan_const(char *start) s++; } } - else if (*s == '(' && lex_inpat && s[1] == '?' && s[2] == '#') { - while (s < send && *s != ')') - *d++ = *s++; + else if (*s == '(' && lex_inpat && s[1] == '?') { + if (s[2] == '#') { + while (s < send && *s != ')') + *d++ = *s++; + } else if (s[2] == '{') { /* This should march regcomp.c */ + I32 count = 1; + char *regparse = s + 3; + char c; + + while (count && (c = *regparse)) { + if (c == '\\' && regparse[1]) + regparse++; + else if (c == '{') + count++; + else if (c == '}') + count--; + regparse++; + } + if (*regparse == ')') + regparse++; + else + yyerror("Sequence (?{...}) not terminated or not {}-balanced"); + while (s < regparse && *s != ')') + *d++ = *s++; + } } else if (*s == '#' && lex_inpat && ((PMOP*)lex_inpat)->op_pmflags & PMf_EXTENDED) {