t/t07iolayer.t

   1 #!perl -w
   2 use strict;
   3 use Test::More tests => 20;
   4
   5 BEGIN { use_ok(Imager => ':all') };
   6
   7 init_log("testout/t07iolayer.log", 1);
   8
   9 undef($/);
  10 # start by testing io buffer
  11
  12 my $data="P2\n2 2\n255\n 255 0\n0 255\n";
  13 my $IO = Imager::io_new_buffer($data);
  14 my $im = Imager::i_readpnm_wiol($IO, -1);
  15
  16 ok($im, "read from data io");
  17
  18 open(FH, ">testout/t07.ppm") or die $!;
  19 binmode(FH);
  20 my $fd = fileno(FH);
  21 my $IO2 = Imager::io_new_fd( $fd );
  22 Imager::i_writeppm_wiol($im, $IO2);
  23 close(FH);
  24 undef($im);
  25
  26 open(FH, "<testimg/penguin-base.ppm");
  27 binmode(FH);
  28 $data = <FH>;
  29 close(FH);
  30 my $IO3 = Imager::io_new_buffer($data);
  31 #undef($data);
  32 $im = Imager::i_readpnm_wiol($IO3, -1);
  33
  34 ok($im, "read from buffer, for compare");
  35 undef $IO3;
  36
  37 open(FH, "<testimg/penguin-base.ppm") or die $!;
  38 binmode(FH);
  39 $fd = fileno(FH);
  40 my $IO4 = Imager::io_new_fd( $fd );
  41 my $im2 = Imager::i_readpnm_wiol($IO4, -1);
  42 close(FH);
  43 undef($IO4);
  44
  45 ok($im2, "read from file, for compare");
  46
  47 is(i_img_diff($im, $im2), 0, "compare images");
  48 undef($im2);
  49
  50 my $IO5 = Imager::io_new_bufchain();
  51 Imager::i_writeppm_wiol($im, $IO5);
  52 my $data2 = Imager::io_slurp($IO5);
  53 undef($IO5);
  54
  55 ok($data2, "check we got data from bufchain");
  56
  57 my $IO6 = Imager::io_new_buffer($data2);
  58 my $im3 = Imager::i_readpnm_wiol($IO6, -1);
  59
  60 is(Imager::i_img_diff($im, $im3), 0, "read from buffer");
  61
  62 my $work = $data;
  63 my $pos = 0;
  64 sub io_reader {
  65   my ($size, $maxread) = @_;
  66   my $out = substr($work, $pos, $maxread);
  67   $pos += length $out;
  68   $out;
  69 }
  70 sub io_reader2 {
  71   my ($size, $maxread) = @_;
  72   my $out = substr($work, $pos, $maxread);
  73   $pos += length $out;
  74   $out;
  75 }
  76 my $IO7 = Imager::io_new_cb(undef, \&io_reader, undef, undef);
  77 ok($IO7, "making readcb object");
  78 my $im4 = Imager::i_readpnm_wiol($IO7, -1);
  79 ok($im4, "read from cb");
  80 ok(Imager::i_img_diff($im, $im4) == 0, "read from cb image match");
  81
  82 $pos = 0;
  83 $IO7 = Imager::io_new_cb(undef, \&io_reader2, undef, undef);
  84 ok($IO7, "making short readcb object");
  85 my $im5 = Imager::i_readpnm_wiol($IO7, -1);
  86 ok($im4, "read from cb2");
  87 is(Imager::i_img_diff($im, $im5), 0, "read from cb2 image match");
  88
  89 sub io_writer {
  90   my ($what) = @_;
  91   substr($work, $pos, $pos+length $what) = $what;
  92   $pos += length $what;
  93
  94   1;
  95 }
  96
  97 my $did_close;
  98 sub io_close {
  99   ++$did_close;
 100 }
 101
 102 my $IO8 = Imager::io_new_cb(\&io_writer, undef, undef, \&io_close);
 103 ok($IO8, "making writecb object");
 104 $pos = 0;
 105 $work = '';
 106 ok(Imager::i_writeppm_wiol($im, $IO8), "write to cb");
 107 # I originally compared this to $data, but that doesn't include the
 108 # Imager header
 109 ok($work eq $data2, "write image match");
 110 ok($did_close, "did close");
 111
 112 # with a short buffer, no closer
 113 my $IO9 = Imager::io_new_cb(\&io_writer, undef, undef, undef, 1);
 114 ok($IO9, "making short writecb object");
 115 $pos = 0;
 116 $work = '';
 117 ok(Imager::i_writeppm_wiol($im, $IO9), "write to short cb");
 118 ok($work eq $data2, "short write image match");
 119