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 - co...@suse.com
+
+- 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) <m...@shadowcat.co.uk>"
+      "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) <m...@shadowcat.co.uk>'
+  - 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;


Reply via email to