Add more words to the spelling whitelist
[gitmo/Moose.git] / t / immutable / definition_context.t
CommitLineData
0f1a71fc 1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Test::More;
5use Test::Fatal;
6
7{
8 use Moose::Util::TypeConstraints;
9 use Carp 'confess';
10 subtype 'Death', as 'Int', where { $_ == 1 };
11 coerce 'Death', from 'Any', via { confess };
12}
13
14{
15 my ($attr_foo_line, $attr_bar_line, $ctor_line);
16 {
17 package Foo;
18 use Moose;
19
20 has foo => (
21 is => 'rw',
22 isa => 'Death',
23 coerce => 1,
24 );
25 $attr_foo_line = __LINE__ - 5;
26
27 has bar => (
28 accessor => 'baz',
29 isa => 'Death',
30 coerce => 1,
31 );
32 $attr_bar_line = __LINE__ - 5;
33
34 __PACKAGE__->meta->make_immutable;
35 $ctor_line = __LINE__ - 1;
36 }
37
38 like(
39 exception { Foo->new(foo => 2) },
40 qr/called at constructor Foo::new \(defined at $0 line $ctor_line\)/,
41 "got definition context for the constructor"
42 );
43
44 like(
45 exception { my $f = Foo->new(foo => 1); $f->foo(2) },
46 qr/called at accessor Foo::foo \(defined at $0 line $attr_foo_line\)/,
47 "got definition context for the accessor"
48 );
49
50 like(
51 exception { my $f = Foo->new(foo => 1); $f->baz(2) },
52 qr/called at accessor Foo::baz of attribute bar \(defined at $0 line $attr_bar_line\)/,
53 "got definition context for the accessor"
54 );
55}
56
57{
58 my ($dtor_line);
59 {
60 package Bar;
61 use Moose;
62
63 # just dying here won't work, because perl's exception handling is
64 # terrible
65 sub DEMOLISH { try { confess } catch { warn $_ } }
66
67 __PACKAGE__->meta->make_immutable;
68 $dtor_line = __LINE__ - 1;
69 }
70
71 {
72 my $warning = '';
73 local $SIG{__WARN__} = sub { $warning .= $_[0] };
74 { Bar->new }
75 like(
76 $warning,
77 qr/called at destructor Bar::DESTROY \(defined at $0 line $dtor_line\)/,
78 "got definition context for the destructor"
79 );
80 }
81}
82
83done_testing;