Make Exporter cope with changing EXPORT_OK (was Re: Recent changes to Exporter::Heavy break Math::Pari)

Message-ID: <20020928175159.GC403@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@17988

2 files changed, 48 insertions, 13 deletions

diff --git a/lib/Exporter.t b/lib/Exporter.t
index d2a9289c61..54150685a7 100644
--- a/lib/Exporter.t
+++ b/lib/Exporter.t
@@ -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");
diff --git a/lib/Exporter/Heavy.pm b/lib/Exporter/Heavy.pm
index 5e05803604..53341a2c1a 100644
--- a/lib/Exporter/Heavy.pm
+++ b/lib/Exporter/Heavy.pm
@@ -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++;
+		    }
 		}
 	    }
 	}