File Coverage

blib/lib/Test/ZeroCopy.pm

Criterion	Covered	Total	%
statement	6	26	23.0
branch	0	10	0.0
condition	0	14	0.0
subroutine	2	5	40.0
pod	0	2	0.0
total	8	57	14.0

package Test::ZeroCopy;

use strict;

our $VERSION = '0.110';

require XSLoader;
XSLoader::load('Test::ZeroCopy', $VERSION);

use base 'Test::Builder::Module';
our @EXPORT = qw(is_zerocopy isnt_zerocopy);


sub _impl {
  my $tb = __PACKAGE__->builder;

  my $desc = $_[2] || '';
  my $want_zerocopy = $_[3];

  my $addr1 = get_pv_address($_[0]);
  my $addr2 = get_pv_address($_[1]);

  if (!defined $addr1 || !defined $addr2) {
    $tb->ok(!$want_zerocopy, "$desc: One or both args aren't strings (don't have SvPV values)");
    return;
  }

  my $len1 = get_pv_cur($_[0]);
  my $len2 = get_pv_cur($_[1]);

  $tb->diag(sprintf("ZC: %s%lx+%lx vs %lx+%lx", ($desc ? "$desc: " : ""), $addr1, $len1, $addr2, $len2));

  if ($addr1 == $addr2 && $len1 == $len2) {
    $tb->ok($want_zerocopy, "$desc => (exact overlap)");
  } elsif ($addr1 >= $addr2 && $addr1 < ($addr2 + $len2)) {
    $tb->ok($want_zerocopy, "$desc => (first starts inside second)");
  } elsif ($addr2 >= $addr1 && $addr2 < ($addr1 + $len1)) {
    $tb->ok($want_zerocopy, "$desc => (second starts inside first)");
  } else {
    $tb->ok(!$want_zerocopy, "$desc => (no overlap)");
  }
}

sub is_zerocopy {
  $_[3] = 1;
  goto &_impl;
}

sub isnt_zerocopy {
  $_[3] = 0;
  goto &_impl;
}


1;



__END__