Followup to change 34979. Tests are good, m'kay. Particularly when they

show you that something you thought worked doesn't.
Sadly it's not possible to trivially make it work, so for now they're
todo_skip().

p4raw-id: //depot/perl@34981

1 files changed, 46 insertions, 16 deletions

diff --git a/t/comp/retainedlines.t b/t/comp/retainedlines.t
index 41c279e62b..b0f999fa53 100644
--- a/t/comp/retainedlines.t
+++ b/t/comp/retainedlines.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict;
 
-plan (tests => 21);
+plan (tests => 55);
 
 $^P = 0xA;
 
@@ -19,17 +19,9 @@ my @before = grep { /eval/ } keys %::;
 is (@before, 0, "No evals");
 
 my %seen;
-my $name = 'foo';
-
-for my $sep (' ', "\0") {
 
-    my $prog = "sub $name {
-    'Perl${sep}Rules'
-};
-1;
-";
-
-    eval $prog or die;
+sub check_retained_lines {
+    my ($prog, $name) = @_;
     # Is there a more efficient way to write this?
     my @expect_lines = (undef, map ({"$_\n"} split "\n", $prog), "\n", ';');
 
@@ -39,19 +31,57 @@ for my $sep (' ', "\0") {
 
     my @got_lines = @{$::{$keys[0]}};
 
-    is (@got_lines, @expect_lines, "Right number of lines for " . ord $sep);
+    is (@got_lines, @expect_lines, "Right number of lines for $name");
 
     for (0..$#expect_lines) {
 	is ($got_lines[$_], $expect_lines[$_], "Line $_ is correct");
     }
     $seen{$keys[0]}++;
+}
+
+my $name = 'foo';
+
+for my $sep (' ', "\0") {
+
+    my $prog = "sub $name {
+    'Perl${sep}Rules'
+};
+1;
+";
+
+    eval $prog or die;
+    check_retained_lines($prog, ord $sep);
     $name++;
 }
 
-is (eval '1 + 1', 2, 'String eval works');
+foreach my $flags (0x0, 0x800, 0x1000, 0x1800) {
+    local $^P = $^P | $flags;
+    # This is easier if we accept that the guts eval will add a trailing \n
+    # for us
+    my $prog = "1 + 1 + 1\n";
+    my $fail = "1 + \n";
+
+    is (eval $prog, 3, 'String eval works');
+    if ($flags & 0x800) {
+	check_retained_lines($prog, sprintf "%#X", $^P);
+    } else {
+	my @after = grep { /eval/ } keys %::;
+
+	is (@after, 0 + keys %seen,
+	    "evals that don't define subroutines are correctly cleaned up");
+    }
 
-my @after = grep { /eval/ } keys %::;
+    is (eval $fail, undef, 'Failed string eval fails');
 
-is (@after, 0 + keys %seen,
-    "evals that don't define subroutines are correctly cleaned up");
+    if ($flags & 0x1000) {
+    TODO: {
+	    todo_skip "Can't yet retain lines for evals with syntax errors", 6;
+	    check_retained_lines($fail, sprintf "%#X", $^P);
+	}
+    } else {
+	my @after = grep { /eval/ } keys %::;
 
+	is (@after, 0 + keys %seen,
+	    "evals that fail are correctly cleaned up");
+    }
+}