Tests for UTF-8 GVs.

Basically t/op/gv.t with UTF-8 names. A vast majority of
the tests currently fail and are marked as TODO; Minus for
failures related to prototypes, these will start working
in the following commits.

1 files changed, 853 insertions, 0 deletions

diff --git a/t/uni/gv.t b/t/uni/gv.t
new file mode 100644
index 0000000000..ab64f1c5eb
--- /dev/null
+++ b/t/uni/gv.t
@@ -0,0 +1,853 @@
+#!./perl
+
+#
+# various typeglob tests
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+
+plan( tests => 206 );
+
+# type coersion on assignment
+$ᕘ = 'ᕘ';
+$ᴮᛅ = *main::ᕘ;
+$ᴮᛅ = $ᕘ;
+is(ref(\$ᴮᛅ), 'SCALAR');
+$ᕘ = *main::ᴮᛅ;
+
+# type coersion (not) on misc ops
+
+ok($ᕘ);
+is(ref(\$ᕘ), 'GLOB');
+
+unlike ($ᕘ, qr/abcd/);
+is(ref(\$ᕘ), 'GLOB');
+
+is($ᕘ, '*main::ᴮᛅ');
+is(ref(\$ᕘ), 'GLOB');
+
+{
+ no warnings;
+ ${\*$ᕘ} = undef;
+ is(ref(\$ᕘ), 'GLOB', 'no type coersion when assigning to *{} retval');
+ $::{ఫｹ} = *ᴮᛅ;
+ is(
+   \$::{ఫｹ}, \*{"ఫｹ"},
+   'symbolic *{} returns symtab entry when FAKE'
+ );
+ ${\*{"ఫｹ"}} = undef;
+ is(
+   ref(\$::{ఫｹ}), 'GLOB',
+  'no type coersion when assigning to retval of symbolic *{}'
+ );
+ $::{pɥአＱuઍ} = *ᴮᛅ;
+ eval '
+   is(
+     \$::{pɥአＱuઍ}, \*pɥአＱuઍ,
+     "compile-time *{} returns symtab entry when FAKE"
+   );
+   ${\*pɥአＱuઍ} = undef;
+ ';
+ is(
+   ref(\$::{pɥአＱuઍ}), 'GLOB',
+  'no type coersion when assigning to retval of compile-time *{}'
+ );
+}
+
+# type coersion on substitutions that match
+$a = *main::ᕘ;
+$b = $a;
+$a =~ s/^X//;
+is(ref(\$a), 'GLOB');
+$a =~ s/^\*//;
+is($a, 'main::ᕘ');
+is(ref(\$b), 'GLOB');
+
+# typeglobs as lvalues
+substr($ᕘ, 0, 1) = "XXX";
+is(ref(\$ᕘ), 'SCALAR');
+is($ᕘ, 'XXXmain::ᴮᛅ');
+
+# returning glob values
+sub ᕘ {
+  local($ᴮᛅ) = *main::ᕘ;
+  $ᕘ = *main::ᴮᛅ;
+  return ($ᕘ, $ᴮᛅ);
+}
+
+($ፉṶ, $ባ) = ᕘ();
+ok(defined $ፉṶ);
+is(ref(\$ፉṶ), 'GLOB');
+
+
+ok(defined $ባ);
+is(ref(\$ባ), 'GLOB');
+
+# nested package globs
+# NOTE:  It's probably OK if these semantics change, because the
+#        fact that %X::Y:: is stored in %X:: isn't documented.
+#        (I hope.)
+
+{ package ฝ오::ʉ; no warnings 'once'; $test=1; }
+ok(exists $ฝ오::{'ʉ::'});
+is($ฝ오::{'ʉ::'}, '*ฝ오::ʉ::');
+
+
+# test undef operator clearing out entire glob
+$ᕘ = 'stuff';
+@ᕘ = qw(more stuff);
+%ᕘ = qw(even more random stuff);
+undef *ᕘ;
+is ($ᕘ, undef);
+is (scalar @ᕘ, 0);
+is (scalar %ᕘ, 0);
+
+TODO: {
+    local $TODO = "sprintf formats might not be clean on globs";
+    # test warnings from assignment of undef to glob
+    my $msg = '';
+    local $SIG{__WARN__} = sub { $msg = $_[0] };
+    use warnings;
+    *ᕘ = 'ᴮᛅ';
+    is($msg, '');
+    *ᕘ = undef;
+    like($msg, qr/Undefined value assigned to typeglob/);
+
+    no warnings 'once';
+    # test warnings for converting globs to other forms
+    my $copy = *PWÒMPF;
+    foreach ($copy, *SKRÈÈÈ) {
+	$msg = '';
+	my $victim = sprintf "%d", $_;
+	like($msg, qr/Argument "\*main::[\p{XIDS}\p{XIDC}]{6}" isn't numeric in sprintf/,
+	     "Warning on conversion to IV");
+	is($victim, 0);
+
+	$msg = '';
+	$victim = sprintf "%u", $_;
+	like($msg, qr/Argument "\*main::[\p{XIDS}\p{XIDC}]{6}" isn't numeric in sprintf/,
+	     "Warning on conversion to UV");
+	is($victim, 0);
+
+	$msg = '';
+	$victim = sprintf "%e", $_;
+	like($msg, qr/Argument "\*main::[\p{XIDS}\p{XIDC}]{6}" isn't numeric in sprintf/,
+	     "Warning on conversion to NV");
+	like($victim, qr/^0\.0+E\+?00/i, "Expect floating point zero");
+
+	$msg = '';
+	$victim = sprintf "%s", $_;
+	is($msg, '', "No warning on stringification");
+	is($victim, '' . $_);
+    }
+}
+
+my $test = curr_test();
+# test *glob{THING} syntax
+$Ẋ = "ok $test\n";
+++$test;
+@Ẋ = ("ok $test\n");
+++$test;
+%Ẋ = ("ok $test" => "\n");
+++$test;
+sub Ẋ { "ok $test\n" }
+print ${*Ẋ{SCALAR}}, @{*Ẋ{ARRAY}}, %{*Ẋ{HASH}}, &{*Ẋ{CODE}};
+# This needs to go here, after the print, as sub Ẋ will return the current
+# value of test
+++$test;
+format Ẋ =
+XXX This text isn't used. Should it be?
+.
+curr_test($test);
+
+is (ref *Ẋ{FORMAT}, "FORMAT");
+*Ẋ = *STDOUT;
+is (*{*Ẋ{GLOB}}, "*main::STDOUT");
+
+{
+    my $test = curr_test();
+
+    print {*Ẋ{IO}} "ok $test\n";
+    ++$test;
+
+    my $warn;
+    local $SIG{__WARN__} = sub {
+	$warn .= $_[0];
+    };
+    my $val = *Ẋ{FILEHANDLE};
+    print {*Ẋ{IO}} ($warn =~ /is deprecated/
+		    ? "ok $test\n" : "not ok $test\n");
+    curr_test(++$test);
+}
+
+
+{
+    # test if defined() doesn't create any new symbols
+
+    my $a = "Sʎｍ000";
+    ok(!defined *{$a});
+
+    ok(!defined @{$a});
+    ok(!defined *{$a});
+
+    {
+	no warnings 'deprecated';
+	ok(!defined %{$a});
+    }
+    ok(!defined *{$a});
+
+    ok(!defined ${$a});
+    ok(!defined *{$a});
+
+    ok(!defined &{$a});
+    ok(!defined *{$a});
+
+    my $state = "not";
+    *{$a} = sub { $state = "ok" };
+    ok(defined &{$a});
+    ok(defined *{$a});
+    &{$a};
+    is ($state, 'ok');
+}
+
+# [ID 20010526.001] localized glob loses value when assigned to
+
+$Ｊ=1; %Ｊ=(a=>1); @Ｊ=(1); local *Ｊ=*Ｊ; *Ｊ = sub{};
+
+is($Ｊ, 1);
+is($Ｊ{a}, 1);
+is($Ｊ[0], 1);
+
+{
+    # does pp_readline() handle glob-ness correctly?
+    my $g = *ᕘ;
+    $g = <DATA>;
+    is ($g, "Perl\n");
+}
+
+{
+    my $w = '';
+    local $SIG{__WARN__} = sub { $w = $_[0] };
+    sub aʙȼ1 ();
+    local *aʙȼ1 = sub { };
+    is ($w, '');
+    sub aʙȼ2 ();
+    local *aʙȼ2;
+    *aʙȼ2 = sub { };
+    is ($w, '');
+    sub aʙȼ3 ();
+    *aʙȼ3 = sub { };
+    like ($w, qr/Prototype mismatch/);
+}
+
+{
+    # [17375] rcatline to formerly-defined undef was broken. Fixed in
+    # do_readline by checking SvOK. AMS, 20020918
+    my $x = "not ";
+    $x  = undef;
+    $x .= <DATA>;
+    is ($x, "Rules\n");
+}
+
+{
+    # test the assignment of a GLOB to an LVALUE
+    my $e = '';
+    local $SIG{__DIE__} = sub { $e = $_[0] };
+    my %Ｖ;
+    sub ƒ { $_[0] = 0; $_[0] = "a"; $_[0] = *DATA }
+    ƒ($Ｖ{Ｖ});
+    is ($Ｖ{Ｖ}, '*main::DATA');
+    is (ref\$Ｖ{Ｖ}, 'GLOB', 'lvalue assignment preserves globs');
+    my $x = readline $Ｖ{Ｖ};
+    is ($x, "perl\n");
+    is ($e, '', '__DIE__ handler never called');
+}
+=begin
+TODO: {
+    local $TODO = "Tie not yet clean";
+    my $e = '';
+    # GLOB assignment to tied element
+    local $SIG{__DIE__} = sub { $e = $_[0] };
+    sub Ʈ::TIEARRAY  { bless [] => "Ʈ" }
+    sub Ʈ::STORE     { $_[0]->[ $_[1] ] = $_[2] }
+    sub Ʈ::FETCH     { $_[0]->[ $_[1] ] }
+    sub Ʈ::FETCHSIZE { @{$_[0]} }
+    tie my @ary => "Ʈ";
+    $ary[0] = *DATA;
+    is ($ary[0], '*main::DATA');
+    is (
+      ref\tied(@ary)->[0], 'GLOB',
+     'tied elem assignment preserves globs'
+    );
+    is ($e, '', '__DIE__ handler not called');
+    my $x = readline $ary[0];
+    is($x, "rocks\n");
+    is ($e, '', '__DIE__ handler never called');
+}
+=cut
+TODO: {
+    local $TODO = "bless not yet clean";
+    SKIP: {
+        skip_if_miniperl('no dynamic loading on miniperl, no Encode');
+        # Need some sort of die or warn to get the global destruction text if the
+        # bug is still present
+        my $prog = <<'EOPROG';
+            use utf8;
+            use open qw( :utf8 :std );
+            package ᴹ;
+            $| = 1;
+            sub DESTROY {eval {die qq{Farewell $_[0]}}; print $@}
+            package main;
+    
+            bless \$Ⱥ::ㄅ, q{ᴹ};
+            *Ⱥ:: = \*ㄅ::;
+EOPROG
+    
+        utf8::decode($prog);
+        my $output = runperl(prog => $prog);
+        
+        require Encode;
+        $output = Encode::decode("UTF-8", $output);
+        like($output, qr/^Farewell ᴹ=SCALAR/, "DESTROY was called");
+        unlike($output, qr/global destruction/,
+            "unreferenced symbol tables should be cleaned up immediately");
+    }
+}
+
+TODO: {
+    local $TODO = "prototype() (and prototypes in general) not yet clean";
+    # Possibly not the correct test file for these tests.
+    # There are certain space optimisations implemented via promotion rules to
+    # GVs
+    
+    foreach (qw (оઓnḲ ga_ㄕƚo잎)) {
+        ok(!exists $::{$_}, "no symbols of any sort to start with for $_");
+    }
+    
+    # A string in place of the typeglob is promoted to the function prototype
+    $::{оઓnḲ} = "pìè";
+    my $proto = eval 'prototype \&оઓnḲ';
+    die if $@;
+    is ($proto, "pìè", "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, *STDOUT) {
+        delete $::{оઓnḲ};
+        $::{оઓnḲ} = \$value;
+        $proto = eval 'prototype \&оઓnḲ';
+        die if $@;
+        is ($proto, '', "Prototype for a constant subroutine is empty");
+    
+        my $got = eval 'оઓnḲ';
+        die if $@;
+        is (ref $got, ref $value, "Correct type of value (" . ref($value) . ")");
+        is ($got, $value, "Value is correctly set");
+    }
+}
+
+delete $::{оઓnḲ};
+$::{оઓnḲ} = \"Value";
+
+*{"ga_ㄕƚo잎"} = \&{"оઓnḲ"};
+
+is (ref $::{ga_ㄕƚo잎}, 'SCALAR', "Export of proxy constant as is");
+is (ref $::{оઓnḲ}, 'SCALAR', "Export doesn't affect original");
+is (eval 'ga_ㄕƚo잎', "Value", "Constant has correct value");
+is (ref $::{ga_ㄕƚo잎}, 'SCALAR',
+    "Inlining of constant doesn't change representation");
+
+delete $::{ga_ㄕƚo잎};
+
+eval 'sub ga_ㄕƚo잎 (); 1' or die $@;
+is ($::{ga_ㄕƚo잎}, '', "Prototype is stored as an empty string");
+
+# Check that a prototype expands.
+*{"ga_ㄕƚo잎"} = \&{"оઓnḲ"};
+
+is (ref $::{оઓnḲ}, 'SCALAR', "Export doesn't affect original");
+is (eval 'ga_ㄕƚo잎', "Value", "Constant has correct value");
+is (ref \$::{ga_ㄕƚo잎}, 'GLOB', "Symbol table has full typeglob");
+
+
+@::zᐓｔ = ('Zᐓｔ!');
+
+# Check that assignment to an existing typeglob works
+{
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  *{"zᐓｔ"} = \&{"оઓnḲ"};
+  is($w, '', "Should be no warning");
+}
+
+is (ref $::{оઓnḲ}, 'SCALAR', "Export doesn't affect original");
+is (eval 'zᐓｔ', "Value", "Constant has correct value");
+is (ref \$::{zᐓｔ}, 'GLOB', "Symbol table has full typeglob");
+is (join ('!', @::zᐓｔ), 'Zᐓｔ!', "Existing array still in typeglob");
+
+sub Ṩp맅싵Ş () {
+    "Traditional";
+}
+
+# Check that assignment to an existing subroutine works
+TODO: {
+  local $TODO = "Warnings not yet UTF-8 clean";
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  *{"Ṩp맅싵Ş"} = \&{"оઓnḲ"};
+  like($w, qr/^Constant subroutine main::Ṩp맅싵Ş redefined/,
+       "Redefining a constant sub should warn");
+}
+
+is (ref $::{оઓnḲ}, 'SCALAR', "Export doesn't affect original");
+is (eval 'Ṩp맅싵Ş', "Value", "Constant has correct value");
+is (ref \$::{Ṩp맅싵Ş}, 'GLOB', "Symbol table has full typeglob");
+
+# Check that assignment to an existing typeglob works
+{
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  *{"plუᒃ"} = [];
+  *{"plუᒃ"} = \&{"оઓnḲ"};
+  is($w, '', "Should be no warning");
+}
+
+is (ref $::{оઓnḲ}, 'SCALAR', "Export doesn't affect original");
+is (eval 'plუᒃ', "Value", "Constant has correct value");
+is (ref \$::{plუᒃ}, 'GLOB', "Symbol table has full typeglob");
+
+my $gr = eval '\*plუᒃ' or die;
+
+{
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  *{$gr} = \&{"оઓnḲ"};
+  is($w, '', "Redefining a constant sub to another constant sub with the same underlying value should not warn (It's just re-exporting, and that was always legal)");
+}
+
+is (ref $::{оઓnḲ}, 'SCALAR', "Export doesn't affect original");
+is (eval 'plუᒃ', "Value", "Constant has correct value");
+is (ref \$::{plუᒃ}, 'GLOB', "Symbol table has full typeglob");
+
+# Non-void context should defeat the optimisation, and will cause the original
+# to be promoted (what change 26482 intended)
+my $result;
+{
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  $result = *{"aẈʞƙʞƙʞƙ"} = \&{"оઓnḲ"};
+  is($w, '', "Should be no warning");
+}
+
+is (ref \$result, 'GLOB',
+    "Non void assignment should still return a typeglob");
+
+is (ref \$::{оઓnḲ}, 'GLOB', "This export does affect original");
+is (eval 'plუᒃ', "Value", "Constant has correct value");
+is (ref \$::{plუᒃ}, 'GLOB', "Symbol table has full typeglob");
+
+delete $::{оઓnḲ};
+$::{оઓnḲ} = \"Value";
+
+sub non_dangling {
+  my $w = '';
+  local $SIG{__WARN__} = sub { $w = $_[0] };
+  *{"z앞"} = \&{"оઓnḲ"};
+  is($w, '', "Should be no warning");
+}
+
+non_dangling();
+is (ref $::{оઓnḲ}, 'SCALAR', "Export doesn't affect original");
+is (eval 'z앞', "Value", "Constant has correct value");
+is (ref $::{z앞}, 'SCALAR', "Exported target is also a PCS");
+
+sub dangling {
+  local $SIG{__WARN__} = sub { die $_[0] };
+  *{"ビfᶠ"} = \&{"оઓnḲ"};
+}
+
+dangling();
+is (ref \$::{оઓnḲ}, 'GLOB', "This export does affect original");
+is (eval 'ビfᶠ', "Value", "Constant has correct value");
+is (ref \$::{ビfᶠ}, 'GLOB', "Symbol table has full typeglob");
+
+{
+    use vars qw($gᓙʞ $sምḲ $ᕘf);
+    # Check reference assignment isn't affected by the SV type (bug #38439)
+    $gᓙʞ = 3;
+    $sምḲ = 4;
+    $ᕘf = "halt and cool down";
+
+    my $rv = \*sምḲ;
+    is($gᓙʞ, 3);
+    *gᓙʞ = $rv;
+    is($gᓙʞ, 4);
+
+    my $pv = "";
+    $pv = \*sምḲ;
+    is($ᕘf, "halt and cool down");
+    *ᕘf = $pv;
+    is($ᕘf, 4);
+}
+
+TODO: {
+local $TODO = "Prototypes not yet clean";
+no warnings 'once';
+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 $::{оઓnḲ};
+        $::{оઓnḲ} = $value;
+        $proto = eval 'prototype \&оઓnḲ';
+        like ($@, qr/^Cannot convert a reference to $type to typeglob/,
+            "Cannot upgrade ref-to-$type to typeglob");
+    }
+}
+
+{
+    no warnings qw(once uninitialized);
+    my $g = \*ȼલᑧɹ;
+    my $r = eval {no strict; ${*{$g}{SCALAR}}};
+    is ($@, '', "PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax");
+
+    $g = \*vȍwɯ;
+    $r = eval {use strict; ${*{$g}{SCALAR}}};
+    is ($@, '',
+	"PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax under strict");
+}
+
+{
+    # Bug reported by broquaint on IRC
+    *ᔅᓗsḨ::{HASH}->{ISA}=[];
+    ᔅᓗsḨ->import;
+    pass("gv_fetchmeth coped with the unexpected");
+
+    # An audit found these:
+    {
+	package ᔅᓗsḨ;
+	sub 맆 {
+	    my $s = shift;
+	    $s->SUPER::맆;
+	}
+    }
+    {
+        local $TODO = "Warnings not yet clean";
+        eval {ᔅᓗsḨ->맆;};
+        like ($@, qr/^Can't locate object method "맆"/, "Even with SUPER");
+    }
+    is(ᔅᓗsḨ->isa('swoosh'), '');
+}
+
+{
+    die if exists $::{본ㄎ};
+    $::{본ㄎ} = \"포ヰｅ";
+    *{"본ㄎ"} = \&{"본ㄎ"};
+    eval 'is(본ㄎ(), "포ヰｅ",
+             "Assignment works when glob created midway (bug 45607)"); 1'
+	or die $@;
+}
+
+
+# [perl #72740] - indirect object syntax, heuristically imputed due to
+# the non-existence of a function, should not cause a stash entry to be
+# created for the non-existent function.
+TODO: {
+    local $TODO = "Objects not yet clean";
+    {
+            package RT72740a;
+            my $f = bless({}, RT72740b);
+            sub s1 { s2 $f; }
+            our $s4;
+            sub s3 { s4 $f; }
+    }
+    {
+            package RT72740b;
+            sub s2 { "RT72740b::s2" }
+            sub s4 { "RT72740b::s4" }
+    }
+    ok(exists($RT72740a::{s1}), "RT72740a::s1 exists");
+    ok(!exists($RT72740a::{s2}), "RT72740a::s2 does not exist");
+    ok(exists($RT72740a::{s3}), "RT72740a::s3 exists");
+    ok(exists($RT72740a::{s4}), "RT72740a::s4 exists");
+    is(RT72740a::s1(), "RT72740b::s2", "RT72740::s1 parsed correctly");
+    is(RT72740a::s3(), "RT72740b::s4", "RT72740::s3 parsed correctly");
+}
+
+# [perl #71686] Globs that are in symbol table can be un-globbed
+$ŚyṀ = undef;
+$::{Ḟ앜ɞ} = *ŚyṀ;
+is (eval 'local *::Ḟ앜ɞ = \"chuck"; $Ḟ앜ɞ', 'chuck',
+	"Localized glob didn't coerce into a RV");
+is ($@, '', "Can localize FAKE glob that's present in stash");
+TODO: {
+    local $TODO = q!$::{glob} = "something"; not yet clean.!;
+    is (scalar $::{Ḟ앜ɞ}, "*main::ŚyṀ",
+            "Localized FAKE glob's value was correctly restored");
+}
+
+# [perl #1804] *$x assignment when $x is a copy of another glob
+# And [perl #77508] (same thing with list assignment)
+TODO: {
+    local $TODO = "Glob/Stash stringify not yet fully clean";
+    no warnings 'once';
+    my $x = *_ràndom::glob_that_is_not_used_elsewhere;
+    *$x = sub{};
+    is(
+      "$x", '*_ràndom::glob_that_is_not_used_elsewhere',
+      '[perl #1804] *$x assignment when $x is FAKE',
+    );
+    $x = *_ràndom::glob_that_is_not_used_elsewhere;
+    (my $dummy, *$x) = (undef,[]);
+    is(
+      "$x", '*_ràndom::glob_that_is_not_used_elsewhere',
+      '[perl #77508] *$x list assignment when $x is FAKE',
+    ) or require Devel::Peek, ($TODO ? () : Devel::Peek::Dump($x));
+}
+
+# [perl #76540]
+# this caused panics or 'Attempt to free unreferenced scalar'
+# (its a compile-time issue, so the die lets us skip the prints)
+{
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings, @_ };
+
+    eval <<'EOF';
+BEGIN { $::{FÒÒ} = \'ᴮᛅ' }
+die "made it";
+print FÒÒ, "\n";
+print FÒÒ, "\n";
+EOF
+
+    like($@, qr/made it/, "#76540 - no panic");
+    ok(!@warnings, "#76540 - no 'Attempt to free unreferenced scalar'");
+}
+
+# [perl #77362] various bugs related to globs as PVLVs
+TODO: {
+ local $TODO = "Glob stringify not fully clean yet.";
+ no warnings qw 'once void';
+ my %h; # We pass a key of this hash to the subroutine to get a PVLV.
+ sub { for(shift) {
+  # Set up our glob-as-PVLV
+  $_ = *hòn;
+  is $_, "*main::hòn";
+
+  # Bad symbol for array
+  ok eval{ @$_; 1 }, 'PVLV glob slots can be autovivified' or diag $@;
+
+    TODO: {
+        local $TODO = "Tie not yet clean";
+        # This should call TIEHANDLE, not TIESCALAR
+        *thèxt::TIEHANDLE = sub{};
+        ok eval{ tie *$_, 'thèxt'; 1 }, 'PVLV globs can be tied as handles'
+            or diag $@;
+    }
+  # Assigning undef to the glob should not overwrite it...
+  {
+   my $w;
+   local $SIG{__WARN__} = sub { $w = shift };
+   *$_ = undef;
+   is $_, "*main::hòn", 'PVLV: assigning undef to the glob does nothing';
+   like $w, qr\Undefined value assigned to typeglob\,
+    'PVLV: assigning undef to the glob warns';
+  }
+
+  # Neither should reference assignment.
+  *$_ = [];
+  is $_, "*main::hòn", "PVLV: arrayref assignment assigns to the AV slot";
+
+  # Concatenation should still work.
+  ok eval { $_ .= 'thlèw' }, 'PVLV concatenation does not die' or diag $@;
+  is $_, '*main::hònthlèw', 'PVLV concatenation works';
+
+  # And we should be able to overwrite it with a string, number, or refer-
+  # ence, too, if we omit the *.
+  $_ = *hòn; $_ = 'tzòr';
+  is $_, 'tzòr', 'PVLV: assigning a string over a glob';
+  $_ = *hòn; $_ = 23;
+  is $_, 23, 'PVLV: assigning an integer over a glob';
+  $_ = *hòn; $_ = 23.23;
+  is $_, 23.23, 'PVLV: assigning a float over a glob';
+  $_ = *hòn; $_ = \my $sthat;
+  is $_, \$sthat, 'PVLV: assigning a reference over a glob';
+
+  # This bug was found by code inspection. Could this ever happen in
+  # real life? :-)
+  # This duplicates a file handle, accessing it through a PVLV glob, the
+  # glob having been removed from the symbol table, so a stringified form
+  # of it does not work. This checks that sv_2io does not stringify a PVLV.
+  $_ = *quìn;
+  open *quìn, "test.pl"; # test.pl is as good a file as any
+  delete $::{quìn};
+  ok eval { open my $zow, "<&", $_ }, 'PVLV: sv_2io stringifieth not'
+   or diag $@;
+
+  # Similar tests to make sure sv_2cv etc. do not stringify.
+  *$_ = sub { 1 };
+  ok eval { &$_ }, "PVLV glob can be called as a sub" or diag $@;
+  *flèlp = sub { 2 };
+  $_ = 'flèlp';
+  is eval { &$_ }, 2, 'PVLV holding a string can be called as a sub'
+   or diag $@;
+
+  # Coderef-to-glob assignment when the glob is no longer accessible
+  # under its name: These tests are to make sure the OPpASSIGN_CV_TO_GV
+  # optimisation takes PVLVs into account, which is why the RHSs have to be
+  # named subs.
+  use constant ghèèn => 'quàrè';
+  $_ = *mìng;
+  delete $::{mìng};
+  *$_ = \&ghèèn;
+  is eval { &$_ }, 'quàrè',
+   'PVLV: constant assignment when the glob is detached from the symtab'
+    or diag $@;
+  $_ = *bèngth;
+  delete $::{bèngth};
+  *ghèck = sub { 'lon' };
+  *$_ = \&ghèck;
+  is eval { &$_ }, 'lon',
+   'PVLV: coderef assignment when the glob is detached from the symtab'
+    or diag $@;
+
+SKIP: {
+    skip_if_miniperl("no dynamic loading on miniperl, so can't load PerlIO::scalar", 1);
+    # open should accept a PVLV as its first argument
+    $_ = *hòn;
+    ok eval { open $_,'<', \my $thlext }, 'PVLV can be the first arg to open'
+	or diag $@;
+  }
+
+  # -t should not stringify
+  $_ = *thlìt; delete $::{thlìt};
+  *$_ = *STDOUT{IO};
+  ok defined -t $_, 'PVLV: -t does not stringify';
+
+  # neither should -T
+  # but some systems don’t support this on file handles
+  my $pass;
+  ok
+    eval {
+     open my $quìle, "<", 'test.pl';
+     $_ = *$quìle;
+     $pass = -T $_;
+     1
+    } ? $pass : $@ =~ /not implemented on filehandles/,
+   "PVLV: -T does not stringify";
+  # Unopened file handle
+  {
+   my $w;
+   local $SIG{__WARN__} = sub { $w .= shift };
+   $_ = *vòr;
+   close $_;
+   like $w, qr\unopened filehandle vòr\,
+    'PVLV globs get their names reported in unopened error messages';
+  }
+
+ }}->($h{k});
+}
+
+*àieee = 4;
+pass('Can assign integers to typeglobs');
+*àieee = 3.14;
+pass('Can assign floats to typeglobs');
+*àieee = 'pi';
+pass('Can assign strings to typeglobs');
+
+=begin
+{
+  package thrèxt;
+  sub TIESCALAR{bless[]}
+  sub STORE{ die "No!"}
+  sub FETCH{ no warnings 'once'; *thrìt }
+  tie my $a, "thrèxt";
+  () = "$a"; # do a fetch; now $a holds a glob
+  eval { *$a = sub{} };
+  untie $a;
+  eval { $a = "ᴮᛅ" };
+  ::is $a, "ᴮᛅ",
+    "[perl #77812] Globs in tied scalars can be reified if STORE dies"
+}
+=cut
+
+# These two crashed prior to 5.13.6. In 5.13.6 they were fatal errors. They
+# were fixed in 5.13.7.
+ok eval {
+  my $glob = \*hèèn::ISA;
+  delete $::{"hèèn::"};
+  *$glob = *ᴮᛅ; 
+}, "glob-to-*ISA assignment works when *ISA has lost its stash";
+ok eval {
+  my $glob = \*slàre::ISA;
+  delete $::{"slàre::"};
+  *$glob = []; 
+}, "array-to-*ISA assignment works when *ISA has lost its stash";
+# These two crashed in 5.13.6. They were likewise fixed in 5.13.7.
+ok eval {
+  sub grèck;
+  my $glob = do { no warnings "once"; \*phìng::ᕘ};
+  delete $::{"phìng::"};
+  *$glob = *grèck; 
+}, "Assigning a glob-with-sub to a glob that has lost its stash warks";
+ok eval {
+  sub pòn::ᕘ;
+  my $glob = \*pòn::ᕘ;
+  delete $::{"pòn::"};
+  *$glob = *ᕘ; 
+}, "Assigning a glob to a glob-with-sub that has lost its stash warks";
+
+{
+  package Tie::Alias;
+  sub TIESCALAR{ bless \\pop }
+  sub FETCH { $${$_[0]} }
+  sub STORE { $${$_[0]} = $_[1] }
+  package main;
+  tie my $alias, 'Tie::Alias', my $var;
+  no warnings 'once';
+  $var = *gàlobbe;
+  {
+    local *$alias = [];
+    $var = 3;
+    is $alias, 3, "[perl #77926] Glob reification during localisation";
+  }
+}
+
+# This code causes gp_free to call a destructor when a glob is being
+# restored on scope exit. The destructor used to see SVs with a refcount of
+# zero inside the glob, which could result in crashes (though not in this
+# test case, which just panics).
+TODO: {
+ local $TODO = "bless not yet clean";
+ no warnings 'once';
+ my $survived;
+ *Trìt::DESTROY = sub {
+   $thwèxt = 42;  # panic
+   $survived = 1;
+ };
+ {
+  local *thwèxt = bless [],'Trìt';
+  ();
+ }
+ ok $survived,
+  'no error when gp_free calls a destructor that assigns to the gv';
+}
+
+__END__
+Perl
+Rules
+perl
+rocks