Home | History | Annotate | Download | only in t
      1 #!/usr/bin/perl -w
      2 
      3 use strict;
      4 use Test::More tests => 10;
      5 
      6 use_ok('base');
      7 
      8 
      9 package No::Version;
     10 
     11 use vars qw($Foo);
     12 sub VERSION { 42 }
     13 
     14 package Test::Version;
     15 
     16 use base qw(No::Version);
     17 ::ok( $No::Version::VERSION =~ /set by base\.pm/,          '$VERSION bug' );
     18 
     19 # Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
     20 package Has::Version;
     21 
     22 BEGIN { $Has::Version::VERSION = '42' };
     23 
     24 package Test::Version2;
     25 
     26 use base qw(Has::Version);
     27 ::is( $Has::Version::VERSION, 42 );
     28 
     29 package main;
     30 
     31 my $eval1 = q{
     32   {
     33     package Eval1;
     34     {
     35       package Eval2;
     36       use base 'Eval1';
     37       $Eval2::VERSION = "1.02";
     38     }
     39     $Eval1::VERSION = "1.01";
     40   }
     41 };
     42 
     43 eval $eval1;
     44 is( $@, '' );
     45 
     46 is( $Eval1::VERSION, 1.01 );
     47 
     48 is( $Eval2::VERSION, 1.02 );
     49 
     50 
     51 eval q{use base 'reallyReAlLyNotexists'};
     52 like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
     53                                           'base with empty package');
     54 
     55 eval q{use base 'reallyReAlLyNotexists'};
     56 like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
     57                                           '  still empty on 2nd load');
     58 
     59 BEGIN { $Has::Version_0::VERSION = 0 }
     60 
     61 package Test::Version3;
     62 
     63 use base qw(Has::Version_0);
     64 ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
     65 
     66 
     67 package Test::SIGDIE;
     68 
     69 { 
     70     local $SIG{__DIE__} = sub { 
     71         ::fail('sigdie not caught, this test should not run') 
     72     };
     73     eval {
     74       'base'->import(qw(Huh::Boo));
     75     };
     76 
     77     ::like($@, qr/^Base class package "Huh::Boo" is empty/, 
     78          'Base class empty error message');
     79 
     80 }
     81