Verify that the code for initialising typeglobs from other types works.

[p5sagit/p5-mst-13.2.git] / t / op / gv.t

diff --git a/t/op/gv.t b/t/op/gv.t
index 66c1cfd..e69c1f4 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 
 require './test.pl';
-plan( tests => 68 );
+plan( tests => 97 );
 
 # type coersion on assignment
 $foo = 'foo';
@@ -247,9 +247,12 @@ is($j[0], 1);
 }
 
 {
-    my $output = runperl(prog => <<'EOPROG', stderr => 1);
+    # Need some sort of die or warn to get the global destruction text if the
+    # bug is still present
+    my $output = runperl(prog => <<'EOPROG');
 package M;
-sub DESTROY {warn "Farewell $_[0]"}
+$| = 1;
+sub DESTROY {eval {die qq{Farewell $_[0]}}; print $@}
 package main;
 
 bless \$A::B, 'M';
@@ -259,6 +262,34 @@ EOPROG
     unlike($output, qr/global destruction/,
            "unreferenced symbol tables should be cleaned up immediately");
 }
+
+# Possibly not the correct test file for these tests.
+# There are certain space optimisations implemented via promotion rules to
+# GVs
+
+ok(!exists $::{oonk}, "no symbols of any sort to start with");
+
+# A string in place of the typeglob is promoted to the function prototype
+$::{oonk} = "pie";
+my $proto = eval 'prototype \&oonk';
+die if $@;
+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) {
+    delete $::{oonk};
+    $::{oonk} = \$value;
+    $proto = eval 'prototype \&oonk';
+    die if $@;
+    is ($proto, '', "Prototype for a constant subroutine is empty");
+
+    my $got = eval 'oonk';
+    die if $@;
+    is (ref $got, ref $value, "Correct type of value");
+    is ($got, $value, "Value is correctly set");
+}
 __END__
 Perl
 Rules