t/002-init.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 9;
   4
   5 my $i = 0;
   6 sub new_singleton_pkg {
   7   my $pkg_name = sprintf 'MooseX::Singleton::Test%s', $i++;
   8   eval qq{
   9     package $pkg_name;
  10     use MooseX::Singleton;
  11     has number => (is => 'rw', isa => 'Num', required => 1);
  12     has string => (is => 'rw', isa => 'Str', default  => 'Hello!');
  13   };
  14
  15   return $pkg_name;
  16 }
  17
  18 eval { new_singleton_pkg()->instance; };
  19 like(
  20   $@,
  21   qr/\QAttribute (number) is required/,
  22   q{can't get the Singleton if requires attrs and we don't provide them},
  23 );
  24
  25 eval { new_singleton_pkg()->string; };
  26 like(
  27   $@,
  28   qr/\QAttribute (number) is required/,
  29   q{can't call any Singleton attr reader if Singleton can't be inited},
  30 );
  31
  32 for my $pkg (new_singleton_pkg) {
  33   my $mst = $pkg->new(number => 5);
  34   isa_ok($mst, $pkg);
  35
  36   is($mst->number, 5, "the instance has the given attribute value");
  37
  38   is(
  39     $pkg->number,
  40     5,
  41     "the class method, called directly, returns the given attribute value"
  42   );
  43
  44   eval { $pkg->new(number => 3) };
  45   like($@, qr/already/, "can't make new singleton with conflicting attributes");
  46
  47   my $second = eval { $pkg->new };
  48   ok(!$@, "...but a second ->new without args is okay");
  49
  50   is($second->number, 5, "...we get the originally inited number from it");
  51
  52   eval { $pkg->initialize };
  53   like($@, qr/already/, "...but ->initialize() is still an error");
  54 }
  55