This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(perl #128095) check pack_sockaddr_un()'s return value
[perl5.git] / t / op / heredoc.t
CommitLineData
c8e9f72f 1# tests for heredocs besides what is tested in base/lex.t
c49688b0 2
c8e9f72f 3BEGIN {
624c42e2
N
4 chdir 't' if -d 't';
5 require './test.pl';
6 set_up_inc('../lib');
c8e9f72f
DN
7}
8
c49688b0 9use strict;
23c4e912 10plan(tests => 41);
c49688b0
MS
11
12
13# heredoc without newline (#65838)
14{
15 my $string = <<'HEREDOC';
c8e9f72f
DN
16testing for 65838
17HEREDOC
c8e9f72f 18
c49688b0
MS
19 my $code = "<<'HEREDOC';\n${string}HEREDOC"; # HD w/o newline, in eval-string
20 my $hd = eval $code or warn "$@ ---";
21 is($hd, $string, "no terminating newline in string-eval");
22}
23
24
25# here-doc edge cases
26{
27 my $string = "testing for 65838";
28
29 fresh_perl_is(
30 "print <<'HEREDOC';\n${string}\nHEREDOC",
31 $string,
32 {},
33 "heredoc at EOF without trailing newline"
34 );
35
36 fresh_perl_is(
37 "print <<;\n$string\n",
38 $string,
3f29db7f 39 { switches => ['-X'] },
c49688b0
MS
40 "blank-terminated heredoc at EOF"
41 );
112d1284
FC
42 fresh_perl_is(
43 "print <<\n$string\n",
44 $string,
45 { switches => ['-X'] },
46 "blank-terminated heredoc at EOF and no semicolon"
47 );
0ee36494
FC
48 fresh_perl_is(
49 "print <<foo\r\nick and queasy\r\nfoo\r\n",
50 'ick and queasy',
51 { switches => ['-X'] },
52 "crlf-terminated heredoc"
53 );
956be2d4
FC
54 fresh_perl_is(
55 "print qq|\${\\<<foo}|\nick and queasy\nfoo\n",
56 'ick and queasy',
57 { switches => ['-w'], stderr => 1 },
58 'no warning for qq|${\<<foo}| in file'
59 );
c8e9f72f 60}
c8e9f72f 61
c49688b0
MS
62
63# here-doc parse failures
64{
65 fresh_perl_like(
66 "print <<HEREDOC;\nwibble\n HEREDOC",
67 qr/find string terminator/,
68 {},
69 "string terminator must start at newline"
70 );
71
d8fe30ad
NC
72 # Loop over various lengths to try to force at least one to cause a
73 # reallocation in S_scan_heredoc()
74 # Timing on a modern machine suggests that this loop executes in less than
75 # 0.1s, so it's a very small cost for the default build. The benefit is
76 # that building with ASAN will reveal the bug and any related regressions.
77 for (1..31) {
78 fresh_perl_like(
79 "print <<;\n" . "x" x $_,
80 qr/find string terminator/,
81 { switches => ['-X'] },
82 "empty string terminator still needs a newline (length $_)"
83 );
84 }
c49688b0
MS
85
86 fresh_perl_like(
87 "print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
88 qr/find string terminator/,
89 {},
90 "long terminator fails correctly"
91 );
d3b9036e
TC
92
93 # this would read freed memory
94 fresh_perl_like(
95 qq(0<<<<""0\n\n),
96 # valgrind and asan reports an error between these two lines
97 qr/^Number found where operator expected at - line 1, near "<<""0"\s+\(Missing operator/,
98 {},
99 "don't use an invalid oldoldbufptr"
100 );
23c4e912
TC
101
102 # [perl #125540] this asserted or crashed
103 fresh_perl_like(
104 q(map d$#<<<<),
105 qr/Can't find string terminator "" anywhere before EOF at - line 1\./,
106 {},
107 "Don't assert parsing a here-doc if we hit EOF early"
108 );
c49688b0 109}