From: Vincent Pit <vince@profvince.com>
Date: Sat, 16 May 2009 10:32:23 +0000 (+0200)
Subject: Introduce vshift()
X-Git-Tag: v0.06~13
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=0062dbd2da53db62346382e729b84097131c61ee;p=perl%2Fmodules%2FScalar-Vec-Util.git

Introduce vshift()
---

diff --git a/MANIFEST b/MANIFEST
index 2c6b0ae..790017d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -20,6 +20,7 @@ t/30-vcopy-pp.t
 t/31-vcopy-copy.t
 t/32-vcopy-move.t
 t/33-vcopy-long.t
+t/40-vshift.t
 t/90-boilerplate.t
 t/91-pod.t
 t/92-pod-coverage.t
diff --git a/lib/Scalar/Vec/Util.pm b/lib/Scalar/Vec/Util.pm
index db6adba..c80d642 100644
--- a/lib/Scalar/Vec/Util.pm
+++ b/lib/Scalar/Vec/Util.pm
@@ -106,6 +106,34 @@ sub vcopy_pp {
  }
 }
 
+=head2 C<< vshift $v, $start, $length => $bits [, $insert ] >>
+
+In the area starting at C<$start> and of length C<$length> in C<$v>, shift bits C<abs $bits> positions left if C<< $bits > 0 >> and right otherwise.
+If C<$insert> is defined, also fills the resulting gap with ones if C<$insert> is true and zeros if it's false.
+Bits outside of the specified area are left untouched.
+Doesn't need to allocate any extra memory.
+
+=cut
+
+sub vshift {
+ my ($start, $length, $bits, $insert) = @_[1 .. 4];
+ return unless $bits;
+ my $left = 1;
+ if ($bits < 0) {
+  $left = 0;
+  $bits = -$bits;
+ }
+ $bits    = $length if $bits > $length;
+ $length -= $bits;
+ if ($left) {
+  vcopy($_[0], $start, $_[0], $start + $bits, $length);
+  vfill($_[0], $start, $bits, $insert) if defined $insert;
+ } else {
+  vcopy($_[0], $start + $bits, $_[0], $start, $length);
+  vfill($_[0], $start + $length, $bits, $insert) if defined $insert;
+ }
+}
+
 =head2 C<< veq $v1 => $v1_start, $v2 => $v2_start, $length >>
 
 Returns true if the C<$length> bits starting at C<$v1_start> in C<$v1> and C<$v2_start> in C<$v2> are equal, and false otherwise.
@@ -126,7 +154,7 @@ sub veq_pp {
 
 =head1 EXPORT
 
-The functions L</vfill>, L</vcopy> and L</veq> are only exported on request.
+The functions L</vfill>, L</vcopy>, L</vshift> and L</veq> are only exported on request.
 All of them are exported by the tags C<':funcs'> and C<':all'>.
 
 The constants L</SVU_PP> and L</SVU_SIZE> are also only exported on request.
@@ -138,7 +166,7 @@ use base qw/Exporter/;
 
 our @EXPORT         = ();
 our %EXPORT_TAGS    = (
- 'funcs'  => [ qw/vfill vcopy veq/ ],
+ 'funcs'  => [ qw/vfill vcopy vshift veq/ ],
  'consts' => [ qw/SVU_PP SVU_SIZE/ ]
 );
 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
diff --git a/t/01-import.t b/t/01-import.t
index 375d523..939ee22 100644
--- a/t/01-import.t
+++ b/t/01-import.t
@@ -3,11 +3,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 6;
 
 require Scalar::Vec::Util;
 
-for (qw/vfill vcopy veq SVU_PP SVU_SIZE/) {
+for (qw/vfill vcopy vshift veq SVU_PP SVU_SIZE/) {
  eval { Scalar::Vec::Util->import($_) };
  ok(!$@, 'import ' . $_);
 }
diff --git a/t/40-vshift.t b/t/40-vshift.t
new file mode 100644
index 0000000..39e14d5
--- /dev/null
+++ b/t/40-vshift.t
@@ -0,0 +1,69 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use Scalar::Vec::Util qw/vshift SVU_SIZE/;
+
+my $p = SVU_SIZE;
+$p = 8 if $p < 8;
+my $n = 3 * $p;
+my $q = 2;
+
+*myfill = *Scalar::Vec::Util::vfill_pp;
+*myeq   = *Scalar::Vec::Util::veq_pp;
+
+sub rst { myfill($_[0], 0, $n, 0); $_[0] = '' }
+
+sub pat {
+ (undef, my $a, my $b, my $x) = @_;
+ $_[0] = '';
+ $x = $x ? 1 : 0;
+ if (defined $b) {
+  myfill($_[0], 0, $a, $x);
+  myfill($_[0], $a, $b, 1 - $x);
+ }
+}
+
+my ($v, $v0, $c) = ('', '') x 2;
+
+sub try {
+ my ($left, $insert) = @_;
+ my @s = ($p - $q) .. ($p + $q);
+ for my $s (@s) {
+  for my $l (0 .. $n - 1) {
+   last if $s + $l > $n;
+   pat $v0, $s, $l, 0;
+   my @b = (0);
+   my $l2 = int($l/2);
+   push @b, $l2 if $l2 != $l;
+   push @b, $l  if $l;
+   for my $b (@b) {
+    $v = $v0;
+    $c = '';
+    myfill($c, 0, $s, 0);
+    if ($left) {
+     myfill($c, $s,      $b,      defined $insert ? $insert : 1);
+     myfill($c, $s + $b, $l - $b, 1);
+    } else {
+     myfill($c, $s,           $l - $b, 1);
+     myfill($c, $s + $l - $b, $b,      defined $insert ? $insert : 1);
+    }
+    $b = -$b unless $left;
+    vshift $v, $s, $l => $b, $insert;
+    my $i = defined $insert ? $insert : 'undef';
+    ok(myeq($v, 0, $c, 0, $n), "vshift $s, $l, $b, $i");
+    is(length $v, length $c, "vshift $s, $l, $b, $i length");
+   }
+  }
+ }
+}
+
+try 1;
+try 1, 0;
+try 1, 1;
+try 0;
+try 0, 0;
+try 0, 1;