Import perl-5.38.2

ok gkoehler@
Commit and we'll fix fallout bluhm@
Right away, please deraadt@

3 files changed, 139 insertions, 4 deletions

diff --git a/gnu/usr.bin/perl/dist/Storable/t/blessed.t b/gnu/usr.bin/perl/dist/Storable/t/blessed.t
index d9a77b37236..dea569b2b07 100755
--- a/gnu/usr.bin/perl/dist/Storable/t/blessed.t
+++ b/gnu/usr.bin/perl/dist/Storable/t/blessed.t
@@ -44,7 +44,7 @@ use Storable qw(freeze thaw store retrieve fd_retrieve);
    'long VSTRING' => \(my $lvstring = eval "v" . 0 x 300),
    LVALUE         => \(my $substr  = substr((my $str = "foo"), 0, 3)));
 
-my $test = 13;
+my $test = 18;
 my $tests = $test + 41 + (2 * 6 * keys %::immortals) + (3 * keys %::weird_refs);
 plan(tests => $tests);
 
@@ -414,3 +414,54 @@ is(ref $t, 'STRESS_THE_STACK');
 
     unlink("store$$");
 }
+
+{
+    # trying to freeze a glob via STORABLE_freeze
+    {
+        package GlobHookedBase;
+
+        sub STORABLE_freeze {
+            return \1;
+        }
+
+        package GlobHooked;
+        our @ISA = "GlobHookedBase";
+    }
+    use Symbol ();
+    my $glob = bless Symbol::gensym(), "GlobHooked";
+    eval {
+        my $data = freeze($glob);
+    };
+    my $msg = $@;
+    like($msg, qr/Unexpected object type \(GLOB\) of class 'GlobHooked' in store_hook\(\) calling GlobHookedBase::STORABLE_freeze/,
+         "check we get the verbose message");
+}
+
+SKIP:
+{
+    $] < 5.012
+      and skip "Can't assign regexps directly before 5.12", 4;
+    my $hook_called;
+    # store regexp via hook
+    {
+        package RegexpHooked;
+        sub STORABLE_freeze {
+            ++$hook_called;
+            "$_[0]";
+        }
+        sub STORABLE_thaw {
+            my ($obj, $cloning, $serialized) = @_;
+            ++$hook_called;
+            $$obj = ${ qr/$serialized/ };
+        }
+    }
+
+    my $obj = bless qr/abc/, "RegexpHooked";
+    my $data = freeze($obj);
+    ok($data, "froze regexp blessed into hooked class");
+    ok($hook_called, "and the hook was actually called");
+    $hook_called = 0;
+    my $obj_thawed = thaw($data);
+    ok($hook_called, "hook called for thaw");
+    like("abc", $obj_thawed, "check the regexp");
+}
diff --git a/gnu/usr.bin/perl/dist/Storable/t/boolean.t b/gnu/usr.bin/perl/dist/Storable/t/boolean.t
new file mode 100644
index 00000000000..9ba19c0e67a
--- /dev/null
+++ b/gnu/usr.bin/perl/dist/Storable/t/boolean.t
@@ -0,0 +1,84 @@
+use strict;
+use warnings;
+
+my $true_ref;
+my $false_ref;
+BEGIN {
+    $true_ref = \!!1;
+    $false_ref = \!!0;
+}
+
+BEGIN {
+    unshift @INC, 't';
+    unshift @INC, 't/compat' if $] < 5.006002;
+    require Config;
+    if ($ENV{PERL_CORE} and $Config::Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+}
+
+use Test::More tests => 12;
+use Storable qw(thaw freeze);
+
+use constant CORE_BOOLS => defined &builtin::is_bool;
+
+{
+  my $x = $true_ref;
+  my $y = ${thaw freeze \$x};
+  is($y, $x);
+  eval {
+    $$y = 2;
+  };
+  isnt $@, '',
+    'immortal true maintained as immortal';
+}
+
+{
+  my $x = $false_ref;
+  my $y = ${thaw freeze \$x};
+  is($y, $x);
+  eval {
+    $$y = 2;
+  };
+  isnt $@, '',
+    'immortal false maintained as immortal';
+}
+
+{
+  my $true = $$true_ref;
+  my $x = \$true;
+  my $y = ${thaw freeze \$x};
+  is($$y, $$x);
+  is($$y, '1');
+  SKIP: {
+    skip "perl $] does not support tracking boolean values", 1
+      unless CORE_BOOLS;
+    BEGIN { CORE_BOOLS and warnings->unimport('experimental::builtin') }
+    ok builtin::is_bool($$y);
+  }
+  eval {
+    $$y = 2;
+  };
+  is $@, '',
+    'mortal true maintained as mortal';
+}
+
+{
+  my $false = $$false_ref;
+  my $x = \$false;
+  my $y = ${thaw freeze \$x};
+  is($$y, $$x);
+  is($$y, '');
+  SKIP: {
+    skip "perl $] does not support tracking boolean values", 1
+      unless CORE_BOOLS;
+    BEGIN { CORE_BOOLS and warnings->unimport('experimental::builtin') }
+    ok builtin::is_bool($$y);
+  }
+  eval {
+    $$y = 2;
+  };
+  is $@, '',
+    'mortal true maintained as mortal';
+}
diff --git a/gnu/usr.bin/perl/dist/Storable/t/malice.t b/gnu/usr.bin/perl/dist/Storable/t/malice.t
index 8adae955023..7b92d3de181 100755
--- a/gnu/usr.bin/perl/dist/Storable/t/malice.t
+++ b/gnu/usr.bin/perl/dist/Storable/t/malice.t
@@ -32,7 +32,7 @@ our $file_magic_str = 'pst0';
 our $other_magic = 7 + length $byteorder;
 our $network_magic = 2;
 our $major = 2;
-our $minor = 11;
+our $minor = 12;
 our $minor_write = $] >= 5.019 ? 11 : $] > 5.008 ? 9 : $] > 5.005_50 ? 8 : 4;
 
 use Test::More;
@@ -206,7 +206,7 @@ sub test_things {
     $where = $file_magic + $network_magic;
   }
 
-  # Just the header and a tag 255. As 33 is currently the highest tag, this
+  # Just the header and a tag 255. As 34 is currently the highest tag, this
   # is "unexpected"
   $copy = substr ($contents, 0, $where) . chr 255;
 
@@ -226,7 +226,7 @@ sub test_things {
   # local $Storable::DEBUGME = 1;
   # This is the delayed croak
   test_corrupt ($copy, $sub,
-                "/^Storable binary image v$header->{major}.$minor6 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 33/",
+                "/^Storable binary image v$header->{major}.$minor6 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 35/",
                 "bogus tag, minor plus 4");
   # And check again that this croak is not delayed:
   {