segfault on &Internals::* due to missing SvROK()

Change the &Internals::* functions that use references in their
prototypes to check if the argument is SvROK() before calling SvRV().

If the function is called as Internals::FOO() perl does this check for
us, but prototypes are bypassed on &Internals::FOO() so we still have
to check this manually.

This fixes [perl #77776], this bug was present in 5.10.x, 5.12.x, and
probably all earlier perl versions that had these functions, but I
haven't tested that.

I'm adding a new test file (t/lib/universal.t) to test universal.c
functions as part of this patch. The testing for Internal::* in t/ was
and is very sparse, but before universal.t there was no obvious place
to put these tests.

Signed-off-by: Ævar Arnfjörð Bjarmason <avar@cpan.org>

4 files changed, 53 insertions, 3 deletions

diff --git a/MANIFEST b/MANIFEST
index 7900589433..e05d019a93 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4412,6 +4412,7 @@ t/lib/strict/vars		Tests of "use strict 'vars'" for strict.t
 t/lib/subs/subs			Tests of "use subs"
 t/lib/test_use_14937.pm		A test pragma for t/comp/use.t
 t/lib/test_use.pm		A test pragma for t/comp/use.t
+t/lib/universal.t		Tests for functions in universal.c
 t/lib/warnings/1global		Tests of global warnings for warnings.t
 t/lib/warnings/2use		Tests for "use warnings" for warnings.t
 t/lib/warnings/3both		Tests for interaction of $^W and "use warnings"
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 4c3451403f..cb83c8c761 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -543,6 +543,16 @@ fixed [perl #21469]. This means the following code will no longer crash:
         *x = *y;
     }
 
+=item *
+
+Perl would segfault if the undocumented C<Internals> functions that
+used reference prototypes were called with the C<&foo()> syntax,
+e.g. C<&Internals::SvREADONLY(undef)> [perl #77776].
+
+These functions now call C<SvROK> on their arguments before
+dereferencing them with C<SvRV>, and we test for this case in
+F<t/lib/universal.t>.
+
 =back
 
 =head1 Known Problems
diff --git a/t/lib/universal.t b/t/lib/universal.t
new file mode 100644
index 0000000000..d8c088920b
--- /dev/null
+++ b/t/lib/universal.t
@@ -0,0 +1,25 @@
+#!./perl
+
+# Test the Internal::* functions and other tibits in universal.c
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+    plan( tests => 4 );
+}
+
+for my $arg ('', 'q[]', qw( 1 undef )) {
+    fresh_perl_is(<<"----", <<'====', "Internals::* functions check their argument under func() AND &func() [perl #77776]");
+sub tryit { eval shift or warn \$@ }
+tryit "&Internals::SvREADONLY($arg)";
+tryit "&Internals::SvREFCNT($arg)";
+tryit "&Internals::hv_clear_placeholders($arg)";
+tryit "&Internals::HvREHASH($arg)";
+----
+Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1.
+Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1.
+Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1.
+Internals::HvREHASH $hashref at (eval 4) line 1.
+====
+}
diff --git a/universal.c b/universal.c
index 65935018f8..6df104eb13 100644
--- a/universal.c
+++ b/universal.c
@@ -794,9 +794,16 @@ XS(XS_Internals_SvREADONLY)	/* This is dangerous stuff. */
 {
     dVAR;
     dXSARGS;
-    SV * const sv = SvRV(ST(0));
+    SV * const svz = ST(0);
+    SV * sv;
     PERL_UNUSED_ARG(cv);
 
+    /* [perl #77776] - called as &foo() not foo() */
+    if (!SvROK(svz))
+        croak_xs_usage(cv, "SCALAR[, ON]");
+
+    sv = SvRV(svz);
+
     if (items == 1) {
 	 if (SvREADONLY(sv))
 	     XSRETURN_YES;
@@ -821,9 +828,16 @@ XS(XS_Internals_SvREFCNT)	/* This is dangerous stuff. */
 {
     dVAR;
     dXSARGS;
-    SV * const sv = SvRV(ST(0));
+    SV * const svz = ST(0);
+    SV * sv;
     PERL_UNUSED_ARG(cv);
 
+    /* [perl #77776] - called as &foo() not foo() */
+    if (!SvROK(svz))
+        croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
+
+    sv = SvRV(svz);
+
     if (items == 1)
 	 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
     else if (items == 2) {
@@ -839,7 +853,7 @@ XS(XS_Internals_hv_clear_placehold)
     dVAR;
     dXSARGS;
 
-    if (items != 1)
+    if (items != 1 || !SvROK(ST(0)))
 	croak_xs_usage(cv, "hv");
     else {
 	HV * const hv = MUTABLE_HV(SvRV(ST(0)));