qpdf_test_helpers.pm
4.77 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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
use File::Spec;
my $dev_null = File::Spec->devnull();
my $compare_images = 0;
if ((exists $ENV{'QPDF_TEST_COMPARE_IMAGES'}) &&
($ENV{'QPDF_TEST_COMPARE_IMAGES'} eq '1'))
{
$compare_images = 1;
}
chomp(my $gs_version = `gs --version`);
my $x_gs_args = "";
if ($gs_version =~ m/^(\d+).(\d+)/)
{
my $major = $1;
my $minor = $2;
if (($major == 9) && ($minor >= 56))
{
# There are some PDF files in the test suite that ghostscript
# 9.56, the first version to have the "new" PDF interpreter,
# can't handle. The bug is fixed for 10.0.0. Fall back to the
# old interpreter in the meantime. See
# https://bugs.ghostscript.com/show_bug.cgi?id=705842
$x_gs_args = "-dNEWPDF=false";
}
}
sub calc_ntests
{
my ($n_tests, $n_compare_pdfs) = @_;
my $result = $n_tests;
if ($compare_images)
{
$result += 3 * ($n_compare_pdfs);
}
$result;
}
sub check_pdf
{
my ($td, $description, $command, $output, $status) = @_;
unlink "a.pdf";
$td->runtest($description,
{$td->COMMAND => "$command a.pdf"},
{$td->STRING => "",
$td->EXIT_STATUS => $status});
$td->runtest("check output",
{$td->COMMAND => "qpdf-test-compare a.pdf $output"},
{$td->FILE => $output, $td->EXIT_STATUS => 0});
}
sub flush_tiff_cache
{
system("rm -rf tiff-cache");
}
sub compare_pdfs
{
return unless $compare_images;
# Each call to compare_pdfs generates three tests. This is known
# in calc_ntests.
my ($td, $f1, $f2, $exp) = @_;
$exp = 0 unless defined $exp;
system("rm -rf tif1 tif2");
mkdir "tiff-cache", 0777 unless -d "tiff-cache";
my $md5_1 = get_md5_checksum($f1);
my $md5_2 = get_md5_checksum($f2);
mkdir "tif1", 0777 or die;
mkdir "tif2", 0777 or die;
if (-f "tiff-cache/$md5_1.tif")
{
$td->runtest("get cached original file image",
{$td->COMMAND => "cp tiff-cache/$md5_1.tif tif1/a.tif"},
{$td->STRING => "",
$td->EXIT_STATUS => 0});
}
else
{
# We discard gs's stderr since it has sometimes been known to
# complain about files that are not bad. In particular, gs
# 9.04 can't handle empty xref sections such as those found in
# the hybrid xref cases. We don't really care whether gs
# complains or not as long as it creates correct images. If
# it doesn't create correct images, the test will fail, and we
# can run manually to see the error message. If it does, then
# we don't care about the warning.
$td->runtest("convert original file to image",
{$td->COMMAND =>
"(cd tif1;" .
" gs 2>$dev_null $x_gs_args" .
" -q -dNOPAUSE -sDEVICE=tiff24nc" .
" -sOutputFile=a.tif - < ../$f1)"},
{$td->STRING => "",
$td->EXIT_STATUS => 0});
copy("tif1/a.tif", "tiff-cache/$md5_1.tif");
}
if (-f "tiff-cache/$md5_2.tif")
{
$td->runtest("get cached new file image",
{$td->COMMAND => "cp tiff-cache/$md5_2.tif tif2/a.tif"},
{$td->STRING => "",
$td->EXIT_STATUS => 0});
}
else
{
$td->runtest("convert new file to image",
{$td->COMMAND =>
"(cd tif2;" .
" gs 2>$dev_null $x_gs_args" .
" -q -dNOPAUSE -sDEVICE=tiff24nc" .
" -sOutputFile=a.tif - < ../$f2)"},
{$td->STRING => "",
$td->EXIT_STATUS => 0});
copy("tif2/a.tif", "tiff-cache/$md5_2.tif");
}
$td->runtest("compare images",
{$td->COMMAND => "tiffcmp -t tif1/a.tif tif2/a.tif"},
{$td->REGEXP => ".*",
$td->EXIT_STATUS => $exp});
system("rm -rf tif1 tif2");
}
sub check_metadata
{
my ($td, $file, $exp_encrypted, $exp_cleartext) = @_;
my $out = "encrypted=$exp_encrypted; cleartext=$exp_cleartext\n" .
"test 6 done\n";
$td->runtest("check metadata: $file",
{$td->COMMAND => "test_driver 6 $file"},
{$td->STRING => $out, $td->EXIT_STATUS => 0},
$td->NORMALIZE_NEWLINES);
}
sub get_md5_checksum
{
my $file = shift;
open(F, "<$file") or fatal("can't open $file: $!");
binmode F;
my $digest = Digest::MD5->new->addfile(*F)->hexdigest;
close(F);
$digest;
}
sub cleanup
{
system("rm -rf ?.json *.ps *.pnm ?.pdf ?.qdf *.enc* tif1 tif2 tiff-cache");
system("rm -rf *split-out* ???-kfo.pdf *.tmpout \@file.pdf auto-*");
}
1;