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