From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 20 Dec 2005 15:11:09 +0000 (+0000)
Subject: Croak if gv_init doesn't know how to create a typeglob from that type
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5c1f4d79697c25c445705da5672c3103505b0d08;p=p5sagit%2Fp5-mst-13.2.git

Croak if gv_init doesn't know how to create a typeglob from that type
of referant. Test that ARRAY, HASH, PVIO, CODE and FORMAT croak.
Globs are actually first class assignable objects, so test that you
can create a constant subroutine that returns one.

p4raw-id: //depot/perl@26422
---

diff --git a/gv.c b/gv.c
index 81b8e58..97c3448 100644
--- a/gv.c
+++ b/gv.c
@@ -134,6 +134,16 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     assert (!(proto && has_constant));
 
     if (has_constant) {
+	/* The constant has to be a simple scalar type.  */
+	switch (SvTYPE(has_constant)) {
+	case SVt_PVAV:
+	case SVt_PVHV:
+	case SVt_PVCV:
+	case SVt_PVFM:
+	case SVt_PVIO:
+            Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
+		       sv_reftype(has_constant, 0));
+	}
 	SvRV_set(gv, NULL);
 	SvROK_off(gv);
     }
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1204117..939e3d7 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -480,6 +480,13 @@ See L<perlfunc/pack>.
 (F) An argument to pack("w",...) was negative.  The BER compressed integer
 format can only be used with positive integers.  See L<perlfunc/pack>.
 
+=item Cannot convert a reference to %s to typeglob
+
+(F) You manipulated Perl's symbol table directly, stored a reference in it,
+then tried to access that symbol via conventional Perl syntax. The access
+triggers Perl to autovivify that typeglob, but it there is no legal conversion
+from that type of reference to a typeglob.
+
 =item Can only compress unsigned integers in pack
 
 (F) An argument to pack("w",...) was not an integer.  The BER compressed
diff --git a/t/op/gv.t b/t/op/gv.t
index e69c1f4..ad2db4a 100755
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 97 );
+plan( tests => 105 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -278,7 +278,7 @@ is ($proto, "pie", "String is promoted to prototype");
 
 # A reference to a value is used to generate a constant subroutine
 foreach my $value (3, "Perl rules", \42, qr/whatever/, [1,2,3], {1=>2},
-		   \*STDIN, \&ok, \undef) {
+		   \*STDIN, \&ok, \undef, *STDOUT) {
     delete $::{oonk};
     $::{oonk} = \$value;
     $proto = eval 'prototype \&oonk';
@@ -287,9 +287,25 @@ foreach my $value (3, "Perl rules", \42, qr/whatever/, [1,2,3], {1=>2},
 
     my $got = eval 'oonk';
     die if $@;
-    is (ref $got, ref $value, "Correct type of value");
+    is (ref $got, ref $value, "Correct type of value (" . ref($value) . ")");
     is ($got, $value, "Value is correctly set");
 }
+
+format =
+.
+
+foreach my $value ([1,2,3], {1=>2}, *STDOUT{IO}, \&ok, *STDOUT{FORMAT}) {
+    # *STDOUT{IO} returns a reference to a PVIO. As it's blessed, ref returns
+    # IO::Handle, which isn't what we want.
+    my $type = $value;
+    $type =~ s/.*=//;
+    $type =~ s/\(.*//;
+    delete $::{oonk};
+    $::{oonk} = $value;
+    $proto = eval 'prototype \&oonk';
+    like ($@, qr/^Cannot convert a reference to $type to typeglob/,
+	  "Cannot upgrade ref-to-$type to typeglob");
+}
 __END__
 Perl
 Rules