search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.85k stars 527 forks source link

[PATCHES] Add tests to the perl debugger and refactor it #12450

Closed p5pRT closed 10 years ago

p5pRT commented 11 years ago

Migrated from rt.perl.org#115084 (status was 'resolved')

Searchable as RT115084$

p5pRT commented 11 years ago

From @shlomif

Hi all\,

this series of patches adds more tests to the perl debugger and starts to refactor it. It can also be found here​:

https://github.com/shlomif/perl/tree/shlomif-perl-d-refactoring

Please apply it.

Regards\,

  Shlomi Fish

--

Shlomi Fish http​://www.shlomifish.org/ UNIX Fortune Cookies - http​://www.shlomifish.org/humour/fortunes/

Doing linear scans over an associative array is like trying to club someone to death with a loaded Uzi. — Larry Wall

Please reply to list if it's a mailing list post - http​://shlom.in/reply .

p5pRT commented 11 years ago

From @shlomif

0001-Add-a-test-for-the-and-commands-together.patch ```diff From c03f546959d4fce67f86d6ecf68c9f66bec17fed Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 10:22:26 +0300 Subject: [PATCH 01/81] Add a test for the < and > commands together. --- lib/perl5db.t | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 10b87ad..51b1cf0 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(73); +plan(74); my $rc_filename = '.perldb'; @@ -1644,6 +1644,32 @@ package main; ); } +# Test the < and > commands together +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + q/$::lorem = 0;/, + q/< $::lorem += 10;/, + q/> print "\nLOREM=<$::lorem>\n"/, + q/b 7/, + q/b 5/, + 'c', + 'c', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->output_like(qr# + ^LOREM=<10>\n + #msx, + q#Test < and > commands. #, + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0002-Test-for-the-and-commands.patch ```diff From ba9d26f3a8479c92a9f410e7baac0431fa47143d Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 10:47:19 +0300 Subject: [PATCH 02/81] Test for the { and { ? commands. --- lib/perl5db.t | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 51b1cf0..81e04d3 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(74); +plan(75); my $rc_filename = '.perldb'; @@ -1670,6 +1670,40 @@ package main; ); } +# Test the { ? and { [command] commands. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + q/{ ?/, + q/{ l/, + q/{ ?/, + q/b 5/, + q/c/, + q/q/, + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + ^No\ pre-debugger\ actions\.\n + .*? + ^pre-debugger\ commands:\n + \s+\{\ --\ l\n + .*? + ^5==>b\s+\$x\ =\ "FirstVal";\n + 6\s*\n + 7:\s+\$dummy\+\+;\n + 8\s*\n + 9:\s+\$x\ =\ "SecondVal";\n + + #msx, + 'Test the pre-prompt debugger commands', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0003-Convert-to-a-different-quoting.patch ```diff From 1b5fdd73944ece7f50aa2925529407ad4d0e0383 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 10:52:12 +0300 Subject: [PATCH 03/81] Convert to a different quoting. This was done so gvim won't be confused with the bracket-matching. I'll report the problem to the perl.vim project. --- lib/perl5db.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 81e04d3..23346d0 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -1676,9 +1676,9 @@ package main; { cmds => [ - q/{ ?/, - q/{ l/, - q/{ ?/, + '{ ?', + '{ l', + '{ ?', q/b 5/, q/c/, q/q/, -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0004-Test-the-command.patch ```diff From 07adf055565800399a9fc6052d84f330406c17b0 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 10:56:54 +0300 Subject: [PATCH 04/81] Test the { * command. --- lib/perl5db.t | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 23346d0..7a65c3b 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(75); +plan(77); my $rc_filename = '.perldb'; @@ -1704,6 +1704,34 @@ package main; ); } +# Test the { * command. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + '{ q', + '{ *', + q/b 5/, + q/c/, + q/print (("One" x 5), "\n");/, + q/q/, + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + ^All\ \{\ actions\ cleared\.\n + #msx, + 'Test the { * command', + ); + + $wrapper->output_like(qr/OneOneOneOneOne/, + '{ * test - output is OK.', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0005-Test-the-command.patch ```diff From b961084799d3237e79896636487819d226095308 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 12:56:51 +0300 Subject: [PATCH 05/81] Test the ! command. --- lib/perl5db.t | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 7a65c3b..aa046cb 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(77); +plan(78); my $rc_filename = '.perldb'; @@ -1732,6 +1732,32 @@ package main; ); } +# Test the ! command. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'l 3-5', + '!', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + (^3:\s+my\ \$dummy\ =\ 0;\n + 4\s*\n + 5:\s+\$x\ =\ "FirstVal";)\n + .*? + ^l\ 3-5\n + \1 + #msx, + 'Test the ! command (along with l 3-5)', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0006-Add-a-test-for-l-num.patch ```diff From c2dca0df1aecc6b9ffb3706ecadf293469d41531 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 13:35:43 +0300 Subject: [PATCH 06/81] Add a test for l -num. --- lib/perl5db.t | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index aa046cb..c559666 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(78); +plan(79); my $rc_filename = '.perldb'; @@ -1758,6 +1758,35 @@ package main; ); } +# Test the ! -number command. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'l 3-5', + 'l 2', + '! -1', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + (^3:\s+my\ \$dummy\ =\ 0;\n + 4\s*\n + 5:\s+\$x\ =\ "FirstVal";)\n + .*? + ^2==\>\s+my\ \$x\ =\ "One";\n + .*? + ^l\ 3-5\n + \1 + #msx, + 'Test the ! -n command (along with l)', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0007-Convert-a-perl5db.t-test-to-DebugWrap.patch ```diff From ef82511b9f8f3fad6c02f07129829637a63733df Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 15:59:12 +0300 Subject: [PATCH 07/81] Convert a perl5db.t test to DebugWrap. --- lib/perl5db.t | 56 +++++++++++++++++++++++++------------------------------- 1 file changed, 25 insertions(+), 31 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index c559666..b48b191 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -65,37 +65,6 @@ sub _out_contents return _slurp($out_fn); } -{ - 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(_out_contents(), qr/sub factorial/, - 'The ${main::_new( + { + cmds => + [ + 'b 23', + 'n', + 'n', + 'n', + 'c', # line 23 + 'n', + "p \@{'main::_<$target'}", + 'q', + ], + prog => $target, + } + ); + $wrapper->contents_like( + qr/sub factorial/, + 'The ${main::_new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0008-Convert-a-test-to-DebugWrap.patch ```diff From ddfe3e3f4d7527445328bd7ba4c29c2cf822c282 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 16:08:16 +0300 Subject: [PATCH 08/81] Convert a test to DebugWrap. --- lib/perl5db.t | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index b48b191..94a923e 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -65,10 +65,7 @@ sub _out_contents return _slurp($out_fn); } - { - my $target = '../lib/perl5db/t/eval-line-bug'; - rc( <<"EOF", &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); @@ -84,17 +81,8 @@ sub _out_contents } EOF ); - - { - local $ENV{PERLDB_OPTS} = "ReadLine=0"; - runperl(switches => [ '-d' ], progfile => $target); - } } -like(_out_contents(), qr/new_var = /, - "no strict 'vars' in evaluated lines.", -); - { local $ENV{PERLDB_OPTS} = "ReadLine=0"; my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug'); @@ -405,6 +393,27 @@ package main; ); } +{ + local $ENV{PERLDB_OPTS} = "ReadLine=0"; + my $target = '../lib/perl5db/t/eval-line-bug'; + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'b 23', + 'n', + '$new_var = "Foo"', + 'x "new_var = <$new_var>\\n"', + 'q', + ], + prog => $target, + } + ); + + $wrapper->contents_like( qr/new_var = /, + "no strict 'vars' in evaluated lines.", + ); +} # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0009-Extract-a-constructor.patch ```diff From 3af057fdc97d7be72e6dc29454a40b7303fd3a34 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 16:29:46 +0300 Subject: [PATCH 09/81] Extract a constructor. This will help in converting the other instances to DebugWrap. --- lib/perl5db.t | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 94a923e..ad92dc8 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -393,10 +393,12 @@ package main; ); } +sub calc_new_var_wrapper { - local $ENV{PERLDB_OPTS} = "ReadLine=0"; - my $target = '../lib/perl5db/t/eval-line-bug'; - my $wrapper = DebugWrap->new( + my ($target, $extra_opts) = @_; + $extra_opts ||= ''; + local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts; + return DebugWrap->new( { cmds => [ @@ -409,11 +411,16 @@ package main; prog => $target, } ); +} - $wrapper->contents_like( qr/new_var = /, - "no strict 'vars' in evaluated lines.", - ); +{ + calc_new_var_wrapper('../lib/perl5db/t/eval-line-bug') + ->contents_like( + qr/new_var = /, + "no strict 'vars' in evaluated lines.", + ); } + # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0010-Convert-another-test-to-DebugWrap.patch ```diff From 574dcb497beff8093b039cf39daffc90a9ee4470 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 16:51:50 +0300 Subject: [PATCH 10/81] Convert another test to DebugWrap. --- lib/perl5db.t | 59 ++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 48 insertions(+), 11 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index ad92dc8..9e40776 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -84,12 +84,6 @@ EOF } { - local $ENV{PERLDB_OPTS} = "ReadLine=0"; - my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/lvalue-bug'); - like($output, qr/foo is defined/, 'lvalue subs work in the debugger'); -} - -{ local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/symbol-table-bug'); like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table'); @@ -251,6 +245,29 @@ sub _include_t return $self->{_include_t}; } +sub _stderr_val +{ + my $self = shift; + + if (@_) + { + $self->{_stderr_val} = shift; + } + + return $self->{_stderr_val}; +} + +sub field +{ + my $self = shift; + + if (@_) + { + $self->{field} = shift; + } + + return $self->{field}; +} sub _contents { my $self = shift; @@ -285,6 +302,8 @@ sub _init $self->_include_t($args->{include_t} ? 1 : 0); + $self->_stderr_val(exists($args->{stderr}) ? $args->{stderr} : 1); + $self->_run(); return; @@ -327,7 +346,10 @@ sub _run { '-d', ($self->_include_t ? ('-I', '../lib/perl5db/t') : ()) ], - stderr => 1, + (defined($self->_stderr_val()) + ? (stderr => $self->_stderr_val()) + : () + ), progfile => $self->_prog() ); @@ -395,7 +417,9 @@ package main; sub calc_new_var_wrapper { - my ($target, $extra_opts) = @_; + my $args = shift; + + my $extra_opts = delete($args->{extra_opts}); $extra_opts ||= ''; local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts; return DebugWrap->new( @@ -403,24 +427,37 @@ sub calc_new_var_wrapper cmds => [ 'b 23', - 'n', + 'c', '$new_var = "Foo"', 'x "new_var = <$new_var>\\n"', 'q', ], - prog => $target, + prog => delete($args->{prog}), + %$args, } ); } { - calc_new_var_wrapper('../lib/perl5db/t/eval-line-bug') + calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'}) ->contents_like( qr/new_var = /, "no strict 'vars' in evaluated lines.", ); } +{ + calc_new_var_wrapper( + { + prog => '../lib/perl5db/t/lvalue-bug', + stderr => undef(), + }, + )->output_like( + qr/foo is defined/, + 'lvalue subs work in the debugger', + ); +} + # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0011-Convert-another-test-to-DebugWrap.patch ```diff From 329de394214994576913c72f5bf63ecae0a26892 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 16:54:30 +0300 Subject: [PATCH 11/81] Convert another test to DebugWrap. --- lib/perl5db.t | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 9e40776..017e54f 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -83,12 +83,6 @@ EOF ); } -{ - local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; - my $output = runperl(switches => [ '-d' ], progfile => '../lib/perl5db/t/symbol-table-bug'); - like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table'); -} - SKIP: { if ( $Config{usethreads} ) { skip('This perl has threads, skipping non-threaded debugger tests'); @@ -458,6 +452,19 @@ sub calc_new_var_wrapper ); } +{ + calc_new_var_wrapper( + { + prog => '../lib/perl5db/t/symbol-table-bug', + extra_opts => "NonStop=1", + stderr => undef(), + } + )->output_like( + qr/Undefined symbols 0/, + 'there are no undefined values in the symbol table', + ); +} + # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0012-Convert-another-test-to-DebugWrap.patch ```diff From 8e994b8adeafb89c9857a44ceb628ca664836cbf Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 17:01:16 +0300 Subject: [PATCH 12/81] Convert another test to DebugWrap. --- lib/perl5db.t | 50 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 39 insertions(+), 11 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 017e54f..6efb74e 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -85,16 +85,6 @@ EOF SKIP: { if ( $Config{usethreads} ) { - skip('This perl has threads, skipping non-threaded debugger tests'); - } else { - my $error = 'This Perl not built to support threads'; - my $output = runperl( switches => [ '-dt' ], stderr => 1 ); - like($output, qr/$error/, 'Perl debugger correctly complains that it was not built with threads'); - } - -} -SKIP: { - if ( $Config{usethreads} ) { local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; my $output = runperl(switches => [ '-dt' ], progfile => '../lib/perl5db/t/symbol-table-bug'); like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table when running with thread support'); @@ -262,6 +252,19 @@ sub field return $self->{field}; } + +sub _switches +{ + my $self = shift; + + if (@_) + { + $self->{_switches} = shift; + } + + return $self->{_switches}; +} + sub _contents { my $self = shift; @@ -298,6 +301,11 @@ sub _init $self->_stderr_val(exists($args->{stderr}) ? $args->{stderr} : 1); + if (exists($args->{switches})) + { + $self->_switches($args->{switches}); + } + $self->_run(); return; @@ -337,7 +345,7 @@ sub _run { ::runperl( switches => [ - '-d', + ($self->_switches ? (@{$self->_switches()}) : ('-d')), ($self->_include_t ? ('-I', '../lib/perl5db/t') : ()) ], (defined($self->_stderr_val()) @@ -465,6 +473,26 @@ sub calc_new_var_wrapper ); } +SKIP: +{ + if ( $Config{usethreads} ) { + skip('This perl has threads, skipping non-threaded debugger tests'); + } + else { + my $error = 'This Perl not built to support threads'; + calc_new_var_wrapper( + { + prog => '../lib/perl5db/t/eval-line-bug', + switches => ['-dt',], + stderr => 1, + } + )->output_like( + qr/\Q$error\E/, + 'Perl debugger correctly complains that it was not built with threads', + ); + } +} + # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0013-Convert-another-test-to-DebugWrap.patch ```diff From 15e68b510adfd1137ce1052d723e2e0e85eaa3f9 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 17:03:48 +0300 Subject: [PATCH 13/81] Convert another test to DebugWrap. --- lib/perl5db.t | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 6efb74e..33fe9bb 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -83,17 +83,6 @@ EOF ); } -SKIP: { - if ( $Config{usethreads} ) { - local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; - my $output = runperl(switches => [ '-dt' ], progfile => '../lib/perl5db/t/symbol-table-bug'); - like($output, qr/Undefined symbols 0/, 'there are no undefined values in the symbol table when running with thread support'); - } else { - skip("This perl is not threaded, skipping threaded debugger tests"); - } -} - - # Test [perl #61222] { local $ENV{PERLDB_OPTS}; @@ -493,6 +482,25 @@ SKIP: } } +SKIP: +{ + if ( $Config{usethreads} ) { + calc_new_var_wrapper( + { + prog => '../lib/perl5db/t/symbol-table-bug', + switches => [ '-dt', ], + stderr => 1, + } + )->output_like( + qr/Undefined symbols 0/, + 'there are no undefined values in the symbol table when running with thread support', + ); + } + else { + skip("This perl is not threaded, skipping threaded debugger tests"); + } +} + # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0014-Prepend-with-an-underscore.patch ```diff From 459bc35def63c74d3471ff0083c752fad3de7ee5 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 17:04:49 +0300 Subject: [PATCH 14/81] Prepend with an underscore. To make it an internally-used subroutine. --- lib/perl5db.t | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 33fe9bb..f12898f 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -406,7 +406,7 @@ package main; ); } -sub calc_new_var_wrapper +sub _calc_new_var_wrapper { my $args = shift; @@ -430,7 +430,7 @@ sub calc_new_var_wrapper } { - calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'}) + _calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'}) ->contents_like( qr/new_var = /, "no strict 'vars' in evaluated lines.", @@ -438,7 +438,7 @@ sub calc_new_var_wrapper } { - calc_new_var_wrapper( + _calc_new_var_wrapper( { prog => '../lib/perl5db/t/lvalue-bug', stderr => undef(), @@ -450,7 +450,7 @@ sub calc_new_var_wrapper } { - calc_new_var_wrapper( + _calc_new_var_wrapper( { prog => '../lib/perl5db/t/symbol-table-bug', extra_opts => "NonStop=1", @@ -469,7 +469,7 @@ SKIP: } else { my $error = 'This Perl not built to support threads'; - calc_new_var_wrapper( + _calc_new_var_wrapper( { prog => '../lib/perl5db/t/eval-line-bug', switches => ['-dt',], @@ -485,7 +485,7 @@ SKIP: SKIP: { if ( $Config{usethreads} ) { - calc_new_var_wrapper( + _calc_new_var_wrapper( { prog => '../lib/perl5db/t/symbol-table-bug', switches => [ '-dt', ], -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0015-Remove-some-no-longer-used-code.patch ```diff From efb55281a10ed7250a10b8036fc675d4ff8773bf Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 17:06:27 +0300 Subject: [PATCH 15/81] Remove some no-longer used code. --- lib/perl5db.t | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index f12898f..9e2171d 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -65,24 +65,6 @@ sub _out_contents return _slurp($out_fn); } -{ - rc( - <<"EOF", - &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); - - sub afterinit { - push(\@DB::typeahead, - 'b 23', - 'c', - '\$new_var = "Foo"', - 'x "new_var = <\$new_var>\\n";', - 'q', - ); - } -EOF - ); -} - # Test [perl #61222] { local $ENV{PERLDB_OPTS}; -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0016-Extract-_calc_threads_wrapper.patch ```diff From 4c7491b48d8bfc53b5a078c63e962b7a0523245d Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 17:08:40 +0300 Subject: [PATCH 16/81] Extract _calc_threads_wrapper. --- lib/perl5db.t | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 9e2171d..bf2d539 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -411,6 +411,19 @@ sub _calc_new_var_wrapper ); } +sub _calc_threads_wrapper +{ + my $args = shift; + + return _calc_new_var_wrapper( + { + switches => [ '-dt', ], + stderr => 1, + %$args + } + ); +} + { _calc_new_var_wrapper({ prog => '../lib/perl5db/t/eval-line-bug'}) ->contents_like( @@ -451,11 +464,9 @@ SKIP: } else { my $error = 'This Perl not built to support threads'; - _calc_new_var_wrapper( + _calc_threads_wrapper( { prog => '../lib/perl5db/t/eval-line-bug', - switches => ['-dt',], - stderr => 1, } )->output_like( qr/\Q$error\E/, @@ -467,11 +478,9 @@ SKIP: SKIP: { if ( $Config{usethreads} ) { - _calc_new_var_wrapper( + _calc_threads_wrapper( { prog => '../lib/perl5db/t/symbol-table-bug', - switches => [ '-dt', ], - stderr => 1, } )->output_like( qr/Undefined symbols 0/, -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0017-Convert-the-61222-test-to-DebugWrap.patch ```diff From 269b714845919a0dc77ececb7ca9a406be899f34 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 12 Sep 2012 17:13:32 +0300 Subject: [PATCH 17/81] Convert the 61222 test to DebugWrap. --- lib/perl5db.t | 39 ++++++++++++++++++--------------------- 1 file changed, 18 insertions(+), 21 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index bf2d539..1b21f0f 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -65,27 +65,6 @@ sub _out_contents return _slurp($out_fn); } -# Test [perl #61222] -{ - local $ENV{PERLDB_OPTS}; - rc( - <<'EOF', - &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); - - sub afterinit { - push(@DB::typeahead, - 'm Pie', - 'q', - ); - } -EOF - ); - - my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-61222'); - unlike(_out_contents(), qr/INCORRECT/, "[perl #61222]"); -} - - # Test for Proxy constants { @@ -492,6 +471,24 @@ SKIP: } } +# Test [perl #61222] +{ + local $ENV{PERLDB_OPTS}; + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'm Pie', + 'q', + ], + prog => '../lib/perl5db/t/rt-61222', + } + ); + + $wrapper->contents_unlike(qr/INCORRECT/, "[perl #61222]"); +} + + # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0018-Convert-more-to-DebugWrap.patch ```diff From a85fa0bb99698de0440e68402c8d8009019e57e5 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 13 Sep 2012 14:26:55 +0300 Subject: [PATCH 18/81] Convert more to DebugWrap. --- lib/perl5db.t | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 1b21f0f..89a3f28 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -94,7 +94,6 @@ EOF like($output, "All tests successful.", "[perl #66110]"); } -# [perl 104168] level option for tracing { rc(<<'EOF'); &parse_options("NonStop=0 TTY=db.out LineInfo=db.out"); @@ -108,11 +107,6 @@ sub afterinit { } EOF - - my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => '../lib/perl5db/t/rt-104168'); - my $contents = _out_contents(); - like($contents, qr/level 2/, "[perl #104168]"); - unlike($contents, qr/baz/, "[perl #104168]"); } # taint tests @@ -488,6 +482,33 @@ SKIP: $wrapper->contents_unlike(qr/INCORRECT/, "[perl #61222]"); } +sub _calc_foo_wrapper +{ + my $args = shift; + + my $extra_opts = delete($args->{extra_opts}); + $extra_opts ||= ''; + local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts; + return DebugWrap->new( + { + cmds => + [ + 't 2', + 'c', + 'q', + ], + prog => delete($args->{prog}), + %$args, + } + ); +} + +# [perl 104168] level option for tracing +{ + my $wrapper = _calc_foo_wrapper({ prog => '../lib/perl5db/t/rt-104168' }); + $wrapper->contents_like(qr/level 2/, "[perl #104168] - level 2 appears"); + $wrapper->contents_unlike(qr/baz/, "[perl #104168] - no 'baz'"); +} # Testing that we can set a line in the middle of the file. { -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0019-Convert-to-DebugWrap.patch ```diff From cf3e15fa03fd578e930a86291200e4075b8ca370 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 13 Sep 2012 14:32:41 +0300 Subject: [PATCH 19/81] Convert to DebugWrap. --- lib/perl5db.t | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 89a3f28..e538c61 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -109,16 +109,6 @@ sub afterinit { EOF } -# 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"); -} - package DebugWrap; sub new { @@ -306,6 +296,11 @@ sub _run { return; } +sub get_output +{ + return shift->_output(); +} + sub output_like { my ($self, $re, $msg) = @_; @@ -510,6 +505,21 @@ sub _calc_foo_wrapper $wrapper->contents_unlike(qr/baz/, "[perl #104168] - no 'baz'"); } +# taint tests +{ + my $wrapper = _calc_foo_wrapper( + { + prog => '../lib/perl5db/t/taint', + extra_opts => ' NonStop=1', + switches => [ '-d', '-T', ], + } + ); + + my $output = $wrapper->get_output(); + chomp $output if $^O eq 'VMS'; # newline guaranteed at EOF + is($output, '[$^X][done]', "taint"); +} + # Testing that we can set a line in the middle of the file. { my $wrapper = DebugWrap->new( -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0020-Rename-to-something-more-meaningful.patch ```diff From 8de8ead4ff0dca1f4578cac5c74387924e894296 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 13 Sep 2012 14:34:18 +0300 Subject: [PATCH 20/81] Rename to something more meaningful. --- lib/perl5db.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index e538c61..d612b6e 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -477,7 +477,7 @@ SKIP: $wrapper->contents_unlike(qr/INCORRECT/, "[perl #61222]"); } -sub _calc_foo_wrapper +sub _calc_trace_wrapper { my $args = shift; @@ -500,14 +500,14 @@ sub _calc_foo_wrapper # [perl 104168] level option for tracing { - my $wrapper = _calc_foo_wrapper({ prog => '../lib/perl5db/t/rt-104168' }); + my $wrapper = _calc_trace_wrapper({ prog => '../lib/perl5db/t/rt-104168' }); $wrapper->contents_like(qr/level 2/, "[perl #104168] - level 2 appears"); $wrapper->contents_unlike(qr/baz/, "[perl #104168] - no 'baz'"); } # taint tests { - my $wrapper = _calc_foo_wrapper( + my $wrapper = _calc_trace_wrapper( { prog => '../lib/perl5db/t/taint', extra_opts => ' NonStop=1', -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0021-Extract-a-common-subroutine.patch ```diff From 464b777e8c3797f2eba7a9c1fde1e84d975aa0e3 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 13 Sep 2012 14:41:59 +0300 Subject: [PATCH 21/81] Extract a common subroutine. --- lib/perl5db.t | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index d612b6e..5b60c54 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -356,7 +356,7 @@ package main; ); } -sub _calc_new_var_wrapper +sub _calc_generic_wrapper { my $args = shift; @@ -365,6 +365,18 @@ sub _calc_new_var_wrapper local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts; return DebugWrap->new( { + cmds => delete($args->{cmds}), + prog => delete($args->{prog}), + %$args, + } + ); +} + +sub _calc_new_var_wrapper +{ + my ($args) = @_; + return _calc_generic_wrapper( + { cmds => [ 'b 23', @@ -373,7 +385,6 @@ sub _calc_new_var_wrapper 'x "new_var = <$new_var>\\n"', 'q', ], - prog => delete($args->{prog}), %$args, } ); @@ -479,12 +490,9 @@ SKIP: sub _calc_trace_wrapper { - my $args = shift; + my ($args) = @_; - my $extra_opts = delete($args->{extra_opts}); - $extra_opts ||= ''; - local $ENV{PERLDB_OPTS} = "ReadLine=0" . $extra_opts; - return DebugWrap->new( + return _calc_generic_wrapper( { cmds => [ @@ -492,7 +500,6 @@ sub _calc_trace_wrapper 'c', 'q', ], - prog => delete($args->{prog}), %$args, } ); -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0022-Add-a-test-for-the-source-command.patch ```diff From f0dbcd6e0b08be7e6f69cf02747cf871deb2f558 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 13 Sep 2012 16:52:54 +0300 Subject: [PATCH 22/81] Add a test for the source command. --- MANIFEST | 1 + lib/perl5db.t | 34 +++++++++++++++++++++++++++++++++- lib/perl5db/t/source-cmd-test.perldb | 2 ++ 3 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 lib/perl5db/t/source-cmd-test.perldb diff --git a/MANIFEST b/MANIFEST index 6ac316d..a1df910 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4328,6 +4328,7 @@ lib/perl5db/t/proxy-constants Tests for the Perl debugger lib/perl5db/t/rt-104168 Tests for the Perl debugger lib/perl5db/t/rt-61222 Tests for the Perl debugger lib/perl5db/t/rt-66110 Tests for the Perl debugger +lib/perl5db/t/source-cmd-test.perldb TTests for the Perl debugger lib/perl5db/t/symbol-table-bug Tests for the Perl debugger lib/perl5db/t/taint Tests for the Perl debugger lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger diff --git a/lib/perl5db.t b/lib/perl5db.t index 5b60c54..a9d49d6 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(79); +plan(80); my $rc_filename = '.perldb'; @@ -1903,6 +1903,38 @@ sub _calc_trace_wrapper ); } +# Test the 'source' command. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'source ../lib/perl5db/t/source-cmd-test.perldb', + # If we have a 'q' here, then the typeahead will override the + # input, and so it won't be reached - solution: + # put a q inside the .perldb commands. + # ( This may be a bug or a misfeature. ) + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + ^3:\s+my\ \$dummy\ =\ 0;\n + 4\s*\n + 5:\s+\$x\ =\ "FirstVal";\n + 6\s*\n + 7:\s+\$dummy\+\+;\n + 8\s*\n + 9:\s+\$x\ =\ "SecondVal";\n + 10\s*\n + #msx, + 'Test the source command (along with l)', + ); + + print $wrapper->get_output(), "\n"; +} + END { 1 while unlink ($rc_filename, $out_fn); } diff --git a/lib/perl5db/t/source-cmd-test.perldb b/lib/perl5db/t/source-cmd-test.perldb new file mode 100644 index 0000000..41a7365 --- /dev/null +++ b/lib/perl5db/t/source-cmd-test.perldb @@ -0,0 +1,2 @@ +l 3-10 +q -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0023-perl5db-Fix-source-cmd-from-typeahead.patch ```diff From 1a2f20dcf84a93c17f8c0b2c70b6ece5a0740fe1 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 13 Sep 2012 17:08:58 +0300 Subject: [PATCH 23/81] [perl5db] Fix source cmd from typeahead. With a test. --- MANIFEST | 1 + lib/perl5db.pl | 26 ++++++++++++++------------ lib/perl5db.t | 29 +++++++++++++++++++++++++++-- lib/perl5db/t/source-cmd-test-no-q.perldb | 1 + 4 files changed, 43 insertions(+), 14 deletions(-) create mode 100644 lib/perl5db/t/source-cmd-test-no-q.perldb diff --git a/MANIFEST b/MANIFEST index a1df910..aac99ac 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4328,6 +4328,7 @@ lib/perl5db/t/proxy-constants Tests for the Perl debugger lib/perl5db/t/rt-104168 Tests for the Perl debugger lib/perl5db/t/rt-61222 Tests for the Perl debugger lib/perl5db/t/rt-66110 Tests for the Perl debugger +lib/perl5db/t/source-cmd-test-no-q.perldb TTests for the Perl debugger lib/perl5db/t/source-cmd-test.perldb TTests for the Perl debugger lib/perl5db/t/symbol-table-bug Tests for the Perl debugger lib/perl5db/t/taint Tests for the Perl debugger diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 4f517d0..54cabdc 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -6517,6 +6517,20 @@ sub readline { # Localize to prevent it from being smashed in the program being debugged. local $.; + # If there are stacked filehandles to read from ... + # (Handle it before the typeahead, because we may call source/etc. from + # the typeahead.) + while (@cmdfhs) { + + # Read from the last one in the stack. + my $line = CORE::readline( $cmdfhs[-1] ); + + # If we got a line ... + defined $line + ? ( print $OUT ">> $line" and return $line ) # Echo and return + : close pop @cmdfhs; # Pop and close + } ## end while (@cmdfhs) + # Pull a line out of the typeahead if there's stuff there. if (@typeahead) { @@ -6542,18 +6556,6 @@ sub readline { local $frame = 0; local $doret = -2; - # If there are stacked filehandles to read from ... - while (@cmdfhs) { - - # Read from the last one in the stack. - my $line = CORE::readline( $cmdfhs[-1] ); - - # If we got a line ... - defined $line - ? ( print $OUT ">> $line" and return $line ) # Echo and return - : close pop @cmdfhs; # Pop and close - } ## end while (@cmdfhs) - # Nothing on the filehandle stack. Socket? if ( ref $OUT and UNIVERSAL::isa( $OUT, 'IO::Socket::INET' ) ) { diff --git a/lib/perl5db.t b/lib/perl5db.t index a9d49d6..66cee89 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(80); +plan(81); my $rc_filename = '.perldb'; @@ -1931,8 +1931,33 @@ sub _calc_trace_wrapper #msx, 'Test the source command (along with l)', ); +} + +# Test the 'source' command being traversed from withing typeahead. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'source ../lib/perl5db/t/source-cmd-test-no-q.perldb', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); - print $wrapper->get_output(), "\n"; + $wrapper->contents_like(qr# + ^3:\s+my\ \$dummy\ =\ 0;\n + 4\s*\n + 5:\s+\$x\ =\ "FirstVal";\n + 6\s*\n + 7:\s+\$dummy\+\+;\n + 8\s*\n + 9:\s+\$x\ =\ "SecondVal";\n + 10\s*\n + #msx, + 'Test the source command inside a typeahead', + ); } END { diff --git a/lib/perl5db/t/source-cmd-test-no-q.perldb b/lib/perl5db/t/source-cmd-test-no-q.perldb new file mode 100644 index 0000000..6a6fddd --- /dev/null +++ b/lib/perl5db/t/source-cmd-test-no-q.perldb @@ -0,0 +1 @@ +l 3-10 -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0024-perl5db-Add-a-test-for-H-7.patch ```diff From e11742906eb04012d8e5bbaed19be081b35f6a26 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 15 Sep 2012 15:35:07 +0300 Subject: [PATCH 24/81] [perl5db] Add a test for H -7. --- lib/perl5db.t | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 66cee89..3c69fa8 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(81); +plan(82); my $rc_filename = '.perldb'; @@ -1960,6 +1960,38 @@ sub _calc_trace_wrapper ); } +# Test the 'H -number' command. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'l 1-10', + 'l 5-10', + 'x "Hello World"', + 'l 1-5', + 'b 3', + 'x (20+4)', + 'H -7', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + ^\d+:\s+H\ -7\n + \d+:\s+x\ \(20\+4\)\n + \d+:\s+b\ 3\n + \d+:\s+l\ 1-5\n + \d+:\s+x\ "Hello\ World"\n + \d+:\s+l\ 5-10\n + \d+:\s+l\ 1-10\n + #msx, + 'Test the source command (along with l)', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0025-Add-a-test-for-the-H-command.patch ```diff From 05e3ae74ae6322667ffefc0b6fb31f2bd162e17b Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 15 Sep 2012 15:40:21 +0300 Subject: [PATCH 25/81] Add a test for the H command. --- lib/perl5db.t | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 3c69fa8..12dd99e 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(82); +plan(83); my $rc_filename = '.perldb'; @@ -1992,6 +1992,37 @@ sub _calc_trace_wrapper ); } +# Add a test for H (without arguments) +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'l 1-10', + 'l 5-10', + 'x "Hello World"', + 'l 1-5', + 'b 3', + 'x (20+4)', + 'H', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + ^\d+:\s+x\ \(20\+4\)\n + \d+:\s+b\ 3\n + \d+:\s+l\ 1-5\n + \d+:\s+x\ "Hello\ World"\n + \d+:\s+l\ 5-10\n + \d+:\s+l\ 1-10\n + #msx, + 'Test the source command (along with l)', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0026-Correct-the-test-blurbs.patch ```diff From 388c43a75cbb7a332d3788011bd762f9bef01d43 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 15 Sep 2012 16:29:55 +0300 Subject: [PATCH 26/81] Correct the test blurbs. --- lib/perl5db.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 12dd99e..c449146 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -1988,7 +1988,7 @@ sub _calc_trace_wrapper \d+:\s+l\ 5-10\n \d+:\s+l\ 1-10\n #msx, - 'Test the source command (along with l)', + 'Test the H -num command', ); } @@ -2019,7 +2019,7 @@ sub _calc_trace_wrapper \d+:\s+l\ 5-10\n \d+:\s+l\ 1-10\n #msx, - 'Test the source command (along with l)', + 'Test the H command (without a number.)', ); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0027-perl5db-Test-the-command.patch ```diff From 57e67b1900a665ea1c0a932c07d164c8bc2af6b0 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 15 Sep 2012 16:46:35 +0300 Subject: [PATCH 27/81] [perl5db] Test the = command. --- lib/perl5db.t | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index c449146..2bb8ffd 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(83); +plan(84); my $rc_filename = '.perldb'; @@ -2023,6 +2023,32 @@ sub _calc_trace_wrapper ); } +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + '= quit q', + '= foobar l', + 'foobar', + 'quit', + ], + prog => '../lib/perl5db/t/test-l-statement-1', + } + ); + + $wrapper->contents_like( + qr/ + ^1==>\s+\$x\ =\ 1;\n + 2:\s+print\ "1\\n";\n + 3\s*\n + 4:\s+\$x\ =\ 2;\n + 5:\s+print\ "2\\n";\n + /msx, + 'Test the = (command alias) command.', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0028-Test-the-m-command.patch ```diff From ea022ed86b15bc78891d14f1dfc92f15750a5fd1 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 15 Sep 2012 16:54:24 +0300 Subject: [PATCH 28/81] Test the m command. --- lib/perl5db.t | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 2bb8ffd..0e00d49 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(84); +plan(86); my $rc_filename = '.perldb'; @@ -2049,6 +2049,32 @@ sub _calc_trace_wrapper ); } +# Add a test for H (without arguments) +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'm main', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + ^via\ UNIVERSAL:\ DOES$ + #msx, + "Test m for main - 1", + ); + + $wrapper->contents_like(qr# + ^via\ UNIVERSAL:\ can$ + #msx, + "Test m for main - 2", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0029-Test-more-for-the-m-staetement.patch ```diff From df93ba75f4523371037540311f8c58482c410152 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 15 Sep 2012 17:10:13 +0300 Subject: [PATCH 29/81] Test more for the m staetement. --- MANIFEST | 1 + lib/perl5db.t | 28 ++++++++++++++++++++++++-- lib/perl5db/t/test-m-statement-1 | 43 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 70 insertions(+), 2 deletions(-) create mode 100644 lib/perl5db/t/test-m-statement-1 diff --git a/MANIFEST b/MANIFEST index aac99ac..aa9d568 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4334,6 +4334,7 @@ lib/perl5db/t/symbol-table-bug Tests for the Perl debugger lib/perl5db/t/taint Tests for the Perl debugger lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger +lib/perl5db/t/test-m-statement-1 Tests for the Perl debugger lib/perl5db/t/test-r-statement Tests for the Perl debugger lib/perl5db/t/test-w-statement-1 Tests for the Perl debugger lib/perl5db/t/uncalled-subroutine Tests for the Perl debugger diff --git a/lib/perl5db.t b/lib/perl5db.t index 0e00d49..086c466 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(86); +plan(88); my $rc_filename = '.perldb'; @@ -2049,7 +2049,7 @@ sub _calc_trace_wrapper ); } -# Add a test for H (without arguments) +# Test the m statement. { my $wrapper = DebugWrap->new( { @@ -2075,6 +2075,30 @@ sub _calc_trace_wrapper ); } +# Test the m statement. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'b 41', + 'c', + 'm $obj', + 'q', + ], + prog => '../lib/perl5db/t/test-m-statement-1', + } + ); + + $wrapper->contents_like(qr#^greet$#ms, + "Test m for obj - 1", + ); + + $wrapper->contents_like(qr#^via UNIVERSAL: can$#ms, + "Test m for obj - 1", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } diff --git a/lib/perl5db/t/test-m-statement-1 b/lib/perl5db/t/test-m-statement-1 new file mode 100644 index 0000000..a699ed3 --- /dev/null +++ b/lib/perl5db/t/test-m-statement-1 @@ -0,0 +1,43 @@ +use strict; +use warnings; + +package MyClass; + +sub new +{ + my $class = shift; + + my $self = bless {}, $class; + + $self->_init(@_); + + return $self; +} + +sub _init +{ + my $self = shift; + + $self->{foo} = 'bar'; + + return; +} + +sub greet +{ + my ($self, $msg) = @_; + + print "$msg - $self->{foo}\n"; + + return; +} + +1; + +package main; + +my $obj = MyClass->new; + +$obj->greet("Hello"); + +1; -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0030-perl5db-Test-the-M-command.patch ```diff From 9baa629a2682eb74b82e1f78750cddfe250cf948 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 15 Sep 2012 17:18:37 +0300 Subject: [PATCH 30/81] [perl5db] Test the M command. --- lib/perl5db.t | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 086c466..c3a072c 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(88); +plan(89); my $rc_filename = '.perldb'; @@ -2099,6 +2099,27 @@ sub _calc_trace_wrapper ); } +# Test the M command. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'M', + 'q', + ], + prog => '../lib/perl5db/t/test-m-statement-1', + } + ); + + $wrapper->contents_like(qr# + ^'strict\.pm'\ =>\ '\d+\.\d+\ from + #msx, + "Test M", + ); + +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0031-perl5db-Test-the-recallCommand-option.patch ```diff From 1528f33e77906ed35a30262457ed76c2fe0374fa Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Tue, 18 Sep 2012 17:24:14 +0300 Subject: [PATCH 31/81] [perl5db] Test the recallCommand option. --- lib/perl5db.t | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index c3a072c..87256b3 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(89); +plan(90); my $rc_filename = '.perldb'; @@ -2120,6 +2120,35 @@ sub _calc_trace_wrapper } +# Test the recallCommand option. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o recallCommand=%', + 'l 3-5', + 'l 2', + '% -1', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr# + (^3:\s+my\ \$dummy\ =\ 0;\n + 4\s*\n + 5:\s+\$x\ =\ "FirstVal";)\n + .*? + ^2==\>\s+my\ \$x\ =\ "One";\n + .*? + ^l\ 3-5\n + \1 + #msx, + 'Test the o recallCommand option', + ); +} END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0032-perl5db-Add-test-for-dieLevel-option.patch ```diff From e7d7da72797c48098d2640a34477b09242e38982 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Wed, 19 Sep 2012 16:33:22 +0300 Subject: [PATCH 32/81] [perl5db] Add test for dieLevel option. --- MANIFEST | 1 + lib/perl5db.t | 28 +++++++++++++++++++++++++++- lib/perl5db/t/test-dieLevel-option-1 | 22 ++++++++++++++++++++++ 3 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 lib/perl5db/t/test-dieLevel-option-1 diff --git a/MANIFEST b/MANIFEST index aa9d568..ab96978 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4332,6 +4332,7 @@ lib/perl5db/t/source-cmd-test-no-q.perldb TTests for the Perl debugger lib/perl5db/t/source-cmd-test.perldb TTests for the Perl debugger lib/perl5db/t/symbol-table-bug Tests for the Perl debugger lib/perl5db/t/taint Tests for the Perl debugger +lib/perl5db/t/test-dieLevel-option-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger lib/perl5db/t/test-m-statement-1 Tests for the Perl debugger diff --git a/lib/perl5db.t b/lib/perl5db.t index 87256b3..26cdeaf 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(90); +plan(91); my $rc_filename = '.perldb'; @@ -2149,6 +2149,32 @@ sub _calc_trace_wrapper 'Test the o recallCommand option', ); } + +# Test the dieLevel option +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + q/o dieLevel='1'/, + q/c/, + 'q', + ], + prog => '../lib/perl5db/t/test-dieLevel-option-1', + } + ); + + $wrapper->output_like(qr# + ^This\ program\ dies\.\ at\ \S+\ line\ 18\.\n + .*? + ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n + \s+main::bar\(\)\ called\ at\ \S+\ line\ 7\n + \s+main::foo\(\)\ called\ at\ \S+\ line\ 21\n + #msx, + 'Test the o dieLevel option', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } diff --git a/lib/perl5db/t/test-dieLevel-option-1 b/lib/perl5db/t/test-dieLevel-option-1 new file mode 100644 index 0000000..0849ae2 --- /dev/null +++ b/lib/perl5db/t/test-dieLevel-option-1 @@ -0,0 +1,22 @@ +use strict; +use warnings; + +sub foo +{ + print "In foo\n"; + bar(); +} + +sub bar +{ + print "In baz\n"; + baz(); +} + +sub baz +{ + die "This program dies."; +} + +foo(); + -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0033-perl5db-Add-a-test-for-warnLevel-1.patch ```diff From 9d4342cb77e841cebc9bf5f9328cb3c80a98eb4d Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 20 Sep 2012 17:28:39 +0300 Subject: [PATCH 33/81] [perl5db] Add a test for warnLevel=1. --- MANIFEST | 1 + lib/perl5db.t | 27 ++++++++++++++++++++++++++- lib/perl5db/t/test-warnLevel-option-1 | 29 +++++++++++++++++++++++++++++ 3 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 lib/perl5db/t/test-warnLevel-option-1 diff --git a/MANIFEST b/MANIFEST index ab96978..e7b33d8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4337,6 +4337,7 @@ lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger lib/perl5db/t/test-m-statement-1 Tests for the Perl debugger lib/perl5db/t/test-r-statement Tests for the Perl debugger +lib/perl5db/t/test-warnLevel-option-1 Tests for the Perl debugger lib/perl5db/t/test-w-statement-1 Tests for the Perl debugger lib/perl5db/t/uncalled-subroutine Tests for the Perl debugger lib/perl5db/t/with-subroutine Tests for the Perl debugger diff --git a/lib/perl5db.t b/lib/perl5db.t index 26cdeaf..8d73d11 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(91); +plan(92); my $rc_filename = '.perldb'; @@ -2175,6 +2175,31 @@ sub _calc_trace_wrapper ); } +# Test the warnLevel option +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + q/o warnLevel='1'/, + q/c/, + 'q', + ], + prog => '../lib/perl5db/t/test-warnLevel-option-1', + } + ); + + $wrapper->contents_like(qr# + ^This\ is\ not\ a\ warning\.\ at\ \S+\ line\ 18\.\n + .*? + ^\s+main::baz\(\)\ called\ at\ \S+\ line\ 13\n + \s+main::bar\(\)\ called\ at\ \S+\ line\ 25\n + \s+main::myfunc\(\)\ called\ at\ \S+\ line\ 28\n + #msx, + 'Test the o warnLevel option', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } diff --git a/lib/perl5db/t/test-warnLevel-option-1 b/lib/perl5db/t/test-warnLevel-option-1 new file mode 100644 index 0000000..04b71f9 --- /dev/null +++ b/lib/perl5db/t/test-warnLevel-option-1 @@ -0,0 +1,29 @@ +use strict; +use warnings; + +sub foo +{ + print "In foo\n"; + bar(); +} + +sub bar +{ + print "In baz\n"; + baz(); +} + +sub baz +{ + warn "This is not a warning."; + + return; +} + +sub myfunc +{ + bar(); +} + +myfunc(); + -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0034-perl5db-Add-a-test-for-the-t-command.patch ```diff From 75cf545deadd12e490ea4fa09f1664d0eab8e9d4 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Fri, 21 Sep 2012 11:31:29 +0300 Subject: [PATCH 34/81] [perl5db] Add a test for the 't' command. Apparently, the 'o AutoTrace' command is broken since perl-5.16.x and I want to get a good output for 't' first before fixing it. --- lib/perl5db.t | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 8d73d11..79814ed 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(92); +plan(93); my $rc_filename = '.perldb'; @@ -2200,6 +2200,30 @@ sub _calc_trace_wrapper ); } +# Test the t command +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 't', + 'c', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr/ + ^main::\([^:]+:15\):\n + 15:\s+\$dummy\+\+;\n + main::\([^:]+:17\):\n + 17:\s+\$x\ =\ "FourthVal";\n + /msx, + 'Test the t command (without a number.)', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0035-perl5db-Test-o-AutoTrace.patch ```diff From a872fe5c8c31615b5b616d660de27cc811327b8a Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Fri, 21 Sep 2012 11:36:00 +0300 Subject: [PATCH 35/81] [perl5db] Test o AutoTrace . It appears to work fine now. Strange. --- lib/perl5db.t | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 79814ed..1d6a342 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(93); +plan(94); my $rc_filename = '.perldb'; @@ -2224,6 +2224,30 @@ sub _calc_trace_wrapper ); } +# Test the o AutoTrace command +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o AutoTrace', + 'c', + 'q', + ], + prog => '../lib/perl5db/t/disable-breakpoints-1', + } + ); + + $wrapper->contents_like(qr/ + ^main::\([^:]+:15\):\n + 15:\s+\$dummy\+\+;\n + main::\([^:]+:17\):\n + 17:\s+\$x\ =\ "FourthVal";\n + /msx, + 'Test the o AutoTrace command', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0036-perl5db-Add-a-test-for-t-command-with-sub-calls.patch ```diff From 9e38c92bc2198b85ef5b84c93e9833dd0961e0f0 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Fri, 21 Sep 2012 11:54:39 +0300 Subject: [PATCH 36/81] [perl5db] Add a test for t command with sub calls. --- lib/perl5db.t | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 1d6a342..631635e 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(94); +plan(95); my $rc_filename = '.perldb'; @@ -2248,6 +2248,33 @@ sub _calc_trace_wrapper ); } +# Test the t command with function calls +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 't', + 'b 18', + 'c', + 'x ["foo"]', + 'x ["bar"]', + 'q', + ], + prog => '../lib/perl5db/t/test-warnLevel-option-1', + } + ); + + $wrapper->contents_like(qr/ + ^main::\([^:]+:28\):\n + 28:\s+myfunc\(\);\n + main::myfunc\([^:]+:25\):\n + 25:\s+bar\(\);\n + /msx, + 'Test the t command with function calls.', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0037-Fix-a-bug-with-o-AutoTrace.patch ```diff From 2f21ff07bf010bd1e6e278992ef43444eeaf4728 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Fri, 21 Sep 2012 12:14:35 +0300 Subject: [PATCH 37/81] Fix a bug with o AutoTrace. There it was. --- lib/perl5db.pl | 4 ++-- lib/perl5db.t | 28 +++++++++++++++++++++++++++- 2 files changed, 29 insertions(+), 3 deletions(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 54cabdc..dee4ebe 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -914,8 +914,8 @@ $inhibit_exit = $option{PrintRet} = 1; use vars qw($trace_to_depth); -# Default to 1 so the prompt will display the first line. -$trace_to_depth = 1; +# Default to 1E9 so it won't be limited to a certain recursion depth. +$trace_to_depth = 1E9; =head1 OPTION PROCESSING diff --git a/lib/perl5db.t b/lib/perl5db.t index 631635e..08f513a 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(95); +plan(96); my $rc_filename = '.perldb'; @@ -2275,6 +2275,32 @@ sub _calc_trace_wrapper ); } +# Test the o AutoTrace command with function calls +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o AutoTrace', + 'b 18', + 'c', + 'x ["foo"]', + 'x ["bar"]', + 'q', + ], + prog => '../lib/perl5db/t/test-warnLevel-option-1', + } + ); + + $wrapper->contents_like(qr/ + ^main::\([^:]+:28\):\n + 28:\s+myfunc\(\);\n + main::myfunc\([^:]+:25\):\n + 25:\s+bar\(\);\n + /msx, + 'Test the t command with function calls.', + ); +} END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0038-Test-o-inhibit_exit-0.patch ```diff From bc0c6d119ea6ac9740083e5cc13ccdcb621a10d4 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Tue, 25 Sep 2012 18:53:12 +0200 Subject: [PATCH 38/81] Test o inhibit_exit=0. --- lib/perl5db.t | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 08f513a..6b7dd19 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(96); +plan(97); my $rc_filename = '.perldb'; @@ -2301,6 +2301,31 @@ sub _calc_trace_wrapper 'Test the t command with function calls.', ); } + +# Test the o inhibit_exit=0 command +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o inhibit_exit=0', + 'n', + 'n', + 'n', + 'n', + 'q', + ], + prog => '../lib/perl5db/t/test-warnLevel-option-1', + } + ); + + $wrapper->contents_unlike(qr/ + ^Debugged\ program\ terminated\. + /msx, + 'Test the o inhibit_exit=0 command.', + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0039-Add-a-test-for-o-PrintRet.patch ```diff From 47e0115621de05c087f83bc1d4b1ce899c5c6da8 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 27 Sep 2012 19:40:31 +0200 Subject: [PATCH 39/81] Add a test for o PrintRet. --- MANIFEST | 1 + lib/perl5db.t | 27 ++++++++++++++++++++- lib/perl5db/t/test-PrintRet-option-1 | 46 ++++++++++++++++++++++++++++++++++++ 3 files changed, 73 insertions(+), 1 deletion(-) create mode 100644 lib/perl5db/t/test-PrintRet-option-1 diff --git a/MANIFEST b/MANIFEST index e7b33d8..9307322 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4336,6 +4336,7 @@ lib/perl5db/t/test-dieLevel-option-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger lib/perl5db/t/test-m-statement-1 Tests for the Perl debugger +lib/perl5db/t/test-PrintRet-option-1 Tests for the Perl debugger lib/perl5db/t/test-r-statement Tests for the Perl debugger lib/perl5db/t/test-warnLevel-option-1 Tests for the Perl debugger lib/perl5db/t/test-w-statement-1 Tests for the Perl debugger diff --git a/lib/perl5db.t b/lib/perl5db.t index 6b7dd19..0ef2eb1 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(97); +plan(98); my $rc_filename = '.perldb'; @@ -2326,6 +2326,31 @@ sub _calc_trace_wrapper ); } +# Test the o PrintRet=1 command +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o PrintRet=1', + 'b 29', + 'c', + q/$x = 's';/, + 'b 10', + 'c', + 'r', + 'q', + ], + prog => '../lib/perl5db/t/test-PrintRet-option-1', + } + ); + + $wrapper->contents_like( + qr/scalar context return from main::return_scalar: 20024/, + "Test o PrintRet=1", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } diff --git a/lib/perl5db/t/test-PrintRet-option-1 b/lib/perl5db/t/test-PrintRet-option-1 new file mode 100644 index 0000000..ccf6607 --- /dev/null +++ b/lib/perl5db/t/test-PrintRet-option-1 @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +my ($x, $y); + +sub return_scalar +{ + $y++; + + return "20024"; +} + +sub return_list +{ + $y++; + + return ("Foo", "Bar", "Baz"); +} + +sub return_void +{ + $y++; + + return; +} + +$y++; + +# Choose one based on $x +# +if ($x eq "s") +{ + my $s = return_scalar(); +} +elsif ($x eq "l") +{ + my @l = return_list(); +} +else +{ + return_void(); + $y++; +} + -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0040-perl5db-add-a-test-for-o-PrintRet-0.patch ```diff From c329dd4da7320a0dd64224a0ffa9ba1b56156931 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 27 Sep 2012 19:50:05 +0200 Subject: [PATCH 40/81] [perl5db] add a test for o PrintRet=0. --- lib/perl5db.t | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 0ef2eb1..68d59c7 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(98); +plan(99); my $rc_filename = '.perldb'; @@ -2326,7 +2326,7 @@ sub _calc_trace_wrapper ); } -# Test the o PrintRet=1 command +# Test the o PrintRet=1 option { my $wrapper = DebugWrap->new( { @@ -2351,6 +2351,31 @@ sub _calc_trace_wrapper ); } +# Test the o PrintRet=0 option +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o PrintRet=0', + 'b 29', + 'c', + q/$x = 's';/, + 'b 10', + 'c', + 'r', + 'q', + ], + prog => '../lib/perl5db/t/test-PrintRet-option-1', + } + ); + + $wrapper->contents_unlike( + qr/scalar context/, + "Test o PrintRet=0", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0041-perl5db-Test-o-PrintRet-in-list-context.patch ```diff From 54099776debc79bf5b1368bb07661496c4ea8ea2 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 27 Sep 2012 20:04:50 +0200 Subject: [PATCH 41/81] [perl5db] Test o PrintRet in list context. --- lib/perl5db.t | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 68d59c7..8eac772 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(99); +plan(100); my $rc_filename = '.perldb'; @@ -2376,6 +2376,31 @@ sub _calc_trace_wrapper ); } +# Test the o PrintRet=1 option in list context +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o PrintRet=1', + 'b 29', + 'c', + q/$x = 'l';/, + 'b 17', + 'c', + 'r', + 'q', + ], + prog => '../lib/perl5db/t/test-PrintRet-option-1', + } + ); + + $wrapper->contents_like( + qr/list context return from main::return_list:\n0\s*'Foo'\n1\s*'Bar'\n2\s*'Baz'\n/, + "Test o PrintRet=1 in list context", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0042-perl5db-Add-another-test.patch ```diff From d72e07f3b57602fec123d69cc5bbbe46e867d317 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 27 Sep 2012 20:13:18 +0200 Subject: [PATCH 42/81] [perl5db] Add another test. --- lib/perl5db.t | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 8eac772..29241d4 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(100); +plan(101); my $rc_filename = '.perldb'; @@ -2401,6 +2401,31 @@ sub _calc_trace_wrapper ); } +# Test the o PrintRet=0 option in list context +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o PrintRet=0', + 'b 29', + 'c', + q/$x = 'l';/, + 'b 17', + 'c', + 'r', + 'q', + ], + prog => '../lib/perl5db/t/test-PrintRet-option-1', + } + ); + + $wrapper->contents_unlike( + qr/list context/, + "Test o PrintRet=0 in list context", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0043-Test-o-PrintRet-1-in-void-context.patch ```diff From 98a6d5b4c6467e1fde3b5dacd4c6be9f48999465 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 27 Sep 2012 20:25:11 +0200 Subject: [PATCH 43/81] Test o PrintRet=1 in void context. --- lib/perl5db.t | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 29241d4..746b525 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(101); +plan(102); my $rc_filename = '.perldb'; @@ -2426,6 +2426,31 @@ sub _calc_trace_wrapper ); } +# Test the o PrintRet=1 option in void context +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o PrintRet=1', + 'b 29', + 'c', + q/$x = 'v';/, + 'b 24', + 'c', + 'r', + 'q', + ], + prog => '../lib/perl5db/t/test-PrintRet-option-1', + } + ); + + $wrapper->contents_like( + qr/void context return from main::return_void/, + "Test o PrintRet=1 in void context", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0044-perl5db-o-PrintRet-0-in-void-context.patch ```diff From 2f5a4752250a38838f414e2b7ea13eb5f606c245 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 27 Sep 2012 20:31:27 +0200 Subject: [PATCH 44/81] [perl5db] o PrintRet=0 in void context. --- lib/perl5db.t | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index 746b525..0dfbd43 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(102); +plan(103); my $rc_filename = '.perldb'; @@ -2451,6 +2451,31 @@ sub _calc_trace_wrapper ); } +# Test the o PrintRet=1 option in void context +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + 'o PrintRet=0', + 'b 29', + 'c', + q/$x = 'v';/, + 'b 24', + 'c', + 'r', + 'q', + ], + prog => '../lib/perl5db/t/test-PrintRet-option-1', + } + ); + + $wrapper->contents_unlike( + qr/void context/, + "Test o PrintRet=0 in void context", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0045-Add-a-test-for-the-frame-option.patch ```diff From 01e5f34ea3219337ff6f65a4db65f3b90be90819 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Fri, 28 Sep 2012 20:03:12 +0200 Subject: [PATCH 45/81] Add a test for the frame option. --- MANIFEST | 1 + lib/perl5db.t | 30 +++++++++++++++++++++++++++++- lib/perl5db/t/test-frame-option-1 | 26 ++++++++++++++++++++++++++ 3 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 lib/perl5db/t/test-frame-option-1 diff --git a/MANIFEST b/MANIFEST index 9307322..4c5c00f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4333,6 +4333,7 @@ lib/perl5db/t/source-cmd-test.perldb TTests for the Perl debugger lib/perl5db/t/symbol-table-bug Tests for the Perl debugger lib/perl5db/t/taint Tests for the Perl debugger lib/perl5db/t/test-dieLevel-option-1 Tests for the Perl debugger +lib/perl5db/t/test-frame-option-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-1 Tests for the Perl debugger lib/perl5db/t/test-l-statement-2 Tests for the Perl debugger lib/perl5db/t/test-m-statement-1 Tests for the Perl debugger diff --git a/lib/perl5db.t b/lib/perl5db.t index 0dfbd43..dfd99b7 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -28,7 +28,7 @@ BEGIN { } } -plan(103); +plan(104); my $rc_filename = '.perldb'; @@ -2476,6 +2476,34 @@ sub _calc_trace_wrapper ); } +# Test the o frame option. +{ + my $wrapper = DebugWrap->new( + { + cmds => + [ + # This is to avoid getting the "Debugger program terminated" + # junk that interferes with the normal output. + 'o inhibit_exit=0', + 'b 10', + 'c', + 'o frame=255', + 'c', + 'q', + ], + prog => '../lib/perl5db/t/test-frame-option-1', + } + ); + + $wrapper->contents_like( + qr/ + in\s*\.=main::my_other_func\(3,\ 1200\)\ from.*? + out\s*\.=main::my_other_func\(3,\ 1200\)\ from + /msx, + "Test o PrintRet=0 in void context", + ); +} + END { 1 while unlink ($rc_filename, $out_fn); } diff --git a/lib/perl5db/t/test-frame-option-1 b/lib/perl5db/t/test-frame-option-1 new file mode 100644 index 0000000..a6b4dd8 --- /dev/null +++ b/lib/perl5db/t/test-frame-option-1 @@ -0,0 +1,26 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +sub my_func +{ + my ($num1, $num2) = @_; + + print $num1+$num2, "\n"; + + my_other_func ($num1*3, $num2*24); + + return $num1*$num2; +} + +sub my_other_func +{ + my ($num1, $num2) = @_; + + print "my_other_func: n1=<$num1> n2=<$num2>\n"; + + return $num1 * $num2; +} + +my_func(1, 50); -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0046-Convert-some-COND-do-to-ifs.patch ```diff From e184c7e1dec90621f7102e2605cf8fa35ddfb636 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 29 Sep 2012 19:26:27 +0200 Subject: [PATCH 46/81] Convert some COND() && do to ifs. Also converted "^" and "$" to the less ambiguous \A and \z and converted an /^q$/ to the "eq" operator. Here I am starting to refactor the perl debugger. --- lib/perl5db.pl | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index dee4ebe..2eb4897 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2154,10 +2154,10 @@ the new command. This is faster, but perhaps a bit more convoluted. $signal = 0; # Handle continued commands (ending with \): - $cmd =~ s/\\$/\n/ && do { + if ($cmd =~ s/\\\z/\n/) { $cmd .= &readline(" cont: "); redo CMD; - }; + } =head4 The null command @@ -2228,11 +2228,11 @@ environment, and executing with the last value of C<$?>. =cut - $cmd =~ /^q$/ && do { + if ($cmd eq 'q') { $fall_off_end = 1; clean_ENV(); exit $?; - }; + } =head4 C - trace [n] @@ -2241,8 +2241,7 @@ If level is specified, set C<$trace_to_depth>. =cut - $cmd =~ /^t(?:\s+(\d+))?$/ && do { - my $levels = $1; + if (my ($levels) = $cmd =~ /\At(?:\s+(\d+))?\z/) { $trace ^= 1; local $\ = ''; $trace_to_depth = $levels ? $stack_depth + $levels : 1E9; @@ -2251,7 +2250,7 @@ If level is specified, set C<$trace_to_depth>. ? ( $levels ? "on (to level $trace_to_depth)" : "on" ) : "off" ) . "\n"; next CMD; - }; + } =head4 C - list subroutines matching/not matching a pattern -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0047-More-refactoring.patch ```diff From e883fbde50ae02cad25b3e6f21faec3af0d3b5c2 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 29 Sep 2012 19:47:19 +0200 Subject: [PATCH 47/81] More refactoring. --- lib/perl5db.pl | 83 ++++++++++++++++++++++++++++++---------------------------- 1 file changed, 43 insertions(+), 40 deletions(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 2eb4897..760e4f0 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2258,11 +2258,13 @@ Walks through C<%sub>, checking to see whether or not to print the name. =cut - $cmd =~ /^S(\s+(!)?(.+))?$/ && do { - - my $Srev = defined $2; # Reverse scan? - my $Spatt = $3; # The pattern (if any) to use. - my $Snocheck = !defined $1; # No args - print all subs. + if (my ($print_all_subs, $should_reverse, $Spatt) + = $cmd =~ /\AS(\s+(!)?(.+))?\z/) { + # $Spatt is the pattern (if any) to use. + # Reverse scan? + my $Srev = defined $should_reverse; + # No args - print all subs. + my $Snocheck = !defined $print_all_subs; # Need to make these sane here. local $\ = ''; @@ -2278,7 +2280,7 @@ Walks through C<%sub>, checking to see whether or not to print the name. } } next CMD; - }; + } =head4 C - list variables in current package @@ -2297,12 +2299,13 @@ Uses C to dump out the current values for selected variables. # Bare V commands get the currently-being-debugged package # added. - $cmd =~ /^V$/ && do { + if ($cmd eq "V") { $cmd = "V $package"; - }; + } # V - show variables in package. - $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do { + if (my ($new_packname, $new_vars_str) = + $cmd =~ /\AV\b\s*(\S+)\s*(.*)/) { # Save the currently selected filehandle and # force output to debugger's filehandle (dumpvar @@ -2310,8 +2313,8 @@ Uses C to dump out the current values for selected variables. my $savout = select($OUT); # Grab package name and variables to dump. - $packname = $1; - my @vars = split( ' ', $2 ); + $packname = $new_packname; + my @vars = split( ' ', $new_vars_str ); # If main::dumpvar isn't here, get it. do 'dumpvar.pl' || die $@ unless defined &main::dumpvar; @@ -2349,7 +2352,7 @@ Uses C to dump out the current values for selected variables. # Restore the output filehandle, and go round again. select($savout); next CMD; - }; + } =head4 C - evaluate and print an expression @@ -2358,15 +2361,15 @@ via C instead of just printing it directly. =cut - $cmd =~ s/^x\b/ / && do { # Remainder gets done by DB::eval() + if ($cmd =~ s#\Ax\b# #) { # Remainder gets done by DB::eval() $onetimeDump = 'dump'; # main::dumpvar shows the output # handle special "x 3 blah" syntax XXX propagate # doc back to special variables. - if ( $cmd =~ s/^\s*(\d+)(?=\s)/ / ) { + if ( $cmd =~ s#\A\s*(\d+)(?=\s)# #) { $onetimedumpDepth = $1; } - }; + } =head4 C - print methods @@ -2374,22 +2377,21 @@ Just uses C to determine what methods are available. =cut - $cmd =~ s/^m\s+([\w:]+)\s*$/ / && do { + if ($cmd =~ s#\Am\s+([\w:]+)\s*\z# #) { methods($1); next CMD; - }; + } # m expr - set up DB::eval to do the work - $cmd =~ s/^m\b/ / && do { # Rest gets done by DB::eval() + if ($cmd =~ s#\Am\b# #) { # Rest gets done by DB::eval() $onetimeDump = 'methods'; # method output gets used there - }; + } =head4 C - switch files =cut - $cmd =~ /^f\b\s*(.*)/ && do { - $file = $1; + if (($file) = $cmd =~ /\Af\b\s*(.*)/) { $file =~ s/\s+$//; # help for no arguments (old-style was return from sub). @@ -2431,7 +2433,7 @@ Just uses C to determine what methods are available. print $OUT "Already in $file.\n"; next CMD; } - }; + } =head4 C<.> - return to last-executed line. @@ -2441,7 +2443,7 @@ and then we look up the line in the magical C<%dbline> hash. =cut # . command. - $cmd =~ /^\.$/ && do { + if ($cmd eq '.') { $incr = -1; # stay at current line # Reset everything to the old location. @@ -2453,7 +2455,7 @@ and then we look up the line in the magical C<%dbline> hash. # Now where are we? print_lineinfo($position); next CMD; - }; + } =head4 C<-> - back one window @@ -2465,7 +2467,7 @@ C<$start>) in C<$cmd> to be executed later. =cut # - - back a window. - $cmd =~ /^-$/ && do { + if ($cmd eq '-') { # back up by a window; go to 1 if back too far. $start -= $incr + $window + 1; @@ -2474,7 +2476,7 @@ C<$start>) in C<$cmd> to be executed later. # Generate and execute a "l +" command (handled below). $cmd = 'l ' . ($start) . '+'; - }; + } =head3 PRE-580 COMMANDS VS. NEW COMMANDS: C, EE, {, {{> @@ -2489,19 +2491,20 @@ deal with them instead of processing them in-line. # All of these commands were remapped in perl 5.8.0; # we send them off to the secondary dispatcher (see below). - $cmd =~ /^([aAbBeEhilLMoOPvwW]\b|[<>\{]{1,2})\s*(.*)/so && do { - &cmd_wrapper( $1, $2, $line ); + if (my ($cmd_letter, $my_arg) = $cmd =~ /\A([aAbBeEhilLMoOPvwW]\b|[<>\{]{1,2})\s*(.*)/so) { + &cmd_wrapper( $cmd_letter, $my_arg, $line ); next CMD; - }; + } =head4 C - List lexicals in higher scope -Uses C to find the lexicals supplied as arguments in a scope +Uses C to find the lexicals supplied as arguments in a scope above the current one and then displays then using C. =cut - $cmd =~ /^y(?:\s+(\d*)\s*(.*))?$/ && do { + if (my ($match_level, $match_vars) + = $cmd =~ /^y(?:\s+(\d*)\s*(.*))?$/) { # See if we've got the necessary support. eval { require PadWalker; PadWalker->VERSION(0.08) } @@ -2519,10 +2522,10 @@ above the current one and then displays then using C. and next CMD; # Got all the modules we need. Find them and print them. - my @vars = split( ' ', $2 || '' ); + my @vars = split( ' ', $match_vars || '' ); # Find the pad. - my $h = eval { PadWalker::peek_my( ( $1 || 0 ) + 1 ) }; + my $h = eval { PadWalker::peek_my( ( $match_level || 0 ) + 1 ) }; # Oops. Can't find it. $@ and $@ =~ s/ at .*//, &warn($@), next CMD; @@ -2537,7 +2540,7 @@ above the current one and then displays then using C. for sort keys %$h; select($savout); next CMD; - }; + } =head3 COMMANDS NOT WORKING AFTER PROGRAM ENDS @@ -2551,12 +2554,12 @@ they can't. Done by setting C<$single> to 2, which forces subs to execute straight through when entered (see C). We also save the C command in C<$laststep>, -so a null command knows what to re-execute. +so a null command knows what to re-execute. =cut # n - next - $cmd =~ /^n$/ && do { + if ($cmd eq 'n') { end_report(), next CMD if $finished and $level <= 1; # Single step, but don't enter subs. @@ -2565,17 +2568,17 @@ so a null command knows what to re-execute. # Save for empty command (repeat last). $laststep = $cmd; last CMD; - }; + } =head4 C - single-step, entering subs -Sets C<$single> to 1, which causes C to continue tracing inside +Sets C<$single> to 1, which causes C to continue tracing inside subs. Also saves C as C<$lastcmd>. =cut # s - single step. - $cmd =~ /^s$/ && do { + if ($cmd eq 's') { # Get out and restart the command loop if program # has finished. @@ -2587,7 +2590,7 @@ subs. Also saves C as C<$lastcmd>. # Save for empty command (repeat last). $laststep = $cmd; last CMD; - }; + } =head4 C - run continuously, setting an optional breakpoint -- 1.7.12.1 ```
p5pRT commented 11 years ago

From @shlomif

0048-perl5db-More-refactoring.patch ```diff From b096f6fe1ca87db9ef52243b5cb8736d9f83e3c2 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 29 Sep 2012 20:33:50 +0200 Subject: [PATCH 48/81] [perl5db] More refactoring. 1. Made the POD better. 2. Converted more && do to ifs. 3. More eq conversions. 4. Captures in lexical variables. 5. Using /ms instead of [\x00-\xFF]. --- lib/perl5db.pl | 137 ++++++++++++++++++++++++++++++--------------------------- 1 file changed, 73 insertions(+), 64 deletions(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 760e4f0..61c9d59 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -186,7 +186,7 @@ uses this hash to determine where breakpoints have been set. Any true value is considered to be a breakpoint; C uses C<$break_condition\0$action>. Values are magical in numeric context: 1 if the line is breakable, 0 if not. -The scalar C<${"_<$filename"}> simply contains the string C<_<$filename>. +The scalar C<${"_<$filename"}> simply contains the string C<<< _<$filename> >>>. This is also the case for evaluated strings that contain subroutines, or which are currently being executed. The $filename for Ced strings looks like C<(eval 34). @@ -2602,14 +2602,14 @@ in this and all call levels above this one. =cut # c - start continuous execution. - $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do { + if (($i) = $cmd =~ m#\Ac\b\s*([\w:]*)\s*\z#) { # Hey, show's over. The debugged program finished # executing already. end_report(), next CMD if $finished and $level <= 1; # Capture the place to put a one-time break. - $subname = $i = $1; + $subname = $i; # Probably not needed, since we finish an interactive # sub-session anyway... @@ -2700,7 +2700,7 @@ in this and all call levels above this one. $stack[ $i ] &= ~1; } last CMD; - }; + } =head4 C - return from a subroutine @@ -2713,7 +2713,7 @@ appropriately, and force us out of the command loop. =cut # r - return from the current subroutine. - $cmd =~ /^r$/ && do { + if ($cmd eq 'r') { # Can't do anything if the program's over. end_report(), next CMD if $finished and $level <= 1; @@ -2724,7 +2724,7 @@ appropriately, and force us out of the command loop. # Print return value unless the stack is empty. $doret = $option{PrintRet} ? $stack_depth - 1 : -2; last CMD; - }; + } =head4 C - stack trace @@ -2732,10 +2732,10 @@ Just calls C. =cut - $cmd =~ /^T$/ && do { + if ($cmd eq 'T') { print_trace( $OUT, 1 ); # skip DB next CMD; - }; + } =head4 C - List window around current line. @@ -2743,7 +2743,10 @@ Just calls C. =cut - $cmd =~ /^w\b\s*(.*)/s && do { &cmd_w( 'w', $1 ); next CMD; }; + if (my ($arg) = $cmd =~ /\Aw\b\s*(.*)/s) { + &cmd_w( 'w', $arg ); + next CMD; + } =head4 C - watch-expression processing. @@ -2751,22 +2754,24 @@ Just calls C. =cut - $cmd =~ /^W\b\s*(.*)/s && do { &cmd_W( 'W', $1 ); next CMD; }; + if (my ($arg) = $cmd =~ /\AW\b\s*(.*)/s) { + &cmd_W( 'W', $arg ); + next CMD; + } =head4 C - search forward for a string in the source -We take the argument and treat it as a pattern. If it turns out to be a +We take the argument and treat it as a pattern. If it turns out to be a bad one, we return the error we got from trying to C it and exit. -If not, we create some code to do the search and C it so it can't +If not, we create some code to do the search and C it so it can't mess us up. =cut - $cmd =~ /^\/(.*)$/ && do { + # The pattern as a string. + use vars qw($inpat); - # The pattern as a string. - use vars qw($inpat); - $inpat = $1; + if (($inpat) = $cmd =~ m#\A/(.*)\z#) { # Remove the final slash. $inpat =~ s:([^\\])/$:$1:; @@ -2831,7 +2836,7 @@ mess us up. # If we wrapped, there never was a match. print $OUT "/$pat/: not found\n" if ( $start == $end ); next CMD; - }; + } =head4 C - search backward for a string in the source @@ -2840,10 +2845,9 @@ Same as for C, except the loop runs backwards. =cut # ? - backward pattern search. - $cmd =~ /^\?(.*)$/ && do { + if (my ($inpat) = $cmd =~ m#\A\?(.*)\z#) { # Get the pattern, remove trailing question mark. - my $inpat = $1; $inpat =~ s:([^\\])\?$:$1:; # If we've got one ... @@ -2902,7 +2906,7 @@ Same as for C, except the loop runs backwards. # Say we failed if the loop never found anything, print $OUT "?$pat?: not found\n" if ( $start == $end ); next CMD; - }; + } =head4 C<$rc> - Recall command @@ -2913,7 +2917,7 @@ into C<$cmd>, and redoes the loop to execute it. =cut # $rc - recall command. - $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do { + if (my ($minus, $arg) = $cmd =~ m#\A$rc+\s*(-)?(\d+)?\z#) { # No arguments, take one thing off history. pop(@hist) if length($cmd) > 1; @@ -2922,7 +2926,7 @@ into C<$cmd>, and redoes the loop to execute it. # Y - index back from most recent (by 1 if bare minus) # N - go to that particular command slot or the last # thing if nothing following. - $i = $1 ? ( $#hist - ( $2 || 1 ) ) : ( $2 || $#hist ); + $i = $minus ? ( $#hist - ( $arg || 1 ) ) : ( $arg || $#hist ); # Pick out the command desired. $cmd = $hist[$i]; @@ -2931,7 +2935,7 @@ into C<$cmd>, and redoes the loop to execute it. # with that command in the buffer. print $OUT $cmd, "\n"; redo CMD; - }; + } =head4 C<$sh$sh> - C command @@ -2942,12 +2946,12 @@ C from getting messed up. # $sh$sh - run a shell command (if it's all ASCII). # Can't run shell commands with Unicode in the debugger, hmm. - $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do { + if (my ($arg) = $cmd =~ m#\A$sh$sh\s*(.*)#ms) { # System it. - &system($1); + &system($arg); next CMD; - }; + } =head4 C<$rc I $rc> - Search command history @@ -2957,10 +2961,10 @@ If a command is found, it is placed in C<$cmd> and executed via C. =cut # $rc pattern $rc - find a command in the history. - $cmd =~ /^$rc([^$rc].*)$/ && do { + if (my ($arg) = $cmd =~ /\A$rc([^$rc].*)\z/) { # Create the pattern to use. - $pat = "^$1"; + $pat = "^$arg"; # Toss off last entry if length is >1 (and it always is). pop(@hist) if length($cmd) > 1; @@ -2982,22 +2986,22 @@ If a command is found, it is placed in C<$cmd> and executed via C. $cmd = $hist[$i]; print $OUT $cmd, "\n"; redo CMD; - }; + } -=head4 C<$sh> - Invoke a shell +=head4 C<$sh> - Invoke a shell Uses C to invoke a shell. =cut # $sh - start a shell. - $cmd =~ /^$sh$/ && do { + if ($cmd =~ /\A$sh\z/) { # Run the user's shell. If none defined, run Bourne. # We resume execution when the shell terminates. &system( $ENV{SHELL} || "/bin/sh" ); next CMD; - }; + } =head4 C<$sh I> - Force execution of a command in a shell @@ -3007,15 +3011,15 @@ C to avoid problems with C and C. =cut # $sh command - start a shell and run a command in it. - $cmd =~ /^$sh\s*([\x00-\xff]*)/ && do { + if (my ($arg) = $cmd =~ m#\A$sh\s*(.*)#ms) { # XXX: using csh or tcsh destroys sigint retvals! #&system($1); # use this instead # use the user's shell, or Bourne if none defined. - &system( $ENV{SHELL} || "/bin/sh", "-c", $1 ); + &system( $ENV{SHELL} || "/bin/sh", "-c", $arg ); next CMD; - }; + } =head4 C - display commands in history @@ -3023,17 +3027,18 @@ Prints the contents of C<@hist> (if any). =cut - $cmd =~ /^H\b\s*\*/ && do { + if ($cmd =~ /\AH\b\s*\*/) { @hist = @truehist = (); print $OUT "History cleansed\n"; next CMD; - }; + } - $cmd =~ /^H\b\s*(-(\d+))?/ && do { + if (my ($num) + = $cmd =~ /\AH\b\s*(?:-(\d+))?/) { # Anything other than negative numbers is ignored by # the (incorrect) pattern, so this test does nothing. - $end = $2 ? ( $#hist - $2 ) : 0; + $end = $num ? ( $#hist - $num ) : 0; # Set to the minimum if less than zero. $hist = 0 if $hist < 0; @@ -3048,7 +3053,7 @@ Prints the contents of C<@hist> (if any). unless $hist[$i] =~ /^.?$/; } next CMD; - }; + } =head4 C - look up documentation @@ -3057,10 +3062,11 @@ Just calls C to print the appropriate document. =cut # man, perldoc, doc - show manual pages. - $cmd =~ /^(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?$/ && do { - runman($1); + if (my ($man_page) + = $cmd =~ /\A(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?\z/) { + runman($man_page); next CMD; - }; + } =head4 C

- print @@ -3069,11 +3075,14 @@ the bottom of the loop. =cut + my $print_cmd = 'print {$DB::OUT} '; # p - print (no args): print $_. - $cmd =~ s/^p$/print {\$DB::OUT} \$_/; + if ($cmd eq 'p') { + $cmd = $print_cmd . '$_'; + } # p - print the given expression. - $cmd =~ s/^p\b/print {\$DB::OUT} /; + $cmd =~ s/\Ap\b/$print_cmd /; =head4 C<=> - define command alias @@ -3082,7 +3091,7 @@ Manipulates C<%alias> to add or list command aliases. =cut # = - set up a command alias. - $cmd =~ s/^=\s*// && do { + if ($cmd =~ s/\A=\s*//) { my @keys; if ( length $cmd == 0 ) { @@ -3151,7 +3160,7 @@ Manipulates C<%alias> to add or list command aliases. } } ## end for my $k (@keys) next CMD; - }; + } =head4 C - read commands from a file. @@ -3161,8 +3170,8 @@ pick it up. =cut # source - read commands from a file (or pipe!) and execute. - $cmd =~ /^source\s+(.*\S)/ && do { - if ( open my $fh, $1 ) { + if (my ($sourced_fn) = $cmd =~ /\Asource\s+(.*\S)/) { + if ( open my $fh, $sourced_fn ) { # Opened OK; stick it in the list of file handles. push @cmdfhs, $fh; @@ -3170,13 +3179,13 @@ pick it up. else { # Couldn't open it. - &warn("Can't execute '$1': $!\n"); + &warn("Can't execute '$sourced_fn': $!\n"); } next CMD; - }; + } - $cmd =~ /^(enable|disable)\s+(\S+)\s*$/ && do { - my ($cmd, $position) = ($1, $2); + if (my ($which_cmd, $position) + = $cmd =~ /^(enable|disable)\s+(\S+)\s*$/) { my ($fn, $line_num); if ($position =~ m{\A\d+\z}) @@ -3184,9 +3193,9 @@ pick it up. $fn = $filename; $line_num = $position; } - elsif ($position =~ m{\A(.*):(\d+)\z}) - { - ($fn, $line_num) = ($1, $2); + elsif (my ($new_fn, $new_line_num) + = $position =~ m{\A(.*):(\d+)\z}) { + ($fn, $line_num) = ($new_fn, $new_line_num); } else { @@ -3196,7 +3205,7 @@ pick it up. if (defined($fn)) { if (_has_breakpoint_data_ref($fn, $line_num)) { _set_breakpoint_enabled_status($fn, $line_num, - ($cmd eq 'enable' ? 1 : '') + ($which_cmd eq 'enable' ? 1 : '') ); } else { @@ -3205,7 +3214,7 @@ pick it up. } next CMD; - }; + } =head4 C - send current history to a file @@ -3217,9 +3226,9 @@ Note that all C<^(save|source)>'s are commented out with a view to minimise recu =cut # save source - write commands to a file for later use - $cmd =~ /^save\s*(.*)$/ && do { - my $file = $1 || '.perl5dbrc'; # default? - if ( open my $fh, "> $file" ) { + if (my ($new_fn) = $cmd =~ /\Asave\s*(.*)\z/) { + my $filename = $new_fn || '.perl5dbrc'; # default? + if ( open my $fh, '>', $filename ) { # chomp to remove extraneous newlines from source'd files chomp( my @truelist = @@ -3229,14 +3238,14 @@ Note that all C<^(save|source)>'s are commented out with a view to minimise recu print "commands saved in $file\n"; } else { - &warn("Can't save debugger commands in '$1': $!\n"); + &warn("Can't save debugger commands in '$new_fn': $!\n"); } next CMD; - }; + } =head4 C - restart -Restart the debugger session. +Restart the debugger session. =head4 C - rerun the current session -- 1.7.12.1 ```

p5pRT commented 11 years ago

From @shlomif

0049-perl5db-Refactored-do-.-s-into-ifs.patch ```diff From 7356c8a2d82e4c440543d0b0778a31144dd59521 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Sat, 29 Sep 2012 21:10:05 +0200 Subject: [PATCH 49/81] [perl5db] Refactored do {...}s into ifs. --- lib/perl5db.pl | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 61c9d59..f61aa90 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -3255,8 +3255,9 @@ Return to any given position in the B-history list # R - restart execution. # rerun - controlled restart execution. - $cmd =~ /^(R|rerun\s*(.*))$/ && do { - my @args = ($1 eq 'R' ? restart() : rerun($2)); + if (my ($cmd_cmd, $cmd_params) = + $cmd =~ /\A((?:R)|(?:rerun\s*(.*)))\z/) { + my @args = ($cmd_cmd eq 'R' ? restart() : rerun($cmd_params)); # Close all non-system fds for a clean restart. A more # correct method would be to close all fds that were not @@ -3281,7 +3282,7 @@ Return to any given position in the B-history list exec(@args) || print $OUT "exec failed: $!\n"; last CMD; - }; + } =head4 C<|, ||> - pipe output through the pager. @@ -3298,7 +3299,7 @@ reading another. =cut # || - run command in the pager, with output to DB::OUT. - $cmd =~ /^\|\|?\s*[^|]/ && do { + if ($cmd =~ m#\A\|\|?\s*[^|]#) { if ( $pager =~ /^\|/ ) { # Default pager is into a pipe. Redirect I/O. @@ -3351,29 +3352,34 @@ reading another. select($selected), $selected = "" unless $cmd =~ /^\|\|/; # Trim off the pipe symbols and run the command now. - $cmd =~ s/^\|+\s*//; + $cmd =~ s#\A\|+\s*##; redo PIPE; - }; + } =head3 END OF COMMAND PARSING -Anything left in C<$cmd> at this point is a Perl expression that we want to -evaluate. We'll always evaluate in the user's context, and fully qualify +Anything left in C<$cmd> at this point is a Perl expression that we want to +evaluate. We'll always evaluate in the user's context, and fully qualify any variables we might want to address in the C package. =cut # t - turn trace on. - $cmd =~ s/^t\s+(\d+)?/\$DB::trace |= 1;\n/ && do { - $trace_to_depth = $1 ? $stack_depth||0 + $1 : 1E9; - }; + if ($cmd =~ s#\At\s+(\d+)?#\$DB::trace |= 1;\n#) { + my $trace_arg = $1; + $trace_to_depth = $trace_arg ? $stack_depth||0 + $1 : 1E9; + } # s - single-step. Remember the last command was 's'. - $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do { $laststep = 's' }; + if ($cmd =~ s/\As\s/\$DB::single = 1;\n/) { + $laststep = 's'; + } # n - single-step, but not into subs. Remember last command # was 'n'. - $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do { $laststep = 'n' }; + if ($cmd =~ s#\An\s#\$DB::single = 2;\n#) { + $laststep = 'n'; + } } # PIPE: -- 1.7.12.1 ```
  • © Githubissues.
  • Githubissues is a development platform for aggregating issues.