Commit | Line | Data |
---|---|---|
bc795616 | 1 | #!perl |
da851177 FC |
2 | |
3 | # Tests too complex for t/base/lex.t | |
4 | ||
f3365a56 | 5 | use strict; |
bc795616 | 6 | use warnings; |
f3365a56 | 7 | |
a817e89d | 8 | BEGIN { chdir 't' if -d 't'; require './test.pl'; } |
f3365a56 | 9 | |
e660c409 | 10 | plan(tests => 10); |
f3365a56 NC |
11 | |
12 | { | |
13 | no warnings 'deprecated'; | |
14 | print <<; # Yow! | |
15 | ok 1 | |
16 | ||
17 | # previous line intentionally left blank. | |
18 | ||
19 | my $yow = "ok 2"; | |
20 | print <<; # Yow! | |
21 | $yow | |
22 | ||
23 | # previous line intentionally left blank. | |
24 | } | |
25 | ||
26 | curr_test(3); | |
bc795616 JV |
27 | |
28 | ||
29 | { | |
30 | my %foo = (aap => "monkey"); | |
31 | my $foo = ''; | |
32 | is("@{[$foo{'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript'); | |
33 | is("@{[$foo {'aap'}]}", 'monkey', 'interpolation of hash lookup with space between lexical variable and subscript - test for [perl #70091]'); | |
34 | ||
35 | # Original bug report [perl #70091] | |
36 | # #!perl | |
37 | # use warnings; | |
38 | # my %foo; | |
39 | # my $foo = ''; | |
40 | # (my $tmp = $foo) =~ s/^/$foo {$0}/e; | |
41 | # __END__ | |
42 | # | |
43 | # This program causes a segfault with 5.10.0 and 5.10.1. | |
44 | # | |
45 | # The space between '$foo' and '{' is essential, which is why piping | |
46 | # it through perl -MO=Deparse "fixes" it. | |
47 | # | |
48 | ||
49 | } | |
50 | ||
58b85e8b FC |
51 | { |
52 | delete local $ENV{PERL_UNICODE}; | |
53 | fresh_perl_is( | |
67a057d6 FC |
54 | 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"} } "\N{a}"', |
55 | 'Constant(\N{a}) unknown at - line 1, within string' . "\n" | |
56 | ."Execution of - aborted due to compilation errors.\n", | |
57 | { stderr => 1 }, | |
58 | 'correct output (and no crash) when charnames cannot load for \N{...}' | |
58b85e8b FC |
59 | ); |
60 | } | |
67a057d6 FC |
61 | fresh_perl_is( |
62 | 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"}; | |
63 | $^H{charnames} = "foo" } "\N{a}"', | |
64 | "Undefined subroutine &main::foo called at - line 2.\n" | |
65 | ."Propagated at - line 2, within string\n" | |
66 | ."Execution of - aborted due to compilation errors.\n", | |
67 | { stderr => 1 }, | |
68 | 'no crash when charnames cannot load and %^H holds string' | |
69 | ); | |
70 | fresh_perl_is( | |
6d70c686 FC |
71 | 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"}; |
72 | $^H{charnames} = \"foo" } "\N{a}"', | |
d2192f4f FC |
73 | "Not a CODE reference at - line 2.\n" |
74 | ."Propagated at - line 2, within string\n" | |
67a057d6 FC |
75 | ."Execution of - aborted due to compilation errors.\n", |
76 | { stderr => 1 }, | |
77 | 'no crash when charnames cannot load and %^H holds string reference' | |
78 | ); | |
4aaee9b8 FC |
79 | |
80 | # not fresh_perl_is, as it seems to hide the error | |
81 | is runperl( | |
82 | nolib => 1, # -Ilib may also hide the error | |
83 | progs => [ | |
84 | '*{', | |
85 | ' XS::APItest::gv_fetchmeth_type()', | |
86 | '}' | |
87 | ], | |
88 | stderr => 1, | |
89 | ), | |
90 | "Undefined subroutine &XS::APItest::gv_fetchmeth_type called at -e line " | |
91 | ."2.\n", | |
92 | 'no buffer corruption with multiline *{...expr...}' | |
93 | ; | |
e660c409 FC |
94 | |
95 | $_ = "rhubarb"; | |
96 | is ${no strict; \$_}, "rhubarb", '${no strict; ...}'; | |
97 | is join("", map{no strict; "rhu$_" } "barb"), 'rhubarb', | |
98 | 'map{no strict;...}'; |