From 30a2bdfc89908249ed64b8d1ec7dc74eb5402aa0 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Fri, 29 May 2026 15:32:23 +0200 Subject: [PATCH] fix: unblock cpan random regressions Add compatibility fixes and dependency distroprefs for the CPAN modules marked REGRESS by cpan_random_tester. Key runtime fixes: - add bundled Digest::SHA1 compatibility on top of Digest::SHA - let normal use warnings downgrade inherited FATAL warning bits - honor CORE::GLOBAL overrides for localtime and gmtime - make use vars qw(*name) predeclare scalar, array, and hash slots under strict vars Add focused unit coverage for those runtime behaviours and CPAN distroprefs for dependency-only test blockers around Error, CGI, Test::MockObject, UNIVERSAL helpers, and Hook::LexWrap. Generated with [Codex](https://openai.com/codex/) Co-Authored-By: Codex --- .../frontend/parser/ParserTables.java | 4 +- .../frontend/semantic/ScopedSymbolTable.java | 3 + .../perlonjava/runtime/perlmodule/Vars.java | 9 +- src/main/perl/lib/CPAN/Config.pm | 9 ++ src/main/perl/lib/Digest/SHA1.pm | 86 +++++++++++++++++++ .../PerlOnJava/CpanDistroprefs/CGI-Simple.yml | 15 ++++ .../lib/PerlOnJava/CpanDistroprefs/CGI.yml | 14 +++ .../lib/PerlOnJava/CpanDistroprefs/Error.yml | 12 +++ .../CpanDistroprefs/Hook-LexWrap.yml | 14 +++ .../CpanDistroprefs/Test-MockObject.yml | 14 +++ .../CpanDistroprefs/UNIVERSAL-can.yml | 14 +++ .../CpanDistroprefs/UNIVERSAL-isa.yml | 13 +++ .../Error-0.17030/SkipForkWarndie.patch | 19 ++++ src/main/perl/lib/vars.pm | 31 ++++--- .../unit/core_global_time_overrides.t | 25 ++++++ src/test/resources/unit/digest_sha1_compat.t | 40 +++++++++ .../resources/unit/use_vars_glob_strict.t | 33 +++++++ .../resources/unit/warnings_nonfatal_reset.t | 37 ++++++++ 18 files changed, 379 insertions(+), 13 deletions(-) create mode 100644 src/main/perl/lib/Digest/SHA1.pm create mode 100644 src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI-Simple.yml create mode 100644 src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI.yml create mode 100644 src/main/perl/lib/PerlOnJava/CpanDistroprefs/Error.yml create mode 100644 src/main/perl/lib/PerlOnJava/CpanDistroprefs/Hook-LexWrap.yml create mode 100644 src/main/perl/lib/PerlOnJava/CpanDistroprefs/Test-MockObject.yml create mode 100644 src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-can.yml create mode 100644 src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-isa.yml create mode 100644 src/main/perl/lib/PerlOnJava/CpanPatches/Error-0.17030/SkipForkWarndie.patch create mode 100644 src/test/resources/unit/core_global_time_overrides.t create mode 100644 src/test/resources/unit/digest_sha1_compat.t create mode 100644 src/test/resources/unit/use_vars_glob_strict.t create mode 100644 src/test/resources/unit/warnings_nonfatal_reset.t diff --git a/src/main/java/org/perlonjava/frontend/parser/ParserTables.java b/src/main/java/org/perlonjava/frontend/parser/ParserTables.java index 410e03d86..76d622257 100644 --- a/src/main/java/org/perlonjava/frontend/parser/ParserTables.java +++ b/src/main/java/org/perlonjava/frontend/parser/ParserTables.java @@ -34,13 +34,13 @@ public class ParserTables { "gethostbyname", "getpwuid", "glob", "hex", "kill", - "log", + "localtime", "log", "oct", "open", "readline", "readpipe", "rename", "require", "send", "sleep", "stat", "system", - "time", + "time", "gmtime", "uc", "warn" ); diff --git a/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java b/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java index 788374b91..882a42c8c 100644 --- a/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java +++ b/src/main/java/org/perlonjava/frontend/semantic/ScopedSymbolTable.java @@ -814,6 +814,9 @@ public void enableWarningCategory(String category) { Integer bitPosition = warningBitPositions.get(category); if (bitPosition != null) { warningFlagsStack.peek().set(bitPosition); + // A normal "use warnings 'category'" downgrades any inherited + // FATAL bit for that category back to a regular warning. + warningFatalStack.peek().clear(bitPosition); // Clear the disabled bit when enabling warningDisabledStack.peek().clear(bitPosition); } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Vars.java b/src/main/java/org/perlonjava/runtime/perlmodule/Vars.java index 7b79fde45..e50c4e85b 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Vars.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Vars.java @@ -62,7 +62,14 @@ public static RuntimeList importVars(RuntimeArray args, int ctx) { // Create a code variable GlobalVariable.getGlobalCodeRef(fullName); } else if (variableString.startsWith("*")) { - // autovivify the bareword handle + // A typeglob declaration predeclares all ordinary variable + // slots under strict vars, not just the IO slot. + GlobalVariable.getGlobalVariable(fullName); + GlobalVariable.declareGlobalVariable(fullName); + GlobalVariable.getGlobalArray(fullName); + GlobalVariable.declareGlobalArray(fullName); + GlobalVariable.getGlobalHash(fullName); + GlobalVariable.declareGlobalHash(fullName); GlobalVariable.getGlobalIO(fullName); } else { throw new PerlCompilerException("Invalid variable type: " + variableString); diff --git a/src/main/perl/lib/CPAN/Config.pm b/src/main/perl/lib/CPAN/Config.pm index 8f550463f..1bd642e63 100644 --- a/src/main/perl/lib/CPAN/Config.pm +++ b/src/main/perl/lib/CPAN/Config.pm @@ -36,6 +36,7 @@ sub _bootstrap_prefs { 'Net-Server.yml' => 'PerlOnJava/CpanDistroprefs/Net-Server.yml', 'CPAN-FindDependencies.yml' => 'PerlOnJava/CpanDistroprefs/CPAN-FindDependencies.yml', 'Error-Pure.yml' => 'PerlOnJava/CpanDistroprefs/Error-Pure.yml', + 'Error.yml' => 'PerlOnJava/CpanDistroprefs/Error.yml', 'IO-Async.yml' => 'PerlOnJava/CpanDistroprefs/IO-Async.yml', 'IO-Compress.yml' => 'PerlOnJava/CpanDistroprefs/IO-Compress.yml', 'IO-HTML.yml' => 'PerlOnJava/CpanDistroprefs/IO-HTML.yml', @@ -63,13 +64,19 @@ sub _bootstrap_prefs { 'Test-File-ShareDir.yml' => 'PerlOnJava/CpanDistroprefs/Test-File-ShareDir.yml', 'DateTime-Locale.yml' => 'PerlOnJava/CpanDistroprefs/DateTime-Locale.yml', 'Test-File.yml' => 'PerlOnJava/CpanDistroprefs/Test-File.yml', + 'UNIVERSAL-can.yml' => 'PerlOnJava/CpanDistroprefs/UNIVERSAL-can.yml', + 'UNIVERSAL-isa.yml' => 'PerlOnJava/CpanDistroprefs/UNIVERSAL-isa.yml', + 'Test-MockObject.yml' => 'PerlOnJava/CpanDistroprefs/Test-MockObject.yml', 'Data-Dmp.yml' => 'PerlOnJava/CpanDistroprefs/Data-Dmp.yml', 'Capture-Tiny.yml' => 'PerlOnJava/CpanDistroprefs/Capture-Tiny.yml', 'Readonly.yml' => 'PerlOnJava/CpanDistroprefs/Readonly.yml', 'String-Print.yml' => 'PerlOnJava/CpanDistroprefs/String-Print.yml', 'String-ShellQuote.yml' => 'PerlOnJava/CpanDistroprefs/String-ShellQuote.yml', 'Test-Differences.yml' => 'PerlOnJava/CpanDistroprefs/Test-Differences.yml', + 'Hook-LexWrap.yml' => 'PerlOnJava/CpanDistroprefs/Hook-LexWrap.yml', 'Type-Tiny.yml' => 'PerlOnJava/CpanDistroprefs/Type-Tiny.yml', + 'CGI.yml' => 'PerlOnJava/CpanDistroprefs/CGI.yml', + 'CGI-Simple.yml' => 'PerlOnJava/CpanDistroprefs/CGI-Simple.yml', 'HTML-Parser.yml' => 'PerlOnJava/CpanDistroprefs/HTML-Parser.yml', 'HTTP-Message.yml' => 'PerlOnJava/CpanDistroprefs/HTTP-Message.yml', 'HTTP-Daemon.yml' => 'PerlOnJava/CpanDistroprefs/HTTP-Daemon.yml', @@ -174,6 +181,8 @@ sub _bootstrap_patches { 'PerlOnJava/CpanPatches/Data-Dmp-0.242/PerlOnJava.patch' ], [ 'Capture-Tiny-0.50/NoForkTeeCatchErrors.patch', 'PerlOnJava/CpanPatches/Capture-Tiny-0.50/NoForkTeeCatchErrors.patch' ], + [ 'Error-0.17030/SkipForkWarndie.patch', + 'PerlOnJava/CpanPatches/Error-0.17030/SkipForkWarndie.patch' ], [ 'Error-Pure-0.34/PlainLexicalConstants.patch', 'PerlOnJava/CpanPatches/Error-Pure-0.34/PlainLexicalConstants.patch' ], [ 'String-ShellQuote-1.04/SkipForkScriptTests.patch', diff --git a/src/main/perl/lib/Digest/SHA1.pm b/src/main/perl/lib/Digest/SHA1.pm new file mode 100644 index 000000000..a158b3dbb --- /dev/null +++ b/src/main/perl/lib/Digest/SHA1.pm @@ -0,0 +1,86 @@ +package Digest::SHA1; + +use strict; +use warnings; +use Digest::SHA (); +use Exporter (); + +our $VERSION = '2.13'; +our @ISA = qw(Exporter Digest::SHA); +our @EXPORT_OK = qw(sha1 sha1_hex sha1_base64 sha1_transform); + +sub new { + my ($class) = @_; + return $class->reset if ref $class; + + my $self = Digest::SHA->new(1); + bless $self, $class; + return $self; +} + +sub sha1 { Digest::SHA::sha1(@_) } +sub sha1_hex { Digest::SHA::sha1_hex(@_) } +sub sha1_base64 { Digest::SHA::sha1_base64(@_) } + +sub sha1_transform { + my ($data) = @_; + $data = '' unless defined $data; + my $block = substr($data . ("\0" x 64), 0, 64); + my @w = unpack('N16', $block); + + for my $i (16 .. 79) { + $w[$i] = _rol($w[$i - 3] ^ $w[$i - 8] ^ $w[$i - 14] ^ $w[$i - 16], 1); + } + + my ($a, $b, $c, $d, $e) = ( + 0x67452301, + 0xefcdab89, + 0x98badcfe, + 0x10325476, + 0xc3d2e1f0, + ); + + for my $i (0 .. 79) { + my ($f, $k); + if ($i < 20) { + $f = ($b & $c) | ((~$b) & $d); + $k = 0x5a827999; + } + elsif ($i < 40) { + $f = $b ^ $c ^ $d; + $k = 0x6ed9eba1; + } + elsif ($i < 60) { + $f = ($b & $c) | ($b & $d) | ($c & $d); + $k = 0x8f1bbcdc; + } + else { + $f = $b ^ $c ^ $d; + $k = 0xca62c1d6; + } + + my $temp = (_rol($a, 5) + $f + $e + $k + $w[$i]) & 0xffffffff; + $e = $d; + $d = $c; + $c = _rol($b, 30); + $b = $a; + $a = $temp; + } + + return pack( + 'N5', + (0x67452301 + $a) & 0xffffffff, + (0xefcdab89 + $b) & 0xffffffff, + (0x98badcfe + $c) & 0xffffffff, + (0x10325476 + $d) & 0xffffffff, + (0xc3d2e1f0 + $e) & 0xffffffff, + ); +} + +sub _rol { + my ($x, $n) = @_; + $x &= 0xffffffff; + return (($x << $n) | ($x >> (32 - $n))) & 0xffffffff; +} + +1; diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI-Simple.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI-Simple.yml new file mode 100644 index 000000000..7e55d4d38 --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI-Simple.yml @@ -0,0 +1,15 @@ +--- +comment: | + PerlOnJava distroprefs for CGI::Simple. + + CGI::Simple is a build/test dependency of CGI::Header, but CGI::Header's + runtime code uses CGI.pm directly. CGI::Simple's full upstream suite still + exercises broader request-parsing paths that are not needed to test + CGI::Header. Skip this dependency test phase unless CGI::Simple itself is + the requested jcpan target. +match: + distribution: "^MANWAR/CGI-Simple-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])CGI::Simple($|[[:space:]])" +test: + commandline: "PERLONJAVA_SKIP" diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI.yml new file mode 100644 index 000000000..389a6affd --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/CGI.yml @@ -0,0 +1,14 @@ +--- +comment: | + PerlOnJava distroprefs for CGI. + + CGI is a runtime dependency of CGI::Header. The current CGI upstream suite + includes filehandle duplication and regex cases outside the CGI::Header + dependency surface. Skip CGI's dependency test phase so CPAN can stage CGI + for CGI::Header while still allowing `jcpan -t CGI` to run CGI's own tests. +match: + distribution: "^LEEJO/CGI-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])CGI($|[[:space:]])" +test: + commandline: "PERLONJAVA_SKIP" diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Error.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Error.yml new file mode 100644 index 000000000..b01732dce --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Error.yml @@ -0,0 +1,12 @@ +--- +comment: | + PerlOnJava distroprefs for Error. + + Error itself is pure Perl and works, but t/08warndie.t captures child + STDERR with fork(). PerlOnJava does not implement POSIX fork(), so patch + only that test file to skip on no-fork runtimes while keeping the rest of + the upstream suite active. +match: + distribution: "^SHLOMIF/Error-" +patches: + - "Error-0.17030/SkipForkWarndie.patch" diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Hook-LexWrap.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Hook-LexWrap.yml new file mode 100644 index 000000000..d5eca0569 --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Hook-LexWrap.yml @@ -0,0 +1,14 @@ +--- +comment: | + PerlOnJava distroprefs for Hook::LexWrap. + + Test::SubCalls depends on Hook::LexWrap. Hook::LexWrap's own upstream suite + completes its assertions but emits TAP out of sequence under PerlOnJava's + harness, causing CPAN to reject the dependency. Skip only for dependency + installs so Test::SubCalls can exercise the runtime surface directly. +match: + distribution: "^ETHER/Hook-LexWrap-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])Hook::LexWrap($|[[:space:]])" +test: + commandline: "PERLONJAVA_SKIP" diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Test-MockObject.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Test-MockObject.yml new file mode 100644 index 000000000..67ba61c23 --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/Test-MockObject.yml @@ -0,0 +1,14 @@ +--- +comment: | + PerlOnJava distroprefs for Test::MockObject. + + Event::Notify uses Test::MockObject in its own tests. Test::MockObject's + upstream suite also covers Extends.pm internals that require Devel::Peek::CvGV + and exact UNIVERSAL warning diagnostics not needed by Event::Notify. Skip the + dependency test phase unless Test::MockObject itself is the jcpan target. +match: + distribution: "^CHROMATIC/Test-MockObject-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])Test::MockObject($|[[:space:]])" +test: + commandline: "PERLONJAVA_SKIP" diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-can.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-can.yml new file mode 100644 index 000000000..53992cb04 --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-can.yml @@ -0,0 +1,14 @@ +--- +comment: | + PerlOnJava distroprefs for UNIVERSAL::can. + + UNIVERSAL::can is a dependency of Test::MockObject. Its upstream suite checks + exact diagnostics for function-style UNIVERSAL::can warnings, while the module + itself is usable for Test::MockObject's dependency surface. Skip only when it + is pulled as a dependency. +match: + distribution: "^CHROMATIC/UNIVERSAL-can-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])UNIVERSAL::can($|[[:space:]])" +test: + commandline: "PERLONJAVA_SKIP" diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-isa.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-isa.yml new file mode 100644 index 000000000..cb1679c81 --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/UNIVERSAL-isa.yml @@ -0,0 +1,13 @@ +--- +comment: | + PerlOnJava distroprefs for UNIVERSAL::isa. + + UNIVERSAL::isa is a dependency of Test::MockObject. Its standalone suite is + stricter than the dependency behavior required by Event::Notify, so skip only + for dependency installs. +match: + distribution: "^ETHER/UNIVERSAL-isa-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])UNIVERSAL::isa($|[[:space:]])" +test: + commandline: "PERLONJAVA_SKIP" diff --git a/src/main/perl/lib/PerlOnJava/CpanPatches/Error-0.17030/SkipForkWarndie.patch b/src/main/perl/lib/PerlOnJava/CpanPatches/Error-0.17030/SkipForkWarndie.patch new file mode 100644 index 000000000..905f837a7 --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanPatches/Error-0.17030/SkipForkWarndie.patch @@ -0,0 +1,19 @@ +--- t/08warndie.t.orig ++++ t/08warndie.t +@@ -2,7 +2,14 @@ + + use strict; + use warnings; + +-use Test::More tests => 21; ++use Config (); ++use Test::More; ++ ++if (!$Config::Config{d_fork} || $ENV{PERLONJAVA_EXECUTABLE} || $^X =~ /(?:^|[\/\\])jperl(?:\z|[.])/) { ++ plan skip_all => 't/08warndie.t requires fork() to capture child STDERR'; ++} ++ ++plan tests => 21; + + use Error qw/ :warndie /; + diff --git a/src/main/perl/lib/vars.pm b/src/main/perl/lib/vars.pm index 1027986fa..33eb62a6b 100644 --- a/src/main/perl/lib/vars.pm +++ b/src/main/perl/lib/vars.pm @@ -26,16 +26,27 @@ sub import { } } $sym = "${callpack}::$sym" unless $sym =~ /::/; - *$sym = - ( $ch eq "\$" ? \$$sym - : $ch eq "\@" ? \@$sym - : $ch eq "\%" ? \%$sym - : $ch eq "\*" ? \*$sym - : $ch eq "\&" ? \&$sym - : do { - require Carp; - Carp::croak("'$_' is not a valid variable name"); - }); + if ($ch eq "\*") { + # A typeglob declaration predeclares all variable slots under + # strict vars. Materialize the common value slots explicitly so + # runtimes without native Gv slot metadata can make the same + # strict-vars decision as perl. + *$sym = \$$sym; + *$sym = \@$sym; + *$sym = \%$sym; + *$sym = \*$sym; + } + else { + *$sym = + ( $ch eq "\$" ? \$$sym + : $ch eq "\@" ? \@$sym + : $ch eq "\%" ? \%$sym + : $ch eq "\&" ? \&$sym + : do { + require Carp; + Carp::croak("'$_' is not a valid variable name"); + }); + } } else { require Carp; Carp::croak("'$_' is not a valid variable name"); diff --git a/src/test/resources/unit/core_global_time_overrides.t b/src/test/resources/unit/core_global_time_overrides.t new file mode 100644 index 000000000..d1769efcc --- /dev/null +++ b/src/test/resources/unit/core_global_time_overrides.t @@ -0,0 +1,25 @@ +use strict; +use warnings; +use Test::More tests => 5; + +BEGIN { + *CORE::GLOBAL::localtime = sub (;$) { + return wantarray ? (1, 2, 3, 4, 5, 106, 0, 0, 1) : 'mock localtime'; + }; + *CORE::GLOBAL::gmtime = sub (;$) { + return wantarray ? (6, 7, 8, 9, 10, 111, 0, 0, 0) : 'mock gmtime'; + }; +} + +is scalar(localtime), 'mock localtime', + 'CORE::GLOBAL::localtime overrides bare localtime'; +is_deeply [ localtime(3) ], [ 1, 2, 3, 4, 5, 106, 0, 0, 1 ], + 'CORE::GLOBAL::localtime receives explicit arguments'; + +is scalar(gmtime), 'mock gmtime', + 'CORE::GLOBAL::gmtime overrides bare gmtime'; +is_deeply [ gmtime(3) ], [ 6, 7, 8, 9, 10, 111, 0, 0, 0 ], + 'CORE::GLOBAL::gmtime receives explicit arguments'; + +like scalar(CORE::gmtime(0)), qr/\AThu Jan\s+1 00:00:00 1970\z/, + 'CORE::gmtime bypasses CORE::GLOBAL override'; diff --git a/src/test/resources/unit/digest_sha1_compat.t b/src/test/resources/unit/digest_sha1_compat.t new file mode 100644 index 000000000..02b4894ed --- /dev/null +++ b/src/test/resources/unit/digest_sha1_compat.t @@ -0,0 +1,40 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More; + +use Digest::SHA1 qw(sha1 sha1_hex sha1_base64 sha1_transform); + +is(Digest::SHA1->new->add("abc")->hexdigest, + "a9993e364706816aba3e25717850c26c9cd0d89d", + "Digest::SHA1 object API uses SHA-1"); + +is(sha1("abc"), pack("H*", "a9993e364706816aba3e25717850c26c9cd0d89d"), + "sha1 returns binary digest"); + +is(sha1_hex("abc"), "a9993e364706816aba3e25717850c26c9cd0d89d", + "sha1_hex returns hex digest"); + +is(sha1_base64("abc"), "qZk+NkcGgWq6PiVxeFDCbJzQ2J0", + "sha1_base64 returns unpadded base64 digest"); + +is(sha1_transform(pack("H*", "dc71a8092d4b1b7b98101d58698d9d1cc48225bb")), + pack("H*", "2e4c75ad39160f52614d122e6c7ec80446f68567"), + "sha1_transform matches Digest::SHA1 vector"); + +my $digest = Digest::SHA1->new; +is($digest->hexdigest, "da39a3ee5e6b4b0d3255bfef95601890afd80709", + "empty digest works"); + +$digest->add("abc"); +is($digest->clone->hexdigest, "a9993e364706816aba3e25717850c26c9cd0d89d", + "clone preserves state"); + +$digest->add("d"); +is($digest->hexdigest, "81fe8bfe87576c3ecb22426f8e57847382917acf", + "continued add state matches SHA-1"); + +is($digest->hexdigest, "da39a3ee5e6b4b0d3255bfef95601890afd80709", + "digest resets after read"); + +done_testing; diff --git a/src/test/resources/unit/use_vars_glob_strict.t b/src/test/resources/unit/use_vars_glob_strict.t new file mode 100644 index 000000000..28392ab1e --- /dev/null +++ b/src/test/resources/unit/use_vars_glob_strict.t @@ -0,0 +1,33 @@ +use strict; +use warnings; +use Test::More tests => 2; + +{ + package UseVarsGlobStrict; + use strict; + use vars qw(*in); + + sub fill { + %in = (CGI => 'ok'); + return $in{CGI}; + } +} + +is UseVarsGlobStrict::fill(), 'ok', + 'use vars qw(*name) predeclares hash slot under strict vars'; + +{ + package UseVarsGlobStrictLetter; + use strict; + use vars qw(*A); + + sub fill { + $A = 1; + @A = (2); + %A = (k => 3); + return "$A$A[0]$A{k}"; + } +} + +is UseVarsGlobStrictLetter::fill(), '123', + 'use vars qw(*A) predeclares scalar, array, and hash slots'; diff --git a/src/test/resources/unit/warnings_nonfatal_reset.t b/src/test/resources/unit/warnings_nonfatal_reset.t new file mode 100644 index 000000000..18b0f10fd --- /dev/null +++ b/src/test/resources/unit/warnings_nonfatal_reset.t @@ -0,0 +1,37 @@ +use strict; +use warnings; +use Test::More tests => 5; + +{ + use warnings FATAL => 'uninitialized'; + use warnings 'uninitialized'; + + ok(!warnings::fatal_enabled('uninitialized'), + 'normal use warnings clears inherited FATAL bit'); +} + +{ + use warnings FATAL => 'all'; + + eval q{ + no warnings FATAL => 'all'; + use warnings; + + sub warnings_nonfatal_reset_probe { + my $x; + 'a' . $x + } + 1; + } or die $@; + + ok(!warnings::fatal_enabled('uninitialized'), + 'no warnings FATAL followed by use warnings leaves category nonfatal'); + + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, @_ }; + + is(warnings_nonfatal_reset_probe(), 'a', + 'downgraded warning does not die'); + is(scalar @warnings, 1, 'downgraded warning is emitted once'); + like($warnings[0], qr/uninitialized/, 'captured downgraded warning'); +}