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
87
88
89
90
91
|
#!/usr/bin/perl
use v5.18;
use warnings;
use Test2::V0;
use Object::Pad; # no version
{
no strict;
$abc = $abc; # to demostrate strict is off
ok( !eval <<'EOPERL',
class TestStrict {
sub x { $def = $def; }
}
EOPERL
'class scope with no import version implies use strict' );
like( $@, qr/^Global symbol "\$def" requires explicit package name /,
'message from failure of use strict' );
}
{
no strict;
ok( eval <<'EOPERL',
use Object::Pad 0.821;
class TestNotStrict {
sub x { $def = $def; }
}
EOPERL
'class scope with import version 0.821 does not imply use strict' )
or diag( "Code failed to compile - $@" );
}
{
my $warnings = "";
local $SIG{__WARN__} = sub {
$warnings .= join "", @_;
};
ok( defined eval <<'EOPERL',
no warnings;
class TestWarnings {
my $str = undef . "boo";
}
EOPERL
'class scope compiles for warnings test' );
like( $warnings, qr/^Use of uninitialized value in concatenation \(\.\) or string at /,
'warning from uninitialized value test' );
}
SKIP: {
# TODO: Work out why and fix it
skip "'no indirect' doesn't appear to work on this perl", 2 if $] < 5.020;
my $warnings = "";
local $SIG{__WARN__} = sub {
$warnings .= join "", @_;
};
ok( !eval <<'EOPERL',
class TestIndirect {
sub x { foo Test->new(1,2,3) }
}
1;
EOPERL
'class scope implies no indirect' );
my $e = $@;
if( $] >= 5.031009 ) {
# On perl 5.31.9 onwards we use core's no feature 'indirect' which has
# different error semantics. It gives a generic "syntax error" plus
# warnings
like( $warnings,
qr/^Bareword found where operator expected (?:\(Do you need to predeclare "foo"\?\) )?at \(eval /,
'warnings from failure of no feature "indirect"' );
like( $e,
qr/^syntax error at \(eval /,
'error result from failure of no feature "indirect"' );
}
else {
like( $e,
qr/^Indirect call of method "foo" on object "Test" /,
'message from failure of no indirect' );
}
}
done_testing;
|
