t/comp/retainedlines.t

   1 #!./perl -w
   2
   3 # Check that lines from eval are correctly retained by the debugger
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8     require "./test.pl";
   9 }
  10
  11 use strict;
  12
  13 plan (tests => 21);
  14
  15 $^P = 0xA;
  16
  17 my @before = grep { /eval/ } keys %::;
  18
  19 is (@before, 0, "No evals");
  20
  21 my %seen;
  22 my $name = 'foo';
  23
  24 for my $sep (' ', "\0") {
  25
  26     my $prog = "sub $name {
  27     'Perl${sep}Rules'
  28 };
  29 1;
  30 ";
  31
  32     eval $prog or die;
  33     # Is there a more efficient way to write this?
  34     my @expect_lines = (undef, map ({"$_\n"} split "\n", $prog), "\n", ';');
  35
  36     my @keys = grep {!$seen{$_}} grep { /eval/ } keys %::;
  37
  38     is (@keys, 1, "1 new eval");
  39
  40     my @got_lines = @{$::{$keys[0]}};
  41
  42     is (@got_lines, @expect_lines, "Right number of lines for " . ord $sep);
  43
  44     for (0..$#expect_lines) {
  45         is ($got_lines[$_], $expect_lines[$_], "Line $_ is correct");
  46     }
  47     $seen{$keys[0]}++;
  48     $name++;
  49 }
  50
  51 is (eval '1 + 1', 2, 'String eval works');
  52
  53 my @after = grep { /eval/ } keys %::;
  54
  55 is (@after, 0 + keys %seen,
  56     "evals that don't define subroutines are correctly cleaned up");
  57