t/025-more-isa.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 30;
   5 use Mouse::Util ':test';
   6
   7 do {
   8     package Class;
   9     use Mouse;
  10
  11     has tb => (
  12         is  => 'rw',
  13         isa => 'Test::Builder',
  14     );
  15
  16     package Test::Builder::Subclass;
  17     our @ISA = qw(Test::Builder);
  18 };
  19
  20 can_ok(Class => 'tb');
  21
  22 lives_ok {
  23     Class->new(tb => Test::Builder->new);
  24 };
  25
  26 lives_ok {
  27     # Test::Builder was a bizarre choice, because it's a singleton.  Because of
  28     # that calling new on T:B:S won't work.  Blessing directly -- rjbs,
  29     # 2008-12-04
  30     Class->new(tb => (bless {} => 'Test::Builder::Subclass'));
  31 };
  32
  33 lives_ok {
  34     my $class = Class->new;
  35     $class->tb(Test::Builder->new);
  36     isa_ok($class->tb, 'Test::Builder');
  37 };
  38
  39 throws_ok {
  40     Class->new(tb => 3);
  41 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/;
  42
  43 throws_ok {
  44     my $class = Class->new;
  45     $class->tb(3);
  46 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value 3/;
  47
  48 throws_ok {
  49     Class->new(tb => Class->new);
  50 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' failed with value Class=HASH\(\w+\)/;
  51
  52 do {
  53     package Other;
  54     use Mouse;
  55
  56     has oops => (
  57         isa     => 'Int',
  58         default => "yikes",
  59     );
  60 };
  61
  62 throws_ok {
  63     Other->new;
  64 } qr/Attribute \(oops\) does not pass the type constraint because: Validation failed for 'Int' failed with value yikes/;
  65
  66 lives_ok {
  67     Other->new(oops => 10);
  68 };
  69
  70 # ClassName coverage tests
  71
  72 do {
  73     package A;
  74     our @VERSION;
  75
  76     package B;
  77     our $VERSION = 1;
  78
  79     package C;
  80     our %ISA;
  81
  82     package D;
  83     our @ISA = 'Mouse::Object';
  84
  85     package E;
  86     sub foo {}
  87
  88     package F;
  89
  90     package G::H;
  91     sub bar {}
  92
  93     package I;
  94     our $NOT_CODE = 1;
  95 };
  96
  97 do {
  98     package ClassNameTests;
  99     use Mouse;
 100
 101     has class => (
 102         is => 'rw',
 103         isa => 'ClassName',
 104     );
 105 };
 106
 107 for ('A'..'E', 'G::H') {
 108     lives_ok {
 109         ClassNameTests->new(class => $_);
 110     };
 111
 112     lives_ok {
 113         my $obj = ClassNameTests->new;
 114         $obj->class($_);
 115     };
 116 }
 117
 118 for ('F', 'G', 'I', 'Z') {
 119     throws_ok {
 120         ClassNameTests->new(class => $_);
 121     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
 122
 123     throws_ok {
 124             my $obj = ClassNameTests->new;
 125             $obj->class($_);
 126     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
 127 };
 128