1#!./perl
2
3# Parser tests that want test.pl, eg to use runperl() for tests to show
4# reads through invalid pointers.
5# Note that this should still be runnable under miniperl.
6
7BEGIN {
8    chdir 't' if -d 't';
9    require './test.pl';
10    set_up_inc( qw(. ../lib ) );
11}
12
13plan(70);
14
15# [perl #130814] can reallocate lineptr while looking ahead for
16# "Missing $ on loop variable" diagnostic.
17my $result = fresh_perl(
18    " foreach my\n\$" . ("v" x 0x2000),
19    { stderr => 1 },
20);
21is($result . "\n", <<EXPECT);
22Identifier too long at - line 2.
23EXPECT
24
25for my $var ('$00','${00}','$001','${001}','$01','${01}','$09324', '${09324}') {
26    for my $utf8 ("","use utf8;") {
27        for my $strict ("","use strict;") {
28            fresh_perl_is(
29                "${strict}${utf8}print $var;",
30                "Numeric variables with more than one digit may not start with '0' at - line 1.",
31                {},
32                sprintf("check %s is illegal%s%s", $var,
33                    $utf8   ? " under utf8" : "",
34                    $strict ? " under strict" : ""
35                ),
36            );
37        }
38    }
39}
40
41for my $var ('$0', '${0}', '$1', '${1}', '$10', '${10}', '$9324', '${9324}') {
42    for my $utf8 ("","use utf8;") {
43        for my $strict ("","use strict;") {
44            fresh_perl_is(
45                "${strict}${utf8} print '$var' if $var or !$var;",
46                $var,
47                {},
48                sprintf("check %s is legal%s%s", $var,
49                    $utf8   ? " under utf8" : "",
50                    $strict ? " under strict" : ""
51                )
52            );
53        }
54    }
55}
56
57
58fresh_perl_is(<<EOS, <<'EXPECT', {}, "linestart before bufptr");
59\${ \xB6eeeeeeeeeeee
60'x
61EOS
62Unrecognized character \xB6; marked by <-- HERE after ${ <-- HERE near column 4 at - line 1.
63EXPECT
64
65fresh_perl_is(<<'EOS', <<'EXPECTED', {}, "use after free (#131836)");
66${sub#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
67EOS
68Missing right curly or square bracket at - line 1, at end of line
69syntax error at - line 1, at EOF
70Execution of - aborted due to compilation errors.
71EXPECTED
72
73SKIP:
74{
75    # [perl #131949] use after free
76    # detected by ASAN
77    # Win32 cmd.exe can't handle newlines well
78    skip("Need POSIXish", 1) if $^O eq "MSWin32";
79    my $out = runperl(prog => "\@{ 0\n\n}", stderr => 1, non_portable => 1);
80    is($out, "", "check for ASAN use after free");
81}
82
83fresh_perl_is('-C-', <<'EXPECTED', {}, "ambiguous unary operator check doesn't crash (#132433)");
84Warning: Use of "-C-" without parentheses is ambiguous at - line 1.
85syntax error at - line 1, at EOF
86Execution of - aborted due to compilation errors.
87EXPECTED
88
89{
90    my $work = tempfile;
91    open my $fh, ">", $work or die;
92    binmode $fh;
93    print $fh +("\n" x 50_000), "1;\n";
94    close $fh;
95    fresh_perl_is('require "./' . $work .'"; print "ok\n";', "ok\n",
96                  {}, "many blank lines doesn't crash");
97}
98
99__END__
100# ex: set ts=8 sts=4 sw=4 et:
101