lib/perl5db.t

   1 #!/usr/bin/perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 use strict;
  10 use warnings;
  11
  12 BEGIN {
  13     if (!-c "/dev/null") {
  14         print "1..0 # Skip: no /dev/null\n";
  15         exit 0;
  16     }
  17 my $dev_tty = '/dev/tty';
  18    $dev_tty = 'TT:' if ($^O eq 'VMS');
  19     if (!-c $dev_tty) {
  20         print "1..0 # Skip: no $dev_tty\n";
  21         exit 0;
  22     }
  23     if ($ENV{PERL5DB}) {
  24         print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n";
  25         exit 0;
  26     }
  27 }
  28
  29 plan(2);
  30
  31 sub rc {
  32     open RC, ">", ".perldb" or die $!;
  33     print RC @_;
  34     close(RC);
  35     # overly permissive perms gives "Must not source insecure rcfile"
  36     # and hangs at the DB(1> prompt
  37     chmod 0644, ".perldb";
  38 }
  39
  40 my $target = '../lib/perl5db/t/eval-line-bug';
  41
  42 rc(
  43     qq|
  44     &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
  45     \n|,
  46
  47     qq|
  48     sub afterinit {
  49         push(\@DB::typeahead,
  50             'b 23',
  51             'n',
  52             'n',
  53             'n',
  54             'c', # line 23
  55             'n',
  56             "p \\\@{'main::_<$target'}",
  57             'q',
  58         );
  59     }\n|,
  60 );
  61
  62 {
  63     local $ENV{PERLDB_OPTS} = "ReadLine=0";
  64     runperl(switches => [ '-d' ], progfile => $target);
  65 }
  66
  67 my $contents;
  68 {
  69     local $/;
  70     open I, "<", 'db.out' or die $!;
  71     $contents = <I>;
  72     close(I);
  73 }
  74
  75 like($contents, qr/sub factorial/,
  76     'The ${main::_<filename} variable in the debugger was not destroyed'
  77 );
  78
  79 TODO: {
  80     local $ENV{PERLDB_OPTS} = "ReadLine=0";
  81     local $::TODO = "lvalueness isn't propagated in the debugger";
  82     my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug');
  83     like($output, qr/foo is defined/, 'lvalue subs work in the debugger');
  84 }
  85
  86 # clean up.
  87
  88 END {
  89     unlink qw(.perldb db.out);
  90 }