1# Before `make install' is performed this script should be runnable with
2# `make test'. After `make install' it should work as
3# `perl 13_writepnmfile.t'
4
5# WARNING: some of these tests are invalid if 10_makepnmheader.t has failed.
6
7#########################
8
9use Test::More tests => 11;
10BEGIN { use_ok('Image::PBMlib') };
11
12use strict;
13
14use vars qw( $val $set @pix %i $val $file $rc $usemd5 %md5 );
15
16%md5 = (
17  'testout-2x10r.ppm' => 'f23163fc655dd21b76f2a72aef461fb8',
18  'testout-3x3a.pgm'  => '9ebebf84cb6458ca9c10783d392cfb59',
19  'testout-3x3hr.pgm' => '16c119e2aaac99a1ea201798246c9978',
20  'testout-3x3r.pgm'  => 'e1464a8852add759f51dfb07f0e6cddd',
21  'testout-9x5r.pgm'  => '4b7de094763f0fe18c6163207f256b58',
22);
23
24eval 'use Digest::MD5;';
25if($@) {
26  $usemd5 = undef;
27} else {
28  $usemd5 = 1;
29}
30
31# does 1 tests
32sub checkfile {
33
34  SKIP: {
35    if(!open(WRITE, '>:raw', $file)) {
36      skip "Cannot open test out $file: $!", 2;
37    }
38    $rc = writepnmfile(\*WRITE, \%i, \@pix); close WRITE;
39
40    if(!defined($rc)) {
41      skip "write to $file failed: $!", 2;
42    }
43    close WRITE;
44
45    ok($rc == $val, "$set writepnmfile $file");
46
47  }
48}
49
50$set = '1-d array';
51
52@pix = ( '31/', '32/', '33/', '21/', '22/', '23/', '11/', '12/', '13/' );
53%i = ( type => 2, width => 3, height => 3, max => 128, comments => 'test 3x3 ascii graymap' );
54# three rows, three cols, 3 chars per number, plus final newline
55$val = length(makepnmheader(\%i)) + 3*3*3 +1;
56$file = 'testout-3x3a.pgm';
57checkfile();
58
59%i = ( type => 5, width => 3, height => 3, max => 128, comments => 'test 3x3 raw graymap' );
60# three rows, three cols, 1 byte per value
61$val = length(makepnmheader(\%i)) + 3*3;
62$file = 'testout-3x3r.pgm';
63checkfile();
64
65%i = ( type => 5, width => 3, height => 3, max => 999, comments => 'test 3x3 high raw graymap' );
66# three rows, three cols, 2 bytes per value
67$val = length(makepnmheader(\%i)) + 3*3*2;
68$file = 'testout-3x3hr.pgm';
69checkfile();
70
71$set = '2-d array';
72@pix = ( [ '31/', '32/', '33/', '21/', '22/', '23/', '11/', '12/', '13/' ],
73         [ '34/', '35/', '36/', '24/', '25/', '26/', '14/', '15/', '16/' ],
74	 [ '37/', '38/', '39/', '27/', '28/', '29/', '17/', '18/', '19/' ],
75	 [ '3A/', '3B/', '3C/', '2A/', '2B/', '2C/', '1A/', '1B/', '1C/' ],
76	 [ '3D/', '3E/', '3F/', '2D/', '2E/', '2F/', '1D/', '1E/', '1F/' ],
77);
78%i = ( type => 5, width => 9, height => 5, max => 255, comments => 'test 9x5 raw graymap' );
79# five rows, nine cols, 1 byte per value
80$val = length(makepnmheader(\%i)) + 5*9;
81$file = 'testout-9x5r.pgm';
82checkfile();
83
84$set = '3-d array';
85@pix = ( [ [ '99:', '98:', '97:' ], [ '96:', '95:', '94:' ], ],
86         [ [ '89:', '88:', '87:' ], [ '86:', '85:', '84:' ], ],
87         [ [ '79:', '78:', '77:' ], [ '76:', '75:', '74:' ], ],
88         [ [ '69:', '68:', '67:' ], [ '66:', '65:', '64:' ], ],
89         [ [ '59:', '58:', '57:' ], [ '56:', '55:', '54:' ], ],
90         [ [ '49:', '48:', '47:' ], [ '46:', '45:', '44:' ], ],
91         [ [ '39:', '38:', '37:' ], [ '36:', '35:', '34:' ], ],
92         [ [ '29:', '28:', '27:' ], [ '26:', '25:', '24:' ], ],
93         [ [ '19:', '18:', '17:' ], [ '16:', '15:', '14:' ], ],
94         [ [  '9:',  '8:',  '7:' ], [  '6:',  '5:',  '4:' ], ],
95       );
96%i = ( type => 6, width => 2, height => 10, max => 100, comments => 'test 2x10 raw pixmap' );
97# ten rows, two cols, 1 byte per value, 3 values per pixel
98$val = length(makepnmheader(\%i)) + 2*10*3;
99$file = 'testout-2x10r.ppm';
100checkfile();
101
102SKIP: {
103  if(!$usemd5) {
104    skip 'No MD5 available', 5;
105  }
106  for $file (keys %md5) {
107    my $ctx = Digest::MD5->new;
108
109    open(READ, '<:raw', $file);
110    $ctx->addfile(*READ);
111    my $digest = $ctx->hexdigest;
112    close READ;
113
114    ok($md5{$file} eq $digest, "$set MD5 $file");
115  }
116}
117
118END {
119  for $file (keys %md5) {
120    unlink $file;
121  }
122}
123