switch to Test::More in a few more test scripts, eliminate the

testtools okx/okn variants

diff --git a/t/t36oofont.t b/t/t36oofont.t
index 6d374c93dc8447fdd610721b58a117b36e5db265..e24d0c9de1eac9d78ce178b9af65eb67f04df1f5 100644 (file)
--- a/t/t36oofont.t
+++ b/t/t36oofont.t
@@ -10,14 +10,10 @@ use strict;
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
+use lib 't';
+use Test::More tests => 20;
 
-my $loaded;
-BEGIN { $| = 1; print "1..20\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Imager;
-BEGIN { require "t/testtools.pl"; }
-$loaded=1;
-okx(1, "loaded");
+BEGIN { use_ok('Imager') };
 
 init_log("testout/t36oofont.log", 1);
 
@@ -30,66 +26,70 @@ die $Imager::ERRSTR unless $green;
 my $red=Imager::Color->new(205, 92, 92, 255);
 die $Imager::ERRSTR unless $red;
 
-if (i_has_format("t1") and -f $fontname_pfb) {
+SKIP:
+{
+  i_has_format("t1") && -f $fontname_pfb
+    or skip("T1lib missing or disabled", 8);
 
   my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
 
   my $font=Imager::Font->new(file=>$fontname_pfb,size=>25)
     or die $img->{ERRSTR};
 
-  okx(1, "created font");
+  ok(1, "created font");
 
-  okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
+  ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
       "draw text");
   $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
 
   my $text="LLySja";
   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
 
-  isx(@bbox, 8, "bounding box list length");
+  is(@bbox, 8, "bounding box list length");
 
   $img->box(box=>\@bbox, color=>$green);
 
   # "utf8" support
   $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
-  okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
+  ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
                    overline=>1),
       "draw 'utf8' hand-encoded text");
 
-  okx($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1, 
+  ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1, 
                    underline=>1, channel=>2),
       "channel 'utf8' hand-encoded text");
 
-  if($] >= 5.006) {
+ SKIP:
+  {
+    $] >= 5.006
+      or skip("perl too old for native utf8", 2);
     eval q{$text = "A\x{2010}A"};
-    okx($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
+    ok($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
                     strikethrough=>1),
        "draw native UTF8 text");
-    okx($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
+    ok($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
        "channel native UTF8 text");
   }
-  else {
-    skipx(2, "perl too old for native utf8");
-  }
 
-  okx($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
+  ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
       "write t36oofont1.ppm")
     or print "# ",$img->errstr,"\n";
 
-} else {
-  skipx(8, "T1lib missing or disabled");
 }
 
-if (i_has_format("tt") and -f $fontname_tt) {
+SKIP:
+{
+  i_has_format("tt") && -f $fontname_tt
+    or skip("FT1.x missing or disabled", 10);
 
   my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
 
   my $font=Imager::Font->new(file=>$fontname_tt,size=>25)
     or die $img->{ERRSTR};
 
-  okx(1, "create TT font object");
+  ok(1, "create TT font object");
 
-  okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
+  ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
       "draw text");
 
   $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
@@ -97,36 +97,34 @@ if (i_has_format("tt") and -f $fontname_tt) {
   my $text="LLySja";
   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
 
-  isx(@bbox, 8, "bbox list size");
+  is(@bbox, 8, "bbox list size");
 
   $img->box(box=>\@bbox, color=>$green);
 
   $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
-  okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
+  ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
       "draw hand-encoded UTF8 text");
 
-  if($] >= 5.006) {
+ SKIP:
+  {
+    $] >= 5.006
+      or skip("perl too old for native utf8", 1);
     eval q{$text = "A\x{2010}A"};
-    okx($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
+    ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
        "draw native UTF8 text");
   }
-  else {
-    skipx(1, "perl too old for native utf8");
-  }
 
-  okx($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
+  ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
       "write t36oofont2.ppm")
     or print "# ", $img->errstr,"\n";
 
-  okx($font->utf8, "make sure utf8 method returns true");
+  ok($font->utf8, "make sure utf8 method returns true");
 
   my $has_chars = $font->has_chars(string=>"\x01A");
-  okx($has_chars eq "\x00\x01", "has_chars scalar");
+  ok($has_chars eq "\x00\x01", "has_chars scalar");
   my @has_chars = $font->has_chars(string=>"\x01A");
-  okx(!$has_chars[0], "has_chars list 0");
-  okx($has_chars[1], "has_chars list 1");
-} else {
-  skipx(10, "FT1.x missing or disabled");
+  ok(!$has_chars[0], "has_chars list 0");
+  ok($has_chars[1], "has_chars list 1");
 }
 
-okx(1, "end");
+ok(1, "end");

diff --git a/t/t58trans2.t b/t/t58trans2.t
index 5b29e6a02c37273875f43997eb79894f118a5ea9..3c29d41b9ccb888c97c76086dd50d2961b542570 100644 (file)
--- a/t/t58trans2.t
+++ b/t/t58trans2.t
@@ -1,16 +1,7 @@
 #!perl -w
-BEGIN { $| = 1; print "1..16\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Imager;
-
-sub ok($$);
-sub is($$$);
-my $num = 1;
-
-$loaded = 1;
-ok(1, "loaded");
-
-#$Imager::DEBUG=1;
+use strict;
+use Test::More tests => 16;
+BEGIN { use_ok('Imager'); }
 
 Imager::init('log'=>'testout/t58trans2.log');
 
@@ -104,32 +95,3 @@ my $im7 = Imager::transform2({rpnexpr=>'x y getp2', width=>100, height=>100});
 ok(!$im7, "expected failure on accessing invalid image");
 print "# ", Imager->errstr, "\n";
 ok(Imager->errstr =~ /not enough images/, "didn't get expected error");
-
-
-sub ok ($$) {
-  my ($test, $desc) = @_;
-
-  if ($test) {
-    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;
-}

diff --git a/t/t80texttools.t b/t/t80texttools.t
index 8483b5edeb33a6a92844582e0b6e3c2994161caa..ae37b98b417a1fc44adfd2eab1e17e111dbc6a05 100644 (file)
--- a/t/t80texttools.t
+++ b/t/t80texttools.t
@@ -1,16 +1,10 @@
+#!perl -w
 use strict;
-my $loaded;
-BEGIN { 
-  require "t/testtools.pl";
-  $| = 1; print "1..11\n"; 
-}
-END { okx(0, "loading") unless $loaded; }
-use Imager;
-$loaded = 1;
+use Test::More tests => 11;
 
-okx(1, "Loaded");
+BEGIN { use_ok('Imager') }
 
-requireokx("Imager/Font/Wrap.pm", "load basic wrapping");
+require_ok('Imager::Font::Wrap');
 
 my $img = Imager->new(xsize=>400, ysize=>400);
 
@@ -40,14 +34,16 @@ my $fontfile = $ENV{WRAPTESTFONT} || $ENV{TTFONTTEST} || "fontfiles/ImUgly.ttf";
 
 my $font = Imager::Font->new(file=>$fontfile);
 
-unless (Imager::i_has_format('tt') || Imager::i_has_format('ft2')) {
-  skipx(9, "Need Freetype 1.x or 2.x to test");
-  exit;
-}
+SKIP:
+{
+  Imager::i_has_format('tt') || Imager::i_has_format('ft2')
+      or skip("Need Freetype 1.x or 2.x to test", 9);
+
+  ok($font, "loading font")
+    or skip("Could not load test font", 8);
 
-if (okx($font, "loading font")) {
   Imager::Font->priorities(qw(t1 ft2 tt));
-  okx(scalar Imager::Font::Wrap->wrap_text(string => $text,
+  ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
                                 font=>$font,
                                 image=>$img,
                                 size=>13,
@@ -56,8 +52,8 @@ if (okx($font, "loading font")) {
                                 justify=>'fill',
                                 color=>'FFFFFF'),
       "basic test");
-  okx($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
-  okx(scalar Imager::Font::Wrap->wrap_text(string => $text,
+  ok($img->write(file=>'testout/t80wrapped.ppm'), "save to file");
+  ok(scalar Imager::Font::Wrap->wrap_text(string => $text,
                                 font=>$font,
                                 image=>undef,
                                 size=>13,
@@ -67,22 +63,19 @@ if (okx($font, "loading font")) {
                                 color=>'FFFFFF'),
       "no image test");
   my $bbox = $font->bounding_box(string=>"Xx", size=>13);
-  okx($bbox, "get height for check");
+  ok($bbox, "get height for check");
 
   my $used;
-  okx(scalar Imager::Font::Wrap->wrap_text
+  ok(scalar Imager::Font::Wrap->wrap_text
       (string=>$text, font=>$font, image=>undef, size=>13, width=>380,
        savepos=> \$used, height => $bbox->font_height), "savepos call");
-  okx($used > 20 && $used < length($text), "savepos value");
+  ok($used > 20 && $used < length($text), "savepos value");
   print "# $used\n";
   my @box = Imager::Font::Wrap->wrap_text
     (string=>substr($text, 0, $used), font=>$font, image=>undef, size=>13,
      width=>380);
 
-  okx(@box == 4, "bounds list count");
+  ok(@box == 4, "bounds list count");
   print "# @box\n";
-  okx($box[3] == $bbox->font_height, "check height");
-}
-else {
-  skipx(8, "Could not load test font");
+  ok($box[3] == $bbox->font_height, "check height");
 }

diff --git a/t/testtools.pl b/t/testtools.pl
index 094a42e85944286580f9ce2deb67b64f76d5d556..a7a79cefef5ee3f13971cb616e4241d35ede8556 100644 (file)
--- a/t/testtools.pl
+++ b/t/testtools.pl
@@ -29,134 +29,6 @@ sub test_oo_img {
   $img;
 }
 
-sub skipn {
-  my ($testnum, $count, $why) = @_;
-  
-  $why = '' unless defined $why;
-
-  print "ok $_ # skip $why\n" for $testnum ... $testnum+$count-1;
-}
-
-sub skipx {
-  my ($count, $why) = @_;
-
-  skipn($TESTNUM, $count, $why);
-  $TESTNUM += $count;
-}
-
-sub okx ($$) {
-  my ($ok, $comment) = @_;
-
-  return okn($TESTNUM++, $ok, $comment);
-}
-
-sub okn ($$$) {
-  my ($num, $ok, $comment) = @_;
-
-  defined $num or confess "No \$num supplied";
-  defined $comment or confess "No \$comment supplied";
-  if ($ok) {
-    print "ok $num # $comment\n";
-  }
-  else {
-    print "not ok $num # $comment\n";
-  }
-
-  return $ok;
-}
-
-sub requireokx {
-  my ($file, $comment) = @_;
-
-  eval {
-    require $file;
-  };
-  if ($@) {
-    my $msg = $@;
-    $msg =~ s/\n+$//;
-    $msg =~ s/\n/\n# /g;
-    okx(0, $comment);
-    print "# $msg\n";
-  }
-  else {
-    okx(1, $comment);
-  }
-}
-
-sub useokx {
-  my ($module, $comment, @imports) = @_;
-  
-  my $pack = caller;
-  eval <<EOS;
-package $pack;
-require $module;
-$module->import(\@imports);
-EOS
-  unless (okx(!$@, $comment)) {
-    my $msg = $@;
-    $msg =~ s/\n+$//;
-    $msg =~ s/\n/\n# /g;
-    print "# $msg\n";
-    return 0;
-  }
-  else {
-    return 1;
-  }
-}
-
-sub matchn($$$$) {
-  my ($num, $str, $re, $comment) = @_;
-
-  my $match = defined($str) && $str =~ $re;
-  okn($num, $match, $comment);
-  unless ($match) {
-    print "# The value: ",_sv_str($str),"\n";
-    print "# did not match: qr/$re/\n";
-  }
-  return $match;
-}
-
-sub matchx($$$) {
-  my ($str, $re, $comment) = @_;
-
-  matchn($TESTNUM++, $str, $re, $comment);
-}
-
-sub isn ($$$$) {
-  my ($num, $left, $right, $comment) = @_;
-
-  my $match;
-  if (!defined $left && defined $right
-     || defined $left && !defined $right) {
-    $match = 0;
-  }
-  elsif (!defined $left && !defined $right) {
-    $match = 1;
-  }
-  # the right of the || produces a string of \0 if $left is a PV
-  # which is true
-  elsif (!length $left  || ($left & ~$left) ||
-        !length $right || ($right & ~$right)) {
-    $match = $left eq $right;
-  }
-  else {
-    $match = $left == $right;
-  }
-  okn($num, $match, $comment);
-  unless ($match) {
-    print "# the following two values were not equal:\n";
-    print "# value: ",_sv_str($left),"\n";
-    print "# other: ",_sv_str($right),"\n";
-  }
-
-  $match;
-}
-
-sub isx ($$$) {
-  my ($left, $right, $comment) = @_;
-
-  isn($TESTNUM++, $left, $right, $comment);
-}
 
 sub _sv_str {
   my ($value) = @_;