Commit | Line | Data |
---|---|---|
c8e9f72f | 1 | # tests for heredocs besides what is tested in base/lex.t |
c49688b0 | 2 | |
c8e9f72f | 3 | BEGIN { |
624c42e2 N |
4 | chdir 't' if -d 't'; |
5 | require './test.pl'; | |
6 | set_up_inc('../lib'); | |
c8e9f72f DN |
7 | } |
8 | ||
c49688b0 | 9 | use strict; |
945fff05 | 10 | plan(tests => 137); |
c49688b0 MS |
11 | |
12 | # heredoc without newline (#65838) | |
13 | { | |
14 | my $string = <<'HEREDOC'; | |
c8e9f72f DN |
15 | testing for 65838 |
16 | HEREDOC | |
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 | } |