X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExporter.t;h=27b1e67653003c095c772fbbb9ac0b3278cc07ce;hb=dfa4e5d386dd8c5329351699b02085856cdd140e;hp=f2771db3f530c7cad054db462cc7d4aa3020e1e7;hpb=9ebf09bc35992a0eeace2e06916ca4dca399c8f2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Exporter.t b/lib/Exporter.t index f2771db..27b1e67 100644 --- a/lib/Exporter.t +++ b/lib/Exporter.t @@ -1,12 +1,14 @@ -#!./perl +#!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't' if -d 't'; + @INC = '../lib'; + } } # Can't use Test::Simple/More, they depend on Exporter. -my $test = 1; +my $test; sub ok ($;$) { my($ok, $name) = @_; @@ -21,9 +23,12 @@ sub ok ($;$) { } -print "1..19\n"; -require Exporter; -ok( 1, 'Exporter compiled' ); +BEGIN { + $test = 1; + print "1..28\n"; + require Exporter; + ok( 1, 'Exporter compiled' ); +} BEGIN { @@ -50,7 +55,7 @@ foreach my $meth (@::Exporter_Methods) { That => [qw(Above the @wailing)], tray => [qw(Fasten $seatbelt)], ); -@EXPORT = qw(lifejacket); +@EXPORT = qw(lifejacket is); @EXPORT_OK = qw(under &your $seat); $VERSION = '1.05'; @@ -72,8 +77,10 @@ $seat = 'seat'; @wailing = qw(AHHHHHH); %left = ( left => "right" ); +BEGIN {*is = \&Is}; +sub Is { 'Is' }; -Exporter::export_ok_tags; +Exporter::export_ok_tags(); my %tags = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS; my %exportok = map { $_ => 1 } @EXPORT_OK; @@ -89,6 +96,24 @@ Testing->import; ::ok( defined &lifejacket, 'simple import' ); +my $got = eval {&lifejacket}; +::ok ( $@ eq "", 'check we can call the imported subroutine') + or print STDERR "# \$\@ is $@\n"; +::ok ( $got eq 'lifejacket', 'and that it gave the correct result') + or print STDERR "# expected 'lifejacket', got " . + (defined $got ? "'$got'" : "undef") . "\n"; + +# The string eval is important. It stops $Foo::{is} existing when +# Testing->import is called. +::ok( eval "defined &is", + "Import a subroutine where exporter must create the typeglob" ); +$got = eval "&is"; +::ok ( $@ eq "", 'check we can call the imported autoloaded subroutine') + or chomp ($@), print STDERR "# \$\@ is $@\n"; +::ok ( $got eq 'Is', 'and that it gave the correct result') + or print STDERR "# expected 'Is', got " . + (defined $got ? "'$got'" : "undef") . "\n"; + package Bar; my @imports = qw($seatbelt &Above stuff @wailing %left); @@ -146,7 +171,7 @@ eval { Yet::More::Testing->require_version(10); 1 }; my $warnings; BEGIN { - $SIG{__WARN__} = sub { $warnings = join '', @_ }; + local $SIG{__WARN__} = sub { $warnings = join '', @_ }; package Testing::Unused::Vars; @ISA = qw(Exporter); @EXPORT = qw(this $TODO that); @@ -158,3 +183,38 @@ BEGIN { ::ok( !$warnings, 'Unused variables can be exported without warning' ) || print "# $warnings\n"; +package Moving::Target; +@ISA = qw(Exporter); +@EXPORT_OK = qw (foo); + +sub foo {"This is foo"}; +sub bar {"This is bar"}; + +package Moving::Target::Test; + +Moving::Target->import ('foo'); + +::ok (foo() eq "This is foo", "imported foo before EXPORT_OK changed"); + +push @Moving::Target::EXPORT_OK, 'bar'; + +Moving::Target->import ('bar'); + +::ok (bar() eq "This is bar", "imported bar after EXPORT_OK changed"); + +package The::Import; + +use Exporter 'import'; + +::ok(\&import == \&Exporter::import, "imported the import routine"); + +@EXPORT = qw( wibble ); +sub wibble {return "wobble"}; + +package Use::The::Import; + +The::Import->import; + +my $val = eval { wibble() }; +::ok($val eq "wobble", "exported importer worked"); +