1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
#!/usr/bin/perl
use v5.22;
use warnings;
use Test2::V0;
use lib "t";
use testcase "t::test", qw( test_constraint );
use Data::Checks qw( Str StrEq StrMatch );
# Str
test_constraint Str => Str,
[
'plain string' => "a string",
'empty string' => "",
'plain integer' => 1234,
'object with stringifty' => ClassWithStrOverload->new,
],
[
'object with numify' => ClassWithNumOverload->new,
];
# Str eq set
{
my $checker = t::test::make_checkdata( StrEq(qw( A C E )), "Value" );
ok( t::test::check_value( $checker, "A" ), 'StrEq accepts a value' );
ok( t::test::check_value( $checker, "E" ), 'StrEq accepts a value' );
ok( !t::test::check_value( $checker, "B" ), 'StrEq rejects a value not in the list' );
my $checker_Z = t::test::make_checkdata( StrEq("Z"), "Value" );
ok( t::test::check_value( $checker_Z, "Z" ), 'StrEq singleton accepts the value' );
ok( !t::test::check_value( $checker_Z, "x" ), 'StrEq singleton rejects a different value' );
my $checker_empty = t::test::make_checkdata( StrEq(""), "Value" );
ok( t::test::check_value( $checker_empty, "" ), 'StrEq empty accepts empty' );
ok( !t::test::check_value( $checker_empty, undef ), 'StrEq empty rejects undef' );
}
# StrMatch
test_constraint 'StrMatch(qr/^[A-Z]/i)' => StrMatch(qr/^[A-Z]/i),
[
'plain string' => "a string",
'matching string' => "MATCH",
],
[
'non-matching string' => "123",
];
# Stringify
is( Data::Checks::Debug::stringify_constraint( Str ), "Str",
'debug stringify Str' );
is( Data::Checks::Debug::stringify_constraint( StrEq("A") ), "StrEq(\"A\")",
'debug stringify StrEq("A")' );
is( Data::Checks::Debug::stringify_constraint( StrEq("A", "B") ), "StrEq(\"A\", \"B\")",
'debug stringify StrEq("A", "B")' );
is( Data::Checks::Debug::stringify_constraint( StrEq('"quoted value"') ), q(StrEq("\\"quoted value\\"")),
'debug stringify StrEq(\'"quoted value"\')' );
is( Data::Checks::Debug::stringify_constraint( StrEq('literal $dollar') ), q(StrEq("literal \\$dollar")),
'debug stringify StrEq(\'literal $dollar\')' );
is( Data::Checks::Debug::stringify_constraint( StrMatch(qr/ABC/) ), "StrMatch(qr/(?^u:ABC)/)",
'debug stringify StrMatch(qr/ABC/)' );
done_testing;
|
