File: constructor-modify.t

package info (click to toggle)
libmoo-perl 2.005005-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 840 kB
  • sloc: perl: 2,506; makefile: 2
file content (142 lines) | stat: -rw-r--r-- 2,678 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
use strict;
use warnings;
use lib 't/lib';

use Test::More;
use CaptureException;

BEGIN {
  package ClassBakedNew;
  use Moo;

  has attr1 => (is => 'ro');
  __PACKAGE__->new;

  ::like ::exception {
    has attr2 => (is => 'ro');
  }, qr/Constructor for ClassBakedNew has been inlined/,
    'error when adding attributes with undeferred constructor';
}

BEGIN {
  package ClassExistingNew;
  use Moo;
  no warnings 'once';

  sub new {
    our $CALLED++;
    bless {}, $_[0];
  }

  ::like ::exception {
    has attr1 => (is => 'ro');
  }, qr/Unknown constructor for ClassExistingNew already exists/,
    'error when adding attributes with foreign constructor';
}

BEGIN {
  package ClassDeferredNew;
  use Moo;
  no warnings 'once';
  use Sub::Quote;

  quote_sub __PACKAGE__ . '::new' => q{
    our $CALLED++;
    bless {}, $_[0];
  };

  ::like ::exception {
    has attr1 => (is => 'ro');
  }, qr/Unknown constructor for ClassDeferredNew already exists/,
    'error when adding attributes with foreign deferred constructor';
}

BEGIN {
  package ClassWithModifier;
  use Moo;
  no warnings 'once';

  has attr1 => (is => 'ro');

  around new => sub {
    our $CALLED++;
    my $orig = shift;
    goto $orig;
  };

  ::like ::exception {
    has attr2 => (is => 'ro');
  }, qr/Constructor for ClassWithModifier has been replaced with an unknown sub/,
    'error when adding attributes after applying modifier to constructor';
}

BEGIN {
  package Role1;
  use Moo::Role;

  has attr1 => (is => 'ro');
}

BEGIN {
  package ClassWithRoleAttr;
  use Moo;
  no warnings 'once';

  around new => sub {
    our $CALLED++;
    my $orig = shift;
    goto $orig;
  };


  ::like ::exception {
    with 'Role1';
  }, qr/Unknown constructor for ClassWithRoleAttr already exists/,
    'error when adding role with attribute after applying modifier to constructor';
}


BEGIN {
  package RoleModifyNew;
  use Moo::Role;
  no warnings 'once';

  around new => sub {
    our $CALLED++;
    my $orig = shift;
    goto $orig;
  };
}

BEGIN {
  package ClassWithModifyRole;
  use Moo;
  no warnings 'once';
  with 'RoleModifyNew';

  ::like ::exception {
    has attr1 => (is => 'ro');
  }, qr/Unknown constructor for ClassWithModifyRole already exists/,
    'error when adding attributes after applying modifier to constructor via role';
}

BEGIN {
  package AClass;
  use Moo;
  has attr1 => (is => 'ro');
}

BEGIN {
  package ClassWithParent;
  use Moo;

  has attr2 => (is => 'ro');
  __PACKAGE__->new;

  ::like ::exception {
    extends 'AClass';
  }, qr/Constructor for ClassWithParent has been inlined/,
    'error when changing parent with undeferred constructor';
}

done_testing;