This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to base and fields 2.12, mostly by Michael G Schwern
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 6 Jul 2007 13:58:58 +0000 (13:58 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 6 Jul 2007 13:58:58 +0000 (13:58 +0000)
p4raw-id: //depot/perl@31540

12 files changed:
MANIFEST
lib/base.pm
lib/base/Changes [new file with mode: 0644]
lib/base/t/base.t
lib/base/t/fields-base.t
lib/base/t/fields.t
lib/base/t/sigdie.t [new file with mode: 0644]
lib/base/t/version.t [new file with mode: 0644]
lib/base/t/warnings.t [new file with mode: 0644]
lib/fields.pm
t/lib/Dummy.pm [new file with mode: 0644]
t/lib/HasSigDie.pm [new file with mode: 0644]

index a134634..062c028 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1456,9 +1456,13 @@ lib/AutoSplit.t                  See if AutoSplit works
 lib/autouse.pm                 Load and call a function only when it's used
 lib/autouse.t                  See if autouse works
 lib/base.pm                    Establish IS-A relationship at compile time
 lib/autouse.pm                 Load and call a function only when it's used
 lib/autouse.t                  See if autouse works
 lib/base.pm                    Establish IS-A relationship at compile time
+lib/base/Changes               base.pm changelog
 lib/base/t/base.t              See if base works
 lib/base/t/fields-base.t       See if fields work
 lib/base/t/fields.t            See if fields work
 lib/base/t/base.t              See if base works
 lib/base/t/fields-base.t       See if fields work
 lib/base/t/fields.t            See if fields work
+lib/base/t/sigdie.t            See if base works with SIGDIE
+lib/base/t/version.t           See if base works with versions
+lib/base/t/warnings.t          See if base works with warnings
 lib/Benchmark.pm               Measure execution time
 lib/Benchmark.t                        See if Benchmark works
 lib/bigfloat.pl                        An arbitrary precision floating point package
 lib/Benchmark.pm               Measure execution time
 lib/Benchmark.t                        See if Benchmark works
 lib/bigfloat.pl                        An arbitrary precision floating point package
@@ -3443,6 +3447,7 @@ t/lib/contains_pod.xr             Pod-Parser test file
 t/lib/cygwin.t                 Builtin cygwin function tests
 t/lib/Devel/switchd.pm         Module for t/run/switchd.t
 t/lib/Dev/Null.pm              Module for testing Test::Harness
 t/lib/cygwin.t                 Builtin cygwin function tests
 t/lib/Devel/switchd.pm         Module for t/run/switchd.t
 t/lib/Dev/Null.pm              Module for testing Test::Harness
+t/lib/Dummy.pm                 Module for testing base.pm
 t/lib/dprof/test1_t            Perl code profiler tests
 t/lib/dprof/test1_v            Perl code profiler tests
 t/lib/dprof/test2_t            Perl code profiler tests
 t/lib/dprof/test1_t            Perl code profiler tests
 t/lib/dprof/test1_v            Perl code profiler tests
 t/lib/dprof/test2_t            Perl code profiler tests
@@ -3470,6 +3475,7 @@ t/lib/Filter/Simple/FilterOnlyTest.pm     Helper file for Filter::Simple tests
 t/lib/Filter/Simple/FilterTest.pm      Helper file for Filter::Simple tests
 t/lib/Filter/Simple/ImportTest.pm      Helper file for Filter::Simple tests
 t/lib/filter-util.pl           See if Filter::Util::Call works
 t/lib/Filter/Simple/FilterTest.pm      Helper file for Filter::Simple tests
 t/lib/Filter/Simple/ImportTest.pm      Helper file for Filter::Simple tests
 t/lib/filter-util.pl           See if Filter::Util::Call works
+t/lib/HasSigDie.pm             Module for testing base.pm
 t/lib/h2ph.h                   Test header file for h2ph
 t/lib/h2ph.pht                 Generated output from h2ph.h by h2ph, for comparison
 t/lib/locale/latin1            Part of locale.t in Latin 1
 t/lib/h2ph.h                   Test header file for h2ph
 t/lib/h2ph.pht                 Generated output from h2ph.h by h2ph, for comparison
 t/lib/locale/latin1            Part of locale.t in Latin 1
index f1644a8..76e235d 100644 (file)
@@ -2,7 +2,7 @@ package base;
 
 use strict 'vars';
 use vars qw($VERSION);
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '2.10';
+$VERSION = '2.12';
 
 # constant.pm is slow
 sub SUCCESS () { 1 }
 
 # constant.pm is slow
 sub SUCCESS () { 1 }
@@ -40,23 +40,23 @@ sub get_attr {
 
 if ($] < 5.009) {
     *get_fields = sub {
 
 if ($] < 5.009) {
     *get_fields = sub {
-       # Shut up a possible typo warning.
-       () = \%{$_[0].'::FIELDS'};
-       my $f = \%{$_[0].'::FIELDS'};
+        # Shut up a possible typo warning.
+        () = \%{$_[0].'::FIELDS'};
+        my $f = \%{$_[0].'::FIELDS'};
 
 
-       # should be centralized in fields? perhaps
-       # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
-       # is used here anyway, it doesn't matter.
-       bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
+        # should be centralized in fields? perhaps
+        # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
+        # is used here anyway, it doesn't matter.
+        bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
 
 
-       return $f;
+        return $f;
     }
 }
 else {
     *get_fields = sub {
     }
 }
 else {
     *get_fields = sub {
-       # Shut up a possible typo warning.
-       () = \%{$_[0].'::FIELDS'};
-       return \%{$_[0].'::FIELDS'};
+        # Shut up a possible typo warning.
+        () = \%{$_[0].'::FIELDS'};
+        return \%{$_[0].'::FIELDS'};
     }
 }
 
     }
 }
 
@@ -78,41 +78,41 @@ sub import {
         next if $inheritor->isa($base);
 
         if (has_version($base)) {
         next if $inheritor->isa($base);
 
         if (has_version($base)) {
-           ${$base.'::VERSION'} = '-1, set by base.pm' 
-             unless defined ${$base.'::VERSION'};
+            ${$base.'::VERSION'} = '-1, set by base.pm' 
+              unless defined ${$base.'::VERSION'};
         }
         else {
         }
         else {
-           my $sigdie;
-           {
-               local $SIG{__DIE__};
-               eval "require $base";
-               # Only ignore "Can't locate" errors from our eval require.
-               # Other fatal errors (syntax etc) must be reported.
-               die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
-               unless (%{"$base\::"}) {
-                   require Carp;
-                   Carp::croak(<<ERROR);
+            my $sigdie;
+            {
+                local $SIG{__DIE__};
+                eval "require $base";
+                # Only ignore "Can't locate" errors from our eval require.
+                # Other fatal errors (syntax etc) must be reported.
+                die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
+                unless (%{"$base\::"}) {
+                    require Carp;
+                    Carp::croak(<<ERROR);
 Base class package "$base" is empty.
     (Perhaps you need to 'use' the module which defines that package first.)
 ERROR
 Base class package "$base" is empty.
     (Perhaps you need to 'use' the module which defines that package first.)
 ERROR
-               }
-               $sigdie = $SIG{__DIE__};
-           }
-           # Make sure a global $SIG{__DIE__} makes it out of the localization.
-           $SIG{__DIE__} = $sigdie if defined $sigdie;
+                }
+                $sigdie = $SIG{__DIE__};
+            }
+            # Make sure a global $SIG{__DIE__} makes it out of the localization.
+            $SIG{__DIE__} = $sigdie if defined $sigdie;
             ${$base.'::VERSION'} = "-1, set by base.pm"
               unless defined ${$base.'::VERSION'};
         }
         push @{"$inheritor\::ISA"}, $base;
 
         if ( has_fields($base) || has_attr($base) ) {
             ${$base.'::VERSION'} = "-1, set by base.pm"
               unless defined ${$base.'::VERSION'};
         }
         push @{"$inheritor\::ISA"}, $base;
 
         if ( has_fields($base) || has_attr($base) ) {
-           # No multiple fields inheritance *suck*
-           if ($fields_base) {
-               require Carp;
-               Carp::croak("Can't multiply inherit %FIELDS");
-           } else {
-               $fields_base = $base;
-           }
+            # No multiple fields inheritance *suck*
+            if ($fields_base) {
+                require Carp;
+                Carp::croak("Can't multiply inherit fields");
+            } else {
+                $fields_base = $base;
+            }
         }
     }
 
         }
     }
 
@@ -135,10 +135,11 @@ sub inherit_fields {
     $dattr->[0] = @$battr;
 
     if( keys %$dfields ) {
     $dattr->[0] = @$battr;
 
     if( keys %$dfields ) {
-        warn "$derived is inheriting from $base but already has its own ".
-             "fields!\n".
-             "This will cause problems.\n".
-             "Be sure you use base BEFORE declaring fields\n";
+        warn <<"END";
+$derived is inheriting from $base but already has its own fields!
+This will cause problems.  Be sure you use base BEFORE declaring fields.
+END
+
     }
 
     # Iterate through the base's fields adding all the non-private
     }
 
     # Iterate through the base's fields adding all the non-private
@@ -147,10 +148,10 @@ sub inherit_fields {
     # This is all too complicated to do efficiently with add_fields().
     while (my($k,$v) = each %$bfields) {
         my $fno;
     # This is all too complicated to do efficiently with add_fields().
     while (my($k,$v) = each %$bfields) {
         my $fno;
-       if ($fno = $dfields->{$k} and $fno != $v) {
-           require Carp;
-           Carp::croak ("Inherited %FIELDS can't override existing %FIELDS");
-       }
+        if ($fno = $dfields->{$k} and $fno != $v) {
+            require Carp;
+            Carp::croak ("Inherited fields can't override existing fields");
+        }
 
         if( $battr->[$v] & PRIVATE ) {
             $dattr->[$v] = PRIVATE | INHERITED;
 
         if( $battr->[$v] & PRIVATE ) {
             $dattr->[$v] = PRIVATE | INHERITED;
@@ -162,8 +163,8 @@ sub inherit_fields {
     }
 
     foreach my $idx (1..$#{$battr}) {
     }
 
     foreach my $idx (1..$#{$battr}) {
-       next if defined $dattr->[$idx];
-       $dattr->[$idx] = $battr->[$idx] & INHERITED;
+        next if defined $dattr->[$idx];
+        $dattr->[$idx] = $battr->[$idx] & INHERITED;
     }
 }
 
     }
 }
 
@@ -174,7 +175,7 @@ __END__
 
 =head1 NAME
 
 
 =head1 NAME
 
-base - Establish IS-A relationship with base classes at compile time
+base - Establish an ISA relationship with base classes at compile time
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
@@ -193,18 +194,29 @@ those modules at the same time.  Roughly similar in effect to
         push @ISA, qw(Foo Bar);
     }
 
         push @ISA, qw(Foo Bar);
     }
 
-If any of the listed modules are not loaded yet, I<base> silently attempts to
-C<require> them (and silently continues if the C<require> failed).  Whether to
-C<require> a base class module is determined by the absence of a global variable
-$VERSION in the base package.  If $VERSION is not detected even after loading
-it, <base> will define $VERSION in the base package, setting it to the string
-C<-1, set by base.pm>.
+C<base> employs some heuristics to determine if a module has already been
+loaded, if it has it doesn't try again. If C<base> tries to C<require> the
+module it will not die if it cannot find the module's file, but will die on any
+other error. After all this, should your base class be empty, containing no
+symbols, it will die. This is useful for inheriting from classes in the same
+file as yourself, like so:
+
+        package Foo;
+        sub exclaim { "I can have such a thing?!" }
+        
+        package Bar;
+        use base "Foo";
+
+If $VERSION is not detected even after loading it, <base> will define $VERSION
+in the base package, setting it to the string C<-1, set by base.pm>.
+
+C<base> will also initialize the fields if one of the base classes has it.
+Multiple inheritance of fields is B<NOT> supported, if two or more base classes
+each have inheritable fields the 'base' pragma will croak. See L<fields>,
+L<public> and L<protected> for a description of this feature.
+
+The base class' C<import> method is B<not> called.
 
 
-Will also initialize the fields if one of the base classes has it.
-Multiple inheritance of fields is B<NOT> supported, if two or more
-base classes each have inheritable fields the 'base' pragma will
-croak.  See L<fields>, L<public> and L<protected> for a description of
-this feature.
 
 =head1 DIAGNOSTICS
 
 
 =head1 DIAGNOSTICS
 
@@ -215,18 +227,18 @@ this feature.
 base.pm was unable to require the base package, because it was not
 found in your path.
 
 base.pm was unable to require the base package, because it was not
 found in your path.
 
-=back
+=item Class 'Foo' tried to inherit from itself
 
 
-=head1 HISTORY
+Attempting to inherit from yourself generates a warning.
 
 
-This module was introduced with Perl 5.004_04.
+    use Foo;
+    use base 'Foo';
 
 
-Attempting to inherit from yourself generates a warning:
+=back
 
 
- use Foo;
- use base 'Foo';
+=head1 HISTORY
 
 
- # Class 'Foo' tried to inherit from itself
+This module was introduced with Perl 5.004_04.
 
 =head1 CAVEATS
 
 
 =head1 CAVEATS
 
diff --git a/lib/base/Changes b/lib/base/Changes
new file mode 100644 (file)
index 0000000..b86a7bd
--- /dev/null
@@ -0,0 +1,53 @@
+2.12  Fri Jul  6 00:57:15 PDT 2007
+    Test Features
+    - Test that base.pm preserves $VERSION after real module loading.
+
+    Bug Fixes
+    - Last version broke the warning about inheriting fields.
+
+2.11  Mon Jul  2 03:30:03 PDT 2007
+    New Features
+    - Inheriting from yourself causes a warning [bleadperl 29090]
+
+    Bug Fixes
+    - Silenced warning when a class with no fields inherits from a class with
+      fields. [bleadperl 22208]
+    - An intermediate class with no fields messes up private fields
+      in the base class. [bleadperl 23266] [bleadperl 23267]
+    * Loading a module via base.pm would mask a global $SIG{__DIE__} in
+      that module. [bleadperl 31163]
+    - A constant named FIELDS in a base class would confuse base.pm
+      [bleadperl 31420]
+
+    Documentation Improvements
+    - Added a DIAGNOSTICS section [bleadperl 22748]
+    - Minor typos [bleadperl 25261]
+    - Better explain how base goes about loading classes.
+    - State explicitly that non-file classes can be based on.
+    - Document that import() is not called.
+
+    Test Fixes
+    - Fix tests for new disallowed hash key access error message in blead.
+
+2.04 through 2.10 were only released with perl.
+
+2.03 Sun Sep 14 20:01:48 PDT 2003
+    * phashes produced via fields::new() will now not warn when used for
+      forward compatiblity purposes
+    - Reformatting the docs to make them a bit more readable
+    - Making it clear that fields::new() is usable with or without
+      pseudohashes
+    * Fixing inheritence from classes which have only private fields
+    * Fixing inheritence when an intermediate class has no fields.
+      [perlbug 20020326.004]
+    - Removing uses of 'our' from tests for backwards compat.
+
+2.02 Wed Sep  3 20:40:13 PDT 2003
+    - Merging the core fields.t test and my own long ago forked base.t test
+      into fields-base.t combining all tests
+
+2.01 Thu Aug 28 13:39:32 PDT 2003
+    - Forgot to set the INSTALLDIRS to 'perl'
+
+2.0  Wed Aug 27 21:47:51 PDT 2003
+    * Seperated from Class::Fields
index 7a707de..8d32064 100644 (file)
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 12;
+use Test::More tests => 11;
 
 use_ok('base');
 
 
 use_ok('base');
 
@@ -63,31 +63,21 @@ like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
                                           '  self-inheriting');
 }
 
                                           '  self-inheriting');
 }
 
-BEGIN { $Has::Version_0::VERSION = 0 }
-
-package Test::Version3;
-
-use base qw(Has::Version_0);
-::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
+{
+    BEGIN { $Has::Version_0::VERSION = 0 }
 
 
+    package Test::Version3;
 
 
-package Test::SIGDIE;
+    use base qw(Has::Version_0);
+    ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
+}
 
 
-{ 
-    local $SIG{__DIE__} = sub { 
-        ::fail('sigdie not caught, this test should not run') 
-    };
-    eval {
-      'base'->import(qw(Huh::Boo));
-    };
 
 
-    ::like($@, qr/^Base class package "Huh::Boo" is empty/, 
-         'Base class empty error message');
+{
+    package Schlozhauer;
+    use constant FIELDS => 6;
 
 
+    package Basilisco;
+    eval q{ use base 'Schlozhauer' };
+    ::is( $@, '', 'Can coexist with a FIELDS constant' );
 }
 }
-
-package Schlozhauer;
-use constant FIELDS => 6;
-package Basilisco;
-eval q{ use base 'Schlozhauer' };
-::is( $@, '', 'Can coexist with a FIELDS constant' );
index da4b5c7..ab4daf5 100644 (file)
@@ -64,8 +64,8 @@ use base qw(M B2);
 # Test that multiple inheritance fails.
 package D6;
 eval { 'base'->import(qw(B2 M B3)); };
 # Test that multiple inheritance fails.
 package D6;
 eval { 'base'->import(qw(B2 M B3)); };
-::like($@, qr/can't multiply inherit %FIELDS/i, 
-                                        'No multiple field inheritance');
+::like($@, qr/can't multiply inherit fields/i, 
+    'No multiple field inheritance');
 
 package Foo::Bar;
 use base 'B1';
 
 package Foo::Bar;
 use base 'B1';
@@ -197,7 +197,7 @@ eval {
     require base;
     'base'->import(qw(E1 E2));
 };
     require base;
     'base'->import(qw(E1 E2));
 };
-::like( $@, qr/Can't multiply inherit %FIELDS/i, 'Again, no multi inherit' );
+::like( $@, qr/Can't multiply inherit fields/i, 'Again, no multi inherit' );
 
 
 # Test that a package with no fields can inherit from a package with
 
 
 # Test that a package with no fields can inherit from a package with
index 4d29d8d..4999cfe 100644 (file)
@@ -39,11 +39,9 @@ is_deeply( [sort &show_fields('Foo', fields::PRIVATE)],
            [sort qw(_no _up_yours)]);
 
 # We should get compile time failures field name typos
            [sort qw(_no _up_yours)]);
 
 # We should get compile time failures field name typos
-eval q(return; my Foo $obj = Foo->new; $obj->{notthere} = "");
+eval q(my Foo $obj = Foo->new; $obj->{notthere} = "");
 
 
-my $error = $Has_PH ? qr/No such(?: [\w-]+)? field "notthere"/
-    : qr/No such class field "notthere" in variable \$obj of type Foo/;
-like( $@, $error );
+like $@, qr/^No such .*field "notthere"/i;
 
 
 foreach (Foo->new) {
 
 
 foreach (Foo->new) {
diff --git a/lib/base/t/sigdie.t b/lib/base/t/sigdie.t
new file mode 100644 (file)
index 0000000..9237463
--- /dev/null
@@ -0,0 +1,36 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+   if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = qw(../lib ../t/lib);
+    }
+}
+
+use strict;
+use Test::More tests => 2;
+
+use base;
+
+{
+    package Test::SIGDIE;
+
+    local $SIG{__DIE__} = sub { 
+        ::fail('sigdie not caught, this test should not run') 
+    };
+    eval {
+      'base'->import(qw(Huh::Boo));
+    };
+
+    ::like($@, qr/^Base class package "Huh::Boo" is empty/, 
+         'Base class empty error message');
+}
+
+
+{
+    use lib 't/lib';
+    
+    local $SIG{__DIE__};
+    base->import(qw(HasSigDie));
+    ok $SIG{__DIE__}, 'base.pm does not mask SIGDIE';
+}
diff --git a/lib/base/t/version.t b/lib/base/t/version.t
new file mode 100644 (file)
index 0000000..f2d7b73
--- /dev/null
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+   if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = qw(../lib ../t/lib);
+    }
+}
+
+use strict;
+
+use Test::More tests => 1;
+
+# Here we emulate a bug with base.pm not finding the Exporter version
+# for some reason.
+use lib qw(t/lib);
+use base qw(Dummy);
+
+is( $Dummy::VERSION, 5.562,       "base.pm doesn't confuse the version" );
diff --git a/lib/base/t/warnings.t b/lib/base/t/warnings.t
new file mode 100644 (file)
index 0000000..51e9174
--- /dev/null
@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 1;
+
+my $warnings;
+BEGIN {
+    $SIG{__WARN__} = sub { $warnings = join '', @_ };
+}
+
+{
+    package Foo;
+    use fields qw(thing);
+}
+
+{
+    package Bar;
+    use fields qw(stuff);
+    use base qw(Foo);
+}
+
+::like $warnings,
+       '/^Bar is inheriting from Foo but already has its own fields!/',
+       'Inheriting from a base with protected fields warns';
index cca778f..44a68c5 100644 (file)
@@ -3,7 +3,7 @@ package fields;
 require 5.005;
 use strict;
 no strict 'refs';
 require 5.005;
 use strict;
 no strict 'refs';
-unless( eval q{require warnings::register; warnings::register->import} ) {
+unless( eval q{require warnings::register; warnings::register->import; 1} ) {
     *warnings::warnif = sub { 
         require Carp;
         Carp::carp(@_);
     *warnings::warnif = sub { 
         require Carp;
         Carp::carp(@_);
@@ -11,7 +11,7 @@ unless( eval q{require warnings::register; warnings::register->import} ) {
 }
 use vars qw(%attr $VERSION);
 
 }
 use vars qw(%attr $VERSION);
 
-$VERSION = '2.03';
+$VERSION = '2.12';
 
 # constant.pm is slow
 sub PUBLIC     () { 2**0  }
 
 # constant.pm is slow
 sub PUBLIC     () { 2**0  }
@@ -42,19 +42,19 @@ sub import {
     bless \%{"$package\::FIELDS"}, 'pseudohash';
 
     if ($next > $fattr->[0]
     bless \%{"$package\::FIELDS"}, 'pseudohash';
 
     if ($next > $fattr->[0]
-       and ($fields->{$_[0]} || 0) >= $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];
+        # There are already fields not belonging to base classes.
+        # Looks like a possible module reload...
+        $next = $fattr->[0];
     }
     foreach my $f (@_) {
     }
     foreach my $f (@_) {
-       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;
+        # Allow the module to be reloaded so long as field positions
+        # have not changed.
+        if ($fno and $fno != $next) {
+            require Carp;
             if ($fno < $fattr->[0]) {
               if ($] < 5.006001) {
                 warn("Hides field '$f' in base class") if $^W;
             if ($fno < $fattr->[0]) {
               if ($] < 5.006001) {
                 warn("Hides field '$f' in base class") if $^W;
@@ -64,19 +64,19 @@ sub import {
             } else {
                 Carp::croak("Field name '$f' already in use");
             }
             } else {
                 Carp::croak("Field name '$f' already in use");
             }
-       }
-       $fields->{$f} = $next;
+        }
+        $fields->{$f} = $next;
         $fattr->[$next] = ($f =~ /^_/) ? PRIVATE : PUBLIC;
         $fattr->[$next] = ($f =~ /^_/) ? PRIVATE : PUBLIC;
-       $next += 1;
+        $next += 1;
     }
     if (@$fattr > $next) {
     }
     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");
+        # 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");
     }
 }
 
     }
 }
 
@@ -88,25 +88,25 @@ sub inherit {
 sub _dump  # sometimes useful for debugging
 {
     for my $pkg (sort keys %attr) {
 sub _dump  # sometimes useful for debugging
 {
     for my $pkg (sort keys %attr) {
-       print "\n$pkg";
-       if (@{"$pkg\::ISA"}) {
-           print " (", join(", ", @{"$pkg\::ISA"}), ")";
-       }
-       print "\n";
-       my $fields = \%{"$pkg\::FIELDS"};
-       for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
-           my $no = $fields->{$f};
-           print "   $no: $f";
-           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;
-               print "\t(", join(", ", @a), ")";
-           }
-           print "\n";
-       }
+        print "\n$pkg";
+        if (@{"$pkg\::ISA"}) {
+            print " (", join(", ", @{"$pkg\::ISA"}), ")";
+        }
+        print "\n";
+        my $fields = \%{"$pkg\::FIELDS"};
+        for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
+            my $no = $fields->{$f};
+            print "   $no: $f";
+            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;
+                print "\t(", join(", ", @a), ")";
+            }
+            print "\n";
+        }
     }
 }
 
     }
 }
 
@@ -177,16 +177,16 @@ fields - compile-time class fields
     {
         package Foo;
         use fields qw(foo bar _Foo_private);
     {
         package Foo;
         use fields qw(foo bar _Foo_private);
-       sub new {
-           my Foo $self = shift;
-           unless (ref $self) {
-               $self = fields::new($self);
-               $self->{_Foo_private} = "this is Foo's secret";
-           }
-           $self->{foo} = 10;
-           $self->{bar} = 20;
-           return $self;
-       }
+        sub new {
+            my Foo $self = shift;
+            unless (ref $self) {
+                $self = fields::new($self);
+                $self->{_Foo_private} = "this is Foo's secret";
+            }
+            $self->{foo} = 10;
+            $self->{bar} = 20;
+            return $self;
+        }
     }
 
     my $var = Foo->new;
     }
 
     my $var = Foo->new;
@@ -199,15 +199,15 @@ fields - compile-time class fields
     {
         package Bar;
         use base 'Foo';
     {
         package Bar;
         use base 'Foo';
-        use fields qw(baz _Bar_private);       # not shared with Foo
-       sub new {
-           my $class = shift;
-           my $self = fields::new($class);
-           $self->SUPER::new();                # init base fields
-           $self->{baz} = 10;                  # init own fields
-           $self->{_Bar_private} = "this is Bar's secret";
-           return $self;
-       }
+        use fields qw(baz _Bar_private);        # not shared with Foo
+        sub new {
+            my $class = shift;
+            my $self = fields::new($class);
+            $self->SUPER::new();                # init base fields
+            $self->{baz} = 10;                  # init own fields
+            $self->{_Bar_private} = "this is Bar's secret";
+            return $self;
+        }
     }
 
 =head1 DESCRIPTION
     }
 
 =head1 DESCRIPTION
@@ -268,11 +268,11 @@ This makes it possible to write a constructor like this:
     use fields qw(cat dog bird);
 
     sub new {
     use fields qw(cat dog bird);
 
     sub new {
-       my $self = shift;
-       $self = fields::new($self) unless ref $self;
-       $self->{cat} = 'meow';                          # scalar element
-       @$self{'dog','bird'} = ('bark','tweet');        # slice
-       return $self;
+        my $self = shift;
+        $self = fields::new($self) unless ref $self;
+        $self->{cat} = 'meow';                          # scalar element
+        @$self{'dog','bird'} = ('bark','tweet');        # slice
+        return $self;
     }
 
 =item phash
     }
 
 =item phash
diff --git a/t/lib/Dummy.pm b/t/lib/Dummy.pm
new file mode 100644 (file)
index 0000000..504330f
--- /dev/null
@@ -0,0 +1,4 @@
+package Dummy;
+
+# Attempt to emulate a bug with finding the version in Exporter.
+$VERSION = '5.562';
diff --git a/t/lib/HasSigDie.pm b/t/lib/HasSigDie.pm
new file mode 100644 (file)
index 0000000..3368e04
--- /dev/null
@@ -0,0 +1,6 @@
+package HasSigDie;
+
+$SIG{__DIE__} = sub { "Die, Bart, Die!" };
+
+1;
+