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

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   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     has obj => (
  17         is  => 'rw',
  18         isa => 'UNIVERSAL',
  19     );
  20
  21     package Test::Builder::Subclass;
  22     our @ISA = qw(Test::Builder);
  23 };
  24
  25 can_ok(Class => 'tb');
  26
  27 lives_ok {
  28     Class->new(tb => Test::Builder->new);
  29 };
  30
  31 lives_ok {
  32     Class->new(obj => Test::Builder->new);
  33 };
  34
  35 lives_ok {
  36     # Test::Builder was a bizarre choice, because it's a singleton.  Because of
  37     # that calling new on T:B:S won't work.  Blessing directly -- rjbs,
  38     # 2008-12-04
  39     Class->new(tb => (bless {} => 'Test::Builder::Subclass'));
  40 };
  41
  42 lives_ok {
  43     my $class = Class->new;
  44     $class->tb(Test::Builder->new);
  45     isa_ok($class->tb, 'Test::Builder');
  46 };
  47
  48 throws_ok {
  49     Class->new(tb => 3);
  50 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' with value 3/;
  51
  52 throws_ok {
  53     my $class = Class->new;
  54     $class->tb(3);
  55 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' with value 3/;
  56
  57 throws_ok {
  58     Class->new(tb => Class->new);
  59 } qr/Attribute \(tb\) does not pass the type constraint because: Validation failed for 'Test::Builder' with value Class=HASH\(\w+\)/;
  60
  61 throws_ok {
  62     Class->new(obj => 42);
  63 } qr/Attribute \(obj\) does not pass the type constraint because: Validation failed for 'UNIVERSAL' with value 42/;
  64
  65 do {
  66     package Other;
  67     use Mouse;
  68
  69     has oops => (
  70         is      => 'bare',
  71         isa     => 'Int',
  72         default => "yikes",
  73     );
  74 };
  75
  76 throws_ok {
  77     Other->new;
  78 } qr/Attribute \(oops\) does not pass the type constraint because: Validation failed for 'Int' with value yikes/;
  79
  80 lives_ok {
  81     Other->new(oops => 10);
  82 };
  83
  84 # ClassName coverage tests
  85
  86 do {
  87     package A;
  88     our @VERSION;
  89
  90     package Bx; # 'B' conflicts the B module
  91     our $VERSION = 1;
  92
  93     package C;
  94     our %ISA;
  95
  96     package D;
  97     our @ISA = 'Mouse::Object';
  98
  99     package E;
 100     sub foo {}
 101
 102     package F;
 103
 104     package G::H;
 105     sub bar {}
 106
 107     package I;
 108     no warnings 'once'; # work around 5.6.2
 109     our $NOT_CODE = 1;
 110 };
 111
 112 do {
 113     package ClassNameTests;
 114     use Mouse;
 115
 116     has class => (
 117         is => 'rw',
 118         isa => 'ClassName',
 119     );
 120 };
 121
 122 for ('Bx', 'D'..'E', 'G::H') {
 123     lives_ok {
 124         ClassNameTests->new(class => $_);
 125     };
 126
 127     lives_ok {
 128         my $obj = ClassNameTests->new;
 129         $obj->class($_);
 130     };
 131 }
 132
 133 throws_ok {
 134     ClassNameTests->new(class => 'A');
 135 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value A/;
 136
 137 throws_ok {
 138         my $obj = ClassNameTests->new;
 139         $obj->class('A');
 140 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value A/;
 141
 142 throws_ok {
 143     ClassNameTests->new(class => 'C');
 144 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value C/;
 145
 146 throws_ok {
 147         my $obj = ClassNameTests->new;
 148         $obj->class('C');
 149 } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value C/;
 150
 151 for ('F', 'G', 'I', 'Z') {
 152     throws_ok {
 153         ClassNameTests->new(class => $_);
 154     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value $_/;
 155
 156     throws_ok {
 157             my $obj = ClassNameTests->new;
 158             $obj->class($_);
 159     } qr/Attribute \(class\) does not pass the type constraint because: Validation failed for 'ClassName' with value $_/;
 160 };
 161
 162
 163 # Check that Roles can be used in 'isa' and they are constrained with
 164 # 'does'
 165 do {
 166     package SausageRole;
 167     use Mouse::Role;
 168
 169     package DoesSausage;
 170     use Mouse;
 171     with 'SausageRole';
 172
 173     package HasSausage;
 174     use Mouse;
 175
 176     has sausage =>
 177         (isa => 'SausageRole',
 178          is => 'rw');
 179
 180 };
 181
 182 my $hs;
 183 lives_ok {
 184     $hs = HasSausage->new(sausage => DoesSausage->new);
 185 };
 186 lives_ok {
 187     $hs->sausage(DoesSausage->new);
 188 };
 189 throws_ok {
 190     HasSausage->new(sausage => Class->new);
 191 } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' with value Class=/;
 192 throws_ok {
 193     $hs->sausage(Class->new);
 194 } qr/^Attribute \(sausage\) does not pass the type constraint because: Validation failed for 'SausageRole' with value Class=/;
 195
 196 done_testing;