t/001_mouse/025-more-isa.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 34;
   5 use Test::Exception;
   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         is      => 'bare',
  58         isa     => 'Int',
  59         default => "yikes",
  60     );
  61 };
  62
  63 throws_ok {
  64     Other->new;
  65 } qr/Attribute \(oops\) does not pass the type constraint because: Validation failed for 'Int' failed with value yikes/;
  66
  67 lives_ok {
  68     Other->new(oops => 10);
  69 };
  70
  71 # ClassName coverage tests
  72
  73 do {
  74     package A;
  75     our @VERSION;
  76
  77     package Bx; # 'B' conflicts the B module
  78     our $VERSION = 1;
  79
  80     package C;
  81     our %ISA;
  82
  83     package D;
  84     our @ISA = 'Mouse::Object';
  85
  86     package E;
  87     sub foo {}
  88
  89     package F;
  90
  91     package G::H;
  92     sub bar {}
  93
  94     package I;
  95     no warnings 'once'; # work around 5.6.2
  96     our $NOT_CODE = 1;
  97 };
  98
  99 do {
 100     package ClassNameTests;
 101     use Mouse;
 102
 103     has class => (
 104         is => 'rw',
 105         isa => 'ClassName',
 106     );
 107 };
 108
 109 for ('Bx', 'D'..'E', 'G::H') {
 110     lives_ok {
 111         ClassNameTests->new(class => $_);
 112     };
 113
 114     lives_ok {
 115         my $obj = ClassNameTests->new;
 116         $obj->class($_);
 117     };
 118 }
 119
 120 throws_ok {
 121     ClassNameTests->new(class => 'A');
 122 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/;
 123
 124 throws_ok {
 125         my $obj = ClassNameTests->new;
 126         $obj->class('A');
 127 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value A/;
 128
 129 throws_ok {
 130     ClassNameTests->new(class => 'C');
 131 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/;
 132
 133 throws_ok {
 134         my $obj = ClassNameTests->new;
 135         $obj->class('C');
 136 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value C/;
 137
 138 for ('F', 'G', 'I', 'Z') {
 139     throws_ok {
 140         ClassNameTests->new(class => $_);
 141     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
 142
 143     throws_ok {
 144             my $obj = ClassNameTests->new;
 145             $obj->class($_);
 146     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' failed with value $_/;
 147 };
 148
 149
 150 # Check that Roles can be used in 'isa' and they are constrained with
 151 # 'does'
 152 do {
 153     package SausageRole;
 154     use Mouse::Role;
 155
 156     package DoesSausage;
 157     use Mouse;
 158     with 'SausageRole';
 159
 160     package HasSausage;
 161     use Mouse;
 162
 163     has sausage =>
 164         (isa => 'SausageRole',
 165          is => 'rw');
 166
 167 };
 168
 169 my $hs;
 170 lives_ok {
 171     $hs = HasSausage->new(sausage => DoesSausage->new);
 172 };
 173 lives_ok {
 174     $hs->sausage(DoesSausage->new);
 175 };
 176 throws_ok {
 177     HasSausage->new(sausage => Class->new);
 178 } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/;
 179 throws_ok {
 180     $hs->sausage(Class->new);
 181 } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' failed with value Class=/;
 182