From: Vincent Pit <vince@profvince.com>
Date: Sun, 17 May 2009 17:36:28 +0000 (+0200)
Subject: Improve argument checking
X-Git-Tag: v0.06~5
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=607607c4f5ec537ba56acb4edc424bc71900517a;p=perl%2Fmodules%2FScalar-Vec-Util.git

Improve argument checking

undef arguments are now allowed. Signedness is checked. Functions have prototypes.
---

diff --git a/Util.xs b/Util.xs
index 75ba8ca..013bea2 100644
--- a/Util.xs
+++ b/Util.xs
@@ -11,7 +11,32 @@
 
 #include "bitvect.h"
 
-STATIC const char svu_error_invarg[] = "Invalid argument";
+STATIC void svu_validate_uv(pTHX_ SV *sv, size_t *offset, const char *desc) {
+#define svu_validate_uv(S, O, D) svu_validate_uv(aTHX_ (S), (O), (D))
+ IV i;
+
+ if (SvOK(sv) && SvIOK(sv)) {
+  if (SvIsUV(sv))
+   *offset = SvUVX(sv);
+  else {
+   i = SvIVX(sv);
+   if (i < 0)
+    goto fail;
+   *offset = i;
+  }
+ } else {
+  i = SvIV(sv);
+  if (i < 0)
+   goto fail;
+  *offset = i;
+ }
+
+ return;
+
+fail:
+ *offset = 0;
+ croak("Invalid negative %s", desc ? desc : "integer");
+}
 
 /* --- XS ------------------------------------------------------------------ */
 
@@ -33,13 +58,10 @@ PREINIT:
  size_t s, l, n, o;
  char f, *v;
 CODE:
- if (!SvOK(sv) || !SvOK(ss) || !SvOK(sl) || !SvOK(sf))
-  croak(svu_error_invarg);
-
- l = SvUV(sl);
+ svu_validate_uv(sl, &l, "length");
  if (!l)
   XSRETURN(0);
- s = SvUV(ss);
+ svu_validate_uv(ss, &s, "offset");
  f = SvTRUE(sf);
  SvUPGRADE(sv, SVt_PV);
 
@@ -65,14 +87,11 @@ PREINIT:
  size_t fs, ts, l, lf = 0, n, o;
  char *t, *f;
 CODE:
- if (!SvOK(sf) || !SvOK(sfs) || !SvOK(st) || !SvOK(sts) || !SvOK(sl))
-  croak(svu_error_invarg);
-
- l  = SvUV(sl);
+ svu_validate_uv(sl, &l, "length");
  if (!l)
   XSRETURN(0);
- fs = SvUV(sfs);
- ts = SvUV(sts);
+ svu_validate_uv(sfs, &fs, "offset");
+ svu_validate_uv(sts, &ts, "offset");
  SvUPGRADE(sf, SVt_PV);
  SvUPGRADE(st, SVt_PV);
 
@@ -114,14 +133,11 @@ PREINIT:
  size_t s1, s2, l, o, n;
  char *v1, *v2;
 CODE:
- if (!SvOK(sv1) || !SvOK(ss1) || !SvOK(sv2) || !SvOK(ss2) || !SvOK(sl))
-  croak(svu_error_invarg);
-
- l  = SvUV(sl);
+ svu_validate_uv(sl, &l, "length");
  if (!l)
-  XSRETURN(0);
- s1 = SvUV(ss1);
- s2 = SvUV(ss2);
+  XSRETURN_YES;
+ svu_validate_uv(ss1, &s1, "offset");
+ svu_validate_uv(ss2, &s2, "offset");
  SvUPGRADE(sv1, SVt_PV);
  SvUPGRADE(sv2, SVt_PV);
 
diff --git a/lib/Scalar/Vec/Util.pm b/lib/Scalar/Vec/Util.pm
index b7ab6ab..da9f033 100644
--- a/lib/Scalar/Vec/Util.pm
+++ b/lib/Scalar/Vec/Util.pm
@@ -72,15 +72,11 @@ Grows C<$vec> if necessary.
 
 =cut
 
-sub _alldef {
- for (@_) { return 0 unless defined }
- return 1;
-}
-
 sub vfill_pp ($$$$) {
- (undef, my $s, my $l, my $x) = @_;
- croak "Invalid argument" unless _alldef @_;
+ my ($s, $l, $x) = @_[1 .. 3];
  return unless $l;
+ croak 'Invalid negative offset' if $s < 0;
+ croak 'Invalid negative length' if $l < 0;
  $x = ~0 if $x;
  my $SIZE = 32;
  my $t = int($s / $SIZE) + 1;
@@ -105,8 +101,9 @@ Doesn't need to allocate any extra memory.
 
 sub vcopy_pp ($$$$$) {
  my ($fs, $ts, $l) = @_[1, 3, 4];
- croak "Invalid argument" unless _alldef @_;
  return unless $l;
+ croak 'Invalid negative offset' if $fs < 0 or $ts < 0;
+ croak 'Invalid negative length' if $l  < 0;
  my $step = $ts - $fs;
  if ($step <= 0) { 
   vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for $fs .. $fs + $l - 1;
@@ -126,7 +123,9 @@ Doesn't need to allocate any extra memory.
 
 sub vshift ($$$$;$) {
  my ($start, $length, $bits, $insert) = @_[1 .. 4];
- return unless $bits;
+ return unless $length and $bits;
+ croak 'Invalid negative offset' if $start  < 0;
+ croak 'Invalid negative length' if $length < 0;
  my $left = 1;
  if ($bits < 0) {
   $left = 0;
@@ -157,6 +156,8 @@ Currently allocates an extra buffer of size C<O($bits)>.
 sub vrot ($$$$) {
  my ($start, $length, $bits) = @_[1 .. 3];
  return unless $length and $bits;
+ croak 'Invalid negative offset' if $start  < 0;
+ croak 'Invalid negative length' if $length < 0;
  my $left = 1;
  if ($bits < 0) {
   $left = 0;
@@ -186,7 +187,8 @@ If needed, C<$length> is decreased to fit inside C<$v1> and C<$v2> boundaries.
 
 sub veq_pp ($$$$$) {
  my ($s1, $s2, $l) = @_[1, 3, 4];
- croak "Invalid argument" unless _alldef @_;
+ croak 'Invalid negative offset' if $s1 < 0 or $s2 < 0;
+ croak 'Invalid negative length' if $l  < 0;
  my $i = 0;
  while ($i < $l) {
   return 0 if vec($_[0], $s1 + $i, 1) != vec($_[2], $s2 + $i, 1);
diff --git a/t/10-veq-pp.t b/t/10-veq-pp.t
index 98fea99..509fd98 100644
--- a/t/10-veq-pp.t
+++ b/t/10-veq-pp.t
@@ -7,16 +7,12 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util;
 
-eval { Scalar::Vec::Util::veq_pp(undef, 0, my $y, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'first argument undef croaks');
-eval { Scalar::Vec::Util::veq_pp(my $x, undef, my $y, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'second argument undef croaks');
-eval { Scalar::Vec::Util::veq_pp(my $x, 0, undef, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'third argument undef croaks');
-eval { Scalar::Vec::Util::veq_pp(my $x, 0, my $y, undef, 0) };
-like($@, qr/Invalid\s+argument/, 'fourth argument undef croaks');
-eval { Scalar::Vec::Util::veq_pp(my $x, 0, my $y, 0, undef) };
-like($@, qr/Invalid\s+argument/, 'fifth argument undef croaks');
+for ([ 1, 'offset', -1 ], [ 3, 'offset', '-1' ], [ 4, 'length', -1 ]) {
+ my @args  = ('1') x 5;
+ $args[$_->[0]] = $_->[2];
+ eval { &Scalar::Vec::Util::veq_pp(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
 
 my $p = 8;
 my $n = 3 * $p;
diff --git a/t/11-veq.t b/t/11-veq.t
index 3d141b3..31ba0a8 100644
--- a/t/11-veq.t
+++ b/t/11-veq.t
@@ -7,16 +7,12 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util qw/veq SVU_SIZE/;
 
-eval { veq undef, 0, my $y, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'first argument undef croaks');
-eval { veq my $x, undef, my $y, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'second argument undef croaks');
-eval { veq my $x, 0, undef, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'third argument undef croaks');
-eval { veq my $x, 0, my $y, undef, 0 };
-like($@, qr/Invalid\s+argument/, 'fourth argument undef croaks');
-eval { veq my $x, 0, my $y, 0, undef };
-like($@, qr/Invalid\s+argument/, 'fifth argument undef croaks');
+for ([ 1, 'offset', -1 ], [ 3, 'offset', '-1' ], [ 4, 'length', -1 ]) {
+ my @args  = ('1') x 5;
+ $args[$_->[0]] = $_->[2];
+ eval { &veq(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
 
 my $p = SVU_SIZE;
 $p = 8 if $p < 8;
@@ -48,8 +44,8 @@ for my $s1 (@s) {
    pat $v1, $s1, $l, 0;
    pat $v2, $s2, $l, 0;
    ok(veq($v1 => $s1, $v2 => $s2, $l), "veq $s1, $s2, $l");
-   ok(!veq($v1 => $s1 - 1, $v2 => $s2, $l), 'not veq_pp ' . ($s1 - 1) . ", $s2, $l") if $l > 0;
-   ok(!veq($v1 => $s1 + 1, $v2 => $s2, $l), 'not veq_pp ' . ($s1 + 1) . ", $s2, $l") if $l > 0;
+   ok(!veq($v1 => $s1 - 1, $v2 => $s2, $l), 'not veq ' . ($s1 - 1) . ", $s2, $l") if $l > 0;
+   ok(!veq($v1 => $s1 + 1, $v2 => $s2, $l), 'not veq ' . ($s1 + 1) . ", $s2, $l") if $l > 0;
   }
  }
 }
diff --git a/t/20-vfill-pp.t b/t/20-vfill-pp.t
index aaf3618..3bb893d 100644
--- a/t/20-vfill-pp.t
+++ b/t/20-vfill-pp.t
@@ -7,14 +7,12 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util;
 
-eval { Scalar::Vec::Util::vfill_pp(undef, 0, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'first argument undef croaks');
-eval { Scalar::Vec::Util::vfill_pp(my $x, undef, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'second argument undef croaks');
-eval { Scalar::Vec::Util::vfill_pp(my $x, 0, undef, 0) };
-like($@, qr/Invalid\s+argument/, 'third argument undef croaks');
-eval { Scalar::Vec::Util::vfill_pp(my $x, 0, 0, undef) };
-like($@, qr/Invalid\s+argument/, 'fourth argument undef croaks');
+for ([ 1, 'offset', -1 ], [ 2, 'length', '-1' ]) {
+ my @args  = ('1') x 4;
+ $args[$_->[0]] = $_->[2];
+ eval { &Scalar::Vec::Util::vfill_pp(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
 
 my $p = 8;
 my $n = 3 * $p;
diff --git a/t/21-vfill.t b/t/21-vfill.t
index 33565f9..4702668 100644
--- a/t/21-vfill.t
+++ b/t/21-vfill.t
@@ -7,14 +7,12 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util qw/vfill SVU_SIZE/;
 
-eval { vfill undef, 0, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'first argument undef croaks');
-eval { vfill my $x, undef, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'second argument undef croaks');
-eval { vfill my $x, 0, undef, 0 };
-like($@, qr/Invalid\s+argument/, 'third argument undef croaks');
-eval { vfill my $x, 0, 0, undef };
-like($@, qr/Invalid\s+argument/, 'fourth argument undef croaks');
+for ([ 1, 'offset', -1 ], [ 2, 'length', '-1' ]) {
+ my @args  = (~0) x 4;
+ $args[$_->[0]] = $_->[2];
+ eval { &vfill(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
 
 my $p = SVU_SIZE;
 $p = 8 if $p < 8;
diff --git a/t/30-vcopy-pp.t b/t/30-vcopy-pp.t
index f8f29cc..2ce2773 100644
--- a/t/30-vcopy-pp.t
+++ b/t/30-vcopy-pp.t
@@ -7,16 +7,12 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util qw/SVU_SIZE/;
 
-eval { Scalar::Vec::Util::vcopy_pp(undef, 0, my $y, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'first argument undef croaks');
-eval { Scalar::Vec::Util::vcopy_pp(my $x, undef, my $y, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'second argument undef croaks');
-eval { Scalar::Vec::Util::vcopy_pp(my $x, 0, undef, 0, 0) };
-like($@, qr/Invalid\s+argument/, 'third argument undef croaks');
-eval { Scalar::Vec::Util::vcopy_pp(my $x, 0, my $y, undef, 0) };
-like($@, qr/Invalid\s+argument/, 'fourth argument undef croaks');
-eval { Scalar::Vec::Util::vcopy_pp(my $x, 0, my $y, 0, undef) };
-like($@, qr/Invalid\s+argument/, 'fifth argument undef croaks');
+for ([ 1, 'offset', -1 ], [ 3, 'offset', '-1' ], [ 4, 'length', -1 ]) {
+ my @args  = ('1') x 5;
+ $args[$_->[0]] = $_->[2];
+ eval { &Scalar::Vec::Util::vcopy_pp(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
 
 my $p = SVU_SIZE;
 $p = 8 if $p < 8;
diff --git a/t/31-vcopy-copy.t b/t/31-vcopy-copy.t
index 2d1132d..af127f8 100644
--- a/t/31-vcopy-copy.t
+++ b/t/31-vcopy-copy.t
@@ -7,16 +7,12 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util qw/vcopy SVU_SIZE/;
 
-eval { vcopy undef, 0, my $y, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'first argument undef croaks');
-eval { vcopy my $x, undef, my $y, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'second argument undef croaks');
-eval { vcopy my $x, 0, undef, 0, 0 };
-like($@, qr/Invalid\s+argument/, 'third argument undef croaks');
-eval { vcopy my $x, 0, my $y, undef, 0 };
-like($@, qr/Invalid\s+argument/, 'fourth argument undef croaks');
-eval { vcopy my $x, 0, my $y, 0, undef };
-like($@, qr/Invalid\s+argument/, 'fifth argument undef croaks');
+for ([ 1, 'offset', -1 ], [ 3, 'offset', '-1' ], [ 4, 'length', -1 ]) {
+ my @args  = (~0) x 5;
+ $args[$_->[0]] = $_->[2];
+ eval { &vcopy(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
 
 my $p = SVU_SIZE;
 $p = 8 if $p < 8;
diff --git a/t/40-vshift.t b/t/40-vshift.t
index 5fe1b69..4c27c83 100644
--- a/t/40-vshift.t
+++ b/t/40-vshift.t
@@ -7,6 +7,13 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util qw/vshift SVU_SIZE/;
 
+for ([ 1, 'offset', -1 ], [ 2, 'length', '-1' ]) {
+ my @args  = ('1') x 4;
+ $args[$_->[0]] = $_->[2];
+ eval { &vshift(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
+
 my $p = SVU_SIZE;
 $p = 8 if $p < 8;
 my $n = 3 * $p;
diff --git a/t/50-vrot.t b/t/50-vrot.t
index 9222ae3..6ce0c41 100644
--- a/t/50-vrot.t
+++ b/t/50-vrot.t
@@ -7,6 +7,13 @@ use Test::More 'no_plan';
 
 use Scalar::Vec::Util qw/vrot vcopy SVU_SIZE/;
 
+for ([ 1, 'offset', -1 ], [ 2, 'length', '-1' ]) {
+ my @args  = ('1') x 4;
+ $args[$_->[0]] = $_->[2];
+ eval { &vrot(@args) }; my $line = __LINE__;
+ like $@, qr/^Invalid\s+negative\s+$_->[1]\s+at\s+\Q$0\E\s+line\s+$line/;
+}
+
 my $p = SVU_SIZE;
 $p = 8 if $p < 8;
 my $n = 3 * $p;
@@ -28,6 +35,11 @@ sub pat {
 
 sub expected {
  (undef, my $s, my $l, my $b, my $left) = @_;
+ unless ($l) {
+  myfill($_[0], 0,  $s,      0);
+  myfill($_[0], $s, $n - $s, 1);
+  return;
+ }
  my $lx = int($l / 2);
  my $ly = $l - $lx;
  $b %= $l;
@@ -71,7 +83,7 @@ sub try {
  my ($left) = @_;
  my @s = ($p - $q) .. ($p + $q);
  for my $s (@s) {
-  for my $l (1 .. $n - 1) {
+  for my $l (0 .. $n - 1) {
    last if $s + $l > $n;
    my $l2 = int($l/2);
    rst $v0;