1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/A# Can't use Test::Simple/More, they depend on Exporter.
1N/Amy $test = 1;
1N/Asub ok ($;$) {
1N/A my($ok, $name) = @_;
1N/A
1N/A # You have to do it this way or VMS will get confused.
1N/A printf "%sok %d%s\n", ($ok ? '' : 'not '), $test,
1N/A (defined $name ? " - $name" : '');
1N/A
1N/A printf "# Failed test at line %d\n", (caller)[2] unless $ok;
1N/A
1N/A $test++;
1N/A return $ok;
1N/A}
1N/A
1N/A
1N/Aprint "1..28\n";
1N/Arequire Exporter;
1N/Aok( 1, 'Exporter compiled' );
1N/A
1N/A
1N/ABEGIN {
1N/A # Methods which Exporter says it implements.
1N/A @Exporter_Methods = qw(import
1N/A export_to_level
1N/A require_version
1N/A export_fail
1N/A );
1N/A}
1N/A
1N/A
1N/Apackage Testing;
1N/Arequire Exporter;
1N/A@ISA = qw(Exporter);
1N/A
1N/A# Make sure Testing can do everything its supposed to.
1N/Aforeach my $meth (@::Exporter_Methods) {
1N/A ::ok( Testing->can($meth), "subclass can $meth()" );
1N/A}
1N/A
1N/A%EXPORT_TAGS = (
1N/A This => [qw(stuff %left)],
1N/A That => [qw(Above the @wailing)],
1N/A tray => [qw(Fasten $seatbelt)],
1N/A );
1N/A@EXPORT = qw(lifejacket is);
1N/A@EXPORT_OK = qw(under &your $seat);
1N/A$VERSION = '1.05';
1N/A
1N/A::ok( Testing->require_version(1.05), 'require_version()' );
1N/Aeval { Testing->require_version(1.11); 1 };
1N/A::ok( $@, 'require_version() fail' );
1N/A::ok( Testing->require_version(0), 'require_version(0)' );
1N/A
1N/Asub lifejacket { 'lifejacket' }
1N/Asub stuff { 'stuff' }
1N/Asub Above { 'Above' }
1N/Asub the { 'the' }
1N/Asub Fasten { 'Fasten' }
1N/Asub your { 'your' }
1N/Asub under { 'under' }
1N/Ause vars qw($seatbelt $seat @wailing %left);
1N/A$seatbelt = 'seatbelt';
1N/A$seat = 'seat';
1N/A@wailing = qw(AHHHHHH);
1N/A%left = ( left => "right" );
1N/A
1N/ABEGIN {*is = \&Is};
1N/Asub Is { 'Is' };
1N/A
1N/AExporter::export_ok_tags;
1N/A
1N/Amy %tags = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
1N/Amy %exportok = map { $_ => 1 } @EXPORT_OK;
1N/Amy $ok = 1;
1N/Aforeach my $tag (keys %tags) {
1N/A $ok = exists $exportok{$tag};
1N/A}
1N/A::ok( $ok, 'export_ok_tags()' );
1N/A
1N/A
1N/Apackage Foo;
1N/ATesting->import;
1N/A
1N/A::ok( defined &lifejacket, 'simple import' );
1N/A
1N/Amy $got = eval {&lifejacket};
1N/A::ok ( $@ eq "", 'check we can call the imported subroutine')
1N/A or print STDERR "# \$\@ is $@\n";
1N/A::ok ( $got eq 'lifejacket', 'and that it gave the correct result')
1N/A or print STDERR "# expected 'lifejacket', got " .
1N/A (defined $got ? "'$got'" : "undef") . "\n";
1N/A
1N/A# The string eval is important. It stops $Foo::{is} existing when
1N/A# Testing->import is called.
1N/A::ok( eval "defined &is",
1N/A "Import a subroutine where exporter must create the typeglob" );
1N/Amy $got = eval "&is";
1N/A::ok ( $@ eq "", 'check we can call the imported autoloaded subroutine')
1N/A or chomp ($@), print STDERR "# \$\@ is $@\n";
1N/A::ok ( $got eq 'Is', 'and that it gave the correct result')
1N/A or print STDERR "# expected 'Is', got " .
1N/A (defined $got ? "'$got'" : "undef") . "\n";
1N/A
1N/A
1N/Apackage Bar;
1N/Amy @imports = qw($seatbelt &Above stuff @wailing %left);
1N/ATesting->import(@imports);
1N/A
1N/A::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
1N/A 'import by symbols' );
1N/A
1N/A
1N/Apackage Yar;
1N/Amy @tags = qw(:This :tray);
1N/ATesting->import(@tags);
1N/A
1N/A::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
1N/A map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
1N/A 'import by tags' );
1N/A
1N/A
1N/Apackage Arrr;
1N/ATesting->import(qw(!lifejacket));
1N/A
1N/A::ok( !defined &lifejacket, 'deny import by !' );
1N/A
1N/A
1N/Apackage Mars;
1N/ATesting->import('/e/');
1N/A
1N/A::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
1N/A grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
1N/A 'import by regex');
1N/A
1N/A
1N/Apackage Venus;
1N/ATesting->import('!/e/');
1N/A
1N/A::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
1N/A grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
1N/A 'deny import by regex');
1N/A::ok( !defined &lifejacket, 'further denial' );
1N/A
1N/A
1N/Apackage More::Testing;
1N/A@ISA = qw(Exporter);
1N/A$VERSION = 0;
1N/Aeval { More::Testing->require_version(0); 1 };
1N/A::ok(!$@, 'require_version(0) and $VERSION = 0');
1N/A
1N/A
1N/Apackage Yet::More::Testing;
1N/A@ISA = qw(Exporter);
1N/A$VERSION = 0;
1N/Aeval { Yet::More::Testing->require_version(10); 1 };
1N/A::ok($@ !~ /\(undef\)/, 'require_version(10) and $VERSION = 0');
1N/A
1N/A
1N/Amy $warnings;
1N/ABEGIN {
1N/A $SIG{__WARN__} = sub { $warnings = join '', @_ };
1N/A package Testing::Unused::Vars;
1N/A @ISA = qw(Exporter);
1N/A @EXPORT = qw(this $TODO that);
1N/A
1N/A package Foo;
1N/A Testing::Unused::Vars->import;
1N/A}
1N/A
1N/A::ok( !$warnings, 'Unused variables can be exported without warning' ) ||
1N/A print "# $warnings\n";
1N/A
1N/Apackage Moving::Target;
1N/A@ISA = qw(Exporter);
1N/A@EXPORT_OK = qw (foo);
1N/A
1N/Asub foo {"foo"};
1N/Asub bar {"bar"};
1N/A
1N/Apackage Moving::Target::Test;
1N/A
1N/AMoving::Target->import (foo);
1N/A
1N/A::ok (foo eq "foo", "imported foo before EXPORT_OK changed");
1N/A
1N/Apush @Moving::Target::EXPORT_OK, 'bar';
1N/A
1N/AMoving::Target->import (bar);
1N/A
1N/A::ok (bar eq "bar", "imported bar after EXPORT_OK changed");
1N/A
1N/Apackage The::Import;
1N/A
1N/Ause Exporter 'import';
1N/A
1N/Aeval { import() };
1N/A::ok(\&import == \&Exporter::import, "imported the import routine");
1N/A
1N/A@EXPORT = qw( wibble );
1N/Asub wibble {return "wobble"};
1N/A
1N/Apackage Use::The::Import;
1N/A
1N/AThe::Import->import;
1N/A
1N/Amy $val = eval { wibble() };
1N/A::ok($val eq "wobble", "exported importer worked");
1N/A