1=pod
2
3=encoding utf-8
4
5=head1 PURPOSE
6
7Basic tests for B<Value> from L<Types::Standard>.
8
9=head1 AUTHOR
10
11Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
12
13=head1 COPYRIGHT AND LICENCE
14
15This software is copyright (c) 2019-2021 by Toby Inkster.
16
17This is free software; you can redistribute it and/or modify it under
18the same terms as the Perl 5 programming language system itself.
19
20=cut
21
22use strict;
23use warnings;
24use Test::More;
25use Test::Fatal;
26use Test::TypeTiny;
27use Types::Standard qw( Value );
28
29isa_ok(Value, 'Type::Tiny', 'Value');
30is(Value->name, 'Value', 'Value has correct name');
31is(Value->display_name, 'Value', 'Value has correct display_name');
32is(Value->library, 'Types::Standard', 'Value knows it is in the Types::Standard library');
33ok(Types::Standard->has_type('Value'), 'Types::Standard knows it has type Value');
34ok(!Value->deprecated, 'Value is not deprecated');
35ok(!Value->is_anon, 'Value is not anonymous');
36ok(Value->can_be_inlined, 'Value can be inlined');
37is(exception { Value->inline_check(q/$xyz/) }, undef, "Inlining Value doesn't throw an exception");
38ok(!Value->has_coercion, "Value doesn't have a coercion");
39ok(!Value->is_parameterizable, "Value isn't parameterizable");
40
41#
42# The @tests array is a list of triples:
43#
44# 1. Expected result - pass, fail, or xxxx (undefined).
45# 2. A description of the value being tested.
46# 3. The value being tested.
47#
48
49my @tests = (
50	fail => 'undef'                    => undef,
51	pass => 'false'                    => !!0,
52	pass => 'true'                     => !!1,
53	pass => 'zero'                     =>  0,
54	pass => 'one'                      =>  1,
55	pass => 'negative one'             => -1,
56	pass => 'non integer'              =>  3.1416,
57	pass => 'empty string'             => '',
58	pass => 'whitespace'               => ' ',
59	pass => 'line break'               => "\n",
60	pass => 'random string'            => 'abc123',
61	pass => 'loaded package name'      => 'Type::Tiny',
62	pass => 'unloaded package name'    => 'This::Has::Probably::Not::Been::Loaded',
63	fail => 'a reference to undef'     => do { my $x = undef; \$x },
64	fail => 'a reference to false'     => do { my $x = !!0; \$x },
65	fail => 'a reference to true'      => do { my $x = !!1; \$x },
66	fail => 'a reference to zero'      => do { my $x = 0; \$x },
67	fail => 'a reference to one'       => do { my $x = 1; \$x },
68	fail => 'a reference to empty string' => do { my $x = ''; \$x },
69	fail => 'a reference to random string' => do { my $x = 'abc123'; \$x },
70	fail => 'blessed scalarref'        => bless(do { my $x = undef; \$x }, 'SomePkg'),
71	fail => 'empty arrayref'           => [],
72	fail => 'arrayref with one zero'   => [0],
73	fail => 'arrayref of integers'     => [1..10],
74	fail => 'arrayref of numbers'      => [1..10, 3.1416],
75	fail => 'blessed arrayref'         => bless([], 'SomePkg'),
76	fail => 'empty hashref'            => {},
77	fail => 'hashref'                  => { foo => 1 },
78	fail => 'blessed hashref'          => bless({}, 'SomePkg'),
79	fail => 'coderef'                  => sub { 1 },
80	fail => 'blessed coderef'          => bless(sub { 1 }, 'SomePkg'),
81	pass => 'glob'                     => do { no warnings 'once'; *SOMETHING },
82	fail => 'globref'                  => do { no warnings 'once'; my $x = *SOMETHING; \$x },
83	fail => 'blessed globref'          => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'),
84	fail => 'regexp'                   => qr/./,
85	fail => 'blessed regexp'           => bless(qr/./, 'SomePkg'),
86	fail => 'filehandle'               => do { open my $x, '<', $0 or die; $x },
87	fail => 'filehandle object'        => do { require IO::File; 'IO::File'->new($0, 'r') },
88	fail => 'ref to scalarref'         => do { my $x = undef; my $y = \$x; \$y },
89	fail => 'ref to arrayref'          => do { my $x = []; \$x },
90	fail => 'ref to hashref'           => do { my $x = {}; \$x },
91	fail => 'ref to coderef'           => do { my $x = sub { 1 }; \$x },
92	fail => 'ref to blessed hashref'   => do { my $x = bless({}, 'SomePkg'); \$x },
93	fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] },
94	fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] },
95	fail => 'object numifying to 0'    => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] },
96	fail => 'object numifying to 1'    => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] },
97	fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} },
98	fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] },
99	fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] },
100#TESTS
101);
102
103while (@tests) {
104	my ($expect, $label, $value) = splice(@tests, 0 , 3);
105	if ($expect eq 'xxxx') {
106		note("UNDEFINED OUTCOME: $label");
107	}
108	elsif ($expect eq 'pass') {
109		should_pass($value, Value, ucfirst("$label should pass Value"));
110	}
111	elsif ($expect eq 'fail') {
112		should_fail($value, Value, ucfirst("$label should fail Value"));
113	}
114	else {
115		fail("expected '$expect'?!");
116	}
117}
118
119done_testing;
120
121