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
|
#!/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);
}
|
