1#!perl
2use strict;
3use warnings FATAL => 'all';
4
5write_test( file => 'basic', tests => 4, best => <<'BEST', code => <<'CODE' );
6use Best qw/A::Module AnAlternative LastChance/;
7BEST
8is "@attempted", 'A::Module AnAlternative LastChance', 'tried all modules';
9is "@loaded",    'LastChance', 'loaded correct one - trace evidence';
10is (Best->which('A::Module'), 'LastChance', 'loaded correct one - which()');
11
12{
13    package Someother;
14    Test::More::is (Best->which('A::Module'), 'LastChance', 'loaded correct one - which() from other module');
15}
16CODE
17
18write_test(
19    file  => 'basic-a',
20    tests => 2,
21    best  => <<'BEST', code => <<'CODE' );
22use Best [ qw/A::Module AnAlternative LastChance/ ];
23BEST
24is "@attempted", 'A::Module AnAlternative LastChance', 'tried all modules';
25is "@loaded",    'LastChance', 'loaded correct one - trace evidence';
26CODE
27
28write_test(
29    file  => 'best',
30    tests => 3,
31    best  => <<'BEST', code => <<'CODE' );
32use Best [ [qw/A::Module AnAlternative LastChance/], qw/moose elk/ ];
33BEST
34is "@attempted", 'A::Module AnAlternative LastChance', 'tried all modules';
35is "@loaded",    'LastChance', 'loaded correct one';
36is "@args",      'LastChance moose elk', '->import';
37CODE
38
39write_test(
40    file  => 'onearg',
41    tests => 3,
42    best  => <<'BEST', code => <<'CODE' );
43# miyagawa++ noticed a crash when there was exactly one element on the
44# import list. Oops!
45use Best [ [qw/A::Module AnAlternative LastChance/], qw/moose/ ];
46BEST
47is "@attempted", 'A::Module AnAlternative LastChance', 'tried all modules';
48is "@loaded",    'LastChance', 'loaded correct one';
49is "@args",      'LastChance moose', '->import';
50CODE
51
52write_test(
53    file  => 'args-a',
54    tests => 3,
55    best  => <<'BEST', code => <<'CODE' );
56use Best [ [qw/A::Module AnAlternative LastChance/], [qw/moose elk/] ];
57BEST
58is "@attempted", 'A::Module AnAlternative LastChance', 'tried all modules';
59is "@loaded",    'LastChance', 'loaded correct one';
60is "@args",      'LastChance moose elk', '->import';
61CODE
62
63write_test(
64    file  => 'noargs',
65    tests => 3,
66    best  => <<'BEST', code => <<'CODE' );
67use Best [ [qw/A::Module AnAlternative LastChance/], [] ];
68BEST
69is "@attempted", 'A::Module AnAlternative', 'tried all modules';
70is "@loaded",    '', q[->import wasn't called]; # AnAlternative's import was not called
71is "@args",      '', q[->import];
72CODE
73
74write_test( file => 'ver', tests => 3, best => <<'BEST', code => <<'CODE' );
75use Best [ [qw/Version::TooLow 2.00 Version::Ok 1.00/], qw/moose elk/ ];
76BEST
77is "@attempted", 'Version::TooLow Version::Ok', 'attempted';
78is "@loaded",    'Version::Ok', 'loaded';
79is "@args",      'Version::Ok moose elk', 'args';
80CODE
81
82write_test(
83    file  => 'exist-a',
84    tests => 3,
85    best  => <<'BEST', code => <<'CODE' );
86use Best [ [qw/Doesn't::Exist LastChance/], qw/moose elk/ ];
87BEST
88is "@attempted", q[Doesn::t::Exist LastChance];
89is "@loaded", 'LastChance';
90is "@args",   'LastChance moose elk';
91CODE
92
93write_test( file => 'exist', tests => 3, best => <<'BEST', code => <<'CODE' );
94use Best qw/Doesn't::Exist LastChance/;
95BEST
96is "@attempted", q[Doesn::t::Exist LastChance];
97is "@loaded", 'LastChance';
98is "@args",   'LastChance';
99CODE
100
101write_test( file => 'code', tests => 3, best => <<'BEST', code => <<'CODE' );
102use Best [ [sub {
103                push @attempted, 'Failed code';
104                return;
105            },
106            'LastChance'], qw/moose elk/ ];
107BEST
108is "@attempted", 'Failed code LastChance';
109is "@loaded",    'LastChance';
110is "@args",      'LastChance moose elk';
111CODE
112
113write_test( file => 'hash', tests => 3, best => <<'BEST', code => <<'CODE' );
114use Best ( 'A::Module' => {},
115           AnAlternative => {},
116           LastChance => {}, );
117BEST
118is "@attempted", 'A::Module AnAlternative LastChance';
119is "@loaded",    'LastChance';
120is "@args",      'LastChance'
121CODE
122
123write_test(
124    file  => 'hash-a',
125    tests => 3,
126    best  => <<'BEST', code => <<'CODE' );
127use Best [ 'A::Module' => {},
128           AnAlternative => {},
129           LastChance => {}, ];
130BEST
131is "@attempted", 'A::Module AnAlternative LastChance';
132is "@loaded",    'LastChance';
133is "@args",      'LastChance'
134CODE
135
136write_test(
137    file  => 'hash-aa',
138    tests => 3,
139    best  => <<'BEST', code => <<'CODE' );
140use Best [[ 'A::Module' => {},
141            AnAlternative => {},
142            LastChance => {}, ]];
143BEST
144is "@attempted", 'A::Module AnAlternative LastChance';
145is "@loaded",    'LastChance';
146is "@args",      'LastChance'
147CODE
148
149write_test(
150    file  => 'ver-h',
151    tests => 3,
152    best  => <<'BEST', code => <<'CODE' );
153use Best [ [ 'Version::TooLow' => { version => '2.00', },
154             'Version::Ok'     => { version => '2.00', }, ],
155           [qw/moose elk/], ];
156BEST
157is "@attempted", 'Version::TooLow Version::Ok';
158is "@loaded",    'Version::Ok';
159is "@args",      'Version::Ok moose elk';
160CODE
161
162write_test(
163    file  => 'ok-h',
164    tests => 3,
165    best  => <<'BEST', code => <<'CODE' );
166use Best [ [ 'Loads::Ok' => { ok => sub { return } },
167             'LastChance', ],
168           [qw/moose elk/], ];
169BEST
170is "@attempted", 'Loads::Ok LastChance', 'attempted';
171is "@loaded",    'LastChance',           'loaded';
172is "@args",      'LastChance moose elk', 'args';
173CODE
174
175write_test( file => 'if-h', tests => 2, best => <<'BEST', code => <<'CODE' );
176use Best [ [ 'A::Module' => { if => sub { 0 }, },
177             qw/AnAlternative LastChance/ ], ];
178BEST
179is "@attempted", 'AnAlternative LastChance';
180is "@loaded",    'LastChance';
181CODE
182
183write_test(
184    file  => 'args-h',
185    tests => 3,
186    best  => <<'BEST', code => <<'CODE' );
187use Best [ [ qw/A::Module AnAlternative/,
188             LastChance => { args => [qw/moose elk/] } ],
189           qw/Unused arguments/];
190BEST
191is "@attempted", 'A::Module AnAlternative LastChance';
192is "@loaded",    'LastChance';
193is "@args",      'LastChance moose elk';
194CODE
195
196write_test(
197    file  => 'code-h',
198    tests => 2,
199    best  => <<'BEST', code => <<'CODE' );
200use Best [ [ sub { push @attempted, 'ignored' } => { if => sub { 0 } },
201             sub { push @attempted, 'ok'; push @loaded, 'ok' } => { ok => sub { 1 } } ] ];
202BEST
203is "@attempted", 'ok';
204is "@loaded",    'ok';
205CODE
206
207use constant TEMPLATE => <<'TEMPLATE';
208#!perl
209## DO NOT EDIT THIS FILE. It is generated by t/Tests.PL
210use strict;
211use warnings;
212use vars qw/@attempted @loaded @args/;
213
214use Test::More tests => 1 + TESTS;
215use lib qw(t t/lib);
216
217# preload for Load::Trace
218use Carp ();
219use Best ();
220use overload ();
221BEGIN { eval { require mro } }  # fixes failure on bleadperl as of 2009-01-17
222BEGIN {
223    overload::Overloaded( sub {} );
224    overload::Method( sub{}, '&{}' );
225    overload::StrVal( sub{} );
226}
227
228use Load::Trace { port => \@attempted };
229
230BEST
231
232pass q[Best didn't crash];
233
234CODE
235
236TEMPLATE
237
238{
239    my $num;
240    BEGIN { $num = 50 }
241
242    sub write_test {
243        my %p = @_;
244        my ( $tests, $best, $code, $file ) = map {
245            if ( not exists $p{$_} )
246            {
247                require Carp;
248                Carp::croak("Missing parameter: $_");
249            }
250            elsif ( not defined $p{$_} ) {
251                require Carp;
252                Carp::croak("Undefined parameter: $_");
253            }
254            delete $p{$_}
255        } qw(tests best code file);
256        die "Unknown parameters: @{[sort keys %p]}"
257            if keys %p;
258
259        my $src = TEMPLATE;
260
261        $src =~ s/TESTS/$tests/ or die;
262        $src =~ s/BEST/$best/   or die;
263        $src =~ s/CODE/$code/   or die;
264
265        $file = sprintf 't/%02d-%s.t', $num++, $file;
266
267        print "Writing test $file\n";
268        open my $fh, '>', $file
269            or die "Can't open $file: $!";
270        print {$fh} $src
271            or die "Can't write to $file: $!";
272        close $fh
273            or die "Can't flush $file: $!";
274        return;
275    }
276}
277