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