setpgrp() should extend the stack before modifying it

As reported by Marcin Owsiany in <http://bugs.debian.org/512796>,
invoking setpgrp without any arguments could corrupt the stack.

diff --git a/MANIFEST b/MANIFEST
index 5713bde..2a8f702 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4120,6 +4120,7 @@ t/op/re_tests                     Regular expressions for regexp.t
 t/op/reverse.t                 See if reverse operator works
 t/op/runlevel.t                        See if die() works from perl_call_*()
 t/op/rxcode.t                  See if /(?{ code })/ works
+t/op/setpgrpstack.t            See if setpgrp works
 t/op/sleep.t                   See if sleep works
 t/op/smartmatch.t              See if the ~~ operator works
 t/op/sort.t                    See if sort works

diff --git a/pp_sys.c b/pp_sys.c
index cfbf918..0d2c970 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4318,6 +4318,7 @@ PP(pp_setpgrp)
     if (MAXARG < 2) {
        pgrp = 0;
        pid = 0;
+       XPUSHi(-1);
     }
     else {
        pgrp = POPi;

diff --git a/t/op/setpgrpstack.t b/t/op/setpgrpstack.t
new file mode 100644 (file)
index 0000000..31f498e
--- /dev/null
+++ b/t/op/setpgrpstack.t
@@ -0,0 +1,16 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use Config;
+plan tests => 2;
+
+SKIP: {
+    skip "setpgrp() is not available", 2 unless $Config{d_setpgrp};
+    ok(!eval { package A;sub foo { die("got here") }; package main; A->foo(setpgrp())});
+    ok($@ =~ /got here/, "setpgrp() should extend the stack before modifying it");
+}