Test more for the m staetement.

diff --git a/MANIFEST b/MANIFEST
index c2ce840..6e0707e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4338,6 +4338,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 (file)
--- 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 (file)
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;