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 }
  24
  25 plan(1);
  26
  27 sub rc {
  28     open RC, ">", ".perldb" or die $!;
  29     print RC @_;
  30     close(RC);
  31     # overly permissive perms gives "Must not source insecure rcfile"
  32     # and hangs at the DB(1> prompt
  33     chmod 0644, ".perldb";
  34 }
  35
  36 my $target = '../lib/perl5db/t/eval-line-bug';
  37
  38 rc(
  39     qq|
  40     &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
  41     \n|,
  42
  43     qq|
  44     sub afterinit {
  45         push(\@DB::typeahead,
  46             'b 23',
  47             'n',
  48             'n',
  49             'n',
  50             'c', # line 23
  51             'n',
  52             "p \\\@{'main::_<$target'}",
  53             'q',
  54         );
  55     }\n|,
  56 );
  57
  58 {
  59     local $ENV{PERLDB_OPTS} = "ReadLine=0";
  60     runperl(switches => [ '-d' ], progfile => $target);
  61 }
  62
  63 my $contents;
  64 {
  65     local $/;
  66     open I, "<", 'db.out' or die $!;
  67     $contents = <I>;
  68     close(I);
  69 }
  70
  71 like($contents, qr/sub factorial/,
  72     'The ${main::_<filename} variable in the debugger was not destroyed'
  73 );
  74
  75 # clean up.
  76
  77 END {
  78     unlink qw(.perldb db.out);
  79 }