Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 8df1d893a7
Fetching contributors…

Cannot retrieve contributors at this time

executable file 119 lines (100 sloc) 2.827 kb
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
#!/usr/bin/perl
use strict;
use warnings;
use blib;
use JSON::SL;
use Data::Dumper::Concise;
use JSON::XS qw(decode_json);
use Getopt::Long;
use Benchmark qw(:all);
use Carp qw(confess);

$SIG{__DIE__} = \&confess;

GetOptions(
    'i|iterations=i' => \my $Iterations,
    'x|jsonxs' => \my $TestJsonxs,
    's|jsonsl' => \my $TestJsonsl,
    'j|jpr' => \my $TestJsonpointer,
    'c|chunked=i' => \my $TestChunks,
    'f|file=s' => \my $TESTFILE,
    'r|recursion=i' => \my $RecursionLimit,
    'd|dump' => \my $DumpTree,
    'U|no-unescape' => \my $DontUnescape,
    'h|help' => \my $PrintHelp
);

if ($PrintHelp) {
    print STDERR <<EOF;
$0 [options]
-i --iterations=NUM Number of iterations
-x --jsonxs Benchmark JSON::XS
-s --jsonsl Benchmark JSON::SL
-j --jpr Test JSONPointer functionality
-f --file=FILE Run benchmarks on FILE
-c --chunked=SIZE Test incremental chunks of SIZE bytes
-r --recursion=LEVEL Set JSON::SL recursion limit
-d --dump Dump object tree on completion
-U --no-unescape Don't have JSON::SL unescape strings
EOF
    exit(1);
}

$Iterations ||= 20;

if ($ENV{PERL_JSONSL_DEFAULTS}) {
    $TestJsonsl = 1;
    $TestJsonxs = 1;
    $TestJsonpointer = 1;
    $TestChunks = 8192;
}

$TESTFILE ||= "share/auction";
$RecursionLimit ||= 256;

my $o = JSON::SL->new($RecursionLimit);
open my $fh, "<", $TESTFILE or die "$TESTFILE: $!";
my $txt = join("", <$fh>);
close($fh);

if ($TestJsonpointer) {
    $o->set_jsonpointer(["/alliance/auctions/^/auc"]);
    my $copy = substr($txt, 0, 246);
    my @all = $o->feed($copy);
    print $copy ."\n";
    print Dumper(\@all);
    print Dumper($o->root);
}

my @Chunks;
if ($TestChunks) {
    printf("Splitting file into chunks..\n");
    @Chunks = unpack("(a$TestChunks)*", $txt);
}

my $sl_incr = JSON::SL->new($RecursionLimit);
my $xs_incr = JSON::XS->new();

sub jsonsl_complete {
    JSON::SL::decode_json($txt);
}

sub jsonsl_incr {
    $sl_incr->reset();
    my $res = $sl_incr->feed($_) for @Chunks;
}

sub jsonxs_complete {
    JSON::XS::decode_json($txt);
}

sub jsonxs_incr {
    $xs_incr->incr_reset();
    my $res = $xs_incr->incr_parse($_) for @Chunks;
}

my %SimpleTests;
my %IncrTests;

if ($TestJsonxs) {
    $SimpleTests{'JSON::XS decode_json'} = \&jsonxs_complete;
    if (@Chunks) {
        $IncrTests{'JSON::XS incr_parse'} = \&jsonxs_incr;
    }
}

if ($TestJsonsl) {
    $SimpleTests{'JSON::SL decode_json'} = \&jsonsl_complete;
    if (@Chunks) {
        $IncrTests{'JSON::SL feed'} = \&jsonsl_incr;
    }
}

printf("Running decode_json tests with input of %d bytes\n", length($txt));
cmpthese($Iterations, \%SimpleTests);
if (@Chunks) {

    print "Running incremental tests\n";
    cmpthese($Iterations, \%IncrTests);
}
Something went wrong with that request. Please try again.