Integrate changes #9544,9547,9549(perlio),9550,9551 from
Jarkko Hietaniemi [Thu, 5 Apr 2001 04:00:33 +0000 (04:00 +0000)]
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..)

1  2 
doop.c
ext/B/B.pm
ext/B/B.xs
ext/B/B/C.pm
ext/B/B/Deparse.pm
ext/Thread/Thread.xs
t/op/tr.t

diff --cc doop.c
--- 1/doop.c
--- 2/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
@@@ -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
@@@ -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
@@@ -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 */
@@@ -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 {
@@@ -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
+++ 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";
++