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
|
=pod
=encoding utf-8
=head1 PURPOSE
More tests for B<StrMatch> from L<Types::Standard>.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2019-2023 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::Requires '5.020';
use Test::Fatal;
use Test::TypeTiny;
use Types::Standard qw( StrMatch );
use Test::Requires { 'Test::Warnings' => 0.005 };
use Test::Warnings ':all';
#
# This is a regexp containing embedded Perl code.
# It's interesting because it cannot easily be inlined.
#
my $xxx = 0;
my $matchfoo = StrMatch[ qr/f(?{ ++$xxx })oo/ ];
# Wrap this in a warnings block because it will generate warnings under
# EXTENDED_TESTING! The warnings will be tested later.
warnings {
should_pass('foo', $matchfoo);
should_fail('bar', $matchfoo);
};
ok($xxx > 0, 'Embedded code executed');
note('$xxx is ' . $xxx);
ok($matchfoo->can_be_inlined, 'It can still be inlined!');
note( $matchfoo->inline_check('$STRING') );
{
local $Type::Tiny::AvoidCallbacks = 1;
my $w = warning { $matchfoo->inline_check('$STRING') };
like(
$w,
qr/serializing using callbacks/,
'The inlining needed to use a callback!',
);
}
#
# Including this mostly for the benefit of Devel::Cover...
#
my $matchfoo2 = StrMatch[ qr/f(?{ ++$xxx })(oo)/, Types::Standard::Enum['oo'] ];
warnings {
should_pass('foo', $matchfoo);
should_fail('bar', $matchfoo);
};
{
local $Type::Tiny::AvoidCallbacks = 1;
my $w = warning { $matchfoo2->inline_check('$STRING') };
like(
$w,
qr/serializing using callbacks/,
'The inlining needed to use a callback!',
);
}
done_testing;
|