This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
silence a warning in Perl_sv_compile_2op
[perl5.git] / lib / Exporter.t
CommitLineData
94dd7035
MS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
9ebf09bc
JH
8# Can't use Test::Simple/More, they depend on Exporter.
9my $test = 1;
94dd7035 10sub ok ($;$) {
9ebf09bc
JH
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;
94dd7035
MS
21}
22
23
fe43f860 24print "1..28\n";
9ebf09bc
JH
25require Exporter;
26ok( 1, 'Exporter compiled' );
94dd7035
MS
27
28
29BEGIN {
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
94dd7035
MS
38
39package Testing;
40require Exporter;
41@ISA = qw(Exporter);
42
43# Make sure Testing can do everything its supposed to.
44foreach 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 );
d7341064 53@EXPORT = qw(lifejacket is);
94dd7035
MS
54@EXPORT_OK = qw(under &your $seat);
55$VERSION = '1.05';
56
57::ok( Testing->require_version(1.05), 'require_version()' );
58eval { Testing->require_version(1.11); 1 };
59::ok( $@, 'require_version() fail' );
60::ok( Testing->require_version(0), 'require_version(0)' );
61
62sub lifejacket { 'lifejacket' }
63sub stuff { 'stuff' }
64sub Above { 'Above' }
65sub the { 'the' }
66sub Fasten { 'Fasten' }
67sub your { 'your' }
68sub under { 'under' }
69use vars qw($seatbelt $seat @wailing %left);
70$seatbelt = 'seatbelt';
71$seat = 'seat';
72@wailing = qw(AHHHHHH);
73%left = ( left => "right" );
74
d7341064
NC
75BEGIN {*is = \&Is};
76sub Is { 'Is' };
94dd7035 77
09e96b99 78Exporter::export_ok_tags();
94dd7035
MS
79
80my %tags = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
81my %exportok = map { $_ => 1 } @EXPORT_OK;
82my $ok = 1;
83foreach my $tag (keys %tags) {
84 $ok = exists $exportok{$tag};
85}
86::ok( $ok, 'export_ok_tags()' );
87
88
89package Foo;
90Testing->import;
91
92::ok( defined &lifejacket, 'simple import' );
93
d7341064
NC
94my $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" );
105my $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
94dd7035
MS
112
113package Bar;
114my @imports = qw($seatbelt &Above stuff @wailing %left);
115Testing->import(@imports);
116
117::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
118 'import by symbols' );
119
120
121package Yar;
122my @tags = qw(:This :tray);
123Testing->import(@tags);
124
125::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
126 map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
127 'import by tags' );
128
129
130package Arrr;
131Testing->import(qw(!lifejacket));
132
133::ok( !defined &lifejacket, 'deny import by !' );
134
135
136package Mars;
137Testing->import('/e/');
138
139::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
140 grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
141 'import by regex');
142
143
144package Venus;
145Testing->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
153package More::Testing;
154@ISA = qw(Exporter);
155$VERSION = 0;
156eval { More::Testing->require_version(0); 1 };
157::ok(!$@, 'require_version(0) and $VERSION = 0');
158
159
160package Yet::More::Testing;
161@ISA = qw(Exporter);
162$VERSION = 0;
163eval { Yet::More::Testing->require_version(10); 1 };
164::ok($@ !~ /\(undef\)/, 'require_version(10) and $VERSION = 0');
9ebf09bc
JH
165
166
167my $warnings;
168BEGIN {
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
364e1267
NC
181package Moving::Target;
182@ISA = qw(Exporter);
183@EXPORT_OK = qw (foo);
184
185sub foo {"foo"};
186sub bar {"bar"};
187
188package Moving::Target::Test;
189
190Moving::Target->import (foo);
191
192::ok (foo eq "foo", "imported foo before EXPORT_OK changed");
193
194push @Moving::Target::EXPORT_OK, 'bar';
195
196Moving::Target->import (bar);
197
198::ok (bar eq "bar", "imported bar after EXPORT_OK changed");
fe43f860
FD
199
200package The::Import;
201
202use Exporter 'import';
203
204eval { import() };
205::ok(\&import == \&Exporter::import, "imported the import routine");
206
207@EXPORT = qw( wibble );
208sub wibble {return "wobble"};
209
210package Use::The::Import;
211
212The::Import->import;
213
214my $val = eval { wibble() };
215::ok($val eq "wobble", "exported importer worked");
216