t/10-obj.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 24;
   7
   8 use Regexp::Wildcards;
   9
  10 my $rw = Regexp::Wildcards->new;
  11 ok(defined $rw, 'RW object is defined');
  12 is(ref $rw, 'Regexp::Wildcards', 'RW object is valid');
  13
  14 my $rw2 = $rw->new;
  15 ok(defined $rw2, 'RW::new called as an object method works' );
  16 is(ref $rw2, 'Regexp::Wildcards', 'RW::new called as an object method works is valid');
  17
  18 $rw2 = Regexp::Wildcards::new();
  19 ok(defined $rw2, 'RW::new called without a class works');
  20 is(ref $rw2, 'Regexp::Wildcards', 'RW::new called without a class is valid');
  21
  22 eval { $rw2 = Regexp::Wildcards->new(qw/a b c/) };
  23 like($@, qr/Optional\s+arguments/, 'RW::new gets parameters as key => value pairs');
  24
  25 my $fake = { };
  26 bless $fake, 'Regexp::Wildcards::Hlagh';
  27 for (qw/do capture type convert/) {
  28  eval "Regexp::Wildcards::$_('Regexp::Wildcards')";
  29  like($@, qr/^First\s+argument/, "RW::$_ isn't a class method");
  30  eval "Regexp::Wildcards::$_(\$fake)";
  31  like($@, qr/^First\s+argument/, "RW::$_ only applies to RW objects");
  32 }
  33
  34 for (qw/do capture/) {
  35  eval { $rw->$_(sub { 'dongs' }) };
  36  like($@, qr/Wrong\s+option\s+set/, "RW::$_ don't want code references");
  37
  38  eval { $rw->$_(\*STDERR) };
  39  like($@, qr/Wrong\s+option\s+set/, "RW::$_ don't want globs");
  40
  41  eval { $rw->$_(qw/a b c/) };
  42  like($@, qr/Arguments\s+must\s+be\s+passed.*unique\s+scalar.*key\s+=>\s+value\s+pairs/, "RW::$_ gets parameters after the first as key => value pairs");
  43 }
  44
  45 eval { $rw->type('monkey!') };
  46 like($@, qr/Wrong\s+type/, 'RW::type wants a type it knows');
  47
  48 eval { $rw->convert(undef, 'again monkey!') };
  49 like($@, qr/Wrong\s+type/, 'RW::convert wants a type it knows');
  50
  51 for (qw/convert/) {
  52  ok(!defined $rw->$_(undef), "RW::$_ returns undef when passed undef");
  53 }