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