Fix subtle $VERSION mistakes with base.pm
Michael G. Schwern [Thu, 5 Apr 2001 21:53:21 +0000 (22:53 +0100)]
Message-ID: <20010405215321.A4828@blackrider.blackstar.co.uk>

p4raw-id: //depot/perl@9576

lib/base.pm
t/lib/fields.t

index d055129..8db7d72 100644 (file)
@@ -55,7 +55,8 @@ sub import {
     foreach my $base (@_) {
        next if $pkg->isa($base);
        push @{"$pkg\::ISA"}, $base;
-       unless (exists ${"$base\::"}{VERSION}) {
+        my $vglob;
+       unless ($vglob = ${"$base\::"}{VERSION} and $vglob{SCALAR}) {
            eval "require $base";
            # Only ignore "Can't locate" errors from our eval require.
            # Other fatal errors (syntax etc) must be reported.
@@ -67,7 +68,7 @@ sub import {
                            "which defines that package first.)");
            }
            ${"$base\::VERSION"} = "-1, set by base.pm"
-               unless exists ${"$base\::"}{VERSION};
+               unless $vglob = ${"$base\::"}{VERSION} and $vglob{SCALAR};
        }
 
        # A simple test like (defined %{"$base\::FIELDS"}) will
index a3f591a..ae50df9 100755 (executable)
@@ -90,7 +90,7 @@ my %expect = (
     'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
 );
 
-print "1..", int(keys %expect)+13, "\n";
+print "1..", int(keys %expect)+14, "\n";
 my $testno = 0;
 while (my($class, $exp) = each %expect) {
    no strict 'refs';
@@ -170,3 +170,16 @@ print "ok ", ++$testno, "\n";
     print $a->{foo}[1], "\n";
     print $a->{bar}->{A}, "\n";
 }
+
+
+# Test $VERSION bug
+package No::Version;
+
+use vars qw($Foo);
+sub VERSION { 42 }
+
+package Test::Version;
+
+use base qw(No::Version);
+print "not " unless $No::Version::VERSION =~ /set by base\.pm/;
+print "ok ", ++$testno ,"\n";