File Coverage

blib/lib/Tie/Array/Pointer.pm

Criterion	Covered	Total	%
statement	46	57	80.7
branch	11	20	55.0
condition	6	18	33.3
subroutine	12	16	75.0
pod	1	1	100.0
total	76	112	67.8

package Tie::Array::Pointer;

use strict;
use vars qw($VERSION);
use base qw(Tie::Array DynaLoader);

$VERSION = '0.000059';

Tie::Array::Pointer->bootstrap($VERSION);

#
sub TIEARRAY {
  my $class = shift;
  my $opt   = shift;
  my $self  = { %$opt };
  bless($self, __PACKAGE__);

  if ($self->address) {
    $self->{allocated} = 0;
  } else {
    my $addr = tsp_malloc($self->{length} * 4);
    die('Memory could not be allocated') if (!$addr);
    $self->{address} = $addr;
    $self->{allocated} = 1;
  }

  return $self;
}

sub DESTROY {
  my $self = shift;
  if ($self->{allocated}) {
    tsp_free($self->{address});
  }
}

#
sub FETCH {
  my $self = shift;
  my $n    = shift;
  my $type = $self->{type};

  my $int;
  if ($type eq 'c' || $type eq 'C') {
    $int = tsp_r8($self->{address} + $n);
  } elsif ($type eq 's' || $type eq 'S') {
    $int = tsp_r16($self->{address} + $n * 2);
  } elsif ($type eq 'l' || $type eq 'L') {
    $int = tsp_r32($self->{address} + $n * 4);
  }

  return $int;
}

#
sub FETCHSIZE {
  return $_[0]->{length};
}

#
sub STORE {
  my $self = shift;
  my $n    = shift;
  my $val  = shift;

  my $type = $self->{type};
  my $int;
  if ($type eq 'c' || $type eq 'C') {
    $int = tsp_w8($self->{address} + $n, $val);
  } elsif ($type eq 's' || $type eq 'S') {
    $int = tsp_w16($self->{address} + $n * 2, $val);
  } elsif ($type eq 'l' || $type eq 'L') {
    $int = tsp_w32($self->{address} + $n * 4, $val);
  }
  return $val;
}

#
sub STORESIZE {
  die('not allowed (yet)');
}

sub PUSH {
  die('not allowed (yet)');
}

sub POP {
  die('not allowed (yet)');
}

sub SHIFT {
  die('not allowed (yet)');
}

sub UNSHIFT {
  die('not allowed (yet)');
}

sub DELETE {
  my $self = shift;
  my $n    = shift;
  $self->STORE($n, 0);
}

sub EXISTS {
  my $self = shift;
  my $n    = shift;
  if ($n < $self->{length}) {
    return 1;
  } else {
    return 0;
  }
}

# base address in memory of C array
sub address {
  return $_[0]->{address};
}

1;

__END__