This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add test preambles
[perl5.git] / lib / base / t / base.t
1 #!/usr/bin/perl -w
2
3 BEGIN {
4    if( $ENV{PERL_CORE} ) {
5         chdir 't' if -d 't';
6         @INC = qw(../lib);
7     }
8 }
9
10 use strict;
11 use Test::More tests => 11;
12
13 use_ok('base');
14
15
16 package No::Version;
17
18 use vars qw($Foo);
19 sub VERSION { 42 }
20
21 package Test::Version;
22
23 use base qw(No::Version);
24 ::ok( $No::Version::VERSION =~ /set by base\.pm/,          '$VERSION bug' );
25
26 # Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
27 package Has::Version;
28
29 BEGIN { $Has::Version::VERSION = '42' };
30
31 package Test::Version2;
32
33 use base qw(Has::Version);
34 ::is( $Has::Version::VERSION, 42 );
35
36 package main;
37
38 my $eval1 = q{
39   {
40     package Eval1;
41     {
42       package Eval2;
43       use base 'Eval1';
44       $Eval2::VERSION = "1.02";
45     }
46     $Eval1::VERSION = "1.01";
47   }
48 };
49
50 eval $eval1;
51 is( $@, '' );
52
53 is( $Eval1::VERSION, 1.01 );
54
55 is( $Eval2::VERSION, 1.02 );
56
57
58 eval q{use base 'reallyReAlLyNotexists'};
59 like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
60                                           'base with empty package');
61
62 eval q{use base 'reallyReAlLyNotexists'};
63 like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
64                                           '  still empty on 2nd load');
65 {
66     my $warning;
67     local $SIG{__WARN__} = sub { $warning = shift };
68     eval q{package HomoGenous; use base 'HomoGenous';};
69     like($warning, qr/^Class 'HomoGenous' tried to inherit from itself/,
70                                           '  self-inheriting');
71 }
72
73 {
74     BEGIN { $Has::Version_0::VERSION = 0 }
75
76     package Test::Version3;
77
78     use base qw(Has::Version_0);
79     ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
80 }
81
82
83 {
84     package Schlozhauer;
85     use constant FIELDS => 6;
86
87     package Basilisco;
88     eval q{ use base 'Schlozhauer' };
89     ::is( $@, '', 'Can coexist with a FIELDS constant' );
90 }