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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
use v5.14;
use autodie;
use utf8;
use Carp qw(confess);
use Test::Exception;
use FindBin qw($Bin);
use File::Glob qw(bsd_glob);
use File::Spec;
use JSON qw(decode_json);
use Data::Dumper;
use JSONLD;
use open ':std', ':encoding(UTF-8)';
use Moo;
use Type::Tiny::Role;
use Test::More skip_all => 'JSON-LD 1.1 Compation is not currently supported';
our $debug = 0;
$JSONLD::debug = $debug;
our $PATTERN;
if ($debug) {
$PATTERN = qr/t0004/;
} else {
$PATTERN = /./;
}
my $REPORT_NEGATIVE_TESTS = 0;
sub load_json {
my $file = shift;
open(my $fh, '<:utf8', $file);
my $j = JSON->new();
return $j->decode(do { local($/); <$fh> });
}
sub _normalize {
# give array elements a predictable order (https://w3c.github.io/json-ld-api/tests/#json-ld-object-comparison)
my $data = shift;
my $preserve_order = shift || 0;
return $data unless (ref($data));
if (ref($data) eq 'ARRAY') {
my $j = JSON->new->canonical(1);
my @v = map { _normalize($_) } @$data;
unless ($preserve_order) {
@v = sort { $j->encode($a) cmp $j->encode($b) } @v;
}
return [@v];
} elsif (ref($data) eq 'HASH') {
my %hash;
foreach my $k (keys %$data) {
my $preseve_order = ($k eq '@list');
$hash{$k} = _normalize($data->{$k}, $preseve_order);
}
return \%hash;
} else {
die "Unexpected ref type: " . ref($data);
}
}
$Data::Dumper::Sortkeys = 1;
my $path = File::Spec->catfile( $Bin, 'data', 'json-ld-api-w3c' );
my $manifest = File::Spec->catfile($path, 'compact-manifest.jsonld');
my $d = load_json($manifest);
my $tests = $d->{'sequence'};
my $base = IRI->new(value => $d->{'baseIri'} // 'http://example.org/');
foreach my $t (@$tests) {
my $id = $t->{'@id'};
next unless ($id =~ $PATTERN);
my $input = $t->{'input'};
my $expect = $t->{'expect'} // '';
my $ctx = $t->{'context'};
my $name = $t->{'name'};
my $purpose = $t->{'purpose'};
my $options = $t->{'option'} // {};
my $_base = $options->{'base'};
my $spec_v = $options->{'specVersion'} // '';
my @types = @{ $t->{'@type'} };
my %types = map { $_ => 1 } @types;
my $test_base;
if (defined($_base)) {
$test_base = IRI->new(value => $_base, base => $base)->abs;
} else {
$test_base = IRI->new(value => $input, base => $base)->abs;
}
my $j = JSON->new->canonical(1);
note($id) if $debug;
if ($spec_v eq 'json-ld-1.0') {
diag("IGNORING JSON-LD-1.0-only test $id\n");
} elsif ($types{'jld:PositiveEvaluationTest'} or $types{'jld:NegativeEvaluationTest'}) {
my $positive = $types{'jld:PositiveEvaluationTest'};
my $jld = JSONLD->new(base_iri => IRI->new($test_base));
my $infile = File::Spec->catfile($path, $input);
my $outfile = File::Spec->catfile($path, $expect);
my $ctx_file = File::Spec->catfile($path, $ctx);
my $data = load_json($infile);
my $context = load_json($ctx_file);
if ($debug) {
warn "Input file: $infile\n";
warn "Output file: $outfile\n";
warn "INPUT:\n===============\n" . JSON->new->pretty->encode($data); # Dumper($data);
}
my $compacted = eval { $jld->compact($data, $context) };
if ($@) {
if ($positive) {
fail("$id: died: $@")
} else {
if ($REPORT_NEGATIVE_TESTS) {
pass("$id: NegativeEvaluationTest");
}
}
} else {
my $got = _normalize($j->encode($compacted));
if ($positive) {
my $expected = _normalize($j->encode(load_json($outfile)));
if ($debug) {
my @data = (
['EXPECTED', $expected],
['OUTPUT__', $got],
);
my @files;
foreach my $d (@data) {
my ($name, $data) = @$d;
warn "=======================\n";
my $filename = "/tmp/json-ld-$$-$name.out";
open(my $fh, '>', $filename) or die $!;
push(@files, $filename);
my $out = Data::Dumper->Dump([$j->decode($data)], ["*$name"]);
warn $out;
print {$fh} $out;
close($fh);
}
unless ($got eq $expected) {
system('/usr/local/bin/bbdiff', '--wait', '--resume', @files);
}
}
is($got, $expected, "$id: $name");
} else {
if ($REPORT_NEGATIVE_TESTS) {
fail("$id: expected failure but found success");
}
}
}
} else {
diag("Not a recognized evaluation test: " . Dumper(\@types));
next;
}
}
done_testing();
|
