File: set_object.t

package info (click to toggle)
libmoox-types-setobject-perl 1.01-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 80 kB
  • sloc: perl: 24; makefile: 2
file content (78 lines) | stat: -rw-r--r-- 2,024 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
{

  package MooX::Types::MooseLike::Test;
  use strict;
  use warnings FATAL => 'all';
  use Moo;
  use MooX::Types::MooseLike::Base qw/ Int /;
  use MooX::Types::SetObject qw/ SetObject /;

  has set_object_of_ints => (
    is  => 'ro',
    isa => SetObject[Int],
    );
}

package main;
use strict;
use warnings FATAL => 'all';
use Test::More;
use Test::Fatal;

BEGIN {
  eval { require Set::Object };
  plan skip_all => 'SetObject tests need Set::Object'
    if $@;
}

# Set::Object
ok(
  MooX::Types::MooseLike::Test->new(
    set_object_of_ints => Set::Object->new(1, 2, 3),
    ),
  'Set::Object of integers'
  );
like(
  exception {
    MooX::Types::MooseLike::Test->new(
      set_object_of_ints => Set::Object->new('fREW'),);
  },
  qr(fREW is not an integer),
  'Int eror mesage is triggered when validation fails'
  );

eval q{ require Moose } or do {
    note "Moose not available; skipping actual inflation tests";
    done_testing;
    exit;
};

my $tc = do {
    $SIG{__WARN__} = sub { 0 };
    MooX::Types::MooseLike::Test->meta->get_attribute('set_object_of_ints')->type_constraint;
};

is(
    exception { MooX::Types::MooseLike::Test->new(set_object_of_ints => Set::Object->new(1..4)) },
    undef,
    'Moose loaded; value which should not violate type constraint',
);
like(
    exception { MooX::Types::MooseLike::Test->new(set_object_of_ints => Set::Object->new(1.1, 2.0, 4)) },
    qr{set_object_of_ints" failed: 1.1 is not an integer},
    'Moose loaded; value which should violate type constraint',
);

is(
    $tc->name,
    '__ANON__',
    'type constraint inflation results in an anonymous type',
);

ok($tc->check(Set::Object->new(16..18)), 'Moose::Meta::TypeConstraint works (1)');
ok($tc->check(Set::Object->new(0,1)), 'Moose::Meta::TypeConstraint works (2)');
ok(!$tc->check('Monkey'), 'Moose::Meta::TypeConstraint works (3)');
ok(!$tc->check([1,2]), 'Moose::Meta::TypeConstraint works (4)');
ok(!$tc->check(Set::Object->new(0,1.1)), 'Moose::Meta::TypeConstraint works (5)');

done_testing;