]> git.imager.perl.org - imager.git/commitdiff
added tests to make sure the correct palette was coming back from
authorTony Cook <tony@develop=help.com>
Sat, 5 May 2001 14:42:45 +0000 (14:42 +0000)
committerTony Cook <tony@develop=help.com>
Sat, 5 May 2001 14:42:45 +0000 (14:42 +0000)
Imager::read

t/t70newgif.t

index ee051bfac9510ece1e97567cd56678cce9f4f72d..5fe1d0c250b2abcc541e60eb17d02a341dac94ba 100644 (file)
@@ -7,7 +7,7 @@
 # (It may become useful if the test is moved to ./t subdirectory.)
 
 
-BEGIN { $| = 1; print "1..3\n"; }
+BEGIN { $| = 1; print "1..8\n"; }
 END {print "not ok 1\n" unless $loaded;}
 
 use Imager;
@@ -28,13 +28,52 @@ print "ok 2\n";
 $img->write(file=>'testout/t70newgif.gif',type=>'gif',gifplanes=>1,gifquant=>'lm',lmfixed=>[$green,$blue]) || print "failed: ",$img->{ERRSTR},"\n";
 print "ok 3\n";
 
-
-
-
-
-
-
-
-
-
-
+# make sure the palette is loaded properly (minimal test)
+my $im2 = Imager->new();
+my $map;
+if ($im2->read(file=>'testimg/bandw.gif', colors=>\$map)) {
+  print "ok 4\n";
+  # check the palette
+  if ($map) {
+    print "ok 5\n";
+    if (@$map == 2) {
+      print "ok 6\n";
+      my @sorted = sort { comp_entry($a,$b) } @$map;
+      # first entry must be #000000 and second #FFFFFF
+      if (comp_entry($sorted[0], [0,0,0]) == 0) {
+       print "ok 7\n";
+      }
+      else {
+       print "not ok 7 # entry should be black\n";
+      }
+      if (comp_entry($sorted[1], [255,255,255]) == 0) {
+       print "ok 8\n";
+      }
+      else {
+       print "not ok 8 # entry should be white\n";
+      }
+    }
+    else {
+      print "not ok 6 # bad map size\n";
+      print "ok 7 # skipped bad map size\n";
+      print "ok 8 # skipped bad map size\n";
+    }
+  }
+  else {
+    print "not ok 5 # no map returned\n";
+    for (6..8) {
+      print "ok $_ # skipped no map returned\n";
+    }
+  }
+}
+else {
+  print "not ok 4 # ",$im2->errstr,"\n";
+  print "ok 5 # skipped - couldn't load image\n";
+}
+
+sub comp_entry {
+  my ($l, $r) = @_;
+  return $l->[0] <=> $r->[0]
+    || $l->[1] <=> $r->[1]
+      || $l->[2] <=> $r->[2];
+}