t/t102png.t

   1 #!perl -w
   2 use strict;
   3 # Before `make install' is performed this script should be runnable with
   4 # `make test'. After `make install' it should work as `perl test.pl'
   5
   6 ######################### We start with some black magic to print on failure.
   7
   8 # Change 1..1 below to 1..last_test_to_print .
   9 # (It may become useful if the test is moved to ./t subdirectory.)
  10 use lib qw(blib/lib blib/arch);
  11
  12 BEGIN { $| = 1; print "1..13\n"; }
  13 BEGIN { require 't/testtools.pl'; }
  14 BEGIN { useokx('Imager', 'load Imager', ':all') }
  15 init_log("testout/t102png.log",1);
  16
  17 i_has_format("png") && print "# has png\n";
  18
  19 my $green  = i_color_new(0,   255, 0,   255);
  20 my $blue   = i_color_new(0,   0,   255, 255);
  21 my $red    = i_color_new(255, 0,   0,   255);
  22
  23 my $img    = Imager::ImgRaw::new(150, 150, 3);
  24
  25 i_box_filled($img, 70, 25, 130, 125, $green);
  26 i_box_filled($img, 20, 25, 80,  125, $blue);
  27 i_arc($img, 75, 75, 30, 0, 361, $red);
  28 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
  29
  30 my $timg = Imager::ImgRaw::new(20, 20, 4);
  31 my $trans = i_color_new(255, 0, 0, 127);
  32 i_box_filled($timg, 0, 0, 20, 20, $green);
  33 i_box_filled($timg, 2, 2, 18, 18, $trans);
  34
  35 if (!i_has_format("png")) {
  36   skipx(12, "no png support");
  37 } else {
  38   Imager::i_tags_add($img, "i_xres", 0, "300", 0);
  39   Imager::i_tags_add($img, "i_yres", 0, undef, 200);
  40   # the following confuses the GIMP
  41   #Imager::i_tags_add($img, "i_aspect_only", 0, undef, 1);
  42   open(FH,">testout/t102.png") || die "cannot open testout/t102.png for writing\n";
  43   binmode(FH);
  44   my $IO = Imager::io_new_fd(fileno(FH));
  45   okx(i_writepng_wiol($img, $IO), "write");
  46   close(FH);
  47
  48   open(FH,"testout/t102.png") || die "cannot open testout/t102.png\n";
  49   binmode(FH);
  50   $IO = Imager::io_new_fd(fileno(FH));
  51   my $cmpimg = i_readpng_wiol($IO, -1);
  52   close(FH);
  53   okx($cmpimg, "read png");
  54
  55   print "# png average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
  56   isx(i_img_diff($img, $cmpimg), 0, "compare saved and original images");
  57
  58   my %tags = map { Imager::i_tags_get($cmpimg, $_) }
  59     0..Imager::i_tags_count($cmpimg) - 1;
  60   okx(abs($tags{i_xres} - 300) < 1, "i_xres: $tags{i_xres}");
  61   okx(abs($tags{i_yres} - 200) < 1, "i_yres: $tags{i_yres}");
  62   isx($tags{i_format}, "png", "i_format: $tags{i_format}");
  63
  64   open FH, "> testout/t102_trans.png"
  65     or die "Cannot open testout/t102_trans.png: $!";
  66   binmode FH;
  67   $IO = Imager::io_new_fd(fileno(FH));
  68   okx(i_writepng_wiol($timg, $IO), "write tranparent");
  69   close FH;
  70
  71   open FH,"testout/t102_trans.png"
  72     or die "cannot open testout/t102_trans.png\n";
  73   binmode(FH);
  74   $IO = Imager::io_new_fd(fileno(FH));
  75   $cmpimg = i_readpng_wiol($IO, -1);
  76   okx($cmpimg, "read transparent");
  77   close(FH);
  78
  79   print "# png average mean square pixel difference: ",sqrt(i_img_diff($timg,$cmpimg))/150*150,"\n";
  80   isx(i_img_diff($timg, $cmpimg), 0, "compare saved and original transparent");
  81
  82   # REGRESSION TEST
  83   # png.c 1.1 would produce an incorrect image when loading images with
  84   # less than 8 bits/pixel with a transparent palette entry
  85   open FH, "< testimg/palette.png"
  86     or die "cannot open testimg/palette.png: $!\n";
  87   binmode FH;
  88   $IO = Imager::io_new_fd(fileno(FH));
  89   # 1.1 may segfault here (it does with libefence)
  90   my $pimg = i_readpng_wiol($IO,-1);
  91   okx($pimg, "read transparent paletted image");
  92   close FH;
  93
  94   open FH, "< testimg/palette_out.png"
  95     or die "cannot open testimg/palette_out.png: $!\n";
  96   binmode FH;
  97   $IO = Imager::io_new_fd(fileno(FH));
  98   my $poimg = i_readpng_wiol($IO, -1);
  99   okx($poimg, "read palette_out image");
 100   close FH;
 101   if (!isx(i_img_diff($pimg, $poimg), 0, "images the same")) {
 102     print <<EOS;
 103 # this tests a bug in Imager's png.c v1.1
 104 # if also tickles a bug in libpng before 1.0.5, so you may need to
 105 # upgrade libpng
 106 EOS
 107   }
 108 }