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
|
=pod
=encoding utf-8
=head1 PURPOSE
Basic tests for B<Maybe> from L<Types::Standard>.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2019 by Toby Inkster.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Test::TypeTiny;
use Types::Standard qw( Maybe );
isa_ok(Maybe, 'Type::Tiny', 'Maybe');
is(Maybe->name, 'Maybe', 'Maybe has correct name');
is(Maybe->display_name, 'Maybe', 'Maybe has correct display_name');
is(Maybe->library, 'Types::Standard', 'Maybe knows it is in the Types::Standard library');
ok(Types::Standard->has_type('Maybe'), 'Types::Standard knows it has type Maybe');
ok(!Maybe->deprecated, 'Maybe is not deprecated');
ok(!Maybe->is_anon, 'Maybe is not anonymous');
ok(Maybe->can_be_inlined, 'Maybe can be inlined');
is(exception { Maybe->inline_check(q/$xyz/) }, undef, "Inlining Maybe doesn't throw an exception");
ok(!Maybe->has_coercion, "Maybe doesn't have a coercion");
ok(Maybe->is_parameterizable, "Maybe is parameterizable");
my @tests = (
pass => 'undef' => undef,
pass => 'false' => !!0,
pass => 'true' => !!1,
pass => 'zero' => 0,
pass => 'one' => 1,
pass => 'negative one' => -1,
pass => 'non integer' => 3.1416,
pass => 'empty string' => '',
pass => 'whitespace' => ' ',
pass => 'line break' => "\n",
pass => 'random string' => 'abc123',
pass => 'loaded package name' => 'Type::Tiny',
pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded',
pass => 'a reference to undef' => do { my $x = undef; \$x },
pass => 'a reference to false' => do { my $x = !!0; \$x },
pass => 'a reference to true' => do { my $x = !!1; \$x },
pass => 'a reference to zero' => do { my $x = 0; \$x },
pass => 'a reference to one' => do { my $x = 1; \$x },
pass => 'a reference to empty string' => do { my $x = ''; \$x },
pass => 'a reference to random string' => do { my $x = 'abc123'; \$x },
pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'),
pass => 'empty arrayref' => [],
pass => 'arrayref with one zero' => [0],
pass => 'arrayref of integers' => [1..10],
pass => 'arrayref of numbers' => [1..10, 3.1416],
pass => 'blessed arrayref' => bless([], 'SomePkg'),
pass => 'empty hashref' => {},
pass => 'hashref' => { foo => 1 },
pass => 'blessed hashref' => bless({}, 'SomePkg'),
pass => 'coderef' => sub { 1 },
pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'),
pass => 'glob' => do { no warnings 'once'; *SOMETHING },
pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x },
pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'),
pass => 'regexp' => qr/./,
pass => 'blessed regexp' => bless(qr/./, 'SomePkg'),
pass => 'filehandle' => do { open my $x, '<', $0 or die; $x },
pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') },
pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y },
pass => 'ref to arrayref' => do { my $x = []; \$x },
pass => 'ref to hashref' => do { my $x = {}; \$x },
pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x },
pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x },
#TESTS
);
while (@tests) {
my ($expect, $label, $value) = splice(@tests, 0 , 3);
if ($expect eq 'todo') {
note("TODO: $label");
}
elsif ($expect eq 'pass') {
should_pass($value, Maybe, ucfirst("$label should pass Maybe"));
}
elsif ($expect eq 'fail') {
should_fail($value, Maybe, ucfirst("$label should fail Maybe"));
}
else {
fail("expected '$expect'?!");
}
}
note("TODO: write tests for parameterized types");
done_testing;
|
