Tie::Array SPLICE method is buggy

[p5pRT]

Migrated from rt.perl.org#4480 (status was 'resolved')

Searchable as RT4480$

[p5pRT]

From [email protected]

Created by [email protected]

If you use the standard splice function and the offset is
beyond the index of the last element, nothing will happen
to the array involved. This is the expected behavior.
Example​:

$ cat tmp.pl
#!/usr/bin/perl
@​foo=qw(0 1 2 3);
print "\@​foo=",join("|",@​foo),"\n";
splice(@​foo,5,2);
print "after splice​:\n";
print "\@​foo=",join("|",@​foo),"\n";

$ tmp.pl
@​foo=0|1|2|3
after splice​:
@​foo=0|1|2|3

However, if you use the inherited SPLICE method from Tie​::Array,
the behavior is different. Even if the offset is beyond
the index of the last element, the tied array may shrink
or it may be completely emptied.

Here is an example which demonstrates the unexpected behavior
when using Tie​::Array​:

$ cat foo.pl
package myArray;
$VERSION = 1.00;
use strict;
use vars qw(@​ISA);
use Carp;
use Symbol;
use Fcntl;
use Tie​::Array;
@​ISA=qw(Tie​::Array);

sub TIEARRAY
{
  my ($class, $file, $grouping) = @​_;
  my $filehandle = gensym();
  sysopen $filehandle, $file, O_RDWR|O_CREAT
  or croak "Could not open file";
  bless
  {
  group => $grouping,
  file => $filehandle,
  }, $class;
}

sub FETCH
{
  my ($impl, $index) = @​_;
  my $element;

  # find the right offset in the file and then read in
  # and return one grouping of chars (i.e. a single element)
  sysseek($impl->{file},$index*$impl->{group},0) &&
  sysread($impl->{file}, $element, $impl->{group});
  return $element
}

sub STORE
{
  my ($impl, $index, $newval) = @​_;

  # ensure data is the right size
  croak "Bad sized data​: '$newval'"
  unless length($newval) == $impl->{group};

  # ensure file is the right size
  my $oldsize = $impl->FETCHSIZE();
  my $newsize = $index+1;
  if ($newsize > $oldsize)
  {
  my $fill_len = $newsize - $oldsize;
  croak "Couldn't extend file"
  unless sysseek($impl->{file}, 0, 2)
  and syswrite($impl->{file}, "\0" x $fill_len,
$fill_len);
  }
 
  # seek to correct position in file and overwrite data
  croak "Couldn't write file"
  unless sysseek($impl->{file}, $index*$impl->{group}, 0)
  and syswrite($impl->{file}, $newval, $impl->{group});
}
sub FETCHSIZE
{
  my ($impl) = @​_;
  return (-s $impl->{file})/$impl->{group};
}
sub STORESIZE
{
  my ($impl, $newsize) = @​_;
  my $oldsize = $impl->FETCHSIZE();

  # either truncate the file if it's shrinking
  if ($newsize < $oldsize)
  {
  truncate $impl->{file}, $newsize * $impl->{group}
  or croak "Couldn't clear file";
  }
  else # extend it since it's growing
  {
  my $fill_len = $newsize - $oldsize;
  croak "Couldn't extend file"
  unless sysseek($impl->{file}, 0, 2)
  and syswrite($impl->{file}, "\0" x $fill_len,
$fill_len);
  }
}

no strict;
package main;

# cat foo.dat
# acg123
tie @​bases, myArray, "foo.dat", 1;

print "\@​bases=",join("|",@​bases),"\n";
splice(@​bases,20,4);
print "after splice\n";
print "\@​bases=",join("|",@​bases),"\n";

$ perl foo.pl
@​bases=a|c|g|1|2|3|

after splice
@​bases=a|c|g

As you can see, this causes major havoc when the user
is expecting the same behavior as from the standard
slice function.

Thanks

Richard Chen

Perl Info

Flags:
    category=library
    severity=medium

Site configuration information for perl v5.6.0:

Configured by richard at Fri Oct 20 06:23:17 EDT 2000.

Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.2.14-5.0, archname=i686-linux
    uname='linux dell 2.2.14-5.0 #1 tue mar 7 21:07:39 est 2000 i686 unknown '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define 
    use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
  Compiler:
    cc='cc', optimize='-O2', gccversion=egcs-2.91.66 19990314/Linux (egcs-1.1.2 release)
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    stdchar='char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    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, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=/lib/libc-2.1.3.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.6.0:
    /home/richard/perl5.6/lib/5.6.0/i686-linux
    /home/richard/perl5.6/lib/5.6.0
    /home/richard/perl5.6/lib/site_perl/5.6.0/i686-linux
    /home/richard/perl5.6/lib/site_perl/5.6.0
    /home/richard/perl5.6/lib/site_perl
    .


Environment for perl v5.6.0:
    HOME=/home/richard
    LANG=en_US
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/q/u01/app/oracle/product/8.1.6/lib
    LOGDIR (unset)
    PATH=office52/program:/usr/jdk118/bin:/usr/local/apache/bin:/usr/local/bin:/usr/local/sbin:/usr/kerberos/bin:/bin:/usr/bin:/usr/X11R6/bin:/sbin:/usr/sbin:/q/u01/app/oracle/product/8.1.6/bin:.:/home/richard/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash2

[p5pRT]

From [email protected]

Created by [email protected]

If you use the standard splice function and the offset is
beyond the index of the last element, nothing will happen
to the array involved. This is the expected behavior.
Example​:

$ cat tmp.pl
#!/usr/bin/perl
@​foo=qw(0 1 2 3);
print "\@​foo=",join("|",@​foo),"\n";
splice(@​foo,5,2);
print "after splice​:\n";
print "\@​foo=",join("|",@​foo),"\n";

$ tmp.pl
@​foo=0|1|2|3
after splice​:
@​foo=0|1|2|3

However, if you use the inherited SPLICE method from Tie​::Array,
the behavior is different. Even if the offset is beyond
the index of the last element, the tied array may shrink
or it may be completely emptied.

Here is an example which demonstrates the unexpected behavior
when using Tie​::Array​:

$ cat foo.pl
package myArray;
$VERSION = 1.00;
use strict;
use vars qw(@​ISA);
use Carp;
use Symbol;
use Fcntl;
use Tie​::Array;
@​ISA=qw(Tie​::Array);

sub TIEARRAY
{
  my ($class, $file, $grouping) = @​_;
  my $filehandle = gensym();
  sysopen $filehandle, $file, O_RDWR|O_CREAT
  or croak "Could not open file";
  bless
  {
  group => $grouping,
  file => $filehandle,
  }, $class;
}

sub FETCH
{
  my ($impl, $index) = @​_;
  my $element;

  # find the right offset in the file and then read in
  # and return one grouping of chars (i.e. a single element)
  sysseek($impl->{file},$index*$impl->{group},0) &&
  sysread($impl->{file}, $element, $impl->{group});
  return $element
}

sub STORE
{
  my ($impl, $index, $newval) = @​_;

  # ensure data is the right size
  croak "Bad sized data​: '$newval'"
  unless length($newval) == $impl->{group};

  # ensure file is the right size
  my $oldsize = $impl->FETCHSIZE();
  my $newsize = $index+1;
  if ($newsize > $oldsize)
  {
  my $fill_len = $newsize - $oldsize;
  croak "Couldn't extend file"
  unless sysseek($impl->{file}, 0, 2)
  and syswrite($impl->{file}, "\0" x $fill_len,
$fill_len);
  }
 
  # seek to correct position in file and overwrite data
  croak "Couldn't write file"
  unless sysseek($impl->{file}, $index*$impl->{group}, 0)
  and syswrite($impl->{file}, $newval, $impl->{group});
}
sub FETCHSIZE
{
  my ($impl) = @​_;
  return (-s $impl->{file})/$impl->{group};
}
sub STORESIZE
{
  my ($impl, $newsize) = @​_;
  my $oldsize = $impl->FETCHSIZE();

  # either truncate the file if it's shrinking
  if ($newsize < $oldsize)
  {
  truncate $impl->{file}, $newsize * $impl->{group}
  or croak "Couldn't clear file";
  }
  else # extend it since it's growing
  {
  my $fill_len = $newsize - $oldsize;
  croak "Couldn't extend file"
  unless sysseek($impl->{file}, 0, 2)
  and syswrite($impl->{file}, "\0" x $fill_len,
$fill_len);
  }
}

no strict;
package main;

# cat foo.dat
# acg123
tie @​bases, myArray, "foo.dat", 1;

print "\@​bases=",join("|",@​bases),"\n";
splice(@​bases,20,4);
print "after splice\n";
print "\@​bases=",join("|",@​bases),"\n";

$ perl foo.pl
@​bases=a|c|g|1|2|3|

after splice
@​bases=a|c|g

As you can see, this causes major havoc when the user
is expecting the same behavior as from the standard
slice function.

Thanks

Richard Chen

Perl Info

Flags:
    category=library
    severity=medium

Site configuration information for perl v5.6.0:

Configured by richard at Fri Oct 20 06:23:17 EDT 2000.

Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.2.14-5.0, archname=i686-linux
    uname='linux dell 2.2.14-5.0 #1 tue mar 7 21:07:39 est 2000 i686 unknown '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define 
    use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
  Compiler:
    cc='cc', optimize='-O2', gccversion=egcs-2.91.66 19990314/Linux (egcs-1.1.2 release)
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    stdchar='char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    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, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=/lib/libc-2.1.3.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.6.0:
    /home/richard/perl5.6/lib/5.6.0/i686-linux
    /home/richard/perl5.6/lib/5.6.0
    /home/richard/perl5.6/lib/site_perl/5.6.0/i686-linux
    /home/richard/perl5.6/lib/site_perl/5.6.0
    /home/richard/perl5.6/lib/site_perl
    .


Environment for perl v5.6.0:
    HOME=/home/richard
    LANG=en_US
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/q/u01/app/oracle/product/8.1.6/lib
    LOGDIR (unset)
    PATH=office52/program:/usr/jdk118/bin:/usr/local/apache/bin:/usr/local/bin:/usr/local/sbin:/usr/kerberos/bin:/bin:/usr/bin:/usr/X11R6/bin:/sbin:/usr/sbin:/q/u01/app/oracle/product/8.1.6/bin:.:/home/richard/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash2