xref: /openbsd/gnu/usr.bin/perl/dist/Exporter/t/Exporter.t (revision 73471bf0)
1#!perl -w
2
3# Can't use Test::Simple/More, they depend on Exporter.
4my $test;
5sub 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
19BEGIN {
20    $test = 1;
21    print "1..33\n";
22    require Exporter;
23    ok( 1, 'Exporter compiled' );
24}
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
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               );
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()' );
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
73BEGIN {*is = \&Is};
74sub Is { 'Is' };
75
76Exporter::export_ok_tags();
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
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" );
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
111package Bar;
112my @imports = qw($seatbelt &Above stuff @wailing %left);
113Testing->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
121package Yar;
122my @tags = qw(:This :tray);
123Testing->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
132package Err;
133my @missing = qw(first second);
134eval { Testing->import(@missing) };
135
136for my $func (@missing) {
137    ::ok( $@ =~ /^"$func" is not exported by the Testing module$/m,
138          "$func is not exported error message" );
139}
140
141
142package Arrr;
143Testing->import(qw(!lifejacket));
144
145::ok( !defined &lifejacket,     'deny import by !' );
146
147
148package Mars;
149Testing->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    'import by regex');
156
157
158package Venus;
159Testing->import('!/e/');
160
161::ok( (! grep { my ($s, $n) = @$_; eval "\\$s$n == \\${s}Testing::$n" }
162         map  { /^(\W)(\w+)/ ? [$1, $2] : ['&', $_] }
163         grep { /e/ }
164            @Testing::EXPORT, @Testing::EXPORT_OK),
165    'deny import by regex');
166
167::ok( !defined &lifejacket, 'further denial' );
168
169
170package More::Testing;
171@ISA = qw(Exporter);
172$VERSION = 0;
173eval { More::Testing->require_version(0); 1 };
174::ok(!$@,       'require_version(0) and $VERSION = 0');
175
176
177package Yet::More::Testing;
178@ISA = qw(Exporter);
179$VERSION = 0;
180eval { Yet::More::Testing->require_version(10); 1 };
181::ok($@ !~ /\(undef\)/,       'require_version(10) and $VERSION = 0');
182
183
184my $warnings;
185BEGIN {
186    local $SIG{__WARN__} = sub { $warnings = join '', @_ };
187    package Testing::Unused::Vars;
188    @ISA = qw(Exporter);
189    @EXPORT = qw(this $TODO that);
190
191    package Foo;
192    Testing::Unused::Vars->import;
193}
194
195::ok( !$warnings, 'Unused variables can be exported without warning' ) ||
196  print "# $warnings\n";
197
198package Moving::Target;
199@ISA = qw(Exporter);
200@EXPORT_OK = qw (foo);
201
202sub foo {"This is foo"};
203sub bar {"This is bar"};
204
205package Moving::Target::Test;
206
207Moving::Target->import ('foo');
208
209::ok (foo() eq "This is foo", "imported foo before EXPORT_OK changed");
210
211push @Moving::Target::EXPORT_OK, 'bar';
212
213Moving::Target->import ('bar');
214
215::ok (bar() eq "This is bar", "imported bar after EXPORT_OK changed");
216
217package The::Import;
218
219use Exporter 'import';
220
221::ok(\&import == \&Exporter::import, "imported the import routine");
222
223@EXPORT = qw( wibble );
224sub wibble {return "wobble"};
225
226package Use::The::Import;
227
228The::Import->import;
229
230my $val = eval { wibble() };
231::ok($val eq "wobble", "exported importer worked");
232
233# Check that Carp recognizes Exporter as internal to Perl
234require Carp;
235eval { Carp::croak() };
236::ok($Carp::Internal{Exporter}, "Carp recognizes Exporter");
237::ok($Carp::Internal{'Exporter::Heavy'}, "Carp recognizes Exporter::Heavy");
238
239package Exporter::for::Tied::_;
240
241@ISA = 'Exporter';
242@EXPORT = 'foo';
243
244package Tied::_;
245
246sub TIESCALAR{bless[]}
247# no tie methods!
248
249{
250 tie my $t, __PACKAGE__;
251 for($t) { # $_ is now tied
252  import Exporter::for::Tied::_;
253 }
254}
255::ok(1, 'import with tied $_');
256