This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Correct typo
[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;
945fff05 10plan(tests => 137);
c49688b0
MS
11
12# heredoc without newline (#65838)
13{
14 my $string = <<'HEREDOC';
c8e9f72f
DN
15testing for 65838
16HEREDOC
c8e9f72f 17
c49688b0
MS
18 my $code = "<<'HEREDOC';\n${string}HEREDOC"; # HD w/o newline, in eval-string
19 my $hd = eval $code or warn "$@ ---";
20 is($hd, $string, "no terminating newline in string-eval");
21}
22
23
24# here-doc edge cases
25{
26 my $string = "testing for 65838";
27
28 fresh_perl_is(
29 "print <<'HEREDOC';\n${string}\nHEREDOC",
30 $string,
31 {},
32 "heredoc at EOF without trailing newline"
33 );
34
35 fresh_perl_is(
c6e25b09 36 qq(print <<"";\n$string\n),
c49688b0 37 $string,
3f29db7f 38 { switches => ['-X'] },
c49688b0
MS
39 "blank-terminated heredoc at EOF"
40 );
112d1284 41 fresh_perl_is(
c6e25b09 42 qq(print <<""\n$string\n),
112d1284
FC
43 $string,
44 { switches => ['-X'] },
45 "blank-terminated heredoc at EOF and no semicolon"
46 );
0ee36494
FC
47 fresh_perl_is(
48 "print <<foo\r\nick and queasy\r\nfoo\r\n",
49 'ick and queasy',
50 { switches => ['-X'] },
51 "crlf-terminated heredoc"
52 );
956be2d4
FC
53 fresh_perl_is(
54 "print qq|\${\\<<foo}|\nick and queasy\nfoo\n",
55 'ick and queasy',
56 { switches => ['-w'], stderr => 1 },
57 'no warning for qq|${\<<foo}| in file'
58 );
c8e9f72f 59}
c8e9f72f 60
c49688b0
MS
61
62# here-doc parse failures
63{
64 fresh_perl_like(
65 "print <<HEREDOC;\nwibble\n HEREDOC",
66 qr/find string terminator/,
67 {},
68 "string terminator must start at newline"
69 );
70
d8fe30ad
NC
71 # Loop over various lengths to try to force at least one to cause a
72 # reallocation in S_scan_heredoc()
73 # Timing on a modern machine suggests that this loop executes in less than
74 # 0.1s, so it's a very small cost for the default build. The benefit is
75 # that building with ASAN will reveal the bug and any related regressions.
76 for (1..31) {
77 fresh_perl_like(
c6e25b09 78 qq(print <<"";\n) . "x" x $_,
d8fe30ad
NC
79 qr/find string terminator/,
80 { switches => ['-X'] },
81 "empty string terminator still needs a newline (length $_)"
82 );
83 }
c49688b0
MS
84
85 fresh_perl_like(
86 "print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
87 qr/find string terminator/,
88 {},
89 "long terminator fails correctly"
90 );
d3b9036e
TC
91
92 # this would read freed memory
93 fresh_perl_like(
94 qq(0<<<<""0\n\n),
95 # valgrind and asan reports an error between these two lines
96 qr/^Number found where operator expected at - line 1, near "<<""0"\s+\(Missing operator/,
97 {},
98 "don't use an invalid oldoldbufptr"
99 );
23c4e912 100
382450a6
TC
101 # also read freed memory, but got an invalid oldoldbufptr in a different way
102 fresh_perl_like(
c6e25b09 103 qq(<<""\n\$ \n),
382450a6 104 # valgrind and asan reports an error between these two lines
c6e25b09 105 qr/^Final \$/,
382450a6
TC
106 {},
107 "don't use an invalid oldoldbufptr (some more)"
108 );
109
23c4e912
TC
110 # [perl #125540] this asserted or crashed
111 fresh_perl_like(
dcb414ac 112 q(map d<<<<""),
23c4e912
TC
113 qr/Can't find string terminator "" anywhere before EOF at - line 1\./,
114 {},
115 "Don't assert parsing a here-doc if we hit EOF early"
116 );
19e16554
DM
117
118 # [perl #129064] heap-buffer-overflow S_scan_heredoc
119 fresh_perl_like(
120 qq(<<`\\),
121 # valgrind and asan reports an error between these two lines
122 qr/^Unterminated delimiter for here document/,
123 {},
124 "delimcpy(): handle last char being backslash properly"
125 );
cdd6375d
MH
126}
127
128
129# indented here-docs
130{
131 my $string = 'some data';
132
133 my %delimiters = (
134 q{EOF} => "EOF",
135 q{'EOF'} => "EOF",
136 q{"EOF"} => "EOF",
137 q{\EOF} => "EOF",
138 q{' EOF'} => " EOF",
139 q{'EOF '} => "EOF ",
140 q{' EOF '} => " EOF ",
141 q{" EOF"} => " EOF",
142 q{"EOF "} => "EOF ",
143 q{" EOF "} => " EOF ",
144 q{''} => "",
145 q{""} => "",
146 );
19e16554 147
cdd6375d
MH
148 my @modifiers = ("~", "~ ");
149
150 my @script_ends = ("", "\n");
151
152 my @tests;
153
154 for my $start_delim (sort keys %delimiters) {
155 my $end_delim = $delimiters{$start_delim};
156
157 for my $modifier (@modifiers) {
158 # For now, "<<~ EOF" and "<<~ \EOF" aren't allowed
159 next if $modifier =~ /\s/ && $start_delim !~ /('|")/n;
160
161 for my $script_end (@script_ends) {
162 # Normal heredoc
163 my $test = "print <<$modifier$start_delim\n $string\n"
164 . " $end_delim$script_end";
165 unshift @tests, [
166 $test,
167 $string,
c52cc390 168 "Indented here-doc: <<$modifier$start_delim with end delim '$end_delim'" . ($script_end ? "\\n" : ""),
cdd6375d
MH
169 ];
170
171 # Eval'd heredoc
172 my $safe_start_delim = $start_delim =~ s/'/\\'/gr;
173 my $eval = "
174 \$_ = '';
175 eval 's//<<$modifier$safe_start_delim.\"\"/e; print
176 $string
177 $end_delim$script_end'
178 or die \$\@
179 ";
180 push @tests, [
181 $eval,
182 $string,
c52cc390
MH
183 "Eval'd Indented here-doc: <<$modifier$start_delim with end delim '$end_delim'" . ($script_end ? "\\n" : ""),
184
cdd6375d
MH
185 ];
186 }
187 }
188 }
189
190 push @tests, [
191 "print <<~EOF;\n\t \t$string\n\t \tEOF\n",
192 $string,
193 "indented here-doc with tabs and spaces",
194 ];
195
196 push @tests, [
197 "print <<~EOF;\n\t \tx EOF\n\t \t$string\n\t \tEOF\n",
198 "x EOF\n$string",
199 "Embedded delimiter ignored",
200 ];
201
202 push @tests, [
203 "print <<~EOF;\n\t \t$string\n\t \tTEOF",
204 "Can't find string terminator \"EOF\" anywhere before EOF at - line 1.",
205 "indented here-doc missing terminator error is correct"
206 ];
207
208 push @tests, [
209 "print <<~EOF;\n $string\n$string\n $string\n $string\n EOF",
210 "Indentation on line 1 of here-doc doesn't match delimiter at - line 1.\n",
211 "indented here-doc with bad indentation"
212 ];
213
945fff05
MH
214 push @tests, [
215 "print <<~EOF;\n $string\n $string\n$string\n $string\n EOF",
216 "Indentation on line 3 of here-doc doesn't match delimiter at - line 1.\n",
217 "indented here-doc with bad indentation"
218 ];
219
cdd6375d
MH
220 # If our delim is " EOF ", make sure other spaced version don't match
221 push @tests, [
222 "print <<~' EOF ';\n $string\n EOF\nEOF \n EOF \n EOF \n",
223 " $string\n EOF\nEOF \n EOF \n",
23665de8 224 "indented here-doc matches final delimiter correctly"
cdd6375d
MH
225 ];
226
227 for my $test (@tests) {
228 fresh_perl_is(
229 $test->[0],
230 $test->[1],
231 { switches => ['-w'], stderr => 1 },
232 $test->[2],
233 );
234 }
c49688b0 235}