mirror of
https://github.com/qpdf/qpdf.git
synced 2024-11-02 11:46:35 +00:00
40ecba4172
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.
74 lines
1.8 KiB
Perl
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);
|
|
}
|