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