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