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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
#!perl
# Tests too complex for t/base/lex.t
use strict;
use warnings;
BEGIN { chdir 't' if -d 't'; require './test.pl'; }
plan(tests => 17);
{
no warnings 'deprecated';
print <<; # Yow!
ok 1
# previous line intentionally left blank.
my $yow = "ok 2";
print <<; # Yow!
$yow
# previous line intentionally left blank.
}
curr_test(3);
{
my %foo = (aap => "monkey");
my $foo = '';
is("@{[$foo{'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript');
is("@{[$foo {'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript - test for [perl #70091]');
# Original bug report [perl #70091]
# #!perl
# use warnings;
# my %foo;
# my $foo = '';
# (my $tmp = $foo) =~ s/^/$foo {$0}/e;
# __END__
#
# This program causes a segfault with 5.10.0 and 5.10.1.
#
# The space between '$foo' and '{' is essential, which is why piping
# it through perl -MO=Deparse "fixes" it.
#
}
{
delete local $ENV{PERL_UNICODE};
fresh_perl_is(
'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"} } "\N{a}"',
'Constant(\N{a}) unknown at - line 1, within string' . "\n"
."Execution of - aborted due to compilation errors.\n",
{ stderr => 1 },
'correct output (and no crash) when charnames cannot load for \N{...}'
);
}
fresh_perl_is(
'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"};
$^H{charnames} = "foo" } "\N{a}"',
"Undefined subroutine &main::foo called at - line 2.\n"
."Propagated at - line 2, within string\n"
."Execution of - aborted due to compilation errors.\n",
{ stderr => 1 },
'no crash when charnames cannot load and %^H holds string'
);
fresh_perl_is(
'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"};
$^H{charnames} = \"foo" } "\N{a}"',
"Not a CODE reference at - line 2.\n"
."Propagated at - line 2, within string\n"
."Execution of - aborted due to compilation errors.\n",
{ stderr => 1 },
'no crash when charnames cannot load and %^H holds string reference'
);
# not fresh_perl_is, as it seems to hide the error
is runperl(
nolib => 1, # -Ilib may also hide the error
progs => [
'*{',
' XS::APItest::gv_fetchmeth_type()',
'}'
],
stderr => 1,
),
"Undefined subroutine &XS::APItest::gv_fetchmeth_type called at -e line "
."2.\n",
'no buffer corruption with multiline *{...expr...}'
;
$_ = "rhubarb";
is ${no strict; \$_}, "rhubarb", '${no strict; ...}';
is join("", map{no strict; "rhu$_" } "barb"), 'rhubarb',
'map{no strict;...}';
# [perl #123753]
fresh_perl_is(
'$eq = "ok\n"; print $' . "\0eq\n",
"ok\n",
{ stderr => 1 },
'$ <null> ident'
);
fresh_perl_is(
'@eq = "ok\n"; print @' . "\0eq\n",
"ok\n",
{ stderr => 1 },
'@ <null> ident'
);
fresh_perl_is(
'%eq = ("o"=>"k\n"); print %' . "\0eq\n",
"ok\n",
{ stderr => 1 },
'% <null> ident'
);
fresh_perl_is(
'sub eq { "ok\n" } print &' . "\0eq\n",
"ok\n",
{ stderr => 1 },
'& <null> ident'
);
fresh_perl_is(
'$eq = "ok\n"; print ${*' . "\0eq{SCALAR}}\n",
"ok\n",
{ stderr => 1 },
'* <null> ident'
);
SKIP: {
skip "Different output on EBCDIC (presumably)", 2 if ord("A") != 65;
fresh_perl_is(
qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish,
Bareword found where operator expected at - line 1, near ""ab}"ax"
(Missing operator before ax?)
syntax error at - line 1, near ""ab}"ax"
Unrecognized character \\x8A; marked by <-- HERE after ab}"ax;&\0z<-- HERE near column 12 at - line 1.
gibberish
{ stderr => 1 },
'gibberish containing &\0z - used to crash [perl #123753]'
);
fresh_perl_is(
qq'"ab}"ax;&{+z}\x8Ao}\x82x;', <<gibberish,
Bareword found where operator expected at - line 1, near ""ab}"ax"
(Missing operator before ax?)
syntax error at - line 1, near ""ab}"ax"
Unrecognized character \\x8A; marked by <-- HERE after }"ax;&{+z}<-- HERE near column 14 at - line 1.
gibberish
{ stderr => 1 },
'gibberish containing &{+z} - used to crash [perl #123753]'
);
}
|
