- added comment support the postfix transform2() expression
[imager.git] / t / t58trans2.t
index bf92dba..163570d 100644 (file)
@@ -1,11 +1,14 @@
-BEGIN { $| = 1; print "1..12\n"; }
+#!perl -w
+BEGIN { $| = 1; print "1..15\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Imager;
 
-sub ok($$$);
+sub ok($$);
+sub is($$$);
+my $num = 1;
 
 $loaded = 1;
-print "ok 1\n";
+ok(1, "loaded");
 
 #$Imager::DEBUG=1;
 
@@ -21,14 +24,14 @@ $im2->open(file=>'testimg/scale.ppm',type=>'pnm')
 # error handling
 my $opts = { rpnexpr=>'x x 10 / sin 10 * y + get1' };
 my $im3 = Imager::transform2($opts);
-ok(2, !$im3, "returned an image on error");
-ok(3, defined($Imager::ERRSTR), "No error message on failure");
+ok(!$im3, "returned an image on error");
+ok(defined($Imager::ERRSTR), "No error message on failure");
 
 # image synthesis
 my $im4 = Imager::transform2({
        width=>300, height=>300,
        rpnexpr=>'x y cx cy distance !d y cy - x cx - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a2 cy * 3.1416 / 1 @a2 sin 1 + 2 / hsv'});
-ok(4, $im4, "synthesis failed");
+ok($im4, "synthesis failed");
 
 if ($im4) {
   $im4->write(type=>'pnm', file=>'testout/t56a.ppm')
@@ -39,7 +42,7 @@ if ($im4) {
 my $im5 = Imager::transform2({
        rpnexpr=>'x x 10 / sin 10 * y + getp1'
 }, $im1);
-ok(5, $im5, "image distortion");
+ok($im5, "image distortion");
 if ($im5) {
   $im5->write(type=>'pnm', file=>'testout/t56b.ppm')
     || die "Cannot write testout/t56b.ppm";
@@ -50,46 +53,76 @@ $opts = {
 rpnexpr=>'x h / !rat x w2 % y h2 % getp2 !pat x y getp1 @rat * @pat 1 @rat - * +'
 };
 my $im6 = Imager::transform2($opts,$im1,$im2);
-ok(6, $im6, "image combination");
+ok($im6, "image combination");
 if ($im6) {
   $im6->write(type=>'pnm', file=>'testout/t56c.ppm')
     || die "Cannot write testout/t56c.ppm";
 }
 
+# alpha
+$opts = 
+  {
+   rpnexpr => '0 0 255 x y + w h + 2 - / 255 * rgba',
+   channels => 4,
+   width => 50,
+   height => 50,
+  };
+my $im8 = Imager::transform2($opts);
+ok($im8, "alpha output");
+my $c = $im8->getpixel(x=>0, 'y'=>0);
+is(($c->rgba)[3], 0, "zero alpha");
+$c = $im8->getpixel(x=>49, 'y'=>49);
+is(($c->rgba)[3], 255, "max alpha");
+
 use Imager::Transform;
 
 # some simple tests
-my @funcs = Imager::Transform->list or print "not ";
-print "ok 7\n";
-my $tran = Imager::Transform->new($funcs[0]) or print "not ";
-print "ok 8\n";
-$tran->describe() eq Imager::Transform->describe($funcs[0]) or print "not ";
-print "ok 9\n";
+print "# Imager::Transform\n";
+my @funcs = Imager::Transform->list;
+ok(@funcs, "funcs");
+
+my $tran = Imager::Transform->new($funcs[0]);
+ok($tran, "got tranform");
+ok($tran->describe() eq Imager::Transform->describe($funcs[0]),
+   "description");
 # look for a function that takes inputs (at least one does)
 my @needsinputs = grep Imager::Transform->new($_)->inputs, @funcs;
 # make sure they're 
 my @inputs = Imager::Transform->new($needsinputs[0])->inputs;
-$inputs[0]{desc} or print "not ";
-print "ok 10\n";
+ok($inputs[0]{desc}, "input description");
 # at some point I might want to test the actual transformations
 
 # check lower level error handling
 my $im7 = Imager::transform2({rpnexpr=>'x y getp2', width=>100, height=>100});
-ok(11, !$im7, "expected failure on accessing invalid image");
+ok(!$im7, "expected failure on accessing invalid image");
 print "# ", Imager->errstr, "\n";
-ok(12, Imager->errstr =~ /not enough images/, "didn't get expected error");
-
+ok(Imager->errstr =~ /not enough images/, "didn't get expected error");
 
 
-sub ok ($$$) {
-  my ($num, $test, $desc) = @_;
+sub ok ($$) {
+  my ($test, $desc) = @_;
 
   if ($test) {
-    print "ok $num\n";
+    print "ok $num # $desc\n";
   }
   else {
     print "not ok $num # $desc\n";
   }
+  ++$num;
   $test;
 }
 
+sub is ($$$) {
+  my ($left, $right, $desc) = @_;
+
+  my $eq = $left == $right;
+  unless (ok($eq, $desc)) {
+    $left =~ s/\n/# \n/g;
+    $left =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
+    $right =~ s/\n/# \n/g;
+    $right =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge;
+    print "# not equal, left = '$left'\n";
+    print "# right = '$right'\n";
+  }
+  $eq;
+}