4 if( $ENV{PERL_CORE} ) {
10 # Can't use Test::Simple/More, they depend on Exporter.
15 # You have to do it this way or VMS will get confused.
16 printf "%sok %d%s\n", ($ok ? '' : 'not '), $test,
17 (defined $name ? " - $name" : '');
19 printf "# Failed test at line %d\n", (caller)[2] unless $ok;
28 ok( 1, 'Exporter compiled' );
32 # Methods which Exporter says it implements.
33 @Exporter_Methods = qw(import
45 # Make sure Testing can do everything its supposed to.
46 foreach my $meth (@::Exporter_Methods) {
47 ::ok( Testing->can($meth), "subclass can $meth()" );
51 This => [qw(stuff %left)],
52 That => [qw(Above the @wailing)],
53 tray => [qw(Fasten $seatbelt)],
55 @EXPORT = qw(lifejacket is);
56 @EXPORT_OK = qw(under &your $seat);
59 ::ok( Testing->require_version(1.05), 'require_version()' );
60 eval { Testing->require_version(1.11); 1 };
61 ::ok( $@, 'require_version() fail' );
62 ::ok( Testing->require_version(0), 'require_version(0)' );
64 sub lifejacket { 'lifejacket' }
68 sub Fasten { 'Fasten' }
71 use vars qw($seatbelt $seat @wailing %left);
72 $seatbelt = 'seatbelt';
74 @wailing = qw(AHHHHHH);
75 %left = ( left => "right" );
80 Exporter::export_ok_tags();
82 my %tags = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
83 my %exportok = map { $_ => 1 } @EXPORT_OK;
85 foreach my $tag (keys %tags) {
86 $ok = exists $exportok{$tag};
88 ::ok( $ok, 'export_ok_tags()' );
94 ::ok( defined &lifejacket, 'simple import' );
96 my $got = eval {&lifejacket};
97 ::ok ( $@ eq "", 'check we can call the imported subroutine')
98 or print STDERR "# \$\@ is $@\n";
99 ::ok ( $got eq 'lifejacket', 'and that it gave the correct result')
100 or print STDERR "# expected 'lifejacket', got " .
101 (defined $got ? "'$got'" : "undef") . "\n";
103 # The string eval is important. It stops $Foo::{is} existing when
104 # Testing->import is called.
105 ::ok( eval "defined &is",
106 "Import a subroutine where exporter must create the typeglob" );
108 ::ok ( $@ eq "", 'check we can call the imported autoloaded subroutine')
109 or chomp ($@), print STDERR "# \$\@ is $@\n";
110 ::ok ( $got eq 'Is', 'and that it gave the correct result')
111 or print STDERR "# expected 'Is', got " .
112 (defined $got ? "'$got'" : "undef") . "\n";
116 my @imports = qw($seatbelt &Above stuff @wailing %left);
117 Testing->import(@imports);
119 ::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
120 'import by symbols' );
124 my @tags = qw(:This :tray);
125 Testing->import(@tags);
127 ::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
128 map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
133 Testing->import(qw(!lifejacket));
135 ::ok( !defined &lifejacket, 'deny import by !' );
139 Testing->import('/e/');
141 ::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
142 grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
147 Testing->import('!/e/');
149 ::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
150 grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
151 'deny import by regex');
152 ::ok( !defined &lifejacket, 'further denial' );
155 package More::Testing;
158 eval { More::Testing->require_version(0); 1 };
159 ::ok(!$@, 'require_version(0) and $VERSION = 0');
162 package Yet::More::Testing;
165 eval { Yet::More::Testing->require_version(10); 1 };
166 ::ok($@ !~ /\(undef\)/, 'require_version(10) and $VERSION = 0');
171 $SIG{__WARN__} = sub { $warnings = join '', @_ };
172 package Testing::Unused::Vars;
174 @EXPORT = qw(this $TODO that);
177 Testing::Unused::Vars->import;
180 ::ok( !$warnings, 'Unused variables can be exported without warning' ) ||
181 print "# $warnings\n";
183 package Moving::Target;
185 @EXPORT_OK = qw (foo);
187 sub foo {"This is foo"};
188 sub bar {"This is bar"};
190 package Moving::Target::Test;
192 Moving::Target->import ('foo');
194 ::ok (foo() eq "This is foo", "imported foo before EXPORT_OK changed");
196 push @Moving::Target::EXPORT_OK, 'bar';
198 Moving::Target->import ('bar');
200 ::ok (bar() eq "This is bar", "imported bar after EXPORT_OK changed");
204 use Exporter 'import';
207 ::ok(\&import == \&Exporter::import, "imported the import routine");
209 @EXPORT = qw( wibble );
210 sub wibble {return "wobble"};
212 package Use::The::Import;
216 my $val = eval { wibble() };
217 ::ok($val eq "wobble", "exported importer worked");