This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deparse: handle warnings NOFATAL
[perl5.git] / dist / autouse / t / autouse.t
CommitLineData
82d4508f
MS
1#!./perl
2
3BEGIN {
78cd8b71 4 require Config;
34c716a1 5 if ($Config::Config{'extensions'} !~ m!\bList/Util\b!){
78cd8b71
NC
6 print "1..0 # Skip -- Perl configured without List::Util module\n";
7 exit 0;
8 }
82d4508f
MS
9}
10
49397f68 11my ($ok1, $ok2);
a6c2ede0 12BEGIN {
82d4508f
MS
13 require autouse;
14 eval {
aa86db36 15 "autouse"->import('Scalar::Util' => 'Scalar::Util::set_prototype(&$)');
5a02ccb1 16 };
49397f68 17 $ok1 = !$@;
5a02ccb1
MS
18
19 eval {
aa86db36 20 "autouse"->import('Scalar::Util' => 'Foo::min');
82d4508f 21 };
49397f68 22 $ok2 = $@;
82d4508f 23
aa86db36 24 "autouse"->import('Scalar::Util' => qw(isdual set_prototype(&$)));
a6c2ede0
JH
25}
26
49397f68
CG
27use Test::More tests => 15;
28
29ok( $ok1, "Function from package with custom 'import()' correctly imported" );
2572a889 30like( $ok2, qr/^autouse into different package attempted/, "Catch autouse into different package" );
49397f68 31
0c6e98c7
JK
32ok( isdual($!),
33 "Function imported via 'autouse' performs as expected");
a6c2ede0 34
a6c2ede0 35
aa86db36
SH
36# set_prototype() has a prototype of &$. Make sure that's preserved.
37sub sum { return $_[0] + $_[1] };
0c6e98c7
JK
38is( (set_prototype \&sum, '$$'), \&sum,
39 "Subroutine prototype preserved after import via 'autouse'");
82d4508f
MS
40
41
42# Example from the docs.
43use autouse 'Carp' => qw(carp croak);
44
45{
46 my @warning;
47 local $SIG{__WARN__} = sub { push @warning, @_ };
48 carp "this carp was predeclared and autoused\n";
0c6e98c7
JK
49 is( scalar @warning, 1, "Expected number of warnings received" );
50 like( $warning[0], qr/^this carp was predeclared and autoused\n/,
51 "Warning received as expected" );
82d4508f
MS
52
53 eval { croak "It is but a scratch!" };
0c6e98c7
JK
54 like( $@, qr/^It is but a scratch!/,
55 "Failure message received as expected" );
82d4508f
MS
56}
57
a6c2ede0 58
43bd726c
JH
59# Test that autouse's lazy module loading works.
60use autouse 'Errno' => qw(EPERM);
a6c2ede0 61
43bd726c 62my $mod_file = 'Errno.pm'; # just fine and portable for %INC
0c6e98c7
JK
63ok( !exists $INC{$mod_file}, "Module not yet loaded" );
64ok( EPERM, "Access a constant from that module" ); # test if non-zero
65ok( exists $INC{$mod_file}, "Module has been lazily loaded" );
a6c2ede0 66
03699e8e
MS
67use autouse Env => "something";
68eval { something() };
0c6e98c7
JK
69like( $@, qr/^\Qautoused module Env has unique import() method/,
70 "Module with unique import() method detected and error reported" );
03699e8e
MS
71
72# Check that UNIVERSAL.pm doesn't interfere with modules that don't use
73# Exporter and have no import() of their own.
74require UNIVERSAL;
00f261ef
SM
75require File::Spec;
76unshift @INC, File::Spec->catdir('t', 'lib'), 'lib';
77autouse->import("MyTestModule" => 'test_function');
78my $ret = test_function();
0c6e98c7 79is( $ret, 'works', "No interference from UNIVERSAL.pm" );
00f261ef 80
799fd3b9
FC
81# Test that autouse is exempt from all methods of triggering the subroutine
82# redefinition warning.
83SKIP: {
84 skip "Fails in 5.15.5 and below (perl bug)", 2 if $] < 5.0150051;
f965e9d4 85 use warnings; local $^W = 1; no warnings 'once';
799fd3b9
FC
86 my $w;
87 local $SIG{__WARN__} = sub { $w .= shift };
88 use autouse MyTestModule2 => 'test_function2';
89 *MyTestModule2::test_function2 = \&test_function2;
90 require MyTestModule2;
91 is $w, undef,
92 'no redefinition warning when clobbering autouse stub with new sub';
93 undef $w;
94 import MyTestModule2 'test_function2';
95 is $w, undef,
96 'no redefinition warning when clobbering autouse stub via *a=\&b';
97}
98SKIP: {
4263b1d0 99 skip "Fails in 5.15.5 and below (perl bug)", 1 if $] < 5.0150051;
799fd3b9
FC
100 use Config;
101 skip "no B", 1 unless $Config{extensions} =~ /\bB\b/;
f965e9d4 102 use warnings; local $^W = 1; no warnings 'once';
799fd3b9
FC
103 my $w;
104 local $SIG{__WARN__} = sub { $w .= shift };
105 use autouse B => "sv_undef";
106 *B::sv_undef = \&sv_undef;
107 require B;
108 is $w, undef,
109 'no redefinition warning when clobbering autouse stub with new XSUB';
110}