File: base.t

package info (click to toggle)
perl 5.8.8-7etch6
  • links: PTS
  • area: main
  • in suites: etch
  • size: 60,396 kB
  • ctags: 33,629
  • sloc: perl: 199,713; ansic: 160,511; sh: 33,095; pascal: 8,270; lisp: 6,121; makefile: 2,373; cpp: 2,035; yacc: 1,047; java: 23
file content (80 lines) | stat: -rwxr-xr-x 1,583 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
#!/usr/bin/perl -w

use strict;
use Test::More tests => 10;

use_ok('base');


package No::Version;

use vars qw($Foo);
sub VERSION { 42 }

package Test::Version;

use base qw(No::Version);
::ok( $No::Version::VERSION =~ /set by base\.pm/,          '$VERSION bug' );

# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
package Has::Version;

BEGIN { $Has::Version::VERSION = '42' };

package Test::Version2;

use base qw(Has::Version);
::is( $Has::Version::VERSION, 42 );

package main;

my $eval1 = q{
  {
    package Eval1;
    {
      package Eval2;
      use base 'Eval1';
      $Eval2::VERSION = "1.02";
    }
    $Eval1::VERSION = "1.01";
  }
};

eval $eval1;
is( $@, '' );

is( $Eval1::VERSION, 1.01 );

is( $Eval2::VERSION, 1.02 );


eval q{use base 'reallyReAlLyNotexists'};
like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
                                          'base with empty package');

eval q{use base 'reallyReAlLyNotexists'};
like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
                                          '  still empty on 2nd load');

BEGIN { $Has::Version_0::VERSION = 0 }

package Test::Version3;

use base qw(Has::Version_0);
::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );


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');

}