Front page | perl.perl5.porters |
Postings from September 2002
[PATCH] Make Exporter cope with changing EXPORT_OK (was Re: Recent changes to Exporter::Heavy break Math::Pari)
Thread Previous
|
Thread Next
From:
Nicholas Clark
Date:
September 28, 2002 10:57
Subject:
[PATCH] Make Exporter cope with changing EXPORT_OK (was Re: Recent changes to Exporter::Heavy break Math::Pari)
Message ID:
20020928175159.GC403@Bagpuss.unfortu.net
On Sat, Sep 28, 2002 at 05:17:24PM +0100, Nicholas Clark wrote:
> On Fri, Sep 27, 2002 at 10:25:27PM -0700, David Dyck wrote:
>
> > Here is a test case that demonstrates how Math::Pari's attempt
> > to update its @EXPORT_OK is ignored by Exporter::Heavy.
> >
> > $ cat mp.pl
> > #!/usr/local/bin/perl -w
> > use strict;
> >
> > use Math::Pari 'floor';
> >
> > eval q( use Math::Pari qw(Pi); print "Pi=",Pi,"\n"; );
> > if ($@) { warn "# eval reports: $@\n"; }
Pi=3.141592653589793238462643383
> I suspect that the correct approach it to hang off the export_fail checking
> code, and reset (or rebuild) the cache there and retry once.
Appended patch does roughly this, seems to work, passes all core perl tests.
Nicholas Clark
--
Even better than the real thing: http://nms-cgi.sourceforge.net/
--- lib/Exporter/Heavy.pm.orig Fri Aug 30 01:08:41 2002
+++ lib/Exporter/Heavy.pm Sat Sep 28 18:19:37 2002
@@ -27,6 +27,17 @@ No user-serviceable parts inside.
# because Carp requires Exporter, and something has to give.
#
+sub _rebuild_cache {
+ my ($pkg, $exports, $cache) = @_;
+ s/^&// foreach @$exports;
+ @{$cache}{@$exports} = (1) x @$exports;
+ my $ok = \@{"${pkg}::EXPORT_OK"};
+ if (@$ok) {
+ s/^&// foreach @$ok;
+ @{$cache}{@$ok} = (1) x @$ok;
+ }
+}
+
sub heavy_export {
# First make import warnings look like they're coming from the "use".
@@ -49,19 +60,14 @@ sub heavy_export {
};
my($pkg, $callpkg, @imports) = @_;
- my($type, $sym, $oops);
+ my($type, $sym, $cache_is_current, $oops);
my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
$Exporter::Cache{$pkg} ||= {});
if (@imports) {
if (!%$export_cache) {
- s/^&// foreach @$exports;
- @{$export_cache}{@$exports} = (1) x @$exports;
- my $ok = \@{"${pkg}::EXPORT_OK"};
- if (@$ok) {
- s/^&// foreach @$ok;
- @{$export_cache}{@$ok} = (1) x @$ok;
- }
+ _rebuild_cache ($pkg, $exports, $export_cache);
+ $cache_is_current = 1;
}
if ($imports[0] =~ m#^[/!:]#){
@@ -127,10 +133,21 @@ sub heavy_export {
last;
}
} elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
- # accumulate the non-exports
- push @carp,
- qq["$sym" is not exported by the $pkg module\n];
- $oops++;
+ # Last chance - see if they've updated EXPORT_OK since we
+ # cached it.
+
+ unless ($cache_is_current) {
+ %$export_cache = ();
+ _rebuild_cache ($pkg, $exports, $export_cache);
+ $cache_is_current = 1;
+ }
+
+ if (!$export_cache->{$sym}) {
+ # accumulate the non-exports
+ push @carp,
+ qq["$sym" is not exported by the $pkg module\n];
+ $oops++;
+ }
}
}
}
--- lib/Exporter.t.orig Mon Dec 17 18:23:19 2001
+++ lib/Exporter.t Sat Sep 28 18:48:34 2002
@@ -21,7 +21,7 @@ sub ok ($;$) {
}
-print "1..24\n";
+print "1..26\n";
require Exporter;
ok( 1, 'Exporter compiled' );
@@ -178,3 +178,21 @@ BEGIN {
::ok( !$warnings, 'Unused variables can be exported without warning' ) ||
print "# $warnings\n";
+package Moving::Target;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw (foo);
+
+sub foo {"foo"};
+sub bar {"bar"};
+
+package Moving::Target::Test;
+
+Moving::Target->import (foo);
+
+::ok (foo eq "foo", "imported foo before EXPORT_OK changed");
+
+push @Moving::Target::EXPORT_OK, 'bar';
+
+Moving::Target->import (bar);
+
+::ok (bar eq "bar", "imported bar after EXPORT_OK changed");
Thread Previous
|
Thread Next