Commit | Line | Data |
864f8ab4 |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
9b6f3a27 |
4 | use Test::More tests => 11; |
864f8ab4 |
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'); |
9b6f3a27 |
58 | { |
59 | my $warning; |
60 | local $SIG{__WARN__} = sub { $warning = shift }; |
61 | eval q{package HomoGenous; use base 'HomoGenous';}; |
62 | like($warning, qr/^Class 'HomoGenous' tried to inherit from itself/, |
63 | ' self-inheriting'); |
64 | } |
864f8ab4 |
65 | |
66 | BEGIN { $Has::Version_0::VERSION = 0 } |
67 | |
68 | package Test::Version3; |
69 | |
70 | use base qw(Has::Version_0); |
71 | ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' ); |
72 | |
73 | |
74 | package Test::SIGDIE; |
75 | |
76 | { |
77 | local $SIG{__DIE__} = sub { |
78 | ::fail('sigdie not caught, this test should not run') |
79 | }; |
80 | eval { |
81 | 'base'->import(qw(Huh::Boo)); |
82 | }; |
83 | |
84 | ::like($@, qr/^Base class package "Huh::Boo" is empty/, |
85 | 'Base class empty error message'); |
86 | |
87 | } |