[ID 19991216.006] [PATCH 5.005_63] Reloading modules that use 'fields'

	Message-Id: <E11ym4U-0000c7-00@einstein.localnet>

p4raw-id: //depot/perl@4835

diff --git a/lib/base.pm b/lib/base.pm
index 7fb3d2b..cb5840e 100644 (file)
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -44,13 +44,16 @@ L<fields>
 
 package base;
 use vars qw($VERSION);
-$VERSION = "1.00";
+$VERSION = "1.01";
 
 sub import {
     my $class = shift;
     my $fields_base;
+    my $pkg = caller(0);
 
     foreach my $base (@_) {
+       next if $pkg->isa($base);
+       push @{"$pkg\::ISA"}, $base;
        unless (exists ${"$base\::"}{VERSION}) {
            eval "require $base";
            # Only ignore "Can't locate" errors from our eval require.
@@ -79,8 +82,6 @@ sub import {
            }
        }
     }
-    my $pkg = caller(0);
-    push @{"$pkg\::ISA"}, @_;
     if ($fields_base) {
        require fields;
        fields::inherit($pkg, $fields_base);

diff --git a/lib/fields.pm b/lib/fields.pm
index f54f639..2727a04 100644 (file)
--- a/lib/fields.pm
+++ b/lib/fields.pm
@@ -73,59 +73,85 @@ use strict;
 no strict 'refs';
 use vars qw(%attr $VERSION);
 
-$VERSION = "0.02";
+$VERSION = "1.01";
 
 # some constants
 sub _PUBLIC    () { 1 }
 sub _PRIVATE   () { 2 }
-sub _INHERITED () { 4 }
 
 # The %attr hash holds the attributes of the currently assigned fields
 # per class.  The hash is indexed by class names and the hash value is
-# an array reference.  The array is indexed with the field numbers
-# (minus one) and the values are integer bit masks (or undef).  The
-# size of the array also indicate the next field index too assign for
-# additional fields in this class.
+# an array reference.  The first element in the array is the lowest field
+# number not belonging to a base class.  The remaining elements' indices
+# are the field numbers.  The values are integer bit masks, or undef
+# in the case of base class private fields (which occupy a slot but are
+# otherwise irrelevant to the class).
 
 sub import {
     my $class = shift;
+    return unless @_;
     my $package = caller(0);
     my $fields = \%{"$package\::FIELDS"};
-    my $fattr = ($attr{$package} ||= []);
+    my $fattr = ($attr{$package} ||= [1]);
+    my $next = @$fattr;
 
+    if ($next > $fattr->[0]
+       and ($fields->{$_[0]} || 0) >= $fattr->[0])
+    {
+       # There are already fields not belonging to base classes.
+       # Looks like a possible module reload...
+       $next = $fattr->[0];
+    }
     foreach my $f (@_) {
-       if (my $fno = $fields->{$f}) {
+       my $fno = $fields->{$f};
+
+       # Allow the module to be reloaded so long as field positions
+       # have not changed.
+       if ($fno and $fno != $next) {
            require Carp;
-            if ($fattr->[$fno-1] & _INHERITED) {
+            if ($fno < $fattr->[0]) {
                 Carp::carp("Hides field '$f' in base class") if $^W;
             } else {
                 Carp::croak("Field name '$f' already in use");
             }
        }
-       $fields->{$f} = @$fattr + 1;
-        push(@$fattr, ($f =~ /^_/) ? _PRIVATE : _PUBLIC);
+       $fields->{$f} = $next;
+        $fattr->[$next] = ($f =~ /^_/) ? _PRIVATE : _PUBLIC;
+       $next += 1;
+    }
+    if (@$fattr > $next) {
+       # Well, we gave them the benefit of the doubt by guessing the
+       # module was reloaded, but they appear to be declaring fields
+       # in more than one place.  We can't be sure (without some extra
+       # bookkeeping) that the rest of the fields will be declared or
+       # have the same positions, so punt.
+       require Carp;
+       Carp::croak ("Reloaded module must declare all fields at once");
     }
 }
 
-sub inherit  # called by base.pm
+sub inherit  # called by base.pm when $base_fields is nonempty
 {
     my($derived, $base) = @_;
-
-    if (keys %{"$derived\::FIELDS"}) {
-        require Carp;
-         Carp::croak("Inherited %FIELDS can't override existing %FIELDS");
-    } else {
-         my $base_fields    = \%{"$base\::FIELDS"};
-        my $derived_fields = \%{"$derived\::FIELDS"};
-
-         $attr{$derived}[@{$attr{$base}}-1] = undef;
-         while (my($k,$v) = each %$base_fields) {
-            next if $attr{$base}[$v-1] & _PRIVATE;
-            $attr{$derived}[$v-1] = _INHERITED;
-            $derived_fields->{$k} = $v;
-         }
-    }
-    
+    my $base_attr = $attr{$base};
+    my $derived_attr = $attr{$derived} ||= [];
+    my $base_fields    = \%{"$base\::FIELDS"};
+    my $derived_fields = \%{"$derived\::FIELDS"};
+
+    $derived_attr->[0] = $base_attr ? scalar(@$base_attr) : 1;
+    while (my($k,$v) = each %$base_fields) {
+       my($fno);
+       if ($fno = $derived_fields->{$k} and $fno != $v) {
+           require Carp;
+           Carp::croak ("Inherited %FIELDS can't override existing %FIELDS");
+       }
+       if ($base_attr->[$v] & _PRIVATE) {
+           $derived_attr->[$v] = undef;
+       } else {
+           $derived_attr->[$v] = $base_attr->[$v];
+           $derived_fields->{$k} = $v;
+       }
+     }
 }
 
 sub _dump  # sometimes useful for debugging
@@ -140,12 +166,12 @@ sub _dump  # sometimes useful for debugging
       for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
          my $no = $fields->{$f};
          print "   $no: $f";
-         my $fattr = $attr{$pkg}[$no-1];
+         my $fattr = $attr{$pkg}[$no];
          if (defined $fattr) {
             my @a;
            push(@a, "public")    if $fattr & _PUBLIC;
             push(@a, "private")   if $fattr & _PRIVATE;
-            push(@a, "inherited") if $fattr & _INHERITED;
+            push(@a, "inherited") if $no < $attr{$pkg}[0];
             print "\t(", join(", ", @a), ")";
          }
          print "\n";

diff --git a/t/lib/fields.t b/t/lib/fields.t
index da874d6..74be2c2 100755 (executable)
--- a/t/lib/fields.t
+++ b/t/lib/fields.t
@@ -56,6 +56,14 @@ package Foo::Bar::Baz;
 use base 'Foo::Bar';
 use fields qw(foo bar baz);
 
+# Test repeatability for when modules get reloaded.
+package B1;
+use fields qw(b1 b2 b3);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
 package main;
 
 sub fstr