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

7 files changed, 55 insertions, 24 deletions

diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 2117c54c18..89fd61dd74 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 bae135bc92..0570c8fe64 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<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 7d0ba542f8..373e1ca84e 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</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 bb1b86abef..aa713bc0a5 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 326273aff1..7a7fc334d3 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 a9e6869a4a..5d8bf8ad78 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 23174221d0..28c5a42c4c 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) {