File: init-arg.t

package info (click to toggle)
libmoo-perl 2.002005-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 856 kB
  • ctags: 192
  • sloc: perl: 2,561; makefile: 6
file content (108 lines) | stat: -rw-r--r-- 1,954 bytes parent folder | download | duplicates (3)
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
use Moo::_strictures;
use Test::More;
use Test::Fatal;

{
  package Foo;

  use Moo;

  has optional => (
    is => 'rw',
    init_arg => 'might_have',
    isa => sub { die "isa" if $_[0] % 2 },
    default => sub { 7 },
  );

  has lazy => (
    is => 'rw',
    init_arg => 'workshy',
    isa => sub { die "aieee" if $_[0] % 2 },
    default => sub { 7 },
    lazy => 1,
  );
}

like(
  exception { Foo->new },
  qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/,
  "isa default"
);

like(
  exception { Foo->new(might_have => 3) },
  qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/,
  "isa init_arg",
);

is(
  exception { Foo->new(might_have => 2) },
  undef, "isa init_arg ok"
);

my $foo = Foo->new(might_have => 2);

like(
  exception { $foo->optional(3) },
  qr/\Aisa check for "optional" failed:/,
  "isa accessor",
);

like(
  exception { $foo->lazy },
  qr/\Aisa check for "lazy" failed:/,
  "lazy accessor",
);

like(
  exception { $foo->lazy(3) },
  qr/\Aisa check for "lazy" failed:/,
  "lazy set isa fail",
);

is(
  exception { $foo->lazy(4) },
  undef,
  "lazy set isa ok",
);

like(
  exception { Foo->new(might_have => 2, workshy => 3) },
  qr/\Aisa check for "lazy" \(constructor argument: "workshy"\) failed:/,
  "lazy init_arg",
);

{
  package Bar;

  use Moo;

  has sane_key_name => (
    is => 'rw',
    init_arg => 'stupid key name',
    isa => sub { die "isa" if $_[0] % 2 },
    required => 1
  );
  has sane_key_name2 => (
    is => 'rw',
    init_arg => 'complete\nnonsense\\\'key',
    isa => sub { die "isa" if $_[0] % 2 },
    required => 1
  );
}

my $bar;
is(
  exception {
    $bar= Bar->new(
      'stupid key name' => 4,
      'complete\nnonsense\\\'key' => 6
    )
  },
  undef, 'requiring init_arg with spaces and insanity',
);

is( $bar->sane_key_name,  4, 'key renamed correctly' );
is( $bar->sane_key_name2, 6, 'key renamed correctly' );

done_testing;