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
81
82
83
84
85
86
|
#!/usr/bin/perl
use v5.18;
use warnings;
use Test2::V0;
use Object::Pad 0.800;
class AClass {
method classm { "AClass" }
}
my $warnings = "";
BEGIN { $SIG{__WARN__} = sub { $warnings .= $_[0] }; }
role DRole { requires mmethod; }
BEGIN {
like( $warnings, qr/^'requires' is now discouraged; use an empty 'method NAME;' declaration instead at /m,
'requires keyword provokes discouraged warning' );
undef $warnings;
}
{
my @called;
my $paramsref;
class EClass {
ADJUST {
push @called, "ADJUST";
}
ADJUSTPARAMS {
my ( $href ) = @_;
push @called, "ADJUSTPARAMS";
$paramsref = $href;
}
ADJUST {
push @called, "ADJUST";
}
}
EClass->new( key => "val" );
is( \@called, [qw( ADJUST ADJUSTPARAMS ADJUST )], 'ADJUST and ADJUSTPARAMS invoked together' );
is( $paramsref, { key => "val" }, 'ADJUSTPARAMS received HASHref' );
}
my $ADJUST_LINE;
class FClass {
ADJUST {
BEGIN { $ADJUST_LINE = __LINE__+1 }
my @d0 = @_;
my $d1 = shift;
my $d2 = shift @_;
my $d3 = $_[0];
}
}
BEGIN {
my $line0 = $ADJUST_LINE;
like( $warnings, qr/^Use of \@_ is deprecated in ADJUST at \S+ line $line0\./m,
'@_ in ADJUST prints deprecation warning' );
my $line1 = $ADJUST_LINE+1;
like( $warnings, qr/^Implicit use of \@_ in shift is deprecated in ADJUST at \S+ line $line1\./m,
'shift in ADJUST prints deprecation warning' );
my $line2 = $ADJUST_LINE+2;
like( $warnings, qr/^Use of \@_ is deprecated in ADJUST at \S+ line $line2\./m,
'shift @_ in ADJUST prints deprecation warning' );
my $line3 = $ADJUST_LINE+3;
like( $warnings, qr/^Use of \@_ is deprecated in ADJUST at \S+ line $line3\./m,
'$_[0] in ADJUST prints deprecation warning' );
undef $warnings;
}
BEGIN {
undef $SIG{__WARN__};
}
done_testing;
|
