Source

p5-moox-struct / t / 14trace.t

Full commit
=head1 PURPOSE

Tests the output of the "-trace" feature.

Checks that the C<PERL_MOOX_STRUCT_TRACE> environment variable is honoured.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2012 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 if ($] < 5.010), 'Test::More', skip_all => 'need Perl 5.10';
use Test::More;

use 5.010;
use MooX::Struct ();
use IO::Handle;

my $default = "MooX::Struct::Processor"->new(trace => 1);
is($default->trace_handle, \*STDERR);

my $output;
open my $handle, '>', \$output;
my $proc = "MooX::Struct::Processor"->new(trace => 1, trace_handle => $handle);

$proc->process(
	__PACKAGE__,
	Something => ['$foo', announce_foo => sub { say shift->foo } ],
);
my $obj = new_ok Something(), [[1]];

is($output, <<"EXPECTED");
package @{[ Something() ]};
use Moo;
has foo => ('isa' => sub { "DUMMY" },'is' => 'ro');
sub announce_foo { ... }
sub FIELDS { ... }
sub TYPE { ... }
EXPECTED

$output = '';

BEGIN {
	package Local::Role;
	use Moo::Role;
	requires 'foo';
};

$proc->flags->{deparse} = 1;
$proc->process(
	__PACKAGE__,
	SomethingElse => [
		-class       => \'Something::Else',
		-isa         => [Something()],
		-with        => ['Local::Role'],
		announce_foo => sub { my $self = shift; print $self->foo, "\n" },
		'+number', 'random',
	],
);

$obj = new_ok SomethingElse(), [[1]];

like($output, qr{package Something::Else});
like($output, qr{with qw.Local::Role.});
like($output, qr{print \$self->foo});
like($output, qr{looks_like_number});

{
	local $ENV{PERL_MOOX_STRUCT_TRACE} = 1;
	ok "MooX::Struct::Processor"->new->trace;
}
ok not "MooX::Struct::Processor"->new->trace;

done_testing;