1# tests for heredocs besides what is tested in base/lex.t 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9use strict; 10plan(tests => 39); 11 12 13# heredoc without newline (#65838) 14{ 15 my $string = <<'HEREDOC'; 16testing for 65838 17HEREDOC 18 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, 39 { switches => ['-X'] }, 40 "blank-terminated heredoc at EOF" 41 ); 42 fresh_perl_is( 43 "print <<\n$string\n", 44 $string, 45 { switches => ['-X'] }, 46 "blank-terminated heredoc at EOF and no semicolon" 47 ); 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 ); 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 ); 60} 61 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 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 } 85 86 fresh_perl_like( 87 "print <<ThisTerminatorIsLongerThanTheData;\nno more newlines", 88 qr/find string terminator/, 89 {}, 90 "long terminator fails correctly" 91 ); 92} 93