From f1d2c3ee8acc56105ffebb0bb2e7d8249818a4be Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Tue, 29 Sep 2026 12:56:12 -0600 Subject: [PATCH 1/3] Implement json_eq_or_diff using jq and diff Canonicalize both JSON documents with jq (>= 1.7, sorted keys) and compare them with diff -U, so the JSON is never decoded in Perl. Failures report a unified diff clipped to max_lines (default 50). - inc/mymm.pl checks for jq >= 1.7 and diff at configure time - CI tests Perl 5.42 against jq 1.7.1 and 1.8.2 - require @Author::Plicease 2.79 so the static workflow runs Co-Authored-By: Claude Opus 5.5 --- .github/workflows/linux.yml | 22 ++-- README.md | 114 +++++++++++++++++ author.yml | 4 +- dist.ini | 7 +- inc/mymm.pl | 57 +++++++++ lib/Test/JSON/Diff.pm | 247 +++++++++++++++++++++++++++++++++++- t/00_diag.t | 88 +++++++++++++ t/test_json_diff.t | 180 +++++++++++++++++++++++++- 8 files changed, 700 insertions(+), 19 deletions(-) create mode 100644 README.md create mode 100644 inc/mymm.pl create mode 100644 t/00_diag.t diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml index ea8cb20..56054d1 100644 --- a/.github/workflows/linux.yml +++ b/.github/workflows/linux.yml @@ -17,18 +17,10 @@ jobs: fail-fast: false matrix: cip_tag: - - "5.41" - - "5.40" - - "5.38" - - "5.36" - - "5.34" - - "5.32" - - "5.30" - - "5.28" - - "5.26" - - "5.24" - - "5.22" - - "5.20" + - "5.42" + jq: + - "1.7.1" + - "1.8.2" env: CIP_TAG: ${{ matrix.cip_tag }} @@ -58,9 +50,15 @@ jobs: run: | cip start + - name: Install jq + run: | + cip sudo curl -fsSL -o /usr/local/bin/jq https://github.com/jqlang/jq/releases/download/jq-${{ matrix.jq }}/jq-linux-amd64 + cip sudo chmod +x /usr/local/bin/jq + - name: Diagnostics run: | cip diag + cip exec jq --version - name: Install-Dependencies run: | diff --git a/README.md b/README.md new file mode 100644 index 0000000..0069715 --- /dev/null +++ b/README.md @@ -0,0 +1,114 @@ +# Test::JSON::Diff ![static](https://github.com/uperl/Test-JSON-Diff/workflows/static/badge.svg) ![linux](https://github.com/uperl/Test-JSON-Diff/workflows/linux/badge.svg) + +Check two large JSON strings for structural equality + +# SYNOPSIS + +```perl +use Test2::V0; +use Test::JSON::Diff qw( json_eq_or_diff ); + +json_eq_or_diff '{"a":1,"b":[1,2]}', '{ "b" : [1,2], "a" : 1 }'; +json_eq_or_diff $actual_json, $expected_json, 'response body'; +json_eq_or_diff $actual_json, $expected_json, { max_lines => 100 }; +json_eq_or_diff $actual_json, $expected_json, 'response body', { context => 5 }; + +done_testing; +``` + +# DESCRIPTION + +This module provides a [Test2](https://metacpan.org/pod/Test2) compatible test for comparing two JSON +documents for structural equality. It is intended for large documents, +so the JSON is never decoded into Perl. Instead each document is +canonicalized with `jq` and, only if they differ, the canonical forms +are compared with `diff`. The failure diagnostic is a unified diff of +the pretty-printed JSON. + +Two documents are considered the same if they differ only in: + +- object key order + + `{"a":"b","c":"d"}` is the same as `{"c":"d","a":"b"}`. + +- whitespace outside of strings + + `{"a":"b"}` is the same as `{ "a" : "b" }`. + +Any other difference is a failure, including: + +- array order + + `[1,2]` is not the same as `[2,1]`. + +- types + + `[1]` is not the same as `["1"]`, and `[true]` is not the same as `[1]`. + +- number literals + + `[1]` is not the same as `[1.0]`. Number literals are compared as + written, which also means that large integers are compared exactly. + +# FUNCTIONS + +## json\_eq\_or\_diff + +``` +json_eq_or_diff $actual_json, $expected_json; +json_eq_or_diff $actual_json, $expected_json, $test_name; +json_eq_or_diff $actual_json, $expected_json, \%options; +json_eq_or_diff $actual_json, $expected_json, $test_name, \%options; +``` + +Passes if `$actual_json` and `$expected_json` are structurally the +same JSON. Both must be strings of raw, undecoded, UTF-8 encoded JSON +containing exactly one JSON value. If either is not valid JSON, the +test fails and the diagnostic contains the error reported by `jq`. + +If the documents differ, the diagnostic is a unified diff of the +pretty-printed, key sorted JSON, with the expected document as the +original (`-`) and the actual document as the new (`+`). + +`$test_name` defaults to `json is the same`. + +Options: + +- context + + The number of lines of context around each change in the diff. + Defaults to `3`. + +- max\_lines + + The maximum number of lines of diff output to include in the + diagnostic. If the diff is longer, the remaining lines are replaced + with `...`. Defaults to `50`. + +This function will die if an unrecognized option is passed, or if +either `jq` or `diff` cannot be found in the `PATH`. + +# CAVEATS + +Strings containing wide characters are not currently supported; the +JSON must be passed as UTF-8 encoded bytes. + +This module requires `jq` 1.7 or later, since older versions do not +preserve number literals. This is checked when the distribution is +installed, but not at runtime. + +# SEE ALSO + +- [Test::Differences](https://metacpan.org/pod/Test::Differences) +- [https://jqlang.org](https://jqlang.org) + +# AUTHOR + +Graham Ollis + +# COPYRIGHT AND LICENSE + +This software is copyright (c) 2026 by Graham Ollis. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff --git a/author.yml b/author.yml index c64a272..7b34987 100644 --- a/author.yml +++ b/author.yml @@ -5,7 +5,9 @@ pod_spelling_system: # (regardless of what spell check thinks) # or stuff that I like to spell incorrectly # intentionally - stopwords: [] + stopwords: + - canonicalized + - undecoded pod_coverage: skip: 0 diff --git a/dist.ini b/dist.ini index bd37cfb..5fab6d7 100644 --- a/dist.ini +++ b/dist.ini @@ -6,7 +6,7 @@ copyright_year = 2026 version = 0.01 [@Author::Plicease] -:version = 2.80 +:version = 2.79 release_tests = 1 installer = Author::Plicease::MakeMaker github_user = uperl @@ -14,11 +14,14 @@ default_branch = main test2_v0 = 1 workflow = static workflow = linux -version_plugin = PkgVersion::Block [Author::Plicease::Core] [Author::Plicease::Upload] cpan = 1 +[Prereqs / ConfigureRequires] +-phase = configure +File::Which = 0 + diff --git a/inc/mymm.pl b/inc/mymm.pl new file mode 100644 index 0000000..72d5ec7 --- /dev/null +++ b/inc/mymm.pl @@ -0,0 +1,57 @@ +package mymm; + +use strict; +use warnings; +use File::Which qw( which ); + +# Test::JSON::Diff shells out to jq and diff, and requires jq 1.7 or better +# since earlier versions do not preserve number literals. If they aren't +# available, bail out without writing a Makefile, which CPAN testers +# reports as N/A rather than FAIL. + +sub unsupported +{ + my($reason) = @_; + print "OS unsupported: $reason\n"; + exit 0; +} + +sub myWriteMakefile +{ + my %args = @_; + + my $jq = which('jq'); + unsupported('Test::JSON::Diff requires jq 1.7 or better, which I am unable to find') + unless defined $jq; + + my $version = do { + open my $fh, '-|', $jq, '--version' or unsupported("unable to run $jq --version: $!"); + my $line = <$fh>; + close $fh; + $line = '' unless defined $line; + chomp $line; + $line; + }; + + if($version =~ /^jq-([0-9]+)\.([0-9]+)/) + { + my($major, $minor) = ($1, $2); + unsupported("Test::JSON::Diff requires jq 1.7 or better, found $version at $jq") + if $major < 1 || ($major == 1 && $minor < 7); + print "found $version at $jq\n"; + } + else + { + unsupported("unable to determine version of $jq (got '$version')"); + } + + my $diff = which('diff'); + unsupported('Test::JSON::Diff requires diff, which I am unable to find') + unless defined $diff; + print "found diff at $diff\n"; + + require ExtUtils::MakeMaker; + ExtUtils::MakeMaker::WriteMakefile(%args); +} + +1; diff --git a/lib/Test/JSON/Diff.pm b/lib/Test/JSON/Diff.pm index 844dec9..5ce9d6e 100644 --- a/lib/Test/JSON/Diff.pm +++ b/lib/Test/JSON/Diff.pm @@ -1,7 +1,250 @@ +package Test::JSON::Diff; + use warnings; use v5.42; +use Test2::API qw( context_do ); +use File::Which qw( which ); +use File::Temp (); +use IPC::Open3 qw( open3 ); +use Carp qw( croak ); +use Exporter qw( import ); + +our @EXPORT_OK = qw( json_eq_or_diff ); + +# ABSTRACT: Check two large JSON strings for structural equality +# VERSION + +=head1 SYNOPSIS + + use Test2::V0; + use Test::JSON::Diff qw( json_eq_or_diff ); + + json_eq_or_diff '{"a":1,"b":[1,2]}', '{ "b" : [1,2], "a" : 1 }'; + json_eq_or_diff $actual_json, $expected_json, 'response body'; + json_eq_or_diff $actual_json, $expected_json, { max_lines => 100 }; + json_eq_or_diff $actual_json, $expected_json, 'response body', { context => 5 }; + + done_testing; + +=head1 DESCRIPTION + +This module provides a L compatible test for comparing two JSON +documents for structural equality. It is intended for large documents, +so the JSON is never decoded into Perl. Instead each document is +canonicalized with C and, only if they differ, the canonical forms +are compared with C. The failure diagnostic is a unified diff of +the pretty-printed JSON. + +Two documents are considered the same if they differ only in: + +=over 4 + +=item object key order + +C<{"a":"b","c":"d"}> is the same as C<{"c":"d","a":"b"}>. + +=item whitespace outside of strings + +C<{"a":"b"}> is the same as C<{ "a" : "b" }>. + +=back + +Any other difference is a failure, including: + +=over 4 + +=item array order + +C<[1,2]> is not the same as C<[2,1]>. + +=item types + +C<[1]> is not the same as C<["1"]>, and C<[true]> is not the same as C<[1]>. + +=item number literals + +C<[1]> is not the same as C<[1.0]>. Number literals are compared as +written, which also means that large integers are compared exactly. + +=back + +=head1 FUNCTIONS + +=head2 json_eq_or_diff + + json_eq_or_diff $actual_json, $expected_json; + json_eq_or_diff $actual_json, $expected_json, $test_name; + json_eq_or_diff $actual_json, $expected_json, \%options; + json_eq_or_diff $actual_json, $expected_json, $test_name, \%options; + +Passes if C<$actual_json> and C<$expected_json> are structurally the +same JSON. Both must be strings of raw, undecoded, UTF-8 encoded JSON +containing exactly one JSON value. If either is not valid JSON, the +test fails and the diagnostic contains the error reported by C. + +If the documents differ, the diagnostic is a unified diff of the +pretty-printed, key sorted JSON, with the expected document as the +original (C<->) and the actual document as the new (C<+>). + +C<$test_name> defaults to C. + +Options: + +=over 4 + +=item context + +The number of lines of context around each change in the diff. +Defaults to C<3>. + +=item max_lines -package Test::JSON::Diff { +The maximum number of lines of diff output to include in the +diagnostic. If the diff is longer, the remaining lines are replaced +with C<...>. Defaults to C<50>. - # ABSTRACT: Check two large JSON strings for structural equality +=back + +This function will die if an unrecognized option is passed, or if +either C or C cannot be found in the C. + +=head1 CAVEATS + +Strings containing wide characters are not currently supported; the +JSON must be passed as UTF-8 encoded bytes. + +This module requires C 1.7 or later, since older versions do not +preserve number literals. This is checked when the distribution is +installed, but not at runtime. + +=head1 SEE ALSO + +=over 4 + +=item L + +=item L + +=back + +=cut + +my %default_options = ( + context => 3, + max_lines => 50, +); + +my $jq_filter = 'if length == 1 then .[0] else error("input must contain exactly one JSON value") end'; + +sub json_eq_or_diff ($actual, $expected, @rest) { + + my %options = %default_options; + if(@rest && ref $rest[-1] eq 'HASH') { + my $user = pop @rest; + if(my @bad = sort grep { !exists $default_options{$_} } keys %$user) { + croak "json_eq_or_diff: unknown option(s): @{[ join ', ', @bad ]}"; + } + %options = (%options, %$user); + } + croak "usage: json_eq_or_diff \$actual_json, \$expected_json [, \$test_name] [, \\%options]" + if @rest > 1; + croak "json_eq_or_diff: context must be a non-negative integer" + unless defined $options{context} && $options{context} =~ /^[0-9]+\z/; + croak "json_eq_or_diff: max_lines must be a positive integer" + unless defined $options{max_lines} && $options{max_lines} =~ /^[0-9]+\z/ && $options{max_lines} > 0; + + my $test_name = $rest[0] // "json is the same"; + + my $jq = which('jq') // croak "json_eq_or_diff: unable to find jq"; + my $diff = which('diff') // croak "json_eq_or_diff: unable to find diff"; + + my $dir = File::Temp->newdir; + + my @diag; + my %canon; + foreach my $which (qw( actual expected )) { + my $raw = "$dir/$which.json"; + _spew($raw, $which eq 'actual' ? $actual : $expected); + $canon{$which} = "$dir/$which.canon.json"; + my $err = "$dir/$which.err"; + my $status = _run_to_files([$jq, '-S', '-s', $jq_filter], $raw, $canon{$which}, $err); + if($status != 0) { + push @diag, "$which is not valid JSON:", _slurp_lines($err); + } + } + + unless(@diag) { + @diag = _diff($diff, $options{context}, $options{max_lines}, $canon{expected}, $canon{actual}, "$dir/diff.err"); + } + + my $ok = !@diag; + + context_do { + my $ctx = shift; + $ctx->ok($ok, $test_name, @diag ? [join "\n", @diag] : ()); + }; + + return $ok; } + +sub _spew ($path, $content) { + open my $fh, '>:raw', $path or die "unable to write $path: $!"; + print $fh $content; + close $fh or die "unable to write $path: $!"; + return; +} + +sub _slurp_lines ($path) { + open my $fh, '<', $path or die "unable to read $path: $!"; + my @lines = <$fh>; + close $fh; + chomp @lines; + return @lines; +} + +# run $cmd with stdin, stdout and stderr connected directly to files, +# so that the (possibly large) data never passes through Perl. +sub _run_to_files ($cmd, $in_path, $out_path, $err_path) { + open my $in, '<:raw', $in_path or die "unable to read $in_path: $!"; + open my $out, '>:raw', $out_path or die "unable to write $out_path: $!"; + open my $err, '>:raw', $err_path or die "unable to write $err_path: $!"; + my $pid = open3('<&' . fileno($in), '>&' . fileno($out), '>&' . fileno($err), @$cmd); + waitpid $pid, 0; + return $?; +} + +# returns an empty list if the files are the same, otherwise up to +# $max_lines lines of unified diff, followed by '...' if clipped. +sub _diff ($diff, $context, $max_lines, $expected, $actual, $err_path) { + open my $err, '>:raw', $err_path or die "unable to write $err_path: $!"; + my $pid = open3(my $stdin, my $stdout, '>&' . fileno($err), + $diff, "-U$context", '--label', 'expected', '--label', 'actual', $expected, $actual); + close $stdin; + + my @lines; + my $clipped = 0; + while(defined(my $line = <$stdout>)) { + if(@lines >= $max_lines) { + $clipped = 1; + last; + } + chomp $line; + push @lines, $line; + } + + if($clipped) { + push @lines, '...'; + kill 'TERM', $pid; + } + close $stdout; + waitpid $pid, 0; + + unless($clipped) { + my $status = $? >> 8; + die join "\n", "diff failed with exit $status:", _slurp_lines($err_path) + if $? == -1 || $? & 127 || $status > 1; + } + + return @lines; +} + diff --git a/t/00_diag.t b/t/00_diag.t new file mode 100644 index 0000000..a5a140c --- /dev/null +++ b/t/00_diag.t @@ -0,0 +1,88 @@ +use Test2::V0 -no_srand => 1; +use Config; + +eval { require 'Test/More.pm' }; + +# This .t file is generated. +# make changes instead to dist.ini + +my %modules; +my $post_diag; + +$modules{$_} = $_ for qw( + ExtUtils::MakeMaker + File::Which + Test2::API + Test2::V0 +); + + + +my @modules = sort keys %modules; + +sub spacer () +{ + diag ''; + diag ''; + diag ''; +} + +pass 'okay'; + +my $max = 1; +$max = $_ > $max ? $_ : $max for map { length $_ } @modules; +our $format = "%-${max}s %s"; + +spacer; + +my @keys = sort grep /(MOJO|PERL|\A(LC|HARNESS)_|\A(SHELL|LANG)\Z)/i, keys %ENV; + +if(@keys > 0) +{ + diag "$_=$ENV{$_}" for @keys; + + if($ENV{PERL5LIB}) + { + spacer; + diag "PERL5LIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERL5LIB}; + + } + elsif($ENV{PERLLIB}) + { + spacer; + diag "PERLLIB path"; + diag $_ for split $Config{path_sep}, $ENV{PERLLIB}; + } + + spacer; +} + +diag sprintf $format, 'perl', "$] $^O $Config{archname}"; + +foreach my $module (sort @modules) +{ + my $pm = "$module.pm"; + $pm =~ s{::}{/}g; + if(eval { require $pm; 1 }) + { + my $ver = eval { $module->VERSION }; + $ver = 'undef' unless defined $ver; + diag sprintf $format, $module, $ver; + } + else + { + diag sprintf $format, $module, '-'; + } +} + +if($post_diag) +{ + spacer; + $post_diag->(); +} + +spacer; + +done_testing; + diff --git a/t/test_json_diff.t b/t/test_json_diff.t index a92f94e..125a8c2 100644 --- a/t/test_json_diff.t +++ b/t/test_json_diff.t @@ -1,6 +1,182 @@ use Test2::V0 -no_srand => 1; -use Test::JSON::Diff; +use v5.42; +use Test::JSON::Diff qw( json_eq_or_diff ); +use File::Which (); +use File::Temp (); -ok 1, 'todo'; +sub run_check (@args) { + my $ret; + my $events = intercept { $ret = json_eq_or_diff(@args) }; + my @results = $events->squash_info->flatten->@*; + is scalar @results, 1, 'exactly one assertion'; + my $result = $results[0]; + # first diag is the standard "Failed test" message + my $diag = $result->{diag} ? $result->{diag}->[1] : undef; + return ($ret, $result, $diag); +} + +package Test::JSON::Diff::NoImport { + use Test::JSON::Diff; +} + +subtest 'export' => sub { + ok main->can('json_eq_or_diff'), 'imported on request'; + ok !Test::JSON::Diff::NoImport->can('json_eq_or_diff'), 'not exported by default'; +}; + +subtest 'same' => sub { + foreach my $case ( + [ '{"a":"b","c":"d"}', '{"c":"d","a":"b"}', 'key order' ], + [ '{"a":"b"}', qq({ "a" :\t"b"\n}\n), 'whitespace' ], + [ '{"x":{"z":[1,{"q":1,"p":2}],"y":null}}', '{"x":{"y":null,"z":[1,{"p":2,"q":1}]}}', 'nested' ], + [ '[true,false,null]', '[ true, false, null ]', 'literals' ], + [ '12345678901234567890', '12345678901234567890', 'big integer' ], + [ '"a b"', '"a b"', 'string scalar' ], + [ qq({"\xc3\xa9":"\xe2\x98\x83"}), qq({ "\xc3\xa9" : "\xe2\x98\x83" }), 'utf-8' ], + ) { + my($actual, $expected, $name) = @$case; + my($ret, $result) = run_check($actual, $expected, $name); + is $ret, T(), "$name: returns true"; + is $result, hash { field pass => 1; field name => $name; etc; }, "$name: passes"; + } +}; + +subtest 'different' => sub { + foreach my $case ( + [ '[1]', '["1"]', 'number vs string' ], + [ '[true]', '[1]', 'boolean vs number' ], + [ '[null]', '[""]', 'null vs string' ], + [ '[1,2]', '[2,1]', 'array order' ], + [ '[1]', '[1.0]', 'number literal' ], + [ '12345678901234567890', '12345678901234567891', 'big integer' ], + [ '{"a":1}', '{"a":1,"b":2}', 'missing key' ], + [ '{"a":"b "}', '{"a":"b"}', 'quoted whitespace' ], + ) { + my($actual, $expected, $name) = @$case; + my($ret, $result, $diag) = run_check($actual, $expected, $name); + is $ret, F(), "$name: returns false"; + is $result, hash { field pass => 0; field name => $name; etc; }, "$name: fails"; + like $diag, qr/^--- expected\n\+\+\+ actual\n\@\@/, "$name: diag is a unified diff"; + } +}; + +subtest 'diff diagnostic' => sub { + my($ret, $result, $diag) = run_check('{"b":[1,2,3],"a":1}', '{"a":1,"b":[1,"2",3]}'); + is $diag, join("\n", + '--- expected', + '+++ actual', + '@@ -2,7 +2,7 @@', + ' "a": 1,', + ' "b": [', + ' 1,', + '- "2",', + '+ 2,', + ' 3', + ' ]', + ' }', + ), 'pretty printed, key sorted, expected then actual'; +}; + +subtest 'default test name' => sub { + my($ret, $result) = run_check('1', '1'); + is $result->{name}, 'json is the same'; + ($ret, $result) = run_check('1', '1', undef); + is $result->{name}, 'json is the same', 'undef name'; + ($ret, $result) = run_check('1', '1', { context => 1 }); + is $result->{name}, 'json is the same', 'options only'; + ($ret, $result) = run_check('1', '1', 'foo', { context => 1 }); + is $result->{name}, 'foo', 'name and options'; +}; + +subtest 'context' => sub { + my $expected = '[' . join(',', 1..20) . ']'; + my $actual = '[' . join(',', 1..9, 'false', 11..20) . ']'; + + my(undef, undef, $diag) = run_check($actual, $expected); + my @lines = split /\n/, $diag; + is scalar(grep /^ /, @lines), 6, 'default context is 3'; + + (undef, undef, $diag) = run_check($actual, $expected, { context => 0 }); + @lines = split /\n/, $diag; + is \@lines, ['--- expected', '+++ actual', '@@ -11 +11 @@', '- 10,', '+ false,'], 'context 0'; + + (undef, undef, $diag) = run_check($actual, $expected, { context => 5 }); + @lines = split /\n/, $diag; + is scalar(grep /^ /, @lines), 10, 'context 5'; +}; + +subtest 'max_lines' => sub { + my $expected = '[' . join(',', 1..200) . ']'; + my $actual = '[' . join(',', map { "\"$_\"" } 1..200) . ']'; + + my(undef, undef, $diag) = run_check($actual, $expected); + my @lines = split /\n/, $diag; + is scalar @lines, 51, 'default is 50 lines plus ...'; + is $lines[0], '--- expected', 'header counts'; + is $lines[-1], '...', 'clipped'; + + (undef, undef, $diag) = run_check($actual, $expected, { max_lines => 5 }); + is [split /\n/, $diag], ['--- expected', '+++ actual', '@@ -1,202 +1,202 @@', ' [', '- 1,', '...'], 'max_lines 5'; + + (undef, undef, $diag) = run_check('[2]', '[1]', { max_lines => 7 }); + is [split /\n/, $diag], ['--- expected', '+++ actual', '@@ -1,3 +1,3 @@', ' [', '- 1', '+ 2', ' ]'], 'exactly max_lines is not clipped'; + + (undef, undef, $diag) = run_check('[2]', '[1]', { max_lines => 6 }); + is [split /\n/, $diag], ['--- expected', '+++ actual', '@@ -1,3 +1,3 @@', ' [', '- 1', '+ 2', '...'], 'one over max_lines is clipped'; +}; + +subtest 'invalid json' => sub { + foreach my $case ( + [ '{"a":', 'unfinished' ], + [ '', 'empty' ], + [ '1 2', 'multiple values' ], + [ '{a:1}', 'unquoted key' ], + ) { + my($bad, $name) = @$case; + + my($ret, $result, $diag) = run_check($bad, '1'); + is $ret, F(), "$name actual: returns false"; + like $diag, qr/^actual is not valid JSON:\njq: /, "$name actual: diag"; + unlike $diag, qr/expected is not valid/, "$name actual: expected is fine"; + + ($ret, $result, $diag) = run_check('1', $bad); + is $ret, F(), "$name expected: returns false"; + like $diag, qr/^expected is not valid JSON:\njq: /, "$name expected: diag"; + } + + my(undef, undef, $diag) = run_check('1 2', ''); + like $diag, qr/^actual is not valid JSON:\n.*exactly one JSON value.*\nexpected is not valid JSON:\n.*exactly one JSON value/s, 'both'; +}; + +subtest 'usage errors' => sub { + like dies { json_eq_or_diff('1', '1', { foo => 1, bar => 2 }) }, + qr/^json_eq_or_diff: unknown option\(s\): bar, foo at /, 'unknown options'; + like dies { json_eq_or_diff('1', '1', 'name', { foo => 1 }) }, + qr/^json_eq_or_diff: unknown option\(s\): foo at /, 'unknown option with name'; + like dies { json_eq_or_diff('1', '1', 'name', 'extra') }, + qr/^usage: /, 'fourth argument not a hash'; + like dies { json_eq_or_diff('1', '1', 'name', {}, {}) }, + qr/^usage: /, 'too many arguments'; + like dies { json_eq_or_diff('1', '1', { context => -1 }) }, + qr/context must be a non-negative integer/, 'bad context'; + like dies { json_eq_or_diff('1', '1', { max_lines => 0 }) }, + qr/max_lines must be a positive integer/, 'bad max_lines'; +}; + +subtest 'missing tools' => sub { + my $jq = File::Which::which('jq'); + + { + local $ENV{PATH} = ''; + like dies { json_eq_or_diff('1', '1') }, qr/^json_eq_or_diff: unable to find jq at /, 'no jq'; + } + + my $dir = File::Temp->newdir; + symlink $jq, "$dir/jq" or die "unable to symlink $jq: $!"; + { + local $ENV{PATH} = "$dir"; + like dies { json_eq_or_diff('1', '1') }, qr/^json_eq_or_diff: unable to find diff at /, 'no diff'; + } +}; done_testing; From 79aa02436a39125f2f89e9e78d9d12b672e52ab3 Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Tue, 29 Sep 2026 13:00:56 -0600 Subject: [PATCH 2/3] Use Path::Tiny for temp files and file I/O Co-Authored-By: Claude Opus 5.5 --- lib/Test/JSON/Diff.pm | 41 +++++++++++++---------------------------- t/00_diag.t | 1 + t/test_json_diff.t | 6 +++--- 3 files changed, 17 insertions(+), 31 deletions(-) diff --git a/lib/Test/JSON/Diff.pm b/lib/Test/JSON/Diff.pm index 5ce9d6e..07c1fb8 100644 --- a/lib/Test/JSON/Diff.pm +++ b/lib/Test/JSON/Diff.pm @@ -4,7 +4,7 @@ use warnings; use v5.42; use Test2::API qw( context_do ); use File::Which qw( which ); -use File::Temp (); +use Path::Tiny qw( tempdir ); use IPC::Open3 qw( open3 ); use Carp qw( croak ); use Exporter qw( import ); @@ -158,23 +158,23 @@ sub json_eq_or_diff ($actual, $expected, @rest) { my $jq = which('jq') // croak "json_eq_or_diff: unable to find jq"; my $diff = which('diff') // croak "json_eq_or_diff: unable to find diff"; - my $dir = File::Temp->newdir; + my $dir = tempdir; my @diag; my %canon; foreach my $which (qw( actual expected )) { - my $raw = "$dir/$which.json"; - _spew($raw, $which eq 'actual' ? $actual : $expected); - $canon{$which} = "$dir/$which.canon.json"; - my $err = "$dir/$which.err"; + my $raw = $dir->child("$which.json"); + $raw->spew_raw($which eq 'actual' ? $actual : $expected); + $canon{$which} = $dir->child("$which.canon.json"); + my $err = $dir->child("$which.err"); my $status = _run_to_files([$jq, '-S', '-s', $jq_filter], $raw, $canon{$which}, $err); if($status != 0) { - push @diag, "$which is not valid JSON:", _slurp_lines($err); + push @diag, "$which is not valid JSON:", $err->lines_raw({ chomp => 1 }); } } unless(@diag) { - @diag = _diff($diff, $options{context}, $options{max_lines}, $canon{expected}, $canon{actual}, "$dir/diff.err"); + @diag = _diff($diff, $options{context}, $options{max_lines}, $canon{expected}, $canon{actual}, $dir->child('diff.err')); } my $ok = !@diag; @@ -187,27 +187,12 @@ sub json_eq_or_diff ($actual, $expected, @rest) { return $ok; } -sub _spew ($path, $content) { - open my $fh, '>:raw', $path or die "unable to write $path: $!"; - print $fh $content; - close $fh or die "unable to write $path: $!"; - return; -} - -sub _slurp_lines ($path) { - open my $fh, '<', $path or die "unable to read $path: $!"; - my @lines = <$fh>; - close $fh; - chomp @lines; - return @lines; -} - # run $cmd with stdin, stdout and stderr connected directly to files, # so that the (possibly large) data never passes through Perl. sub _run_to_files ($cmd, $in_path, $out_path, $err_path) { - open my $in, '<:raw', $in_path or die "unable to read $in_path: $!"; - open my $out, '>:raw', $out_path or die "unable to write $out_path: $!"; - open my $err, '>:raw', $err_path or die "unable to write $err_path: $!"; + my $in = $in_path->openr_raw; + my $out = $out_path->openw_raw; + my $err = $err_path->openw_raw; my $pid = open3('<&' . fileno($in), '>&' . fileno($out), '>&' . fileno($err), @$cmd); waitpid $pid, 0; return $?; @@ -216,7 +201,7 @@ sub _run_to_files ($cmd, $in_path, $out_path, $err_path) { # returns an empty list if the files are the same, otherwise up to # $max_lines lines of unified diff, followed by '...' if clipped. sub _diff ($diff, $context, $max_lines, $expected, $actual, $err_path) { - open my $err, '>:raw', $err_path or die "unable to write $err_path: $!"; + my $err = $err_path->openw_raw; my $pid = open3(my $stdin, my $stdout, '>&' . fileno($err), $diff, "-U$context", '--label', 'expected', '--label', 'actual', $expected, $actual); close $stdin; @@ -241,7 +226,7 @@ sub _diff ($diff, $context, $max_lines, $expected, $actual, $err_path) { unless($clipped) { my $status = $? >> 8; - die join "\n", "diff failed with exit $status:", _slurp_lines($err_path) + die join "\n", "diff failed with exit $status:", $err_path->lines_raw({ chomp => 1 }) if $? == -1 || $? & 127 || $status > 1; } diff --git a/t/00_diag.t b/t/00_diag.t index a5a140c..5add79f 100644 --- a/t/00_diag.t +++ b/t/00_diag.t @@ -12,6 +12,7 @@ my $post_diag; $modules{$_} = $_ for qw( ExtUtils::MakeMaker File::Which + Path::Tiny Test2::API Test2::V0 ); diff --git a/t/test_json_diff.t b/t/test_json_diff.t index 125a8c2..534ef15 100644 --- a/t/test_json_diff.t +++ b/t/test_json_diff.t @@ -2,7 +2,7 @@ use Test2::V0 -no_srand => 1; use v5.42; use Test::JSON::Diff qw( json_eq_or_diff ); use File::Which (); -use File::Temp (); +use Path::Tiny qw( tempdir ); sub run_check (@args) { my $ret; @@ -171,8 +171,8 @@ subtest 'missing tools' => sub { like dies { json_eq_or_diff('1', '1') }, qr/^json_eq_or_diff: unable to find jq at /, 'no jq'; } - my $dir = File::Temp->newdir; - symlink $jq, "$dir/jq" or die "unable to symlink $jq: $!"; + my $dir = tempdir; + symlink $jq, $dir->child("jq") or die "unable to symlink $jq: $!"; { local $ENV{PATH} = "$dir"; like dies { json_eq_or_diff('1', '1') }, qr/^json_eq_or_diff: unable to find diff at /, 'no diff'; From fff2a07146540300d0b0f78c5c387d13d341e216 Mon Sep 17 00:00:00 2001 From: Graham Ollis Date: Tue, 29 Sep 2026 13:03:03 -0600 Subject: [PATCH 3/3] CI: test Perl 5.44 and 5.45 Co-Authored-By: Claude Opus 5.5 --- .github/workflows/linux.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml index 56054d1..34d1ec0 100644 --- a/.github/workflows/linux.yml +++ b/.github/workflows/linux.yml @@ -17,6 +17,8 @@ jobs: fail-fast: false matrix: cip_tag: + - "5.45" + - "5.44" - "5.42" jq: - "1.7.1"