# This test is meant to exercise all the possible ways that parsing
# can fail, and also check that correct, yet weird or stupid inputs
# are not marked as invalid.
use warnings;
use strict;
use Test::More;
use JSON::Parse qw/valid_json validate_json/;
# https://github.com/benkasminbullock/JSON-Parse/issues/2
my $fdegir1 = <<'EOF';
{
"gav": {
"groupId": "mygroup",
"artifactId": "myartifact"
"version": "1.0"
}
}
EOF
ok (! valid_json ($fdegir1));
eval {
validate_json ($fdegir1);
};
ok ($@, "validate_json dies");
like ($@, qr/line 5/i, "line number OK");
my $empty = ' ';
run_fail_like ($empty, qr/unexpected end of input/i);
my $undef = undef;
ok (! valid_json ($undef));
eval {
no warnings 'uninitialized';
validate_json ($undef);
use warnings 'uninitialized';
};
ok ($@, "undef input dies");
like ($@, qr/empty input/i, "flagged as empty input");
# ____ _
# / ___|___ _ __ ___ _ __ ___ __ _ ___ __ _ _ __ __| |
# | | / _ \| '_ ` _ \| '_ ` _ \ / _` / __| / _` | '_ \ / _` |
# | |__| (_) | | | | | | | | | | | (_| \__ \ | (_| | | | | (_| |
# \____\___/|_| |_| |_|_| |_| |_|\__,_|___/ \__,_|_| |_|\__,_|
#
# _
# ___ ___ | | ___ _ __ ___
# / __/ _ \| |/ _ \| '_ \/ __|
# | (_| (_) | | (_) | | | \__ \
# \___\___/|_|\___/|_| |_|___/
#
# Test comma and colon parsing.
my $unknown_character = qr/unexpected character/i;
my $bad_comma_1 = '{,"bad":"bad"}';
run_fail_like ($bad_comma_1, $unknown_character);
my $bad_comma_array = '[,"bad","bad"]';
run_fail_like ($bad_comma_array, $unknown_character);
my $bad_comma_2 = '{"bad",:"bad"}';
run_fail_like ($bad_comma_2, $unknown_character);
my $bad_comma_3 = '{"bad":,"bad"}';
run_fail_like ($bad_comma_3, $unknown_character);
my $bad_comma_4 = '{"bad":"bad",}';
run_fail_like ($bad_comma_4, $unknown_character);
my $bad_comma_5 = '["bad","bad",]';
run_fail_like ($bad_comma_5, $unknown_character);
my $no_comma_array = '["bad" "bad"]';
run_fail_like ($no_comma_array, $unknown_character);
# Single-element array OK
run_ok ('["bad"]');
# Empty array OK
run_ok ('[]');
# Empty object OK
run_ok ('{}');
# Check the checking of final junk
my $too_many_end_braces = '{"bad":"bad"}}';
run_fail_like ($too_many_end_braces, $unknown_character);
my $too_many_end_brackets = '["bad","bad"]]';
run_fail_like ($too_many_end_brackets, $unknown_character);
run_fail_like ('{"bad":"forgot the end quotes}', qr/end of input/i);
# Bug in "get_key_string" found by randomtest
run_fail_like ("[\"\0]", $unknown_character);
# See what happens when we send a string with a null byte.
my $contains_null = '["' . "pupparoon\0\0 baba". '"]';
run_fail_like ($contains_null, qr/unexpected.*0x00/i);
# See what happens when we send a string with a disallowed byte.
my $contains_junk = '["' . chr (07) . '"]';
run_fail_like ($contains_junk, qr/unexpected.*0x07/i);
my $contains_escaped_null = '["\u0000"]';
run_ok ($contains_escaped_null);
my $contains_escaped_junk = '["\u0007"]';
run_ok ($contains_escaped_junk);
# Don't fail on pointless whitespace.
my $contains_silly_whitespace = <<EOF;
{
\r\n"why"
:
\t"do"\t
}
EOF
run_ok ($contains_silly_whitespace);
# Throw an error with an unknown escape.
my $unknown_escape_1 = '["\a"]';
run_fail_like ($unknown_escape_1, $unknown_character);
# Test all the JSON escapes at once. Note here that \\\\ turns into \\
# after Perl has finished with it.
run_ok ('["\t\f\b\r\n\\\\\"\/"]');
my $bad_literal = '[truk]';
run_fail_like ($bad_literal, qr/unexpected character 'k'/i);
# _ _ _
# | \ | |_ _ _ __ ___ | |__ ___ _ __ ___
# | \| | | | | '_ ` _ \| '_ \ / _ \ '__/ __|
# | |\ | |_| | | | | | | |_) | __/ | \__ \_
# |_| \_|\__,_|_| |_| |_|_.__/ \___|_| |___(_)
#
# Bad numbers.
my $double_minus = '[--1]';
run_fail_like ($double_minus, $unknown_character);
my $leading_zero = '[01]';
run_fail_like ($leading_zero, $unknown_character);
my $leading_plus = '[+1]';
run_fail_like ($leading_plus, $unknown_character);
my $double_exp_plus = '[0.1e++3]';
run_fail_like ($double_exp_plus, $unknown_character);
my $double_exp_minus = '[0.1e--3]';
run_fail_like ($double_exp_minus, $unknown_character);
my $misplaced_minus = '[0.1e1-3]';
run_fail_like ($misplaced_minus, $unknown_character);
my $bad_double = '[1.0e1.0]';
run_fail_like ($bad_double, $unknown_character);
my $ending = '[1234567';
run_fail_like ($ending, qr/unexpected end of input/i);
# Don't accept an isolated minus sign.
my $wsnumber = '[[null, true, -, 7965, 58]]';
run_fail ($wsnumber);
run_fail ('[43E+]');
# Numbers we accept.
run_ok ('[1.0e4]');
run_ok ('[1.0e+4]');
run_ok ('[1.0e-4]');
run_ok ('[0.0001e-4]');
run_ok ('[0e0]');
run_ok ('[0e1]');
run_ok ('[0.2e10]');
run_fail_like ('["a":1]', qr/unexpected character.*':'/i);
run_fail_like ('{1,2,3}', qr/unexpected character '1' parsing object/i);
run_fail_like ('[1,2,3}', qr/unexpected character.*'}'/i);
run_fail_like ('["\z"]', $unknown_character);
run_fail_like ('{"go":{"buddy":{"go":{"buddy":', qr/unexpected end of input/i);
run_fail_like ('{"gobuggs}', qr/unexpected end of input parsing/i);
run_fail_like ('["\uNOTHEX"]', qr/unexpected character 'N'/i);
run_fail_like ('["\uABC', qr/unexpected end of input/i);
run_fail_like ('["\uD834monkey\uDD1E"]', qr/unexpected character 'm'/i);
# This checks the string-length-checking code.
run_fail_like ('["\udc00???"]', qr/Unexpected end of input parsing unicode escape starting from byte 3/);
my $bad_plus = '[1.0e1+0]';
run_fail_like ($bad_plus, qr/unexpected character/i);
run_fail ('{"baba":6-3}');
run_fail_like ('{"baba":6.', qr/unexpected end of input parsing number/i);
run_fail_like ("{\"baba\":6.\0", qr/unexpected character.*parsing number/i);
# Bare values.
run_ok ('"clive"');
TODO: {
local $TODO = 'known bugs';
};
done_testing ();
exit;
# Run the validator on $json with the expectation of getting an error
# which looks like $expected.
sub run_fail_like
{
my ($json, $expected) = @_;
my $error = run_fail ($json);
like ($error, $expected,
"Got expected error '$expected' parsing '$json'");
}
# Run the test on $json with the expectation of it being invalid.
sub run_fail
{
my ($json) = @_;
ok (! valid_json ($json), "Error detection for '$json' with 'valid_json'");
eval {
validate_json ($json);
};
ok ($@, "Error detection for '$json' with 'validate_json'");
return $@;
}
# Run the test on $json with the expectation of it being valid. This
# is for testing that kooky inputs don't cause failures.
sub run_ok
{
my ($json) = @_;
ok (valid_json ($json), "Parsing of '$json' with 'valid_json' succeeded");
eval {
validate_json ($json);
};
ok (! $@, "Parsing of '$json' with 'validate_json' succeeded");
note ($@);
}