view release on metacpan or  search on metacpan

t/13_to.t  view on Meta::CPAN

{
   # XXX: need to update test when update shape properties.
   my $h = get_prop_names();
   # for my $k (sort keys %{$h}) { print "k='$k' v='@{$h->{$k}}'\n" }
   ref($h) eq 'HASH' or print "not ";
   ++$itest; print "ok $itest - valid props, hash ref\n";
   my @skey = sort keys %{$h};
   my $nskey = @skey;
   print STDERR "# properties: @skey\n";
   $nskey == 6 or print "not ";
   ++$itest; print "ok $itest - valid props, number should be $nskey\n";
   for my $k ('author',
              'authorcpanid',
              'description',
              'keywords',
              'nick',
              'source') {
      shift(@skey) eq $k or print "not ";
      ++$itest; print "ok $itest - valid props, '$k'\n";
   }
}

# -----------------------------------------------------------------------
# _get_properties() tests.

test_one_get_properties(
   'empty file',
   "",
   {}
);
test_one_get_properties(
   'simple file',
   "tang:autrijus\n",
   { 'tang' => 'autrijus' }
);
test_one_get_properties(
   'comment file',
   "  # comment\n \ttang \t :\t autrijus",
   { 'tang' => 'autrijus' }
);

test_one_get_properties(
   'extendo file',
   "wall:larry  \\\n \t not wall russ\n",
   { 'wall' => 'larry  not wall russ' }
);

test_one_get_properties(
   'two keys file',
   " wall:larry\\\nnot wall russ\n\tConway: The  Damian \t\n",
   { 'wall'   => 'larrynot wall russ',
     'Conway' => 'The  Damian' }
);

# -----------------------------------------------------------------------
# get_eye_properties() tests.

{
   my $tmpeyp = 'tmpeye.eyp';
   -f $tmpeyp and (unlink($tmpeyp) or die "error unlink '$tmpeyp': $!");
   my $h = Acme::EyeDrops::_get_eye_properties('.', 'tmpeye');
   defined($h) and print "not ";
   ++$itest; print "ok $itest - get_eye_properties, no props\n";
}

{
   # XXX: need to update test when update shape properties.
   my $h = get_eye_properties('camel');
   ref($h) eq 'HASH' or print "not ";
   ++$itest; print "ok $itest - get_eye_properties, camel 1\n";
   keys(%$h) == 2 or print "not ";
   ++$itest; print "ok $itest - get_eye_properties, camel 2\n";
   $h->{'keywords'} eq 'animal' or print "not ";
   ++$itest; print "ok $itest - get_eye_properties, camel 3\n";
}

# -----------------------------------------------------------------------
# find_eye_shapes() tests.

eval { find_eye_shapes() };
$@ or print "not ";
++$itest; print "ok $itest - find_eye_shapes, no params\n";

# XXX: need to update test when update shape properties.
test_one_find_eye_shapes(
   'one',
   [ 'flag' ],
   [ 'flag_canada' ]
);
# XXX: need to update test when update shape properties.
test_one_find_eye_shapes(
   'dup keyword',
   [ 'flag', 'flag' ],
   [ 'flag_canada' ]
);
# XXX: need to update test when update shape properties.
# This is the example from the doco that cog specifically asked for.
test_one_find_eye_shapes(
   'cog',
   [ 'face', 'person', 'perlhacker' ],
   [ 'acme',
     'adrianh',
     'autrijus',
     'damian',
     'dan',
     'eugene',
     'gelly',
     'larry',
     'larry2',
     'merlyn',
     'schwern2',
     'simon',
     'yanick' ]
);
# XXX: need to update test when update shape properties.
test_one_find_eye_shapes(
   'OR',
   [ 'flag OR sport' ],
   [ 'cricket',
     'flag_canada',

t/13_to.t  view on Meta::CPAN

   # Test some _get_eye_keywords...
   {
      my $h = Acme::EyeDrops::_get_eye_keywords('.');
      # for my $k (sort keys %{$h}) { print "k='$k' v='@{$h->{$k}}'\n" }
      ref($h) eq 'HASH' or print "not ";
      ++$itest; print "ok $itest - get_eye_keywords, hash ref\n";
      my @skey = sort keys %{$h};
      @skey == 6 or print "not ";
      ++$itest; print "ok $itest - get_eye_keywords, number\n";
      for my $k ('apple',
                 'big',
                 'cat',
                 'dog',
                 'orange',
                 'pink') {
         shift(@skey) eq $k or print "not ";
         ++$itest; print "ok $itest - get_eye_keywords, '$k'\n";
      }
   }

   unlink($tmpeye, $tmpeyp, $tmpeye2, $tmpeyp2, $tmpeye3, $tmpeyp3,
          $tmpeye4, $tmpeyp4, $tmpeye5, $tmpeyp5, $tmpeye6, $tmpeyp6,
          $tmpeye7);
}

{
   # XXX: need to update test when update shape properties.
   my $h = get_eye_keywords();
   # for my $k (sort keys %{$h}) { print "k='$k' v='@{$h->{$k}}'\n" }
   ref($h) eq 'HASH' or print "not ";
   ++$itest; print "ok $itest - get_eye_keywords, hash ref\n";
   my @skey = sort keys %{$h};
   @skey == 15 or print "not ";
   ++$itest; print "ok $itest - get_eye_keywords, number\n";
   for my $k ('animal',
              'debian',
              'face',
              'flag',
              'hbanner',
              'logo',
              'map',
              'object',
              'opera',
              'perlhacker',
              'person',
              'planet',
              'sport',
              'underwear',
              'vbanner') {
      shift(@skey) eq $k or print "not ";
      ++$itest; print "ok $itest - get_eye_keywords, '$k'\n";
   }
}

# -----------------------------------------------------------------------
# Old tests -- function set_eye_dir() has been removed.

# my $mypwd =  Cwd::cwd();
# my $mytesteyedir  =  "$mypwd/eyedir.tmp";
# my $mytesteyefile =  "$mytesteyedir/tmp.eye";
# -d $mytesteyedir or (mkdir($mytesteyedir, 0777) or die "error: mkdir '$mytesteyedir': $!");
# build_file($mytesteyefile, $mytestshapestr);

# set_eye_dir($mytesteyedir);
# get_eye_dir() eq $mytesteyedir or print "not ";
# ++$itest; print "ok $itest - set_eye_dir sane\n";
# my @eyes = get_eye_shapes();
# @eyes==1 or print "not ";
# ++$itest; print "ok $itest - set_eye_dir number\n";
# $eyes[0] eq 'tmp' or print "not ";
# ++$itest; print "ok $itest - set_eye_dir filename\n";
# test_one_shape('tmp', get_eye_string('tmp'));

# This is just a simple example of testing die inside EyeDrops.pm.
# eval { set_eye_dir($mytesteyefile) };
# $@ or print "not ";
# ++$itest; print "ok $itest - set_eye_dir eval die\n";
# $@ eq "error set_eye_dir '" . $mytesteyefile . "': no such directory\n"
#    or print "not ";
# ++$itest; print "ok $itest - set_eye_dir eval die string\n";

# -----------------------------------------------------------------------

# unlink($mytesteyefile) or die "error: unlink '$mytesteyefile': $!";
# rmdir($mytesteyedir) or die "error: rmdir '$mytesteyedir': $!";

# --------------------------------------------------

unlink($tmpf) or die "error: unlink '$tmpf': $!";

# ----------------------------------------------------------------
# Test for file that does not exist.

eval { Acme::EyeDrops::_get_properties($tmpf) };
$@ =~ /'\Q$tmpf\E':/ or print "not ";
++$itest; print "ok $itest - _get_properties, file not found\n";

eval { Acme::EyeDrops::_get_eye_shapes($tmpf) };
$@ =~ /'\Q$tmpf\E':/ or print "not ";
++$itest; print "ok $itest - _get_eye_shapes, dir not found\n";

# ----------------------------------------------------------------