Hello community, here is the log from the commit of package perl-Sub-Quote for openSUSE:Factory checked in at 2018-02-12 10:08:04 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Sub-Quote (Old) and /work/SRC/openSUSE:Factory/.perl-Sub-Quote.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Sub-Quote" Mon Feb 12 10:08:04 2018 rev:3 rq:573951 version:2.005000 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Sub-Quote/perl-Sub-Quote.changes 2017-06-09 15:58:12.472890277 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Sub-Quote.new/perl-Sub-Quote.changes 2018-02-12 10:08:11.808680464 +0100 @@ -1,0 +2,24 @@ +Wed Feb 7 17:20:10 UTC 2018 - [email protected] + +- updated to 2.005000 + see /usr/share/doc/packages/perl-Sub-Quote/Changes + + 2.005000 - 2018-02-06 + - fixed defer_info and undefer_sub from returning data for a deferred sub + after it expires, even if the ref address matches + - fixed defer_info not returning info for undeferred unnamed subs after the + deferred sub expires + - include options in defer_info return data + - exclude internals from defer_info return data + - document defer_info function + - encode all utf8 flagged scalars as strings, since they generally will + always have originated as strings. Avoids future warning on bitwise ops + on strings with wide characters. + - more thorough check for threads availability to avoid needless test + failures. + - added file and line options to quote_sub to allow specifying apparent + source location. + - documented additional options to Sub::Defer::defer_sub and + Sub::Quote::quote_sub. + +------------------------------------------------------------------- Old: ---- Sub-Quote-2.004000.tar.gz New: ---- Sub-Quote-2.005000.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Sub-Quote.spec ++++++ --- /var/tmp/diff_new_pack.0xIJ1k/_old 2018-02-12 10:08:13.108633614 +0100 +++ /var/tmp/diff_new_pack.0xIJ1k/_new 2018-02-12 10:08:13.112633470 +0100 @@ -1,7 +1,7 @@ # # spec file for package perl-Sub-Quote # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,7 +17,7 @@ Name: perl-Sub-Quote -Version: 2.004000 +Version: 2.005000 Release: 0 %define cpan_name Sub-Quote Summary: Efficient generation of subroutines via string eval ++++++ Sub-Quote-2.004000.tar.gz -> Sub-Quote-2.005000.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/Changes new/Sub-Quote-2.005000/Changes --- old/Sub-Quote-2.004000/Changes 2017-06-07 03:08:49.000000000 +0200 +++ new/Sub-Quote-2.005000/Changes 2018-02-06 19:06:01.000000000 +0100 @@ -1,5 +1,23 @@ Revision history for Sub::Quote +2.005000 - 2018-02-06 + - fixed defer_info and undefer_sub from returning data for a deferred sub + after it expires, even if the ref address matches + - fixed defer_info not returning info for undeferred unnamed subs after the + deferred sub expires + - include options in defer_info return data + - exclude internals from defer_info return data + - document defer_info function + - encode all utf8 flagged scalars as strings, since they generally will + always have originated as strings. Avoids future warning on bitwise ops + on strings with wide characters. + - more thorough check for threads availability to avoid needless test + failures. + - added file and line options to quote_sub to allow specifying apparent + source location. + - documented additional options to Sub::Defer::defer_sub and + Sub::Quote::quote_sub. + 2.004000 - 2017-06-07 - more extensive quotify tests - split tests into separate files diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/MANIFEST new/Sub-Quote-2.005000/MANIFEST --- old/Sub-Quote-2.004000/MANIFEST 2017-06-07 03:30:43.000000000 +0200 +++ new/Sub-Quote-2.005000/MANIFEST 2018-02-06 19:06:30.000000000 +0100 @@ -10,6 +10,7 @@ t/leaks.t t/lib/ErrorLocation.pm t/lib/InlineModule.pm +t/lib/ThreadsCheck.pm t/quotify.t t/sub-defer-no-subname.t t/sub-defer-threads.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/META.json new/Sub-Quote-2.005000/META.json --- old/Sub-Quote-2.004000/META.json 2017-06-07 03:30:43.000000000 +0200 +++ new/Sub-Quote-2.005000/META.json 2018-02-06 19:06:29.000000000 +0100 @@ -1,10 +1,10 @@ { "abstract" : "Efficient generation of subroutines via string eval", "author" : [ - "mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>" + "unknown" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", + "generated_by" : "ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -63,7 +63,7 @@ }, "x_IRC" : "irc://irc.perl.org/#moose" }, - "version" : "2.004000", + "version" : "2.005000", "x_authority" : "cpan:MSTROUT", - "x_serialization_backend" : "JSON::PP version 2.94" + "x_serialization_backend" : "JSON::PP version 2.97001" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/META.yml new/Sub-Quote-2.005000/META.yml --- old/Sub-Quote-2.004000/META.yml 2017-06-07 03:30:42.000000000 +0200 +++ new/Sub-Quote-2.005000/META.yml 2018-02-06 19:06:29.000000000 +0100 @@ -1,14 +1,14 @@ --- abstract: 'Efficient generation of subroutines via string eval' author: - - 'mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>' + - unknown build_requires: Test::Fatal: '0.003' Test::More: '0.94' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' +generated_by: 'ExtUtils::MakeMaker version 7.3, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -28,6 +28,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.004000' +version: '2.005000' 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.004000/README new/Sub-Quote-2.005000/README --- old/Sub-Quote-2.004000/README 2017-06-07 03:30:43.000000000 +0200 +++ new/Sub-Quote-2.005000/README 2018-02-06 19:06:30.000000000 +0100 @@ -59,7 +59,34 @@ "package" The package that the quoted sub will be evaluated in. If not - specified, the sub calling "quote_sub" will be used. + specified, the package from sub calling "quote_sub" will be used. + + "hints" + The value of $^H to use for the code being evaluated. This captures + the settings of the strict pragma. If not specified, the value from + the calling code will be used. + + "warning_bits" + The value of "${^WARNING_BITS}" to use for the code being evaluated. + This captures the warnings set. If not specified, the warnings from + the calling code will be used. + + "%^H" + The value of "%^H" to use for the code being evaluated. This captures + additional pragma settings. If not specified, the value from the + calling code will be used if possible (on perl 5.10+). + + "attributes" + The "Subroutine Attributes" in perlsub to apply to the sub generated. + Should be specified as an array reference. The attributes will be + applied to both the generated sub and the deferred wrapper, if one is + used. + + "file" + The apparent filename to use for the code being evaluated. + + "line" + The apparent line number to use for the code being evaluated. unquote_sub my $coderef = unquote_sub $sub; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/lib/Sub/Defer.pm new/Sub-Quote-2.005000/lib/Sub/Defer.pm --- old/Sub-Quote-2.004000/lib/Sub/Defer.pm 2017-06-07 03:08:15.000000000 +0200 +++ new/Sub-Quote-2.005000/lib/Sub/Defer.pm 2018-02-06 19:05:54.000000000 +0100 @@ -5,7 +5,7 @@ use Scalar::Util qw(weaken); use Carp qw(croak); -our $VERSION = '2.004000'; +our $VERSION = '2.005000'; $VERSION = eval $VERSION; our @EXPORT = qw(defer_sub undefer_sub undefer_all); @@ -47,9 +47,16 @@ sub undefer_sub { my ($deferred) = @_; - my ($target, $maker, $undeferred_ref) = @{ - $DEFERRED{$deferred}||return $deferred - }; + my $info = $DEFERRED{$deferred} or return $deferred; + my ($target, $maker, $options, $undeferred_ref, $deferred_sub) = @$info; + + if (!( + $deferred_sub && $deferred eq $deferred_sub + || ${$undeferred_ref} && $deferred eq ${$undeferred_ref} + )) { + return $deferred; + } + return ${$undeferred_ref} if ${$undeferred_ref}; ${$undeferred_ref} = my $made = $maker->(); @@ -62,9 +69,9 @@ # _install_coderef calls are not necessary --ribasushi *{_getglob($target)} = $made; } - $DEFERRED{$made} = $DEFERRED{$deferred}; - weaken $DEFERRED{$made} - unless $target; + my $undefer_info = [ $target, $maker, $options, \$$undeferred_ref ]; + $info->[5] = $DEFERRED{$made} = $undefer_info; + weaken ${$undefer_info->[3]}; return $made; } @@ -87,7 +94,19 @@ sub defer_info { my ($deferred) = @_; my $info = $DEFERRED{$deferred||''} or return undef; - [ @$info ]; + + my ($target, $maker, $options, $undeferred_ref, $deferred_sub) = @$info; + if (!( + $deferred_sub && $deferred eq $deferred_sub + || ${$undeferred_ref} && $deferred eq ${$undeferred_ref} + )) { + delete $DEFERRED{$deferred}; + return undef; + } + [ + $target, $maker, $options, + ( $undeferred_ref && $$undeferred_ref ? $$undeferred_ref : ()), + ]; } sub defer_sub { @@ -105,7 +124,7 @@ } my $deferred; my $undeferred; - my $deferred_info = [ $target, $maker, \$undeferred ]; + my $deferred_info = [ $target, $maker, $options, \$undeferred ]; if (@attributes || $target && !_CAN_SUBNAME) { my $code = q[#line ].(__LINE__+2).q[ "].__FILE__.qq["\n] @@ -115,7 +134,7 @@ package Sub::Defer; # uncoverable subroutine # uncoverable statement - $undeferred ||= undefer_sub($deferred_info->[3]); + $undeferred ||= undefer_sub($deferred_info->[4]); goto &$undeferred; # uncoverable statement $undeferred; # fake lvalue return }]."\n" @@ -131,23 +150,25 @@ else { # duplicated from above $deferred = sub { - $undeferred ||= undefer_sub($deferred_info->[3]); + $undeferred ||= undefer_sub($deferred_info->[4]); goto &$undeferred; }; _install_coderef($target, $deferred) if $target; } - weaken($deferred_info->[3] = $deferred); + weaken($deferred_info->[4] = $deferred); weaken($DEFERRED{$deferred} = $deferred_info); return $deferred; } sub CLONE { - %DEFERRED = map { defined $_ && $_->[3] ? ($_->[3] => $_) : () } values %DEFERRED; - foreach my $info (values %DEFERRED) { - weaken($info) - unless $info->[0] && ${$info->[2]}; - } + %DEFERRED = map { + defined $_ ? ( + $_->[4] ? ($_->[4] => $_) + : ($_->[3] && ${$_->[3]}) ? (${$_->[3]} => $_) + : () + ) : () + } values %DEFERRED; } 1; @@ -178,7 +199,7 @@ =head2 defer_sub - my $coderef = defer_sub $name => sub { ... }; + my $coderef = defer_sub $name => sub { ... }, \%options; This subroutine returns a coderef that encapsulates the provided sub - when it is first called, the provided sub is called and is -itself- expected to @@ -189,6 +210,24 @@ Exported by default. +=head3 Options + +A hashref of options can optionally be specified. + +=over 4 + +=item package + +The package to generate the sub in. Will be overridden by a fully qualified +C<$name> option. If not specified, will default to the caller's package. + +=item attributes + +The L<perlsub/Subroutine Attributes> to apply to the sub generated. Should be +specified as an array reference. + +=back + =head2 undefer_sub my $coderef = undefer_sub \&Foo::name; @@ -200,6 +239,19 @@ Exported by default. +=head2 defer_info + + my $data = defer_info $sub; + my ($name, $generator, $options, $undeferred_sub) = @$data; + +Returns original arguments to defer_sub, plus the undeferred version if this +sub has already been undeferred. + +Note that $sub can be either the original deferred version or the undeferred +version for convenience. + +Not exported by default. + =head2 undefer_all undefer_all(); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/lib/Sub/Quote.pm new/Sub-Quote-2.005000/lib/Sub/Quote.pm --- old/Sub-Quote-2.004000/lib/Sub/Quote.pm 2017-06-07 03:08:15.000000000 +0200 +++ new/Sub-Quote-2.005000/lib/Sub/Quote.pm 2018-02-06 19:05:54.000000000 +0100 @@ -12,10 +12,11 @@ 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}; } -our $VERSION = '2.004000'; +our $VERSION = '2.005000'; $VERSION = eval $VERSION; our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub qsub); @@ -28,7 +29,8 @@ no warnings 'numeric'; ! defined $value ? 'undef()' # numeric detection - : (length( (my $dummy = '') & $value ) + : (!(_HAVE_IS_UTF8 && utf8::is_utf8($value)) + && length( (my $dummy = '') & $value ) && 0 + $value eq $value && $value * 0 == 0 ) ? $value @@ -105,7 +107,7 @@ unless $subname =~ /^[^\d\W]\w*$/; } my @caller = caller(0); - my $attributes = $options->{attributes}; + my ($attributes, $file, $line) = @{$options}{qw(attributes file line)}; if ($attributes) { /\A\w+(?:\(.*\))?\z/s || croak "invalid attribute $_" for @$attributes; @@ -119,6 +121,8 @@ warning_bits => (exists $options->{warning_bits} ? $options->{warning_bits} : $caller[9]), hintshash => (exists $options->{hintshash} ? $options->{hintshash} : $caller[10]), ($attributes ? (attributes => $attributes) : ()), + ($file ? (file => $file) : ()), + ($line ? (line => $line) : ()), }; my $unquoted; weaken($quoted_info->{unquoted} = \$unquoted); @@ -150,8 +154,20 @@ sub _context { my $info = shift; $info->{context} ||= do { - my ($package, $hints, $warning_bits, $hintshash) - = @{$info}{qw(package hints warning_bits hintshash)}; + my ($package, $hints, $warning_bits, $hintshash, $file, $line) + = @{$info}{qw(package hints warning_bits hintshash file line)}; + + $line ||= 1 + if $file; + + my $line_mark = ''; + if ($line) { + $line_mark = "#line ".($line-1); + if ($file) { + $line_mark .= qq{ "$file"}; + } + $line_mark .= "\n"; + } $info->{context} ="# BEGIN quote_sub PRELUDE\n" @@ -165,6 +181,7 @@ keys %$hintshash) ." );\n" ."}\n" + .$line_mark ."# END quote_sub PRELUDE\n"; }; } @@ -244,10 +261,11 @@ } sub CLONE { - %QUOTED = map { defined $_ ? ( + my @quoted = map { defined $_ ? ( $_->{unquoted} && ${$_->{unquoted}} ? (${ $_->{unquoted} } => $_) : (), $_->{deferred} ? ($_->{deferred} => $_) : (), ) : () } values %QUOTED; + %QUOTED = @quoted; weaken($_) for values %QUOTED; } @@ -326,7 +344,40 @@ =item C<package> The package that the quoted sub will be evaluated in. If not specified, the -sub calling C<quote_sub> will be used. +package from sub calling C<quote_sub> will be used. + +=item C<hints> + +The value of L<< C<$^H> | perlvar/$^H >> to use for the code being evaluated. +This captures the settings of the L<strict> pragma. If not specified, the value +from the calling code will be used. + +=item C<warning_bits> + +The value of L<< C<${^WARNING_BITS}> | perlvar/${^WARNING_BITS} >> to use for +the code being evaluated. This captures the L<warnings> set. If not specified, +the warnings from the calling code will be used. + +=item C<%^H> + +The value of L<< C<%^H> | perlvar/%^H >> to use for the code being evaluated. +This captures additional pragma settings. If not specified, the value from the +calling code will be used if possible (on perl 5.10+). + +=item C<attributes> + +The L<perlsub/Subroutine Attributes> to apply to the sub generated. Should be +specified as an array reference. The attributes will be applied to both the +generated sub and the deferred wrapper, if one is used. + +=item C<file> + +The apparent filename to use for the code being evaluated. + +=item C<line> + +The apparent line number +to use for the code being evaluated. =back diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/t/lib/ThreadsCheck.pm new/Sub-Quote-2.005000/t/lib/ThreadsCheck.pm --- old/Sub-Quote-2.004000/t/lib/ThreadsCheck.pm 1970-01-01 01:00:00.000000000 +0100 +++ new/Sub-Quote-2.005000/t/lib/ThreadsCheck.pm 2017-11-23 14:00:41.000000000 +0100 @@ -0,0 +1,48 @@ +package ThreadsCheck; +use strict; +use warnings; +no warnings 'once'; + +sub _skip { + print "1..0 # SKIP $_[0]\n"; + exit 0; +} + +sub import { + my ($class, $op) = @_; + require Config; + if (! $Config::Config{useithreads}) { + _skip "your perl does not support ithreads"; + } + elsif (system "$^X", __FILE__, 'installed') { + _skip "threads.pm not installed"; + } + elsif (system "$^X", __FILE__, 'create') { + _skip "threads are broken on this machine"; + } +} + +if (!caller && @ARGV) { + my ($op) = @ARGV; + require POSIX; + if ($op eq 'installed') { + eval { require threads } or POSIX::_exit(1); + } + elsif ($op eq 'create') { + require threads; + require File::Spec; + open my $olderr, '>&', \*STDERR + or die "can't dup filehandle: $!"; + open STDERR, '>', File::Spec->devnull + or die "can't open null: $!"; + my $out = threads->create(sub { 1 })->join; + open STDERR, '>&', $olderr; + POSIX::_exit((defined $out && $out eq '1') ? 0 : 1); + } + else { + die "Invalid option $op!\n"; + } + POSIX::_exit(0); +} + +1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/t/sub-defer-threads.t new/Sub-Quote-2.005000/t/sub-defer-threads.t --- old/Sub-Quote-2.004000/t/sub-defer-threads.t 2016-12-08 01:09:29.000000000 +0100 +++ new/Sub-Quote-2.005000/t/sub-defer-threads.t 2017-11-23 14:00:41.000000000 +0100 @@ -1,14 +1,5 @@ -use Config; -BEGIN { - unless ($Config{useithreads}) { - print "1..0 # SKIP your perl does not support ithreads\n"; - exit 0; - } - if ("$]" <= 5.008_004) { - print "1..0 # SKIP threads not reliable enough on perl <= 5.8.4\n"; - exit 0; - } -} +use lib 't/lib'; +use ThreadsCheck; use threads; use strict; use warnings; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/t/sub-defer.t new/Sub-Quote-2.005000/t/sub-defer.t --- old/Sub-Quote-2.004000/t/sub-defer.t 2016-12-08 01:09:29.000000000 +0100 +++ new/Sub-Quote-2.005000/t/sub-defer.t 2018-02-06 19:02:54.000000000 +0100 @@ -2,7 +2,8 @@ use warnings; use Test::More; use Test::Fatal; -use Sub::Defer qw(defer_sub undefer_sub undefer_all undefer_package); +use Sub::Defer qw(defer_sub undefer_sub undefer_all undefer_package defer_info); +use Scalar::Util qw(refaddr weaken); my %made; @@ -101,7 +102,7 @@ my $foo_string = "$foo"; undef $foo; - is Sub::Defer::defer_info($foo_string), undef, + is defer_info($foo_string), undef, "deferred subs don't leak"; Sub::Defer->CLONE; @@ -115,20 +116,18 @@ Sub::Defer->CLONE; undef $foo; - is Sub::Defer::defer_info($foo_string), undef, + is defer_info($foo_string), undef, "CLONE doesn't strengthen refs"; } { my $foo = defer_sub undef, sub { sub { 'foo' } }; my $foo_string = "$foo"; - my $foo_info = Sub::Defer::defer_info($foo_string); + my $foo_info = defer_info($foo_string); undef $foo; is exception { Sub::Defer->CLONE }, undef, 'CLONE works when quoted info saved externally'; - ok exists $Sub::Defer::DEFERRED{$foo_string}, - 'CLONE keeps entries that had info saved externally'; } { @@ -159,4 +158,133 @@ is $foo, 'foo', 'attributes are applied to deferred subs'; } +{ + my $guff; + my $deferred = defer_sub "Foo::flub", sub { sub { $guff } }; + my $undeferred = undefer_sub($deferred); + my $undeferred_addr = refaddr($undeferred); + my $deferred_str = "$deferred"; + weaken($deferred); + + is $deferred, undef, + 'no strong external refs kept for deferred named subs'; + + is defer_info($deferred_str), undef, + 'defer_info on expired deferred named sub gives undef'; + + isnt refaddr(undefer_sub($deferred_str)), $undeferred_addr, + 'undefer_sub on expired deferred named sub does not give undeferred sub'; + + is refaddr(undefer_sub($undeferred)), $undeferred_addr, + 'undefer_sub on undeferred named sub after deferred expiry gives undeferred'; +} + +{ + my $guff; + my $deferred = defer_sub undef, sub { sub { $guff } }; + my $undeferred = undefer_sub($deferred); + my $undeferred_addr = refaddr($undeferred); + my $deferred_str = "$deferred"; + my $undeferred_str = "$undeferred"; + weaken($deferred); + + is $deferred, undef, + 'no strong external refs kept for deferred unnamed subs'; + + is defer_info($deferred_str), undef, + 'defer_info on expired deferred unnamed sub gives undef'; + + isnt refaddr(undefer_sub($deferred_str)), $undeferred_addr, + 'undefer_sub on expired deferred unnamed sub does not give undeferred sub'; + + is refaddr(undefer_sub($undeferred)), $undeferred_addr, + 'undefer_sub on undeferred unnamed sub after deferred expiry gives undeferred'; +} + +{ + my $guff; + my $deferred = defer_sub "Foo::gwarf", sub { sub { $guff } }; + my $undeferred = undefer_sub($deferred); + my $undeferred_addr = refaddr($undeferred); + my $deferred_str = "$deferred"; + my $undeferred_str = "$undeferred"; + delete $Foo::{gwarf}; + + weaken($deferred); + weaken($undeferred); + + is $undeferred, undef, + 'no strong external refs kept for undeferred named subs'; + + is defer_info($undeferred_str), undef, + 'defer_info on expired undeferred named sub gives undef'; + + isnt refaddr(undefer_sub($undeferred_str)), $undeferred_addr, + 'undefer_sub on expired undeferred named sub does not give undeferred sub'; +} + +{ + my $guff; + my $deferred = defer_sub undef, sub { sub { $guff } }; + my $undeferred = undefer_sub($deferred); + my $undeferred_addr = refaddr($undeferred); + my $deferred_str = "$deferred"; + my $undeferred_str = "$undeferred"; + + weaken($deferred); + weaken($undeferred); + + is $undeferred, undef, + 'no strong external refs kept for undeferred unnamed subs'; + + is defer_info($undeferred_str), undef, + 'defer_info on expired undeferred unnamed sub gives undef'; + + isnt refaddr(undefer_sub($undeferred_str)), $undeferred_addr, + 'undefer_sub on expired undeferred unnamed sub does not give undeferred sub'; +} + +{ + my $guff; + my $deferred = defer_sub undef, sub { sub { $guff } }; + my $undeferred = undefer_sub($deferred); + weaken($deferred); + + ok defer_info($undeferred), + 'defer_info still returns info for undeferred unnamed subs after deferred sub expires'; +} + +{ + my $guff; + my $deferred = defer_sub undef, sub { sub { $guff } }; + my $undeferred = undefer_sub($deferred); + weaken($deferred); + + Sub::Defer->CLONE; + + ok defer_info($undeferred), + 'defer_info still returns info for undeferred unnamed subs after deferred sub expires and CLONE'; +} + +{ + my $guff; + my $gen = sub { +sub :lvalue { $guff } }; + my $deferred = defer_sub 'Foo::blorp', $gen, + { attributes => [ 'lvalue' ] }; + + is_deeply defer_info($deferred), + [ 'Foo::blorp', $gen, { attributes => [ 'lvalue' ] } ], + 'defer_info gives name, generator, options before undefer'; + + my $undeferred = undefer_sub $deferred; + + is_deeply defer_info($deferred), + [ 'Foo::blorp', $gen, { attributes => [ 'lvalue' ] }, $undeferred ], + 'defer_info on deferred gives name, generator, options after undefer'; + + is_deeply defer_info($undeferred), + [ 'Foo::blorp', $gen, { attributes => [ 'lvalue' ] }, $undeferred ], + 'defer_info on undeferred gives name, generator, options after undefer'; +} + done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/t/sub-quote-threads.t new/Sub-Quote-2.005000/t/sub-quote-threads.t --- old/Sub-Quote-2.004000/t/sub-quote-threads.t 2016-12-08 01:09:29.000000000 +0100 +++ new/Sub-Quote-2.005000/t/sub-quote-threads.t 2017-11-23 14:00:41.000000000 +0100 @@ -1,14 +1,5 @@ -use Config; -BEGIN { - unless ($Config{useithreads}) { - print "1..0 # SKIP your perl does not support ithreads\n"; - exit 0; - } - if ("$]" <= 5.008_004) { - print "1..0 # SKIP threads not reliable enough on perl <= 5.8.4\n"; - exit 0; - } -} +use lib 't/lib'; +use ThreadsCheck; use threads; use strict; use warnings; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Sub-Quote-2.004000/t/sub-quote.t new/Sub-Quote-2.005000/t/sub-quote.t --- old/Sub-Quote-2.004000/t/sub-quote.t 2017-06-07 03:05:39.000000000 +0200 +++ new/Sub-Quote-2.005000/t/sub-quote.t 2017-11-23 14:00:41.000000000 +0100 @@ -247,4 +247,9 @@ 'attributes applied to quoted sub with no_defer'; } +{ + my $sub = quote_sub q{ sub { join " line ", (caller(0))[1,2] }->() }, {}, { file => "welp.pl", line => 42 }; + is $sub->(), "welp.pl line 42", "file and line provided"; +} + done_testing;
