This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move Exporter from lib/ to dist/Exporter/
[perl5.git] / dist / Exporter / t / Exporter.t
1 #!perl -w
2
3 # Can't use Test::Simple/More, they depend on Exporter.
4 my $test;
5 sub ok ($;$) {
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;
16 }
17
18
19 BEGIN {
20     $test = 1;
21     print "1..31\n";
22     require Exporter;
23     ok( 1, 'Exporter compiled' );
24 }
25
26
27 BEGIN {
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
36
37 package Testing;
38 require Exporter;
39 @ISA = qw(Exporter);
40
41 # Make sure Testing can do everything its supposed to.
42 foreach 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                );
51 @EXPORT    = qw(lifejacket is);
52 @EXPORT_OK = qw(under &your $seat);
53 $VERSION = '1.05';
54
55 ::ok( Testing->require_version(1.05),   'require_version()' );
56 eval { Testing->require_version(1.11); 1 };
57 ::ok( $@,                               'require_version() fail' );
58 ::ok( Testing->require_version(0),      'require_version(0)' );
59
60 sub lifejacket  { 'lifejacket'  }
61 sub stuff       { 'stuff'       }
62 sub Above       { 'Above'       }
63 sub the         { 'the'         }
64 sub Fasten      { 'Fasten'      }
65 sub your        { 'your'        }
66 sub under       { 'under'       }
67 use vars qw($seatbelt $seat @wailing %left);
68 $seatbelt = 'seatbelt';
69 $seat     = 'seat';
70 @wailing = qw(AHHHHHH);
71 %left = ( left => "right" );
72
73 BEGIN {*is = \&Is};
74 sub Is { 'Is' };
75
76 Exporter::export_ok_tags();
77
78 my %tags     = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
79 my %exportok = map { $_ => 1 } @EXPORT_OK;
80 my $ok = 1;
81 foreach my $tag (keys %tags) {
82     $ok = exists $exportok{$tag};
83 }
84 ::ok( $ok, 'export_ok_tags()' );
85
86
87 package Foo;
88 Testing->import;
89
90 ::ok( defined &lifejacket,      'simple import' );
91
92 my $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" );
103 $got = eval "&is";
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
110
111 package Bar;
112 my @imports = qw($seatbelt &Above stuff @wailing %left);
113 Testing->import(@imports);
114
115 ::ok( (! grep { my ($s, $n) = @$_; eval "\\$s$n != \\${s}Testing::$n" }
116          map  { /^(\W)(\w+)/ ? [$1, $2] : ['&', $_] }
117             @imports),
118     'import by symbols' );
119
120
121 package Yar;
122 my @tags = qw(:This :tray);
123 Testing->import(@tags);
124
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' );
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 { 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');
146
147
148 package Venus;
149 Testing->import('!/e/');
150
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
157 ::ok( !defined &lifejacket, 'further denial' );
158
159
160 package More::Testing;
161 @ISA = qw(Exporter);
162 $VERSION = 0;
163 eval { More::Testing->require_version(0); 1 };
164 ::ok(!$@,       'require_version(0) and $VERSION = 0');
165
166
167 package Yet::More::Testing;
168 @ISA = qw(Exporter);
169 $VERSION = 0;
170 eval { Yet::More::Testing->require_version(10); 1 };
171 ::ok($@ !~ /\(undef\)/,       'require_version(10) and $VERSION = 0');
172
173
174 my $warnings;
175 BEGIN {
176     local $SIG{__WARN__} = sub { $warnings = join '', @_ };
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
188 package Moving::Target;
189 @ISA = qw(Exporter);
190 @EXPORT_OK = qw (foo);
191
192 sub foo {"This is foo"};
193 sub bar {"This is bar"};
194
195 package Moving::Target::Test;
196
197 Moving::Target->import ('foo');
198
199 ::ok (foo() eq "This is foo", "imported foo before EXPORT_OK changed");
200
201 push @Moving::Target::EXPORT_OK, 'bar';
202
203 Moving::Target->import ('bar');
204
205 ::ok (bar() eq "This is bar", "imported bar after EXPORT_OK changed");
206
207 package The::Import;
208
209 use Exporter 'import';
210
211 ::ok(\&import == \&Exporter::import, "imported the import routine");
212
213 @EXPORT = qw( wibble );
214 sub wibble {return "wobble"};
215
216 package Use::The::Import;
217
218 The::Import->import;
219
220 my $val = eval { wibble() };
221 ::ok($val eq "wobble", "exported importer worked");
222
223 # Check that Carp recognizes Exporter as internal to Perl 
224 require Carp;
225 eval { Carp::croak() };
226 ::ok($Carp::Internal{Exporter}, "Carp recognizes Exporter");
227 ::ok($Carp::Internal{'Exporter::Heavy'}, "Carp recognizes Exporter::Heavy");
228
229 package Exporter::for::Tied::_;
230
231 @ISA = 'Exporter';
232 @EXPORT = 'foo';
233
234 package Tied::_;
235
236 sub 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 $_');