=head1 PURPOSE Tests the output of the "-trace" feature. Checks that the C environment variable is honoured. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =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;