This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Retract #11898 for now because it introduces
[perl5.git] / lib / Exporter.t
CommitLineData
94dd7035
MS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8# Utility testing functions.
9my $test_num = 1;
10sub ok ($;$) {
11 my($test, $name) = @_;
12 print "not " unless $test;
13 print "ok $test_num";
992a8485 14 print " - $name" if (defined $name && ! $^O eq 'VMS');
94dd7035
MS
15 print "\n";
16 $test_num++;
17}
18
19
20my $loaded;
21BEGIN { $| = 1; $^W = 1; }
22END {print "not ok $test_num\n" unless $loaded;}
23print "1..$Total_tests\n";
24use Exporter;
25$loaded = 1;
26ok(1, 'compile');
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
38BEGIN { $Total_tests = 14 + @Exporter_Methods }
39
40package Testing;
41require Exporter;
42@ISA = qw(Exporter);
43
44# Make sure Testing can do everything its supposed to.
45foreach my $meth (@::Exporter_Methods) {
46 ::ok( Testing->can($meth), "subclass can $meth()" );
47}
48
49%EXPORT_TAGS = (
50 This => [qw(stuff %left)],
51 That => [qw(Above the @wailing)],
52 tray => [qw(Fasten $seatbelt)],
53 );
54@EXPORT = qw(lifejacket);
55@EXPORT_OK = qw(under &your $seat);
56$VERSION = '1.05';
57
58::ok( Testing->require_version(1.05), 'require_version()' );
59eval { Testing->require_version(1.11); 1 };
60::ok( $@, 'require_version() fail' );
61::ok( Testing->require_version(0), 'require_version(0)' );
62
63sub lifejacket { 'lifejacket' }
64sub stuff { 'stuff' }
65sub Above { 'Above' }
66sub the { 'the' }
67sub Fasten { 'Fasten' }
68sub your { 'your' }
69sub under { 'under' }
70use vars qw($seatbelt $seat @wailing %left);
71$seatbelt = 'seatbelt';
72$seat = 'seat';
73@wailing = qw(AHHHHHH);
74%left = ( left => "right" );
75
76
77Exporter::export_ok_tags;
78
79my %tags = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
80my %exportok = map { $_ => 1 } @EXPORT_OK;
81my $ok = 1;
82foreach my $tag (keys %tags) {
83 $ok = exists $exportok{$tag};
84}
85::ok( $ok, 'export_ok_tags()' );
86
87
88package Foo;
89Testing->import;
90
91::ok( defined &lifejacket, 'simple import' );
92
93
94package Bar;
95my @imports = qw($seatbelt &Above stuff @wailing %left);
96Testing->import(@imports);
97
98::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
99 'import by symbols' );
100
101
102package Yar;
103my @tags = qw(:This :tray);
104Testing->import(@tags);
105
106::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
107 map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
108 'import by tags' );
109
110
111package Arrr;
112Testing->import(qw(!lifejacket));
113
114::ok( !defined &lifejacket, 'deny import by !' );
115
116
117package Mars;
118Testing->import('/e/');
119
120::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
121 grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
122 'import by regex');
123
124
125package Venus;
126Testing->import('!/e/');
127
128::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
129 grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
130 'deny import by regex');
131::ok( !defined &lifejacket, 'further denial' );
132
133
134package More::Testing;
135@ISA = qw(Exporter);
136$VERSION = 0;
137eval { More::Testing->require_version(0); 1 };
138::ok(!$@, 'require_version(0) and $VERSION = 0');
139
140
141package Yet::More::Testing;
142@ISA = qw(Exporter);
143$VERSION = 0;
144eval { Yet::More::Testing->require_version(10); 1 };
145::ok($@ !~ /\(undef\)/, 'require_version(10) and $VERSION = 0');