charnames.pm: Clarify comments

[perl5.git] / lib / Exporter.t

diff --git a/lib/Exporter.t b/lib/Exporter.t
index f2771db..0e69cb1 100644 (file)
--- 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..30\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,22 +96,44 @@ 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);
 Testing->import(@imports);
 
-::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
-      'import by symbols' );
+::ok( (! grep { my ($s, $n) = @$_; eval "\\$s$n != \\${s}Testing::$n" }
+         map  { /^(\W)(\w+)/ ? [$1, $2] : ['&', $_] }
+            @imports),
+    'import by symbols' );
 
 
 package Yar;
 my @tags = qw(:This :tray);
 Testing->import(@tags);
 
-::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
-             map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
-      'import by tags' );
+::ok( (! grep { my ($s, $n) = @$_; eval "\\$s$n != \\${s}Testing::$n" }
+         map  { /^(\W)(\w+)/ ? [$1, $2] : ['&', $_] }
+         map  { @$_ }
+            @{$Testing::EXPORT_TAGS{@tags}}),
+    'import by tags' );
 
 
 package Arrr;
@@ -116,17 +145,22 @@ Testing->import(qw(!lifejacket));
 package Mars;
 Testing->import('/e/');
 
-::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
-            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
-      'import by regex');
+::ok( (! grep { my ($s, $n) = @$_; eval "\\$s$n != \\${s}Testing::$n" }
+         map  { /^(\W)(\w+)/ ? [$1, $2] : ['&', $_] }
+         grep { /e/ }
+            @Testing::EXPORT, @Testing::EXPORT_OK),
+    'import by regex');
 
 
 package Venus;
 Testing->import('!/e/');
 
-::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
-            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
-      'deny import by regex');
+::ok( (! grep { my ($s, $n) = @$_; eval "\\$s$n == \\${s}Testing::$n" }
+         map  { /^(\W)(\w+)/ ? [$1, $2] : ['&', $_] }
+         grep { /e/ }
+            @Testing::EXPORT, @Testing::EXPORT_OK),
+    'deny import by regex');
+
 ::ok( !defined &lifejacket, 'further denial' );
 
 
@@ -146,7 +180,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 +192,44 @@ 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");
+
+# Check that Carp recognizes Exporter as internal to Perl 
+require Carp;
+eval { Carp::croak() };
+::ok($Carp::Internal{Exporter}, "Carp recognizes Exporter");
+::ok($Carp::Internal{'Exporter::Heavy'}, "Carp recognizes Exporter::Heavy");
+