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