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