This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: perl@13661
[perl5.git] / lib / Exporter.t
CommitLineData
94dd7035
MS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
9ebf09bc
JH
8# Can't use Test::Simple/More, they depend on Exporter.
9my $test = 1;
94dd7035 10sub ok ($;$) {
9ebf09bc
JH
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;
94dd7035
MS
21}
22
23
9ebf09bc
JH
24print "1..19\n";
25require Exporter;
26ok( 1, 'Exporter compiled' );
94dd7035
MS
27
28
29BEGIN {
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
94dd7035
MS
38
39package Testing;
40require Exporter;
41@ISA = qw(Exporter);
42
43# Make sure Testing can do everything its supposed to.
44foreach 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);
54@EXPORT_OK = qw(under &your $seat);
55$VERSION = '1.05';
56
57::ok( Testing->require_version(1.05), 'require_version()' );
58eval { Testing->require_version(1.11); 1 };
59::ok( $@, 'require_version() fail' );
60::ok( Testing->require_version(0), 'require_version(0)' );
61
62sub lifejacket { 'lifejacket' }
63sub stuff { 'stuff' }
64sub Above { 'Above' }
65sub the { 'the' }
66sub Fasten { 'Fasten' }
67sub your { 'your' }
68sub under { 'under' }
69use vars qw($seatbelt $seat @wailing %left);
70$seatbelt = 'seatbelt';
71$seat = 'seat';
72@wailing = qw(AHHHHHH);
73%left = ( left => "right" );
74
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
92
93package Bar;
94my @imports = qw($seatbelt &Above stuff @wailing %left);
95Testing->import(@imports);
96
97::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
98 'import by symbols' );
99
100
101package Yar;
102my @tags = qw(:This :tray);
103Testing->import(@tags);
104
105::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
106 map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
107 'import by tags' );
108
109
110package Arrr;
111Testing->import(qw(!lifejacket));
112
113::ok( !defined &lifejacket, 'deny import by !' );
114
115
116package Mars;
117Testing->import('/e/');
118
119::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
120 grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
121 'import by regex');
122
123
124package Venus;
125Testing->import('!/e/');
126
127::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
128 grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
129 'deny import by regex');
130::ok( !defined &lifejacket, 'further denial' );
131
132
133package More::Testing;
134@ISA = qw(Exporter);
135$VERSION = 0;
136eval { More::Testing->require_version(0); 1 };
137::ok(!$@, 'require_version(0) and $VERSION = 0');
138
139
140package Yet::More::Testing;
141@ISA = qw(Exporter);
142$VERSION = 0;
143eval { Yet::More::Testing->require_version(10); 1 };
144::ok($@ !~ /\(undef\)/, 'require_version(10) and $VERSION = 0');
9ebf09bc
JH
145
146
147my $warnings;
148BEGIN {
149 $SIG{__WARN__} = sub { $warnings = join '', @_ };
150 package Testing::Unused::Vars;
151 @ISA = qw(Exporter);
152 @EXPORT = qw(this $TODO that);
153
154 package Foo;
155 Testing::Unused::Vars->import;
156}
157
158::ok( !$warnings, 'Unused variables can be exported without warning' ) ||
159 print "# $warnings\n";
160