1 files changed, 82 insertions, 0 deletions
diff --git a/t/lib/PVTests/Callbacks.pm b/t/lib/PVTests/Callbacks.pm
new file mode 100644
index 0000000..c45b4fb
--- /dev/null
+++ b/t/lib/PVTests/Callbacks.pm
@@ -0,0 +1,82 @@
+package PVTests::Callbacks;
+
+use strict;
+use warnings;
+
+use Params::Validate qw(:all);
+
+use PVTests;
+use Test::More;
+
+sub run_tests {
+    my %allowed = ( foo => 1, baz => 1 );
+    eval {
+        my @a = ( foo => 'foo' );
+        validate(
+            @a, {
+                foo => {
+                    callbacks => {
+                        is_allowed => sub { $allowed{ lc $_[0] } }
+                    },
+                }
+            }
+        );
+    };
+    is( $@, q{} );
+
+    eval {
+        my @a = ( foo => 'aksjgakl' );
+
+        validate(
+            @a, {
+                foo => {
+                    callbacks => {
+                        is_allowed => sub { $allowed{ lc $_[0] } }
+                    },
+                }
+            }
+        );
+    };
+
+    if ( $ENV{PERL_NO_VALIDATION} ) {
+        is( $@, q{} );
+    }
+    else {
+        like( $@, qr/is_allowed/ );
+    }
+
+    # duplicates code from Lingua::ZH::CCDICT that revealad bug fixed in
+    # 0.56.
+    eval { Foo->new( storage => 'InMemory', file => 'something' ); };
+    is( $@, q{} );
+
+    done_testing();
+}
+
+package Foo;
+
+use Params::Validate qw(:all);
+
+my %storage = map { lc $_ => $_ } (qw( InMemory XML BerkeleyDB ));
+
+sub new {
+    my $class = shift;
+
+    local $^W = 1;
+
+    my %p = validate_with(
+        params => \@_,
+        spec   => {
+            storage => {
+                callbacks => {
+                    'is a valid storage type' => sub { $storage{ lc $_[0] } }
+                },
+            },
+        },
+        allow_extra => 1,
+    );
+
+    return 1;
+}
+
+1;