From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu, 5 Apr 2001 04:00:33 +0000 (+0000)
Subject: Integrate changes #9544,9547,9549(perlio),9550,9551 from
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=76ef7183b725f0ef3e642f805cb4d676a5263201;p=p5sagit%2Fp5-mst-13.2.git

Integrate changes #9544,9547,9549(perlio),9550,9551 from
maintperl into mainline.

"double" should be "NV"; standard typemap is missing entry
for NV

s/djSP/dSP/

Downgrade "Wide character in print" to a warning.

B::Deparse fix for ${^FOO} and documentation for PVX() method
(from Robin Houston)

tr/// doesn't null-terminate the result in some situations
(from Gisle Aas)

p4raw-link: @9549 on //depot/perlio: ae79846703a543a04b4fe449abfd6b1e08a9e149
p4raw-link: @9547 on //depot/maint-5.6/perl: 5976aebc9f997fdf4f4889f497e528a90c8a7dc3
p4raw-link: @9544 on //depot/maint-5.6/perl: 405f61b82790e3c0b3cb02962f34aa8522c5a18e

p4raw-id: //depot/perl@9553
p4raw-integrated: from //depot/maint-5.6/perl@9552 'copy in'
	ext/B/B/C.pm (@9235..) 'merge in' lib/ExtUtils/typemap
	(@8151..) ext/Thread/Thread.xs (@8606..) t/op/tr.t (@9152..)
	doop.c (@9288..) ext/B/B.pm ext/B/B/Deparse.pm (@9548..)
p4raw-integrated: from //depot/maint-5.6/perl@9544 'merge in'
	ext/B/B.xs (@8621..)
---

76ef7183b725f0ef3e642f805cb4d676a5263201
diff --cc doop.c
index 266411a,266411a..d7baecc
--- a/doop.c
+++ b/doop.c
@@@ -184,6 -184,6 +184,7 @@@ S_do_trans_complex(pTHX_ SV *sv)/* SPC 
  		s++;
  	    }
  	}
++	*d = '\0';
  	SvCUR_set(sv, d - dstart);
      }
      else { /* isutf8 */
diff --cc ext/B/B.pm
index 41ba5d6,41ba5d6..ad8699f
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@@ -365,8 -365,8 +365,22 @@@ C<REFCNT> (corresponding to the C funct
  
  =item PV
  
++This method is the one you usually want. It constructs a
++string using the length and offset information in the struct:
++for ordinary scalars it will return the string that you'd see
++from Perl, even if it contains null characters.
++
  =item PVX
  
++This method is less often useful. It assumes that the string
++stored in the struct is null-terminated, and disregards the
++length information.
++
++It is the appropriate method to use if you need to get the name
++of a lexical variable from a padname array. Lexical variable names
++are always stored with a null terminator, and the length field
++(SvCUR) is overloaded for other purposes and can't be relied on here.
++
  =back
  
  =head2 B::PVMG METHODS
diff --cc ext/B/B.xs
index 51ce983,51ce983..39b579f
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@@ -885,11 -885,11 +885,11 @@@ packiv(sv
  
  MODULE = B	PACKAGE = B::NV		PREFIX = Sv
  
--double
++NV
  SvNV(sv)
  	B::NV	sv
  
--double
++NV
  SvNVX(sv)
  	B::NV	sv
  
diff --cc ext/B/B/C.pm
index 5008875,5008875..4befe79
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@@ -1048,15 -1048,15 +1048,15 @@@ typedef struct 
      STRLEN	xpv_cur;	/* length of xp_pv as a C string */
      STRLEN	xpv_len;	/* allocated size */
      IV		xof_off;	/* integer value */
--    double	xnv_nv;		/* numeric value, if any */
++    NV		xnv_nv;		/* numeric value, if any */
      MAGIC*	xmg_magic;	/* magic for scalar array */
      HV*		xmg_stash;	/* class package */
  
      HV *	xcv_stash;
      OP *	xcv_start;
      OP *	xcv_root;
--    void      (*xcv_xsub) (CV*);
--    void *	xcv_xsubany;
++    void      (*xcv_xsub) (pTHXo_ CV*);
++    ANY		xcv_xsubany;
      GV *	xcv_gv;
      char *	xcv_file;
      long	xcv_depth;	/* >= 2 indicates recursive call */
diff --cc ext/B/B/Deparse.pm
index 32baa50,32baa50..eb8eb60
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@@ -782,8 -782,8 +782,9 @@@ sub gv_name 
      } else {
  	$stash = $stash . "::";
      }
--    if ($name =~ /^([\cA-\cZ])$/) {
--	$name = "^" . chr(64 + ord($1));
++    if ($name =~ /^([\cA-\cZ])(.*)$/) {
++	$name = "^" . chr(64 + ord($1)) . $2;
++	$name = "{$name}" if length($2);	# ${^WARNING_BITS} etc
      }
      return $stash . $name;
  }
@@@ -2418,7 -2418,7 +2419,7 @@@ sub pp_const 
      my $sv = $self->const_sv($op);
  #    return const($sv);
      my $c = const $sv; 
--    return $c < 0 ? $self->maybe_parens($c, $cx, 21) : $c;
++    return $c =~ /^-\d/ ? $self->maybe_parens($c, $cx, 21) : $c;
  }
  
  sub dq {
diff --cc ext/Thread/Thread.xs
index c117c60,c117c60..f87e7c4
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@@ -82,7 -82,7 +82,7 @@@ threadstart(void *arg
  #else
      Thread thr = (Thread) arg;
      LOGOP myop;
--    djSP;
++    dSP;
      I32 oldmark = TOPMARK;
      I32 oldscope = PL_scopestack_ix;
      I32 retval;
diff --cc t/op/tr.t
index c7b4461,c7b4461..90b0370
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@@ -5,7 -5,7 +5,7 @@@ BEGIN 
      @INC = '../lib';
  }
  
--print "1..66\n";
++print "1..67\n";
  
  $_ = "abcdefghijklmnopqrstuvwxyz";
  
@@@ -370,3 -370,3 +370,9 @@@ print "ok 65\n"
  $a = "\xfe\xff"; $a =~ tr/\xfe\xff/\x{1ff}\x{1fe}/;
  print "not " unless $a eq "\x{1ff}\x{1fe}";
  print "ok 66\n";
++
++# From David Dyck
++($a = "R0_001") =~ tr/R_//d;
++print "not " if hex($a) != 1;
++print "ok 67\n";
++