1#!perl -T 2use strict; 3use warnings; 4 5=head1 TEST PURPOSE 6 7These tests exercise that the polymorphic exporter-builder used when 8Sub::Exporter's -import group is invoked. 9 10They use Test::SubExporter::DashSetup, bundled in ./t/lib, which uses this 11calling style. 12 13=cut 14 15use Test::More tests => 40; 16 17BEGIN { use_ok('Sub::Exporter'); } 18 19our $exporting_class = 'Test::SubExporter::DashSetup'; 20 21use lib 't/lib'; 22 23for my $iteration (1..2) { 24 { 25 package Test::SubExporter::SETUP; 26 use Sub::Exporter -setup => [ qw(X) ]; 27 28 sub X { return "desired" } 29 30 package Test::SubExporter::SETUP::CONSUMER; 31 32 Test::SubExporter::SETUP->import(':all'); 33 main::is(X(), "desired", "constructed importer (via -setup [LIST]) worked"); 34 } 35 36 { 37 package Test::SubExporter::EXPORT_MISSING; 38 use Sub::Exporter -setup => [ qw(X) ]; 39 40 package Test::SubExporter::SETUP::CONSUMER_OF_MISSING; 41 42 eval { Test::SubExporter::EXPORT_MISSING->import(':all') }; 43 main::like( 44 $@, 45 qr/can't locate export/, 46 "croak if we're configured to export something that can't be found", 47 ); 48 } 49 50 { 51 package Test::SubExporter::SETUPFAILURE; 52 eval { Sub::Exporter->import( -setup => sub { 1 }) }; 53 main::like($@, qr/-setup failed validation/, "only [],{} ok for -setup"); 54 } 55 56 package Test::SubExporter::DEFAULT; 57 main::use_ok($exporting_class); 58 use subs qw(xyzzy hello_sailor); 59 60 main::is( 61 xyzzy, 62 "Nothing happens.", 63 "DEFAULT: default export xyzzy works as expected" 64 ); 65 66 main::is( 67 hello_sailor, 68 "Nothing happens yet.", 69 "DEFAULT: default export hello_sailor works as expected" 70 ); 71 72 package Test::SubExporter::RENAME; 73 main::use_ok($exporting_class, xyzzy => { -as => 'plugh' }); 74 use subs qw(plugh); 75 76 main::is( 77 plugh, 78 "Nothing happens.", 79 "RENAME: default export xyzzy=>plugh works as expected" 80 ); 81 82 package Test::SubExporter::SAILOR; 83 main::use_ok($exporting_class, ':sailor');; 84 use subs qw(xyzzy hs_works hs_fails); 85 86 main::is( 87 xyzzy, 88 "Nothing happens.", 89 "SAILOR: default export xyzzy works as expected" 90 ); 91 92 main::is( 93 hs_works, 94 "Something happens!", 95 "SAILOR: hs_works export works as expected" 96 ); 97 98 main::is( 99 hs_fails, 100 "Nothing happens yet.", 101 "SAILOR: hs_fails export works as expected" 102 ); 103 104 package Test::SubExporter::Z3; 105 main::use_ok($exporting_class, hello_sailor => { game => 'zork3' }); 106 use subs qw(hello_sailor); 107 108 main::is( 109 hello_sailor, 110 "Something happens!", 111 "Z3: custom hello_sailor works as expected" 112 ); 113 114 package Test::SubExporter::FROTZ_SAILOR; 115 main::use_ok($exporting_class, -sailor => { -prefix => 'frotz_' }); 116 use subs map { "frotz_$_" }qw(xyzzy hs_works hs_fails); 117 118 main::is( 119 frotz_xyzzy, 120 "Nothing happens.", 121 "FROTZ_SAILOR: default export xyzzy works as expected" 122 ); 123 124 main::is( 125 frotz_hs_works, 126 "Something happens!", 127 "FROTZ_SAILOR: hs_works export works as expected" 128 ); 129 130 main::is( 131 frotz_hs_fails, 132 "Nothing happens yet.", 133 "FROTZ_SAILOR: hs_fails export works as expected" 134 ); 135} 136 137{ 138 package Test::SubExporter::SETUPALT; 139 use Sub::Exporter -setup => { 140 -as => 'alternimport', 141 exports => [ qw(Y) ], 142 }; 143 144 sub X { return "desired" } 145 sub Y { return "other" } 146 147 package Test::SubExporter::SETUP::ALTCONSUMER; 148 149 Test::SubExporter::SETUPALT->import(':all'); 150 eval { X() }; 151 main::like($@, qr/undefined subroutine/i, "X didn't get imported"); 152 153 eval { Y() }; 154 main::like($@, qr/undefined subroutine/i, "Y didn't get imported"); 155 156 Test::SubExporter::SETUPALT->alternimport(':all'); 157 main::is(Y(), "other", "other importer (via -setup { -as ...}) worked"); 158} 159