use Config;
BEGIN {
- if (!-c "/dev/null") {
- print "1..0 # Skip: no /dev/null\n";
- exit 0;
+ if (! -c "/dev/null") {
+ print "1..0 # Skip: no /dev/null\n";
+ exit 0;
}
-my $dev_tty = '/dev/tty';
- $dev_tty = 'TT:' if ($^O eq 'VMS');
- if (!-c $dev_tty) {
- print "1..0 # Skip: no $dev_tty\n";
- exit 0;
+
+ my $dev_tty = '/dev/tty';
+ $dev_tty = 'TT:' if ($^O eq 'VMS');
+ if (! -c $dev_tty) {
+ print "1..0 # Skip: no $dev_tty\n";
+ exit 0;
}
if ($ENV{PERL5DB}) {
- print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n";
- exit 0;
+ print "1..0 # Skip: \$ENV{PERL5DB} is already set to '$ENV{PERL5DB}'\n";
+ exit 0;
}
}
-plan(8);
+plan(14);
+
+my $rc_filename = '.perldb';
sub rc {
- open RC, ">", ".perldb" or die $!;
- print RC @_;
- close(RC);
+ open my $rc_fh, '>', $rc_filename
+ or die $!;
+ print {$rc_fh} @_;
+ close ($rc_fh);
+
# overly permissive perms gives "Must not source insecure rcfile"
# and hangs at the DB(1> prompt
- chmod 0644, ".perldb";
+ chmod 0644, $rc_filename;
}
-my $target = '../lib/perl5db/t/eval-line-bug';
+sub _slurp
+{
+ my $filename = shift;
-rc(
- qq|
- &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
- \n|,
+ open my $in, '<', $filename
+ or die "Cannot open '$filename' for slurping - $!";
- qq|
- sub afterinit {
- push(\@DB::typeahead,
- 'b 23',
- 'n',
- 'n',
- 'n',
- 'c', # line 23
- 'n',
- "p \\\@{'main::_<$target'}",
- 'q',
- );
- }\n|,
-);
+ local $/;
+ my $contents = <$in>;
+
+ close($in);
+
+ return $contents;
+}
+
+my $out_fn = 'db.out';
+sub _out_contents
{
- local $ENV{PERLDB_OPTS} = "ReadLine=0";
- runperl(switches => [ '-d' ], progfile => $target);
+ return _slurp($out_fn);
}
-my $contents;
{
- local $/;
- open I, "<", 'db.out' or die $!;
- $contents = <I>;
- close(I);
+ my $target = '../lib/perl5db/t/eval-line-bug';
+
+ rc(
+ <<"EOF",
+ &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+ sub afterinit {
+ push(\@DB::typeahead,
+ 'b 23',
+ 'n',
+ 'n',
+ 'n',
+ 'c', # line 23
+ 'n',
+ "p \\\@{'main::_<$target'}",
+ 'q',
+ );
+ }
+EOF
+ );
+
+ {
+ local $ENV{PERLDB_OPTS} = "ReadLine=0";
+ runperl(switches => [ '-d' ], progfile => $target);
+ }
}
-like($contents, qr/sub factorial/,
+like(_out_contents(), qr/sub factorial/,
'The ${main::_<filename} variable in the debugger was not destroyed'
);
# Test [perl #61222]
{
rc(
- qq|
+ <<'EOF',
&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
- \n|,
- qq|
sub afterinit {
- push(\@DB::typeahead,
+ push(@DB::typeahead,
'm Pie',
'q',
);
- }\n|,
+ }
+EOF
);
my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-61222');
- my $contents;
- {
- local $/;
- open I, "<", 'db.out' or die $!;
- $contents = <I>;
- close(I);
- }
- unlike($contents, qr/INCORRECT/, "[perl #61222]");
+ unlike(_out_contents(), qr/INCORRECT/, "[perl #61222]");
}
# Test for Proxy constants
{
rc(
- qq|
- &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
- \n|,
+ <<'EOF',
- qq|
- sub afterinit {
- push(\@DB::typeahead,
- 'm main->s1',
- 'q',
- );
- }\n|,
+&parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+ push(@DB::typeahead,
+ 'm main->s1',
+ 'q',
+ );
+}
+
+EOF
);
my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/proxy-constants');
is($output, "", "proxy constant subroutines");
}
+# Testing that we can set a line in the middle of the file.
+{
+ rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+ push (@DB::typeahead,
+ 'b ../lib/perl5db/t/MyModule.pm:12',
+ 'c',
+ q/do { use IO::Handle; STDOUT->autoflush(1); print "Var=$var\n"; }/,
+ 'c',
+ 'q',
+ );
+
+}
+EOF
+
+ my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/filename-line-breakpoint');
+
+ like($output, qr/
+ ^Var=Bar$
+ .*
+ ^In\ MyModule\.$
+ .*
+ ^In\ Main\ File\.$
+ .*
+ /msx,
+ "Can set breakpoint in a line in the middle of the file.");
+}
+
# [perl #66110] Call a subroutine inside a regex
{
like($output, "All tests successful.", "[perl #66110]");
}
+# taint tests
+
+{
+ local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1";
+ my $output = runperl(switches => [ '-d', '-T' ], stderr => 1,
+ progfile => '../lib/perl5db/t/taint');
+ chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF
+ is($output, '[$^X][done]', "taint");
+}
+
+# Testing that we can set a breakpoint
+{
+ rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+ push (@DB::typeahead,
+ 'b 6',
+ 'c',
+ q/do { use IO::Handle; STDOUT->autoflush(1); print "X={$x}\n"; }/,
+ 'c',
+ 'q',
+ );
+
+}
+EOF
+
+ my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/breakpoint-bug');
+
+ like($output, qr/
+ X=\{Two\}
+ /msx,
+ "Can set breakpoint in a line.");
+}
+
+# Testing that we can disable a breakpoint at a numeric line.
+{
+ rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+ push (@DB::typeahead,
+ 'b 7',
+ 'b 11',
+ 'disable 7',
+ 'c',
+ q/print "X={$x}\n";/,
+ 'c',
+ 'q',
+ );
+
+}
+EOF
+
+ my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-1'); +
+ like($output, qr/
+ X=\{SecondVal\}
+ /msx,
+ "Can set breakpoint in a line.");
+}
+
+# Testing that we can re-enable a breakpoint at a numeric line.
+{
+ rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+ push (@DB::typeahead,
+ 'b 8',
+ 'b 24',
+ 'disable 24',
+ 'c',
+ 'enable 24',
+ 'c',
+ q/print "X={$x}\n";/,
+ 'c',
+ 'q',
+ );
+
+}
+EOF
+
+ my $output = runperl(switches => [ '-d', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-2');
+ like($output, qr/
+ X=\{SecondValOneHundred\}
+ /msx,
+ "Can set breakpoint in a line.");
+}
# clean up.
+# Disable and enable for breakpoints on outer files.
+{
+ rc(<<'EOF');
+&parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+
+sub afterinit {
+ push (@DB::typeahead,
+ 'b 10',
+ 'b ../lib/perl5db/t/EnableModule.pm:14',
+ 'disable ../lib/perl5db/t/EnableModule.pm:14',
+ 'c',
+ 'enable ../lib/perl5db/t/EnableModule.pm:14',
+ 'c',
+ q/print "X={$x}\n";/,
+ 'c',
+ 'q',
+ );
+
+}
+EOF
+
+ my $output = runperl(switches => [ '-d', '-I', '../lib/perl5db/t', ], stderr => 1, progfile => '../lib/perl5db/t/disable-breakpoints-3'); +
+ like($output, qr/
+ X=\{SecondValTwoHundred\}
+ /msx,
+ "Can set breakpoint in a line.");
+}
END {
- 1 while unlink qw(.perldb db.out);
+ 1 while unlink ($rc_filename, $out_fn);
}
https://perl5.git.perl.org / perl5.git / blobdiff