2
1
mirror of https://github.com/qpdf/qpdf.git synced 2024-11-14 16:54:03 +00:00
qpdf/libtests/qtest/dct.test
Jay Berkenbilt 40ecba4172 Pl_DCT: Use custom source and destination managers (fixes #153)
Avoid calling jpeg_mem_src and jpeg_mem_dest. The custom destination
manager writes to the pipeline in smaller chunks to avoid having the
whole image in memory at once. The source manager works directly with
the Buffer object. Using customer managers avoids use of memory source
and destination managers, which are not present in older versions of
libjpeg still in use by some Linux distributions.
2017-09-07 22:59:11 -04:00

74 lines
1.8 KiB
Perl

#!/usr/bin/env perl
require 5.008;
use warnings;
use strict;
chdir("dct") or die "chdir testdir failed: $!\n";
require TestDriver;
# This test suite does light verification of DCT by running some data
# through a round trip with one encoding system. The
# examples/pdf-create program also exercises DCT but does so more
# fully.
my $td = new TestDriver('dct');
cleanup();
my $checked_data = 0;
foreach my $d (['rawdata', '400 256 gray', 0],
['big-rawdata', '1024 576 rgb', 0.2])
{
my ($in, $args, $mismatch_fraction) = @$d;
$td->runtest("compress",
{$td->COMMAND => "dct_compress $in a.jpg $args"},
{$td->STRING => "", $td->EXIT_STATUS => 0});
$td->runtest("decompress",
{$td->COMMAND => "dct_uncompress a.jpg out"},
{$td->STRING => "", $td->EXIT_STATUS => 0});
# Compare
my @raw = get_data($in);
my @processed = get_data('out');
my $bytes = scalar(@raw);
if ($td->runtest("bytes in data",
{$td->STRING => scalar(@processed)},
{$td->STRING => $bytes}))
{
++$checked_data;
my $mismatch = 0;
for (my $i = 0; $i < scalar(@raw); ++$i)
{
my $delta = abs(ord($raw[$i]) - ord($processed[$i]));
if ($delta > 10)
{
++$mismatch;
}
}
my $threshold = int($mismatch_fraction * $bytes);
$td->runtest("data is close enough",
{$td->STRING => $mismatch <= $threshold ? 'pass' : 'fail'},
{$td->STRING => 'pass'});
}
}
cleanup();
$td->report(6 + $checked_data);
sub cleanup
{
system("rm -f a.jpg out");
}
sub get_data
{
my $file = shift;
local $/ = undef;
open(F, "<$file") || die;
binmode(F);
my $data = <F>;
close(F);
split('', $data);
}