This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Cleanup PERL_VERSION checks in .c files
[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;
cdd6375d 10plan(tests => 136);
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(
36 "print <<;\n$string\n",
37 $string,
3f29db7f 38 { switches => ['-X'] },
c49688b0
MS
39 "blank-terminated heredoc at EOF"
40 );
112d1284
FC
41 fresh_perl_is(
42 "print <<\n$string\n",
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(
78 "print <<;\n" . "x" x $_,
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(
103 qq(<<\n\$ \n),
104 # valgrind and asan reports an error between these two lines
105 qr/^Use of bare << to mean <<"" is deprecated at - line 1\.\s+Final \$/,
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(
112 q(map d$#<<<<),
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,
168 "Indented here-doc: $test",
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,
183 "Eval'd Indented here-doc: $eval",
184 ];
185 }
186 }
187 }
188
189 push @tests, [
190 "print <<~EOF;\n\t \t$string\n\t \tEOF\n",
191 $string,
192 "indented here-doc with tabs and spaces",
193 ];
194
195 push @tests, [
196 "print <<~EOF;\n\t \tx EOF\n\t \t$string\n\t \tEOF\n",
197 "x EOF\n$string",
198 "Embedded delimiter ignored",
199 ];
200
201 push @tests, [
202 "print <<~EOF;\n\t \t$string\n\t \tTEOF",
203 "Can't find string terminator \"EOF\" anywhere before EOF at - line 1.",
204 "indented here-doc missing terminator error is correct"
205 ];
206
207 push @tests, [
208 "print <<~EOF;\n $string\n$string\n $string\n $string\n EOF",
209 "Indentation on line 1 of here-doc doesn't match delimiter at - line 1.\n",
210 "indented here-doc with bad indentation"
211 ];
212
213 # If our delim is " EOF ", make sure other spaced version don't match
214 push @tests, [
215 "print <<~' EOF ';\n $string\n EOF\nEOF \n EOF \n EOF \n",
216 " $string\n EOF\nEOF \n EOF \n",
217 "intented here-doc matches final delimiter correctly"
218 ];
219
220 for my $test (@tests) {
221 fresh_perl_is(
222 $test->[0],
223 $test->[1],
224 { switches => ['-w'], stderr => 1 },
225 $test->[2],
226 );
227 }
c49688b0 228}