lib/Exporter.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 # Can't use Test::Simple/More, they depend on Exporter.
   9 my $test = 1;
  10 sub ok ($;$) {
  11     my($ok, $name) = @_;
  12
  13     # You have to do it this way or VMS will get confused.
  14     printf "%sok %d%s\n", ($ok ? '' : 'not '), $test,
  15       (defined $name ? " - $name" : '');
  16
  17     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  18
  19     $test++;
  20     return $ok;
  21 }
  22
  23
  24 print "1..28\n";
  25 require Exporter;
  26 ok( 1, 'Exporter compiled' );
  27
  28
  29 BEGIN {
  30     # Methods which Exporter says it implements.
  31     @Exporter_Methods = qw(import
  32                            export_to_level
  33                            require_version
  34                            export_fail
  35                           );
  36 }
  37
  38
  39 package Testing;
  40 require Exporter;
  41 @ISA = qw(Exporter);
  42
  43 # Make sure Testing can do everything its supposed to.
  44 foreach my $meth (@::Exporter_Methods) {
  45     ::ok( Testing->can($meth), "subclass can $meth()" );
  46 }
  47
  48 %EXPORT_TAGS = (
  49                 This => [qw(stuff %left)],
  50                 That => [qw(Above the @wailing)],
  51                 tray => [qw(Fasten $seatbelt)],
  52                );
  53 @EXPORT    = qw(lifejacket is);
  54 @EXPORT_OK = qw(under &your $seat);
  55 $VERSION = '1.05';
  56
  57 ::ok( Testing->require_version(1.05),   'require_version()' );
  58 eval { Testing->require_version(1.11); 1 };
  59 ::ok( $@,                               'require_version() fail' );
  60 ::ok( Testing->require_version(0),      'require_version(0)' );
  61
  62 sub lifejacket  { 'lifejacket'  }
  63 sub stuff       { 'stuff'       }
  64 sub Above       { 'Above'       }
  65 sub the         { 'the'         }
  66 sub Fasten      { 'Fasten'      }
  67 sub your        { 'your'        }
  68 sub under       { 'under'       }
  69 use vars qw($seatbelt $seat @wailing %left);
  70 $seatbelt = 'seatbelt';
  71 $seat     = 'seat';
  72 @wailing = qw(AHHHHHH);
  73 %left = ( left => "right" );
  74
  75 BEGIN {*is = \&Is};
  76 sub Is { 'Is' };
  77
  78 Exporter::export_ok_tags;
  79
  80 my %tags     = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
  81 my %exportok = map { $_ => 1 } @EXPORT_OK;
  82 my $ok = 1;
  83 foreach my $tag (keys %tags) {
  84     $ok = exists $exportok{$tag};
  85 }
  86 ::ok( $ok, 'export_ok_tags()' );
  87
  88
  89 package Foo;
  90 Testing->import;
  91
  92 ::ok( defined &lifejacket,      'simple import' );
  93
  94 my $got = eval {&lifejacket};
  95 ::ok ( $@ eq "", 'check we can call the imported subroutine')
  96   or print STDERR "# \$\@ is $@\n";
  97 ::ok ( $got eq 'lifejacket', 'and that it gave the correct result')
  98   or print STDERR "# expected 'lifejacket', got " .
  99   (defined $got ? "'$got'" : "undef") . "\n";
 100
 101 # The string eval is important. It stops $Foo::{is} existing when
 102 # Testing->import is called.
 103 ::ok( eval "defined &is",
 104       "Import a subroutine where exporter must create the typeglob" );
 105 my $got = eval "&is";
 106 ::ok ( $@ eq "", 'check we can call the imported autoloaded subroutine')
 107   or chomp ($@), print STDERR "# \$\@ is $@\n";
 108 ::ok ( $got eq 'Is', 'and that it gave the correct result')
 109   or print STDERR "# expected 'Is', got " .
 110   (defined $got ? "'$got'" : "undef") . "\n";
 111
 112
 113 package Bar;
 114 my @imports = qw($seatbelt &Above stuff @wailing %left);
 115 Testing->import(@imports);
 116
 117 ::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
 118       'import by symbols' );
 119
 120
 121 package Yar;
 122 my @tags = qw(:This :tray);
 123 Testing->import(@tags);
 124
 125 ::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
 126              map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
 127       'import by tags' );
 128
 129
 130 package Arrr;
 131 Testing->import(qw(!lifejacket));
 132
 133 ::ok( !defined &lifejacket,     'deny import by !' );
 134
 135
 136 package Mars;
 137 Testing->import('/e/');
 138
 139 ::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
 140             grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
 141       'import by regex');
 142
 143
 144 package Venus;
 145 Testing->import('!/e/');
 146
 147 ::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
 148             grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
 149       'deny import by regex');
 150 ::ok( !defined &lifejacket, 'further denial' );
 151
 152
 153 package More::Testing;
 154 @ISA = qw(Exporter);
 155 $VERSION = 0;
 156 eval { More::Testing->require_version(0); 1 };
 157 ::ok(!$@,       'require_version(0) and $VERSION = 0');
 158
 159
 160 package Yet::More::Testing;
 161 @ISA = qw(Exporter);
 162 $VERSION = 0;
 163 eval { Yet::More::Testing->require_version(10); 1 };
 164 ::ok($@ !~ /\(undef\)/,       'require_version(10) and $VERSION = 0');
 165
 166
 167 my $warnings;
 168 BEGIN {
 169     $SIG{__WARN__} = sub { $warnings = join '', @_ };
 170     package Testing::Unused::Vars;
 171     @ISA = qw(Exporter);
 172     @EXPORT = qw(this $TODO that);
 173
 174     package Foo;
 175     Testing::Unused::Vars->import;
 176 }
 177
 178 ::ok( !$warnings, 'Unused variables can be exported without warning' ) ||
 179   print "# $warnings\n";
 180
 181 package Moving::Target;
 182 @ISA = qw(Exporter);
 183 @EXPORT_OK = qw (foo);
 184
 185 sub foo {"foo"};
 186 sub bar {"bar"};
 187
 188 package Moving::Target::Test;
 189
 190 Moving::Target->import (foo);
 191
 192 ::ok (foo eq "foo", "imported foo before EXPORT_OK changed");
 193
 194 push @Moving::Target::EXPORT_OK, 'bar';
 195
 196 Moving::Target->import (bar);
 197
 198 ::ok (bar eq "bar", "imported bar after EXPORT_OK changed");
 199
 200 package The::Import;
 201
 202 use Exporter 'import';
 203
 204 eval { import() };
 205 ::ok(\&import == \&Exporter::import, "imported the import routine");
 206
 207 @EXPORT = qw( wibble );
 208 sub wibble {return "wobble"};
 209
 210 package Use::The::Import;
 211
 212 The::Import->import;
 213
 214 my $val = eval { wibble() };
 215 ::ok($val eq "wobble", "exported importer worked");
 216