Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

allow pluggable is-a-opt-value tests

  • Loading branch information...
commit 840f08e70987fdf1a2310cba1b42f895a2051ded 1 parent 82663ae
@rjbs authored
Showing with 58 additions and 7 deletions.
  1. +18 −5 lib/Data/OptList.pm
  2. +40 −2 t/mkopt.t
View
23 lib/Data/OptList.pm
@@ -150,10 +150,23 @@ sub __is_a {
}
sub mkopt {
- my ($opt_list, $moniker, $require_unique, $must_be) = @_;
+ my ($opt_list) = shift;
+
+ my ($moniker, $require_unique, $must_be); # the old positional args
+ my $val_test;
+
+ if (@_ == 1 and Params::Util::_HASHLIKE($_[0])) {
+ my $arg = $_[0];
+ ($moniker, $require_unique, $must_be, $val_test)
+ = @$arg{ qw(moniker require_unique must_be val_test) };
+ } else {
+ ($moniker, $require_unique, $must_be) = @_;
+ }
return [] unless $opt_list;
+ $val_test ||= sub { ref $_[0] };
+
$opt_list = [
map { $_ => (ref $opt_list->{$_} ? $opt_list->{$_} : ()) } keys %$opt_list
] if ref $opt_list eq 'HASH';
@@ -169,10 +182,10 @@ sub mkopt {
Carp::croak "multiple definitions provided for $name" if $seen{$name}++;
}
- if ($i == $#$opt_list) { $value = undef; }
- elsif (not defined $opt_list->[$i+1]) { $value = undef; $i++ }
- elsif (ref $opt_list->[$i+1]) { $value = $opt_list->[++$i] }
- else { $value = undef; }
+ if ($i == $#$opt_list) { $value = undef; }
+ elsif (not defined $opt_list->[$i+1]) { $value = undef; $i++ }
+ elsif ($val_test->($opt_list->[$i+1])) { $value = $opt_list->[++$i] }
+ else { $value = undef; }
if ($must_be and defined $value) {
unless (__is_a($value, $must_be)) {
View
42 t/mkopt.t
@@ -8,10 +8,10 @@ These tests test option list cannonization (from an option list into a aref).
=cut
+use Data::OptList;
use Sub::Install;
-use Test::More tests => 19;
+use Test::More 0.88;
-BEGIN { use_ok('Data::OptList'); }
# let's get a convenient copy to use:
Sub::Install::install_sub({
@@ -105,6 +105,17 @@ like($@, qr/HASH-ref values are not/, "exception tossed on invaild ref value");
eval { OPT([ foo => { a => 1 }, ':bar', 'baz' ], 0, ['ARRAY']); };
like($@, qr/HASH-ref values are not/, "exception tossed on invaild ref value");
+eval {
+ mkopt(
+ [ foo => { a => 1 }, ':bar', 'baz' ],
+ {
+ moniker => 'test',
+ must_be => ['ARRAY'],
+ }
+ );
+};
+like($@, qr/HASH-ref values are not/, "exception tossed on invaild ref value");
+
eval { OPT([ foo => { a => 1 }, ':bar', 'baz' ], 0, 'Test::DOL::Obj'); };
like($@, qr/HASH-ref values are not/, "exception tossed on invaild ref value");
@@ -125,3 +136,30 @@ is_deeply(
[ [ foo => { a => 1 } ], [ ':bar' => undef ], [ baz => undef ] ],
"previously tested expansion OK with require_unique",
);
+
+# This one is complicated. We defined valid values as only hash-like
+# references, so other reference types, like arrayrefs, can be "names."
+# -- rjbs, 2011-04-08
+is_deeply(
+ mkopt(
+ [
+ foo => { a => 1 },
+ bar => undef,
+ baz =>
+ xyz => [ 1, 2, 3 ],
+ ],
+ {
+ moniker => 'test',
+ val_test => sub { Params::Util::_HASHLIKE($_[0]) },
+ },
+ ),
+ [
+ [ foo => { a => 1 } ],
+ [ bar => undef ],
+ [ baz => undef ],
+ [ xyz => undef ],
+ [ [ 1, 2, 3 ], undef ],
+ ],
+);
+
+done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.