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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
# vim: set ft=perl ts=8 sts=2 sw=2 tw=100 et :
use strictures 2;
use 5.020;
use stable 0.031 'postderef';
use experimental 'signatures';
no autovivification warn => qw(fetch store exists delete);
use if "$]" >= 5.022, experimental => 're_strict';
no if "$]" >= 5.031009, feature => 'indirect';
no if "$]" >= 5.033001, feature => 'multidimensional';
no if "$]" >= 5.033006, feature => 'bareword_filehandles';
no if "$]" >= 5.041009, feature => 'smartmatch';
no feature 'switch';
use utf8;
use open ':std', ':encoding(UTF-8)'; # force stdin, stdout, stderr into utf8
use lib 't/lib';
use Helper;
my $js = JSON::Schema::Modern->new;
my $tests = sub ($char, $test_substr) {
cmp_result(
$js->evaluate($char, { pattern => '[a-z]' })->TO_JSON,
{
valid => false,
errors => [
{
instanceLocation => '',
keywordLocation => '/pattern',
error => 'pattern does not match',
},
],
},
$test_substr.' LATIN SMALL LETTER E WITH ACUTE does not match the ascii range [a-z]',
);
cmp_result(
$js->evaluate($char, { pattern => '\w' })->TO_JSON,
{
valid => true,
},
$test_substr.' LATIN SMALL LETTER E WITH ACUTE does match the "word" character class, because unicode semantics are used for matching',
);
};
my $letter = "é";
$tests->($letter, 'unchanged');
utf8::upgrade($letter);
$tests->($letter, 'upgraded');
utf8::downgrade($letter);
$tests->($letter, 'downgraded');
subtest 'empty pattern' => sub {
# create a "last successful match" in a containing scope
my $str = "furble" =~ s/fur/meow/r;
cmp_result(
$js->evaluate('hello', { pattern => '' })->TO_JSON,
{ valid => true },
'empty pattern in "pattern" will correctly match',
);
# create a new "last successful match"
$str = "furble" =~ s/fur/meow/r;
cmp_result(
$js->evaluate(
{ alpha => 'hello' },
{
patternProperties => { '' => true },
additionalProperties => false,
unevaluatedProperties => false,
},
)->TO_JSON,
{ valid => true },
'empty pattern in "patternProperties" will correctly match',
);
};
done_testing;
|
