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 (file)
--- 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 (file)
--- 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<DB_File>
 or the F<Config> module for interesting tie() implementations.
 
+For further details see L<perltie>, L<tied VARIABLE>.
+
 =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 (file)
--- 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</x> 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</\w+(?=\t)/>
 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</foo(?!bar)/>
 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</(?=\t)\w+/>
 matches a word following a tab, without including the tab in C<$&>.
 Works only for fixed-width lookbehind.
 
-=item (?<!regexp)
+=item C<(?<!regexp)>
 
 A zero-width negative lookbehind assertion.  For example C</(?<!bar)foo/>
 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<code> ends.
-
+succeeds.  C<code> is not interpolated.  Currently the rules to
+determine where the C<code> ends are somewhat convoluted.
 
 =item C<(?E<gt>regexp)>
 
@@ -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 C<a>s.
 
-=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 (file)
--- 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 (executable)
--- 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 (executable)
--- 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 (file)
--- 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) {