This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
base.pm no longer modifies $VERSION
authorDavid Golden <dagolden@cpan.org>
Thu, 22 Sep 2011 15:09:33 +0000 (11:09 -0400)
committerDavid Golden <dagolden@cpan.org>
Thu, 22 Sep 2011 15:19:43 +0000 (11:19 -0400)
Previously, base.pm modified the $VERSION of modules it loaded to
the string "-1, set by base.pm".  This is not a valid lax version
string and thus could not be parsed by version.pm. (It is also an
encapsulation violation, as it modifies a global in another package.)

This patch removes the $VERSION modification code entirely and uses
a private hash to track which modules base.pm has successfully loaded.
This also eliminates a subtle bug in how base.pm was checking for
the existence of a package's VERSION scalar.

[Though the final mechanism is different, thank you to John Peacock for
proposing the initial patch to eliminate the "-1..." code from base.pm]

dist/base/lib/base.pm
dist/base/t/base.t

index 3fd288c..b3443d4 100644 (file)
@@ -2,7 +2,7 @@ package base;
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '2.17';
+$VERSION = '2.18';
 $VERSION = eval $VERSION;
 
 # constant.pm is slow
@@ -22,12 +22,6 @@ sub has_fields {
     return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
 }
 
-sub has_version {
-    my($base) = shift;
-    my $vglob = ${$base.'::'}{VERSION};
-    return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
-}
-
 sub has_attr {
     my($proto) = shift;
     my($class) = ref $proto || $proto;
@@ -61,6 +55,8 @@ else {
     }
 }
 
+my %loaded; # track modules loaded via base.pm
+
 sub import {
     my $class = shift;
 
@@ -80,11 +76,7 @@ sub import {
 
         next if grep $_->isa($base), ($inheritor, @bases);
 
-        if (has_version($base)) {
-            ${$base.'::VERSION'} = '-1, set by base.pm' 
-              unless defined ${$base.'::VERSION'};
-        }
-        else {
+        if (! $loaded{$base}) {
             my $sigdie;
             {
                 local $SIG{__DIE__};
@@ -105,8 +97,7 @@ ERROR
             }
             # 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'};
+            $loaded{$base}++;
         }
         push @bases, $base;
 
@@ -206,21 +197,23 @@ those modules at the same time.  Roughly similar in effect to
         push @ISA, qw(Foo Bar);
     }
 
-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:
+When C<base> tries to C<require> a 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, C<base> will die. This is
+useful for inheriting from classes in the same file as yourself but where
+the filename does not match the base module name, like so:
 
+        # in Bar.pm
         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>.
+There is no F<Foo.pm>, but because C<Foo> defines a symbol (the C<exclaim>
+subroutine), C<base> will not die when the C<require> fails to load F<Foo.pm>.
+C<base> keeps track of modules that were successfully used as a base and will
+not C<require> them again.
 
 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
index 19a2817..6fb24ea 100644 (file)
@@ -14,7 +14,7 @@ sub VERSION { 42 }
 package Test::Version;
 
 use base qw(No::Version);
-::ok( $No::Version::VERSION =~ /set by base\.pm/,          '$VERSION bug' );
+::ok( ! defined $No::Version::VERSION, '$VERSION bug' );
 
 # Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
 package Has::Version;