Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-Sub-Quote for openSUSE:Factory checked in at 2023-02-01 16:38:35 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Sub-Quote (Old) and /work/SRC/openSUSE:Factory/.perl-Sub-Quote.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Sub-Quote" Wed Feb 1 16:38:35 2023 rev:7 rq:1062201 version:2.006008 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Sub-Quote/perl-Sub-Quote.changes 2019-10-14 12:31:31.540265102 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Sub-Quote.new.32243/perl-Sub-Quote.changes 2023-02-01 16:50:22.593486546 +0100 @@ -1,0 +2,17 @@ +Sat Jan 21 03:10:25 UTC 2023 - Tina Müller <[email protected]> + +- updated to 2.006008 + see /usr/share/doc/packages/perl-Sub-Quote/Changes + + 2.006008 - 2023-01-20 + - drop Test::Fatal prereq + - recommend Sub::Util rather than Sub::Name + - use XString for quoting strings where possible + - move tests for quotify on perl 5.6 to author only + + 2.006_007 - 2022-04-05 + - accurately detect numbers vs strings in quotify on perl 5.36 + - accurately detect booleans in quotify on perl 5.36 + - add workaround for float formatting for perls compiled to use gcvd + +------------------------------------------------------------------- Old: ---- Sub-Quote-2.006006.tar.gz New: ---- Sub-Quote-2.006008.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Sub-Quote.spec ++++++ --- /var/tmp/diff_new_pack.meMuTp/_old 2023-02-01 16:50:23.249490435 +0100 +++ /var/tmp/diff_new_pack.meMuTp/_new 2023-02-01 16:50:23.273490577 +0100 @@ -1,7 +1,7 @@ # # spec file for package perl-Sub-Quote # -# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -16,34 +16,31 @@ # +%define cpan_name Sub-Quote Name: perl-Sub-Quote -Version: 2.006006 +Version: 2.006008 Release: 0 -%define cpan_name Sub-Quote -Summary: Efficient generation of subroutines via string eval License: Artistic-1.0 OR GPL-1.0-or-later -Group: Development/Libraries/Perl -Url: https://metacpan.org/release/%{cpan_name} +Summary: Efficient generation of subroutines via string eval +URL: https://metacpan.org/release/%{cpan_name} Source0: https://cpan.metacpan.org/authors/id/H/HA/HAARG/%{cpan_name}-%{version}.tar.gz Source1: cpanspec.yml BuildArch: noarch -BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl BuildRequires: perl-macros -BuildRequires: perl(Test::Fatal) >= 0.003 BuildRequires: perl(Test::More) >= 0.94 -Recommends: perl(Sub::Name) >= 0.08 +Recommends: perl(Sub::Util) %{perl_requires} %description This package provides performant ways to generate subroutines from strings. %prep -%setup -q -n %{cpan_name}-%{version} +%autosetup -n %{cpan_name}-%{version} %build perl Makefile.PL INSTALLDIRS=vendor -make %{?_smp_mflags} +%make_build %check make test @@ -54,7 +51,6 @@ %perl_gen_filelist %files -f %{name}.files -%defattr(-,root,root,755) %doc Changes README %license LICENSE ++++++ Sub-Quote-2.006006.tar.gz -> Sub-Quote-2.006008.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/Changes new/Sub-Quote-2.006008/Changes --- old/Sub-Quote-2.006006/Changes 2019-10-01 19:31:20.000000000 +0200 +++ new/Sub-Quote-2.006008/Changes 2023-01-20 11:26:50.000000000 +0100 @@ -1,5 +1,16 @@ Revision history for Sub::Quote +2.006008 - 2023-01-20 + - drop Test::Fatal prereq + - recommend Sub::Util rather than Sub::Name + - use XString for quoting strings where possible + - move tests for quotify on perl 5.6 to author only + +2.006_007 - 2022-04-05 + - accurately detect numbers vs strings in quotify on perl 5.36 + - accurately detect booleans in quotify on perl 5.36 + - add workaround for float formatting for perls compiled to use gcvd + 2.006006 - 2019-10-01 - change quotify to use longest form of floating point numbers if unable to find a perfectly accurate representation diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/LICENSE new/Sub-Quote-2.006008/LICENSE --- old/Sub-Quote-2.006006/LICENSE 2019-10-01 19:33:15.000000000 +0200 +++ new/Sub-Quote-2.006008/LICENSE 2023-01-20 11:27:23.000000000 +0100 @@ -7,7 +7,7 @@ --- The GNU General Public License, Version 1, February 1989 --- -This software is Copyright (c) 2019 by mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>. +This software is Copyright (c) 2023 by mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>. This is free software, licensed under: @@ -267,7 +267,7 @@ --- The Artistic License 1.0 --- -This software is Copyright (c) 2019 by mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>. +This software is Copyright (c) 2023 by mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>. This is free software, licensed under: @@ -287,21 +287,21 @@ - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through - textual modification. + textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright - Holder. + Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for - the package. + the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the - computing community at large as a market that must bear the fee.) + computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they - received it. + received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you @@ -368,7 +368,7 @@ 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF -MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/MANIFEST new/Sub-Quote-2.006008/MANIFEST --- old/Sub-Quote-2.006006/MANIFEST 2019-10-01 19:33:15.000000000 +0200 +++ new/Sub-Quote-2.006008/MANIFEST 2023-01-20 11:27:23.000000000 +0100 @@ -11,7 +11,6 @@ t/lib/ErrorLocation.pm t/lib/InlineModule.pm t/lib/ThreadsCheck.pm -t/quotify-5.6.t t/quotify-no-hex.t t/quotify.t t/sub-defer-no-subname.t @@ -23,6 +22,10 @@ t/subname-sub-name-preload.t t/subname-sub-name.t t/subname-sub-util.t +xt/quotify-5.10.0.t +xt/quotify-5.6.t +xt/quotify-b.t +xt/quotify-no-xstring.t xt/release/kwalitee.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/META.json new/Sub-Quote-2.006008/META.json --- old/Sub-Quote-2.006006/META.json 2019-10-01 19:33:14.000000000 +0200 +++ new/Sub-Quote-2.006008/META.json 2023-01-20 11:27:22.000000000 +0100 @@ -4,7 +4,7 @@ "mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.38, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.66, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -33,7 +33,7 @@ }, "runtime" : { "recommends" : { - "Sub::Name" : "0.08" + "Sub::Util" : "0" }, "requires" : { "Scalar::Util" : "0", @@ -42,7 +42,6 @@ }, "test" : { "requires" : { - "Test::Fatal" : "0.003", "Test::More" : "0.94" } } @@ -63,7 +62,7 @@ }, "x_IRC" : "irc://irc.perl.org/#moose" }, - "version" : "2.006006", + "version" : "2.006008", "x_authority" : "cpan:MSTROUT", - "x_serialization_backend" : "JSON::PP version 4.04" + "x_serialization_backend" : "JSON::PP version 4.16" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/META.yml new/Sub-Quote-2.006008/META.yml --- old/Sub-Quote-2.006006/META.yml 2019-10-01 19:33:14.000000000 +0200 +++ new/Sub-Quote-2.006008/META.yml 2023-01-20 11:27:21.000000000 +0100 @@ -3,12 +3,11 @@ author: - 'mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>' build_requires: - Test::Fatal: '0.003' Test::More: '0.94' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.38, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.66, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -19,7 +18,7 @@ - t - xt recommends: - Sub::Name: '0.08' + Sub::Util: '0' requires: Scalar::Util: '0' perl: '5.006' @@ -28,6 +27,6 @@ bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Sub-Quote license: http://dev.perl.org/licenses/ repository: https://github.com/moose/Sub-Quote.git -version: '2.006006' +version: '2.006008' x_authority: cpan:MSTROUT x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/Makefile.PL new/Sub-Quote-2.006008/Makefile.PL --- old/Sub-Quote-2.006006/Makefile.PL 2017-11-23 14:00:41.000000000 +0100 +++ new/Sub-Quote-2.006008/Makefile.PL 2023-01-05 22:10:03.000000000 +0100 @@ -14,7 +14,6 @@ test => { requires => { 'Test::More' => 0.94, - 'Test::Fatal' => 0.003, }, }, runtime => { @@ -23,7 +22,7 @@ 'perl' => 5.006, }, recommends => { - 'Sub::Name' => 0.08, + 'Sub::Util' => 0, }, }, develop => { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/lib/Sub/Defer.pm new/Sub-Quote-2.006008/lib/Sub/Defer.pm --- old/Sub-Quote-2.006006/lib/Sub/Defer.pm 2019-10-01 19:31:09.000000000 +0200 +++ new/Sub-Quote-2.006008/lib/Sub/Defer.pm 2023-01-05 22:16:48.000000000 +0100 @@ -1,13 +1,15 @@ package Sub::Defer; use strict; use warnings; -use Exporter qw(import); + +our $VERSION = '2.006008'; +$VERSION =~ tr/_//d; + +use Exporter (); +BEGIN { *import = \&Exporter::import } use Scalar::Util qw(weaken); use Carp qw(croak); -our $VERSION = '2.006006'; -$VERSION = eval $VERSION; - our @EXPORT = qw(defer_sub undefer_sub undefer_all); our @EXPORT_OK = qw(undefer_package defer_info); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/lib/Sub/Quote.pm new/Sub-Quote-2.006008/lib/Sub/Quote.pm --- old/Sub-Quote-2.006006/lib/Sub/Quote.pm 2019-10-01 19:31:09.000000000 +0200 +++ new/Sub-Quote-2.006008/lib/Sub/Quote.pm 2023-01-05 22:16:48.000000000 +0100 @@ -5,17 +5,22 @@ use strict; use warnings; +our $VERSION = '2.006008'; +$VERSION =~ tr/_//d; + use Sub::Defer qw(defer_sub); use Scalar::Util qw(weaken); -use Exporter qw(import); +use Exporter (); +BEGIN { *import = \&Exporter::import } use Carp qw(croak); BEGIN { our @CARP_NOT = qw(Sub::Defer) } -use B (); BEGIN { - *_HAVE_IS_UTF8 = defined &utf8::is_utf8 ? sub(){1} : sub(){0}; - *_HAVE_PERLSTRING = defined &B::perlstring ? sub(){1} : sub(){0}; - *_BAD_BACKSLASH_ESCAPE = _HAVE_PERLSTRING() && "$]" == 5.010_000 ? sub(){1} : sub(){0}; - *_HAVE_HEX_FLOAT = !$ENV{SUB_QUOTE_NO_HEX_FLOAT} && "$]" >= 5.022 ? sub(){1} : sub(){0}; + my $TRUE = sub(){!!1}; + my $FALSE = sub(){!!0}; + *_HAVE_IS_UTF8 = defined &utf8::is_utf8 ? $TRUE : $FALSE; + *_CAN_TRACK_BOOLEANS = defined &builtin::is_bool ? $TRUE : $FALSE; + *_CAN_TRACK_NUMBERS = defined &builtin::created_as_number ? $TRUE : $FALSE; + *_HAVE_HEX_FLOAT = !$ENV{SUB_QUOTE_NO_HEX_FLOAT} && "$]" >= 5.022 ? $TRUE : $FALSE; # This may not be perfect, as we can't tell the format purely from the size # but it should cover the common cases, and other formats are more likely to @@ -32,42 +37,78 @@ ; my $precision = int( log(2)/log(10)*$nvmantbits ); - *_NVSIZE = sub(){$nvsize}; - *_NVMANTBITS = sub(){$nvmantbits}; - *_FLOAT_PRECISION = sub(){$precision}; + *_NVSIZE = sub(){ $nvsize }; + *_NVMANTBITS = sub(){ $nvmantbits }; + *_FLOAT_PRECISION = sub(){ $precision }; + + local $@; + # if B is already loaded, just use its perlstring + if ("$]" >= 5.008_000 && "$]" != 5.010_000 && defined &B::perlstring) { + *_perlstring = \&B::perlstring; + } + # XString is smaller than B, so prefer to use it. Buggy until 0.003. + elsif (eval { require XString; XString->VERSION(0.003) }) { + *_perlstring = \&XString::perlstring; + } + # B::perlstring in perl 5.10 handles escaping incorrectly on utf8 strings + elsif ("$]" == 5.010_000) { + my %escape = ( + (map +(chr($_) => sprintf '\x%02x', $_), 0 .. 0x31, 0x7f), + "\t" => "\\t", + "\n" => "\\n", + "\r" => "\\r", + "\f" => "\\f", + "\b" => "\\b", + "\a" => "\\a", + "\e" => "\\e", + (map +($_ => "\\$_"), qw(" \ $ @)), + ); + *_perlstring = sub { + my $value = shift; + $value =~ s{(["\$\@\\[:cntrl:]]|[^\x00-\x7f])}{ + $escape{$1} || sprintf('\x{%x}', ord($1)) + }ge; + qq["$value"]; + }; + } + elsif ("$]" >= 5.008_000 && eval { require B; 1 } && defined &B::perlstring ) { + *_perlstring = \&B::perlstring; + } + # on perl 5.6, perlstring is not available. quotemeta will mostly serve as a + # replacement. it quotes just by adding lots of backslashes though. if a + # utf8 string was written out directly as bytes, it wouldn't get interpreted + # correctly if not under 'use utf8'. this is mostly a theoretical concern, + # but enough to stick with perlstring when possible. + else { + *_perlstring = sub { qq["\Q$_[0]\E"] }; + } } -our $VERSION = '2.006006'; -$VERSION =~ tr/_//d; - our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub qsub); our @EXPORT_OK = qw(quotify capture_unroll inlinify sanitize_identifier); our %QUOTED; -my %escape; -if (_BAD_BACKSLASH_ESCAPE) { - %escape = ( - (map +(chr($_) => sprintf '\x%02x', $_), 0 .. 0x31, 0x7f), - "\t" => "\\t", - "\n" => "\\n", - "\r" => "\\r", - "\f" => "\\f", - "\b" => "\\b", - "\a" => "\\a", - "\e" => "\\e", - (map +($_ => "\\$_"), qw(" \ $ @)), - ); -} - sub quotify { my $value = $_[0]; no warnings 'numeric'; + BEGIN { + warnings->unimport(qw(experimental::builtin)) + if _CAN_TRACK_BOOLEANS || _CAN_TRACK_NUMBERS; + } ! defined $value ? 'undef()' + : _CAN_TRACK_BOOLEANS && builtin::is_bool($value) ? ( + $value ? '(!!1)' : '(!!0)' + ) # numeric detection - : (!(_HAVE_IS_UTF8 && utf8::is_utf8($value)) - && length( (my $dummy = '') & $value ) - && 0 + $value eq $value + : ( + _CAN_TRACK_NUMBERS + ? builtin::created_as_number($value) + : ( + !(_HAVE_IS_UTF8 && utf8::is_utf8($value)) + && length( (my $dummy = '') & $value ) + && 0 + $value eq $value + ) ) ? ( $value != $value ? ( $value eq (9**9**9*0) @@ -90,7 +131,7 @@ FACTOR: for my $ex (0 .. abs($max_factor)) { my $num = $value / 2**($ex_sign * $ex); for my $precision (_FLOAT_PRECISION .. _FLOAT_PRECISION+2) { - my $formatted = sprintf '%.'.$precision.'g', $num; + my $formatted = sprintf '%0.'.$precision.'g', $num; $float = $formatted if $ex == 0; if ($formatted == $num) { @@ -115,15 +156,8 @@ "$float"; } ) - : !length($value) && length( (my $dummy2 = '') & $value ) ? '(!1)' # false - : _BAD_BACKSLASH_ESCAPE && _HAVE_IS_UTF8 && utf8::is_utf8($value) ? do { - $value =~ s/(["\$\@\\[:cntrl:]]|[^\x00-\x7f])/ - $escape{$1} || sprintf('\x{%x}', ord($1)) - /ge; - qq["$value"]; - } - : _HAVE_PERLSTRING ? B::perlstring($value) - : qq["\Q$value\E"]; + : !_CAN_TRACK_BOOLEANS && !length($value) && length( (my $dummy2 = '') & $value ) ? '(!!0)' # false + : _perlstring($value); } sub sanitize_identifier { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/maint/Makefile.PL.include new/Sub-Quote-2.006008/maint/Makefile.PL.include --- old/Sub-Quote-2.006006/maint/Makefile.PL.include 2017-11-23 14:00:41.000000000 +0100 +++ new/Sub-Quote-2.006008/maint/Makefile.PL.include 2023-01-05 22:05:43.000000000 +0100 @@ -1,4 +1,4 @@ -BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } +BEGIN { -e 'Distar' or system qw(git clone https://github.com/p5sagit/Distar.git) } use lib 'Distar/lib'; use Distar 0.001; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/hints.t new/Sub-Quote-2.006008/t/hints.t --- old/Sub-Quote-2.006006/t/hints.t 2019-09-05 22:57:20.000000000 +0200 +++ new/Sub-Quote-2.006008/t/hints.t 2023-01-05 22:10:03.000000000 +0100 @@ -14,7 +14,6 @@ use warnings; no warnings 'once'; use Test::More; -use Test::Fatal; use Sub::Quote qw( quote_sub @@ -27,7 +26,10 @@ no strict 'subs'; local $TODO = "hints from caller not available on perl < 5.8" if "$]" < 5.008_000; - like exception { quote_sub(q{ my $f = SomeBareword; ${"string_ref"} })->(); }, + + my $e; + eval { quote_sub(q{ my $f = SomeBareword; ${"string_ref"} })->(); 1 } or $e = $@; + like $e, qr/strict refs/, 'hints preserved from context'; } @@ -39,7 +41,9 @@ no strict 'subs'; BEGIN { $hints = $^H } } - like exception { quote_sub(q{ my $f = SomeBareword; ${"string_ref"} }, {}, { hints => $hints })->(); }, + my $e; + eval { quote_sub(q{ my $f = SomeBareword; ${"string_ref"} }, {}, { hints => $hints })->(); 1 } or $e = $@; + like $e, qr/strict refs/, 'hints used from options'; } @@ -78,7 +82,9 @@ 1; } or die $@; no warnings 'uninitialized'; - like exception { quote_sub(q{ 0 + undef }, {}, { warning_bits => $warn_bits })->(); }, + my $e; + eval { quote_sub(q{ 0 + undef }, {}, { warning_bits => $warn_bits })->(); 1 } or $e = $@; + like $e, qr/uninitialized/, 'warnings used from options'; } @@ -172,7 +178,9 @@ todo_skip "refs in hints hash not yet implemented", 4; { my $context_val; - is exception { $context_val = $context_sub->() }, undef, + my $e; + eval { $context_val = $context_sub->(); 1 } or $e = $@; + is $e, undef, 'hints hash refs from context not broken'; local $TODO = 'hints hash from context not available on perl 5.8' if !$TODO && "$]" < 5.010_000; @@ -182,7 +190,9 @@ { my $options_val; - is exception { $options_val = $options_sub->() }, undef, + my $e; + eval { $options_val = $options_sub->(); 1 } or $e = $@; + is $e, undef, 'hints hash refs from options not broken'; is $options_val, 11, 'hints hash refs used from options'; @@ -206,7 +216,9 @@ { my $context_val; - is exception { $context_val = $context_sub->() }, undef, + my $e; + eval { $context_val = $context_sub->(); 1 } or $e = $@; + is $e, undef, 'hints hash closure refs from context not broken'; local $TODO = 'hints hash from context not available on perl 5.8' if !$TODO && "$]" < 5.010_000; @@ -216,7 +228,9 @@ { my $options_val; - is exception { $options_val = $options_sub->() }, undef, + my $e; + eval { $options_val = $options_sub->(); 1 } or $e = $@; + is $e, undef, 'hints hash closure refs from options not broken'; is $options_val, 12, 'hints hash closure refs used from options'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/inline.t new/Sub-Quote-2.006008/t/inline.t --- old/Sub-Quote-2.006006/t/inline.t 2019-03-06 15:03:22.000000000 +0100 +++ new/Sub-Quote-2.006008/t/inline.t 2023-01-05 22:10:03.000000000 +0100 @@ -2,7 +2,6 @@ use warnings; no warnings 'once'; use Test::More; -use Test::Fatal; use Data::Dumper; use Sub::Quote qw( @@ -23,9 +22,14 @@ is_deeply $sub->(), [ 1, 2 ], 'unrolled variables get correct values'; } -like exception { +my $e; +eval { capture_unroll '$captures', { '&foo' => \sub { 5 } }, 4; -}, qr/^capture key should start with @, % or \$/, + 1; +} or $e = $@; + +like $e, + qr/^capture key should start with @, % or \$/, 'capture_unroll rejects vars other than scalar, hash, or array'; { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/leaks.t new/Sub-Quote-2.006008/t/leaks.t --- old/Sub-Quote-2.006006/t/leaks.t 2017-11-23 14:00:41.000000000 +0100 +++ new/Sub-Quote-2.006008/t/leaks.t 2023-01-05 22:10:03.000000000 +0100 @@ -2,8 +2,6 @@ use warnings; no warnings 'once'; use Test::More; -use Test::Fatal; -use Data::Dumper; use Sub::Quote qw( quote_sub @@ -40,7 +38,9 @@ my $foo_info = quoted_from_sub($foo_string); undef $foo; - is exception { Sub::Quote->CLONE }, undef, + my $e; + eval { Sub::Quote->CLONE; 1 } or $e = $@; + is $e, undef, 'CLONE works when quoted info saved externally'; ok exists $Sub::Quote::QUOTED{$foo_string}, 'CLONE keeps entries that had info saved'; @@ -52,7 +52,9 @@ my $foo_info = $Sub::Quote::QUOTED{$foo_string}; undef $foo; - is exception { Sub::Quote->CLONE }, undef, + my $e; + eval { Sub::Quote->CLONE; 1 } or $e = $@; + is $e, undef, 'CLONE works when quoted info kept alive externally'; ok !exists $Sub::Quote::QUOTED{$foo_string}, 'CLONE removes expired entries that were kept alive externally'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/quotify-5.6.t new/Sub-Quote-2.006008/t/quotify-5.6.t --- old/Sub-Quote-2.006006/t/quotify-5.6.t 2019-03-06 15:03:22.000000000 +0100 +++ new/Sub-Quote-2.006008/t/quotify-5.6.t 1970-01-01 01:00:00.000000000 +0100 @@ -1,12 +0,0 @@ -use strict; -use warnings; -no warnings 'once'; -use B; -BEGIN { - local $utf8::{is_utf8}; - local $B::{perlstring}; - require Sub::Quote; -} -die "Unable to disable utf8::is_utf8 and B::perlstring for testing" - unless !Sub::Quote::_HAVE_IS_UTF8 && ! Sub::Quote::_HAVE_PERLSTRING; -do './t/quotify.t' or die $@ || $!; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/quotify-no-hex.t new/Sub-Quote-2.006008/t/quotify-no-hex.t --- old/Sub-Quote-2.006006/t/quotify-no-hex.t 2019-09-05 22:54:08.000000000 +0200 +++ new/Sub-Quote-2.006008/t/quotify-no-hex.t 2023-01-05 22:10:12.000000000 +0100 @@ -1,5 +1,5 @@ use strict; use warnings; no warnings 'once'; -$::SUB_QUOTE_NO_HEX_FLOAT = 1; +unshift @ARGV, '--no-hex'; do './t/quotify.t' or die $@ || $!; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/quotify.t new/Sub-Quote-2.006008/t/quotify.t --- old/Sub-Quote-2.006006/t/quotify.t 2019-09-05 22:54:08.000000000 +0200 +++ new/Sub-Quote-2.006008/t/quotify.t 2023-01-05 22:10:12.000000000 +0100 @@ -1,20 +1,68 @@ use strict; use warnings; no warnings 'once'; -use Test::More; -use Data::Dumper; -use B; +my %opts; BEGIN { - $ENV{SUB_QUOTE_NO_HEX_FLOAT} = $::SUB_QUOTE_NO_HEX_FLOAT ? 1 : 0; + for my $arg (@ARGV) { + if ($arg =~ /\A--(perfect|5_10_0|5_6|no-hex|b-perlstring|no-xstring)\z/) { + $opts{$1} = 1; + } + else { + die "Invalid option: $arg\n"; + } + } + + $ENV{SUB_QUOTE_NO_HEX_FLOAT} = 0+!!$opts{'no-hex'}; + + { + my $v; + + $opts{'5_6'} || $opts{'5_10_0'} || $opts{'no-xstring'} and + (eval { require XString }), + (local $XString::VERSION = '0.001'), + ; + + $opts{'5_6'} and + (require B), + (local $B::{perlstring}), + (local $utf8::{is_utf8}), + ($v = 5.006), + ; + + $opts{'5_10_0'} and + ($v = 5.010000), + ; + + $opts{'b-perlstring'} and + (require B), + ; + + $v and + ($v = sprintf "%.6f", $v), + (my $t = $v + 0), + (Internals::SvREADONLY($], 0)), + (local $] = $v), + (Internals::SvREADONLY($], 1)), + ; + + require Sub::Quote; + } + + Internals::SvREADONLY($], 1); } use Sub::Quote qw( quotify ); +use Test::More; +use Data::Dumper; +use B; + use constant HAVE_UTF8 => Sub::Quote::_HAVE_IS_UTF8; use constant FLOAT_PRECISION => Sub::Quote::_FLOAT_PRECISION; use constant HAVE_HEX_FLOAT => Sub::Quote::_HAVE_HEX_FLOAT; +use constant CAN_TRACK_BOOLEANS => Sub::Quote::_CAN_TRACK_BOOLEANS; use constant INF => 9**9**9**9; use constant NAN => INF * 0; use constant MAXUINT => ~0; @@ -40,10 +88,22 @@ $d; } +sub _is_diag { + my ($got, $expect) = map _dump($_), @_; + diag sprintf <<'END_DIAG', $got, $expect; + got: %s + expected: %s +END_DIAG +} + sub is_numeric { my $flags = B::svref_2object(\($_[0]))->FLAGS; !!( $flags & ( B::SVp_IOK | B::SVp_NOK ) ) } +die "ASSERT: is_numeric broken for numbers" + if !is_numeric(1); +die "ASSERT: is_numeric broken for strings" + if is_numeric("1"); sub is_float { my $num = shift; @@ -51,6 +111,36 @@ || $num > ~0 || $num < -(~0>>1)-1; } +die "ASSERT: is_float broken for integers" + if is_float(1); +die "ASSERT: is_float broken for floats" + if !is_float(1.1); + +sub is_bool { + my $bool = shift; + if (CAN_TRACK_BOOLEANS) { + BEGIN { CAN_TRACK_BOOLEANS && warnings->unimport(qw(experimental::builtin)) } + return builtin::is_bool($bool); + } + else { + if (is_numeric($bool) && $bool == 0 && $bool eq '') { + return !!1; + } + else { + # can't detect true + return !!0; + } + } +} +die "ASSERT: is_bool broken for integers" + if is_bool(1) || is_bool(0); +die "ASSERT: is_bool broken for floats" + if is_bool(1.0); +die "ASSERT: is_bool broken for strings" + if is_bool("1") || is_bool("0"); +die "ASSERT: is_bool broken for booleans" + if !is_bool(!!0) || (CAN_TRACK_BOOLEANS && !is_bool(!!1)); + sub is_strict_numeric { my $flags = B::svref_2object(\($_[0]))->FLAGS; @@ -59,7 +149,7 @@ } my %flags; -{ +BEGIN { no strict 'refs'; for my $flag (qw( SVs_TEMP @@ -165,10 +255,15 @@ undef, @booleans, (map { - my $indeterminate = $_; - my $number = $indeterminate + 0; - my $string = $indeterminate . ""; - ($number, $indeterminate, $string); + my $number = $_; + $number += 0; + my $string = $_; + $string .= ""; + my $started_as_number = $number; + my $void = $started_as_number . ""; + my $started_as_string = $string; + $void = $started_as_string + 0; + ($number, $started_as_number, $string, $started_as_string); } @numbers), @strings, @utf8_strings, @@ -186,7 +281,8 @@ = _dump($value) . (HAVE_UTF8 && utf8::is_utf8($value) ? ' utf8' : '') . (is_strict_numeric($value) ? ' pure' : '') - . (is_numeric($value) ? ' num' : ''); + . (is_numeric($value) ? ' num' : '') + . (is_bool($value) ? ' bool' : ''); my $quoted = quotify(my $copy = $value); utf8::downgrade($quoted, 1) @@ -218,7 +314,7 @@ if (is_numeric($value)) { if ($value == $value) { my $todo; - if (!HAVE_HEX_FLOAT && $check_value != $value && is_float($value)) { + if (!$opts{perfect} && !HAVE_HEX_FLOAT && $check_value != $value && is_float($value)) { my $diff = abs($check_value - $value); my $accuracy = abs($value)/$diff; my $precision = FLOAT_PRECISION + 1; @@ -243,12 +339,14 @@ } if (defined $value) { - cmp_ok $check_value, 'eq', $value, - "$value_name: string value maintained$suffix"; + ok $check_value eq $value, + "$value_name: string value maintained$suffix" + or _is_diag($check_value, $value); } else { is $check_value, undef, - "$value_name: undef maintained$suffix"; + "$value_name: undef maintained$suffix" + or _is_diag($check_value, $value); } } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/sub-defer.t new/Sub-Quote-2.006008/t/sub-defer.t --- old/Sub-Quote-2.006006/t/sub-defer.t 2019-03-06 15:03:22.000000000 +0100 +++ new/Sub-Quote-2.006008/t/sub-defer.t 2023-01-05 22:10:03.000000000 +0100 @@ -1,7 +1,6 @@ use strict; use warnings; use Test::More; -use Test::Fatal; use Sub::Defer qw(defer_sub undefer_sub undefer_all undefer_package defer_info); use Scalar::Util qw(refaddr weaken); @@ -30,13 +29,17 @@ is(Foo->one, 'one', 'one (undeferred) runs'); -like exception { defer_sub 'welp' => sub { sub { 1 } } }, +my $e; +eval { defer_sub 'welp' => sub { sub { 1 } }; 1 } or $e = $@; +like $e, qr/^welp is not a fully qualified sub name!/, 'correct error for defer_sub with unqualified name'; is(my $two_made = undefer_sub($two_defer), $made{'Foo::two'}, 'make two'); -is exception { undefer_sub($two_defer) }, undef, +undef $e; +eval { undefer_sub($two_defer); 1 } or $e = $@; +is $e, undef, "repeated undefer doesn't regenerate"; is($two_made, \&Foo::two, 'two installed'); @@ -134,7 +137,9 @@ my $foo_info = defer_info($foo_string); undef $foo; - is exception { Sub::Defer->CLONE }, undef, + my $e; + eval { Sub::Defer->CLONE; 1 } or $e = $@; + is $e, undef, 'CLONE works when quoted info saved externally'; } @@ -144,7 +149,9 @@ my $foo_info = $Sub::Defer::DEFERRED{$foo_string}; undef $foo; - is exception { Sub::Defer->CLONE }, undef, + my $e; + eval { Sub::Defer->CLONE; 1 } or $e = $@; + is $e, undef, 'CLONE works when quoted info kept alive externally'; ok !exists $Sub::Defer::DEFERRED{$foo_string}, 'CLONE removes expired entries that were kept alive externally'; @@ -155,7 +162,9 @@ my $foo_string = "$foo"; undef $foo; Sub::Defer::undefer_package 'Unused'; - is exception { undefer_sub $foo_string }, undef, + my $e; + eval { undefer_sub $foo_string; 1 } or $e = $@; + is $e, undef, "undeferring expired sub (or reused refaddr) after undefer_package lives"; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/t/sub-quote.t new/Sub-Quote-2.006008/t/sub-quote.t --- old/Sub-Quote-2.006006/t/sub-quote.t 2019-03-06 15:03:22.000000000 +0100 +++ new/Sub-Quote-2.006008/t/sub-quote.t 2023-01-05 22:10:03.000000000 +0100 @@ -2,7 +2,6 @@ use warnings; no warnings 'once'; use Test::More; -use Test::Fatal; use Sub::Quote qw( quote_sub @@ -58,10 +57,11 @@ is(Foo->three, 'spoon', 'get ok (named method)'); is(Foo->three('fork'), 'fork', 'set ok (named method)'); is(Foo->three, 'fork', 're-get ok (named method)'); -like( - exception { Foo->three(qw(full cutlery set)) }, qr/Foo::three/, - 'exception contains correct name' -); +my $e; +eval { Foo->three(qw(full cutlery set)); 1 } or $e = $@; +like $e, + qr/Foo::three/, + 'exception contains correct name'; quote_sub 'Foo::four' => q{ return 5; @@ -84,39 +84,66 @@ 'bare sub name installed in current package'; my $long = "a" x 251; -is exception { +undef $e; +eval { (quote_sub "${long}a::${long}", q{ return 1; })->(); -}, undef, + 1; +} or $e = $@; +is $e, undef, 'long names work if package and sub are short enough'; -like exception { +undef $e; +eval { quote_sub "${long}${long}::${long}", q{ return 1; }; -}, qr/^package name "$long$long" too long/, + 1; +} or $e = $@; +like $e, + qr/^package name "$long$long" too long/, 'over long package names error'; -like exception { +undef $e; +eval { quote_sub "${long}::${long}${long}", q{ return 1; }; -}, qr/^sub name "$long$long" too long/, + 1; +} or $e = $@; +like $e, + qr/^sub name "$long$long" too long/, 'over long sub names error'; -like exception { +undef $e; +eval { quote_sub "got a space::gorp", q{ return 1; }; -}, qr/^package name "got a space" is not valid!/, + 1; +} or $e = $@; +like $e, + qr/^package name "got a space" is not valid!/, 'packages with spaces are invalid'; -like exception { +undef $e; +eval { quote_sub "Gorp::got a space", q{ return 1; }; -}, qr/^sub name "got a space" is not valid!/, + 1; +} or $e = $@; +like $e, + qr/^sub name "got a space" is not valid!/, 'sub names with spaces are invalid'; -like exception { +undef $e; +eval { quote_sub "0welp::gorp", q{ return 1; }; -}, qr/^package name "0welp" is not valid!/, + 1; +} or $e = $@; +like $e, + qr/^package name "0welp" is not valid!/, 'package names starting with numbers are not valid'; -like exception { +undef $e; +eval { quote_sub "Gorp::0welp", q{ return 1; }; -}, qr/^sub name "0welp" is not valid!/, + 1; +} or $e = $@; +like $e, + qr/^sub name "0welp" is not valid!/, 'sub names starting with numbers are not valid'; my $broken_quoted = quote_sub q{ @@ -124,20 +151,29 @@ Guh }; -my $err = exception { $broken_quoted->() }; +undef $e; +eval { + $broken_quoted->(); + 1; +} or $e = $@; like( - $err, qr/Eval went very, very wrong/, + $e, qr/Eval went very, very wrong/, "quoted sub with syntax error dies when called" ); -my ($location) = $err =~ /syntax error at .+? line (\d+)/; +my ($location) = $e =~ /syntax error at .+? line (\d+)/; like( - $err, qr/$location:\s*return 5<;/, + $e, qr/$location:\s*return 5<;/, "syntax errors include usable line numbers" ); sub in_main { 1 } -is exception { quote_sub(q{ in_main(); })->(); }, undef, +undef $e; +eval { + quote_sub(q{ in_main(); })->(); + 1; +} or $e = $@; +is $e, undef, 'package preserved from context'; { @@ -145,7 +181,12 @@ sub in_arf { 1 } } -is exception { quote_sub(q{ in_arf(); }, {}, { package => 'Arf' })->(); }, undef, +undef $e; +eval { + quote_sub(q{ in_arf(); }, {}, { package => 'Arf' })->(); + 1; +} or $e = $@; +is $e, undef, 'package used from options'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/xt/quotify-5.10.0.t new/Sub-Quote-2.006008/xt/quotify-5.10.0.t --- old/Sub-Quote-2.006006/xt/quotify-5.10.0.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Sub-Quote-2.006008/xt/quotify-5.10.0.t 2023-01-05 22:10:12.000000000 +0100 @@ -0,0 +1,5 @@ +use strict; +use warnings; +no warnings 'once'; +unshift @ARGV, '--5_10_0'; +do './t/quotify.t' or die $@ || $!; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/xt/quotify-5.6.t new/Sub-Quote-2.006008/xt/quotify-5.6.t --- old/Sub-Quote-2.006006/xt/quotify-5.6.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Sub-Quote-2.006008/xt/quotify-5.6.t 2023-01-05 22:10:12.000000000 +0100 @@ -0,0 +1,5 @@ +use strict; +use warnings; +no warnings 'once'; +unshift @ARGV, '--5_6'; +do './t/quotify.t' or die $@ || $!; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/xt/quotify-b.t new/Sub-Quote-2.006008/xt/quotify-b.t --- old/Sub-Quote-2.006006/xt/quotify-b.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Sub-Quote-2.006008/xt/quotify-b.t 2023-01-05 22:10:12.000000000 +0100 @@ -0,0 +1,5 @@ +use strict; +use warnings; +no warnings 'once'; +unshift @ARGV, '--b-perlstring'; +do './t/quotify.t' or die $@ || $!; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.006006/xt/quotify-no-xstring.t new/Sub-Quote-2.006008/xt/quotify-no-xstring.t --- old/Sub-Quote-2.006006/xt/quotify-no-xstring.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Sub-Quote-2.006008/xt/quotify-no-xstring.t 2023-01-05 22:10:12.000000000 +0100 @@ -0,0 +1,5 @@ +use strict; +use warnings; +no warnings 'once'; +unshift @ARGV, '--no-xstring'; +do './t/quotify.t' or die $@ || $!;
