From: Jim Cromie <jcromie@cpan.org>
Date: Sun, 29 Oct 2006 14:50:02 +0000 (-0700)
Subject: [patch] simplify optree test support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ab7e0f544dbf50e31b2ea173f6c5d078f5d74caa;p=p5sagit%2Fp5-mst-13.2.git

[patch] simplify optree test support
Message-ID: <4545220A.6060500@gmail.com>

p4raw-id: //depot/perl@29148
---

diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm
index fa1a825..a3dd3e0 100644
--- a/ext/B/t/OptreeCheck.pm
+++ b/ext/B/t/OptreeCheck.pm
@@ -514,10 +514,7 @@ sub getRendering {
 	}
 	# set walk-output b4 compiling, which writes 'announce' line
 	walk_output(\$rendering);
-	if ($tc->{fail}) {
-	    fail("forced failure: stdout follows");
-	    walk_output(\*STDOUT);
-	}
+
 	my $opwalker = B::Concise::compile(@opts, $code);
 	die "bad BC::compile retval" unless ref $opwalker eq 'CODE';
 
@@ -662,19 +659,13 @@ sub mkCheckRex {
     }
     $tc->{wantstr} = $str;
 
-    # convert all (args) and [args] to temp forms wo bracing
-    $str =~ s/\[(.*?)\]/__CAPSQR$1__/msg;
-    $str =~ s/\((.*?)\)/__CAPRND$1__/msg;
-    $str =~ s/\((.*?)\)/__CAPRND$1__/msg; # nested () in nextstate
-    
+    # make targ args wild
+    $str =~ s/\[t\d+\]/[t\\d+]/msg;
+
     # escape bracing, etc.. manual \Q (doesnt escape '+')
     $str =~ s/([\[\]()*.\$\@\#\|{}])/\\$1/msg;
+    # $str =~ s/(?<!\\)([\[\]\(\)*.\$\@\#\|{}])/\\$1/msg;
 
-    # now replace temp forms with original, preserving reference bracing 
-    $str =~ s/__CAPSQR(.*?)__\b/\\[$1\\]/msg; # \b is important
-    $str =~ s/__CAPRND(.*?)__\b/\\($1\\)/msg;
-    $str =~ s/__CAPRND(.*?)__\b/\\($1\\)/msg; # nested () in nextstate
-    
     # treat dbstate like nextstate (no in-debugger false reports)
     $str =~ s/(?:next|db)state(\\\(.*?\\\))/(?:next|db)state(.*?)/msg;
     # widened for -terse mode
@@ -690,14 +681,9 @@ sub mkCheckRex {
     $str =~ s/leavesub \[\d\]/leavesub [\\d]/msg;	# for -terse
     #$str =~ s/(\s*)\n/\n/msg;				# trailing spaces
     
-    # these fix up pad-slot assignment args
-    if ($] < 5.009 or $tc->{cross}) {
-	$str =~ s/\[t\d+\\]/\[t\\d+\\]/msg;	# pad slot assignments
-    }
-
     croak "no reftext found for $want: $tc->{name}"
 	unless $str =~ /\w+/; # fail unless a real test
-
+    
     # $str = '.*'	if 1;	# sanity test
     # $str .= 'FAIL'	if 1;	# sanity test