From dc1f106ccdacefbf1f731ee572b446730d08d664 Mon Sep 17 00:00:00 2001
From: Bas van Sisseren <bas@quarantainenet.nl>
Date: Wed, 26 Oct 2005 15:59:42 +0200
Subject: [PATCH] Integrate: [ 25934] A B::Deparse fix from : Subject: Re:
 [perl #37527] regular-expression parser does not see '(' character
 Message-ID: <435F6FAE.4060502@quarantainenet.nl>

[ 26019]
Make the 5.9 changes to B conditional on perl version.

[ 26085]
Correct the version-dependant expression for the number of tests, as it
is now giving the wrong number for 5.8.x

[ 26089]
26085 was wrong. Undo it.
(I suspect that I got this wrong because more changes have been made
 in blead subsequent to the change I was attempting to merge in, and
 and jiggled around with the number of tests)
p4raw-link: @26089 on //depot/perl: a49b57c670c0e84581cdf732a6a8c6ba17aa39b1
p4raw-link: @26085 on //depot/perl: 736c8e7472a989af95503ed73eeb0403d987ab9e
p4raw-link: @26019 on //depot/perl: edcc7c74ed376a449c95af027d10cdeb74f64de8
p4raw-link: @25934 on //depot/perl: 80b7d6d21a210be1e3f8b895dc124aa24c96d7df

p4raw-id: //depot/maint-5.8/perl@30350
p4raw-integrated: from //depot/perl@26085 'edit in'
	ext/B/t/concise-xs.t (@25956..)
p4raw-integrated: from //depot/perl@26019 'edit in' ext/B/B.pm
	(@24538..)
p4raw-integrated: from //depot/perl@25934 'edit in' ext/B/B/Deparse.pm
	(@25601..)
p4raw-integrated: from //depot/perl@24271 'edit in' ext/B/B.xs
	(@24170..)
---
 ext/B/B.pm         | 13 +++++++++++++
 ext/B/B.xs         | 26 +++++++++++++++++++-------
 ext/B/B/Deparse.pm |  7 +++++--
 3 files changed, 37 insertions(+), 9 deletions(-)

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 0e96f40..be02309 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -857,8 +857,16 @@ IoIFP($io) == PerlIO_stdin() ).
 Like C<ARRAY>, but takes an index as an argument to get only one element,
 rather than a list of all of them.
 
+=item OFF
+
+This method is deprecated if running under Perl 5.8, and is no longer present
+if running under Perl 5.9
+
 =item AvFLAGS
 
+This method returns the AV specific flags. In Perl 5.9 these are now stored
+in with the main SV flags, so this method is no longer present.
+
 =back
 
 =head2 B::CV Methods
@@ -913,6 +921,11 @@ For constant subroutines, returns the constant SV returned by the subroutine.
 
 =item ARRAY
 
+=item PMROOT
+
+This method is not present if running under Perl 5.9, as the PMROOT
+information is no longer stored directly in the hash.
+
 =back
 
 =head2 OP-RELATED CLASSES
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 269372a..3695aa7 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -19,7 +19,7 @@ typedef FILE * InputStream;
 #endif
 
 
-static char *svclassnames[] = {
+static const char* const svclassnames[] = {
     "B::NULL",
     "B::IV",
     "B::NV",
@@ -58,7 +58,7 @@ typedef enum {
     OPc_COP	/* 11 */
 } opclass;
 
-static char *opclassnames[] = {
+static const char* const opclassnames[] = {
     "B::NULL",
     "B::OP",
     "B::UNOP",
@@ -73,7 +73,7 @@ static char *opclassnames[] = {
     "B::COP"	
 };
 
-static size_t opsizes[] = {
+static const size_t opsizes[] = {
     0,	
     sizeof(OP),
     sizeof(UNOP),
@@ -211,13 +211,13 @@ cc_opclass(pTHX_ const OP *o)
 static char *
 cc_opclassname(pTHX_ const OP *o)
 {
-    return opclassnames[cc_opclass(aTHX_ o)];
+    return (char *)opclassnames[cc_opclass(aTHX_ o)];
 }
 
 static SV *
 make_sv_object(pTHX_ SV *arg, SV *sv)
 {
-    char *type = 0;
+    const char *type = 0;
     IV iv;
     dMY_CXT;
     
@@ -730,7 +730,7 @@ threadsv_names()
 
 #define OP_next(o)	o->op_next
 #define OP_sibling(o)	o->op_sibling
-#define OP_desc(o)	PL_op_desc[o->op_type]
+#define OP_desc(o)	(char *)PL_op_desc[o->op_type]
 #define OP_targ(o)	o->op_targ
 #define OP_type(o)	o->op_type
 #if PERL_VERSION >= 9
@@ -765,7 +765,7 @@ char *
 OP_name(o)
 	B::OP		o
     CODE:
-	RETVAL = PL_op_name[o->op_type];
+	RETVAL = (char *)PL_op_name[o->op_type];
     OUTPUT:
 	RETVAL
 
@@ -1583,12 +1583,17 @@ SSize_t
 AvMAX(av)
 	B::AV	av
 
+#if PERL_VERSION < 9
+			   
+
 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
 
 IV
 AvOFF(av)
 	B::AV	av
 
+#endif
+
 void
 AvARRAY(av)
 	B::AV	av
@@ -1610,6 +1615,7 @@ AvARRAYelt(av, idx)
 	else
 	    XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
 
+#if PERL_VERSION < 9
 				   
 MODULE = B	PACKAGE = B::AV
 
@@ -1617,6 +1623,8 @@ U8
 AvFLAGS(av)
 	B::AV	av
 
+#endif
+
 MODULE = B	PACKAGE = B::FM		PREFIX = Fm
 
 IV
@@ -1715,10 +1723,14 @@ char *
 HvNAME(hv)
 	B::HV	hv
 
+#if PERL_VERSION < 9
+
 B::PMOP
 HvPMROOT(hv)
 	B::HV	hv
 
+#endif
+
 void
 HvARRAY(hv)
 	B::HV	hv
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index f4114d4..4f6f6b0 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -3387,14 +3387,16 @@ sub re_unback {
 sub balanced_delim {
     my($str) = @_;
     my @str = split //, $str;
-    my($ar, $open, $close, $fail, $c, $cnt);
+    my($ar, $open, $close, $fail, $c, $cnt, $last_bs);
     for $ar (['[',']'], ['(',')'], ['<','>'], ['{','}']) {
 	($open, $close) = @$ar;
-	$fail = 0; $cnt = 0;
+	$fail = 0; $cnt = 0; $last_bs = 0;
 	for $c (@str) {
 	    if ($c eq $open) {
+		$fail = 1 if $last_bs;
 		$cnt++;
 	    } elsif ($c eq $close) {
+		$fail = 1 if $last_bs;
 		$cnt--;
 		if ($cnt < 0) {
 		    # qq()() isn't ")("
@@ -3402,6 +3404,7 @@ sub balanced_delim {
 		    last;
 		}
 	    }
+	    $last_bs = $c eq '\\';
 	}
 	$fail = 1 if $cnt != 0;
 	return ($open, "$open$str$close") if not $fail;
-- 
1.8.3.1