This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix two local *ISA bugs
[perl5.git] / t / mro / basic.t
index f496956..ab34fc2 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-BEGIN { require q(./test.pl); } plan(tests => 49);
+BEGIN { require q(./test.pl); } plan(tests => 59);
 
 require mro;
 
@@ -57,10 +57,10 @@ ok(!mro::is_universal('MRO_B'));
 ok(mro::is_universal('MRO_B'));
 
 @UNIVERSAL::ISA = ();
-ok(mro::is_universal('MRO_B'));
+ok(!mro::is_universal('MRO_B'));
 
 # is_universal, get_mro, and get_linear_isa should
-# handle non-existant packages sanely
+# handle non-existent packages sanely
 ok(!mro::is_universal('Does_Not_Exist'));
 is(mro::get_mro('Also_Does_Not_Exist'), 'dfs');
 ok(eq_array(
@@ -300,3 +300,73 @@ is(eval { MRO_N->testfunc() }, 123);
     main->do;
     is $output, 'parentparent2', '@main::ISA is magical';
 }
+
+{
+    # Undefining *ISA, then modifying @ISA
+    # This broke Class::Trait. See [perl #79024].
+    {package Class::Trait::Base}
+    no strict 'refs';
+    undef   *{"Extra::TSpouse::ISA"};
+    'Extra::TSpouse'->isa('Class::Trait::Base'); # cache the mro
+    unshift @{"Extra::TSpouse::ISA"}, 'Class::Trait::Base';
+    ok 'Extra::TSpouse'->isa('Class::Trait::Base'),
+     'a isa b after undef *a::ISA and @a::ISA modification';
+}
+
+{
+    # Deleting $package::{ISA}
+    # Broken in 5.10.0; fixed in 5.13.7
+    @Blength::ISA = 'Bladd';
+    delete $Blength::{ISA};
+    ok !Blength->isa("Bladd"), 'delete $package::{ISA}';
+}
+
+{
+    # Undefining stashes
+    @Thrext::ISA = "Thwit";
+    @Thwit::ISA = "Sile";
+    undef %Thwit::;
+    ok !Thrext->isa('Sile'), 'undef %package:: updates subclasses';
+}
+
+{
+    # Obliterating @ISA via glob assignment
+    # Broken in 5.14.0; fixed in 5.17.2
+    @Gwythaint::ISA = "Fantastic::Creature";
+    undef *This_glob_haD_better_not_exist; # paranoia; must have no array
+    *Gwythaint::ISA = *This_glob_haD_better_not_exist;
+    ok !Gwythaint->isa("Fantastic::Creature"),
+       'obliterating @ISA via glob assignment';
+}
+
+{
+    # Autovivifying @ISA via @{*ISA}
+    no warnings;
+    undef *fednu::ISA;
+    @{*fednu::ISA} = "pyfg";
+    ok +fednu->isa("pyfg"), 'autovivifying @ISA via *{@ISA}';
+}
+
+{
+    sub Detached::method;
+    my $h = delete $::{"Detached::"};
+    eval { local *Detached::method };
+    is $@, "", 'localising gv-with-cv belonging to detached package';
+}
+
+{
+    # *ISA localisation
+    @il::ISA = "ilsuper";
+    sub ilsuper::can { "puree" }
+    sub il::tomatoes;
+    {
+        local *il::ISA;
+        is +il->can("tomatoes"), \&il::tomatoes, 'local *ISA';
+    }
+    is "il"->can("tomatoes"), "puree", 'local *ISA unwinding';
+    {
+        local *il::ISA = [];
+        is +il->can("tomatoes"), \&il::tomatoes, 'local *ISA = []';
+    }
+    is "il"->can("tomatoes"), "puree", 'local *ISA=[] unwinding';
+}