xref: /openbsd/gnu/usr.bin/perl/dist/base/t/base.t (revision 771fbea0) 
1#!/usr/bin/perl -w
2
3use strict;
4use Test::More tests => 15;
5
6use_ok('base');
7
8
9package No::Version;
10
11our $Foo;
12sub VERSION { 42 }
13
14package Test::Version;
15
16use base qw(No::Version);
17::ok( ! defined $No::Version::VERSION, '$VERSION bug' );
18
19# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
20package Has::Version;
21
22BEGIN { $Has::Version::VERSION = '42' };
23
24package Test::Version2;
25
26use base qw(Has::Version);
27::is( $Has::Version::VERSION, 42 );
28
29package main;
30
31my $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
43eval $eval1;
44is( $@, '' );
45
46is( $Eval1::VERSION, 1.01 );
47
48is( $Eval2::VERSION, 1.02 );
49
50
51eval q{use base 'reallyReAlLyNotexists'};
52like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty\./,
53                                          'base with empty package');
54
55eval q{use base 'reallyReAlLyNotexists'};
56like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty\./,
57                                          '  still empty on 2nd load');
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}
65
66{
67    BEGIN { $Has::Version_0::VERSION = 0 }
68
69    package Test::Version3;
70
71    use base qw(Has::Version_0);
72    ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
73}
74
75
76{
77    package Schlozhauer;
78    use constant FIELDS => 6;
79
80    package Basilisco;
81    eval q{ use base 'Schlozhauer' };
82    ::is( $@, '', 'Can coexist with a FIELDS constant' );
83}
84
85{
86    use lib 't/lib';
87    package UsingBroken;
88    eval q{use base 'Broken';};
89    ::like( $@, qr/^Can't locate ThisModuleDoesNotExist\.pm/,
90        'base fails to compile by loading nonexistent module');
91}
92
93SKIP: {
94    skip "unicode not supported on perl $]", 2 if $] < 5.008;
95    eval q{
96        package UsingUnicode;
97        my $base = "M\N{U+00D8}dule";
98        no strict 'refs';
99        *{"${base}::foo"} = sub {};
100        eval q{use base $base;};
101        ::is( $@, '', 'nonexistent unicode module allowed');
102    };
103
104    eval q{
105        package UsingUtf8;
106        my $base = "M\N{U+00D8}dule";
107        utf8::encode($base);
108        no strict 'refs';
109        *{"${base}::foo"} = sub {};
110        eval q{use base $base;};
111        ::is( $@, '', 'nonexistent utf8 module allowed');
112    };
113}
114
115{
116    package WithHostileINC;
117    local @INC = (@INC, "a\nb");
118    my $base = "NonExistentModule";
119    no strict 'refs';
120    *{"${base}::foo"} = sub {};
121    eval q{use base $base;};
122    ::is( $@, '', 'nonexistent module allowed when @INC has hostile entries');
123}
124