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