Add a test for o PrintRet.
authorShlomi Fish <shlomif@shlomifish.org>
Thu, 27 Sep 2012 17:40:31 +0000 (19:40 +0200)
committerRicardo Signes <rjbs@cpan.org>
Mon, 12 Nov 2012 14:18:24 +0000 (09:18 -0500)
MANIFEST
lib/perl5db.t
lib/perl5db/t/test-PrintRet-option-1 [new file with mode: 0644]

index 117b33b..df23ed2 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4340,6 +4340,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
index 6b7dd19..0ef2eb1 100644 (file)
@@ -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 (file)
index 0000000..ccf6607
--- /dev/null
@@ -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++;
+}
+