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