# New Ticket Created by  Andris Kalnozols 
# Please include the string:  [perl #56610]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=56610 > 



It appears that there's a bug in Perl v5.10.0 that is only
exposed by the Tie-CPHash module.  Since the module is pure
Perl, the module's author and I agree that this is a corner
case defect in Perl itself.  The same set of circumstances
runs just fine using Perl 5.8.8 futher lending credence that
the problem is with version 5.10.0.

The problem is that a regex operation fails when trying to
manipulate the value of a CPHash'ed hash when running v5.10.0.

Here is the output of the demonstration script which is
attached at the end of this message:

Regards,
Andris Kalnozols
HP Laboratories

-----------------------------------------------------
                     HP-UX
-----------------------------------------------------

usno# perl-bug

The "%Names" hash is *not* tied to the "Tie-CPHash" module.

Incrementing the numeric value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = 1
 After: $Names{'ntp-1.2.3.4'} = 2

Contatenating '2' to the value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = '1'
 After: $Names{'ntp-1.2.3.4'} = '12'

Using regex to remove `ntp2-pa' from the value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa ntp2-pa '
 After: $Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa '

.......................................................................

usno# perl-bug show

Executing `tie %Names, "Tie::CPHash";'.

Incrementing the numeric value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = 1
 After: $Names{'ntp-1.2.3.4'} = 2

Contatenating '2' to the value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = '1'
 After: $Names{'ntp-1.2.3.4'} = '12'

*DEFECT*
Using regex to remove `ntp2-pa' from the value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa ntp2-pa '
 After: $Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa ntp2-pa '

.......................................................................

usno# perl -V
Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=hpux, osvers=11.31, archname=IA64.ARCHREV_0-thread-multi
    uname='hp-ux usno b.11.31 u ia64 3696645879 unlimited-user license '
    config_args='-der'
    hint=previous, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_POSIX_C_SOURCE=199506L -D_REENTRANT -Ae -z -D_XOPEN_SOURCE_EXTENDE
D -Wl,+mergeseg -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='+O0 -g +check=bounds:all +check=globals +check=malloc +check=stack +Olit=all +
DSnative',
    cppflags='-Aa -D__STDC_EXT__ -D_HPUX_SOURCE -D_POSIX_C_SOURCE=199506L -D_REENTRANT -Ae -
z -D_XOPEN_SOURCE_EXTENDED -Wl,+mergeseg -I/usr/local/include -D_POSIX_C_SOURCE=199506L -D_R
EENTRANT -Ae -z -D_XOPEN_SOURCE_EXTENDED -Wl,+mergeseg -I/usr/local/include -D_LARGEFILE_SOU
RCE -D_FILE_OFFSET_BITS=64'
    ccversion='B3910B', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='/usr/bin/ld', ldflags ='-L/usr/local/lib/hpux32 -L/opt/langtools/lib/hpux32 -L/usr/l
ib/hpux32'
    libpth=/usr/local/lib/hpux32 /usr/lib/hpux32 /usr/ccs/lib/hpux32 /opt/langtools/lib/hpux
32
    libs=-lnsl -lnm -lndbm -ldb -ldl -lm -lsec -lpthread -lrtc_aux -lrtc
    perllibs=-lnsl -lnm -ldl -lm -lsec -lpthread -lrtc_aux -lrtc
    libc=/usr/lib/hpux32/libc.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_hpux.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-B,deferred '
    cccdlflags=' ', lddlflags='-b +mergeseg -L/usr/local/lib/hpux32 -L/opt/langtools/lib/hpu
x32 -lrtc_aux -lrtc -L/usr/lib/hpux32'


Characteristics of this binary (from libperl):
  Compile-time options: MULTIPLICITY PERL_DONT_CREATE_GVSV
                        PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP USE_ITHREADS
                        USE_LARGE_FILES USE_PERLIO USE_REENTRANT_API
  Built under hpux
  Compiled at Jul  2 2008 09:43:13
  @INC:
    /usr/local/perl/lib/5.10.0
    /usr/local/perl/lib/site_perl/5.10.0
    /usr/local/lib/site_perl
    .

  NOTE: Despite using the instrumentation features of HP's ANSI-C
        compiler to build in various checks for bounds violations
        (array and pointer), stack corruption, malloc, etc., the
        HP-UX version of Perl did not abort as it did under Linux.

        I will recompile using Perl's malloc to see aany useful
        diagnostics can be generated on the HP-UX platform.


-----------------------------------------------------
                  Linux (Debian)
-----------------------------------------------------

masterns# ./perl-bug

The "%Names" hash is *not* tied to the "Tie-CPHash" module.

Incrementing the numeric value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = 1
 After: $Names{'ntp-1.2.3.4'} = 2

Contatenating '2' to the value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = '1'
 After: $Names{'ntp-1.2.3.4'} = '12'

Using regex to remove `ntp2-pa' from the value of `$Names{'ntp-1.2.3.4'}'...
Before: $Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa ntp2-pa '
 After: $Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa '

.......................................................................

masterns# ./perl-bug show

Executing `tie %Names, "Tie::CPHash";'.

Incrementing the value of `$Names{'ntp-1.2.3.4'}'
Before: $Names{'ntp-1.2.3.4'} = 1
 After: $Names{'ntp-1.2.3.4'} = 2

Contatenating '2' to the value of `$Names{'ntp-1.2.3.4'}'
Before: $Names{'ntp-1.2.3.4'} = '1'
 After: $Names{'ntp-1.2.3.4'} = '12'

*DEFECT*
Removing `ntp2-pa' from the value of `$Names{'ntp-1.2.3.4'}'
Before: $Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa ntp2-pa '
*** glibc detected *** /usr/bin/perl: double free or corruption (fasttop): 0x081a7568 ***
======= Backtrace: =========
/lib/i686/cmov/libc.so.6[0xb7e888f5]
/lib/i686/cmov/libc.so.6(cfree+0x90)[0xb7e8c360]
/usr/bin/perl(Perl_pp_substcont+0x3bf)[0x80f019f]
/usr/bin/perl(Perl_runops_standard+0x19)[0x80b17f9]
/usr/bin/perl(perl_run+0x2e0)[0x80ac620]
/usr/bin/perl(main+0xed)[0x8063ddd]
/lib/i686/cmov/libc.so.6(__libc_start_main+0xe0)[0xb7e33450]
/usr/bin/perl[0x8063c51]
======= Memory map: ========
08048000-08179000 r-xp 00000000 68:03 3842900    /usr/bin/perl
08179000-0817b000 rw-p 00130000 68:03 3842900    /usr/bin/perl
0817b000-081de000 rw-p 0817b000 00:00 0          [heap]
b7c00000-b7c21000 rw-p b7c00000 00:00 0
b7c21000-b7d00000 ---p b7c21000 00:00 0
b7ddc000-b7de8000 r-xp 00000000 68:03 2469173    /lib/libgcc_s.so.1
b7de8000-b7de9000 rw-p 0000b000 68:03 2469173    /lib/libgcc_s.so.1
b7de9000-b7deb000 rw-p b7de9000 00:00 0
b7deb000-b7df4000 r-xp 00000000 68:03 2469367    /lib/i686/cmov/libcrypt-2.7.so
b7df4000-b7df6000 rw-p 00008000 68:03 2469367    /lib/i686/cmov/libcrypt-2.7.so
b7df6000-b7e1d000 rw-p b7df6000 00:00 0
b7e1d000-b7f65000 r-xp 00000000 68:03 2469362    /lib/i686/cmov/libc-2.7.so
b7f65000-b7f66000 r--p 00148000 68:03 2469362    /lib/i686/cmov/libc-2.7.so
b7f66000-b7f68000 rw-p 00149000 68:03 2469362    /lib/i686/cmov/libc-2.7.so
b7f68000-b7f6b000 rw-p b7f68000 00:00 0
b7f6b000-b7f7f000 r-xp 00000000 68:03 2469388    /lib/i686/cmov/libpthread-2.7.so
b7f7f000-b7f81000 rw-p 00013000 68:03 2469388    /lib/i686/cmov/libpthread-2.7.so
b7f81000-b7f83000 rw-p b7f81000 00:00 0
b7f83000-b7fa6000 r-xp 00000000 68:03 2469370    /lib/i686/cmov/libm-2.7.so
b7fa6000-b7fa8000 rw-p 00023000 68:03 2469370    /lib/i686/cmov/libm-2.7.so
b7fa8000-b7faa000 r-xp 00000000 68:03 2469369    /lib/i686/cmov/libdl-2.7.so
b7faa000-b7fac000 rw-p 00001000 68:03 2469369    /lib/i686/cmov/libdl-2.7.so
b7fac000-b7fad000 rw-p b7fac000 00:00 0
b7fbd000-b7fbe000 rw-p b7fbd000 00:00 0
b7fbe000-b7fd8000 r-xp 00000000 68:03 2469171    /lib/ld-2.7.so
b7fd8000-b7fda000 rw-p 00019000 68:03 2469171    /lib/ld-2.7.so
bfc00000-bfc15000 rw-p bffeb000 00:00 0          [stack]
ffffe000-fffff000 r-xp 00000000 00:00 0          [vdso]
Aborted
masterns# echo $?
134

.......................................................................

masterns# perl -V
Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.25.7, archname=i486-linux-gnu-thread-multi
    uname='linux ninsei 2.6.25.7 #1 smp preempt fri jun 20 14:17:13 pdt 2008 i686 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchna
me=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.10 -Darchlib=/usr/lib/perl/5.10 
-Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/u
sr/local -Dsitelib=/usr/local/share/perl/5.10.0 -Dsitearch=/usr/local/lib/perl/5.10.0 -Dman1
dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsi
teman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -U
afs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibper
l=libperl.so.5.10.0 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -I/usr
/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/in
clude'
    ccversion='', gccversion='4.3.1', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /usr/lib64
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.7.so, so=so, useshrplib=true, libperl=libperl.so.5.10.0
    gnulibc_version='2.7'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib'


Characteristics of this binary (from libperl):
  Compile-time options: MULTIPLICITY PERL_DONT_CREATE_GVSV
                        PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP USE_ITHREADS
                        USE_LARGE_FILES USE_PERLIO USE_REENTRANT_API
  Built under linux
  Compiled at Jun 21 2008 21:09:08
  @INC:
    /etc/perl
    /usr/local/lib/perl/5.10.0
    /usr/local/share/perl/5.10.0
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.10
    /usr/share/perl/5.10
    /usr/local/lib/site_perl
    .

***********************************************************************

#!/usr/bin/perl -w
#

use strict;
use Tie::CPHash;

my ($name, %Names);

if (@ARGV) {
    #
    # Any command-line argument(s) will cause the "%Names"
    # hash to be tied to the Tie-CPHash module.
    #
    print "\nExecuting `tie %Names, \"Tie::CPHash\";'.\n\n";
    tie %Names, "Tie::CPHash";
} else {
    print "\n", 'The "%Names" hash is *not* tied ',
                'to the "Tie-CPHash" module.', "\n\n";
}

# Initialize the "%Names" hash with a numeric value.
#
$Names{'ntp-1.2.3.4'} = 1;

# Modify the value of the hash to demonstrate that
# numeric data are not affected by the bug.
#
print "Incrementing the numeric value of `\$Names\{'ntp-1.2.3.4'\}'...\n";
print "Before: \$Names\{'ntp-1.2.3.4'\} = ",
      $Names{'ntp-1.2.3.4'}, "\n";

$Names{'ntp-1.2.3.4'}++;

print " After: \$Names\{'ntp-1.2.3.4'\} = ",
      $Names{'ntp-1.2.3.4'}, "\n\n";

# Initialize the "%Names" hash with a simple character value.
#
$Names{'ntp-1.2.3.4'} = '1';

# Modify the value of the hash to demonstrate that a simple
# string concatenation is not affected by the bug.
#
print "Contatenating '2' to the value of `\$Names\{'ntp-1.2.3.4'\}'...\n";
print "Before: \$Names\{'ntp-1.2.3.4'\} = '",
      $Names{'ntp-1.2.3.4'}, "'\n";

$Names{'ntp-1.2.3.4'} .= '2';

print " After: \$Names\{'ntp-1.2.3.4'\} = '",
      $Names{'ntp-1.2.3.4'}, "'\n\n";

# Initialize the "%Names" hash with the demonstration data.
#
$Names{'ntp-1.2.3.4'} = 'ntp-2 ntp2 ntp-pa ntp-2-pa ntp2-pa ';

# Modify the value of the hash with an RE to expose the perl defect.
#
print "*DEFECT*\n" if @ARGV;
$name = 'ntp2-pa';
print "Using regex to remove `$name' from ",
      "the value of `\$Names\{'ntp-1.2.3.4'\}'...\n";
print "Before: \$Names\{'ntp-1.2.3.4'\} = '",
      $Names{'ntp-1.2.3.4'}, "'\n";

$Names{'ntp-1.2.3.4'} =~ s/(^|\s)$name\s/$1/;

print " After: \$Names\{'ntp-1.2.3.4'\} = '",
      $Names{'ntp-1.2.3.4'}, "'\n\n";

exit;