t/58-yield-misc.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 4 * 3;
   7
   8 use lib 't/lib';
   9 use VPIT::TestHelpers;
  10
  11 use Scope::Upper qw<yield HERE>;
  12
  13 # Test timely destruction of values returned from yield()
  14
  15 our $destroyed;
  16 sub guard { VPIT::TestHelpers::Guard->new(sub { ++$destroyed }) }
  17
  18 {
  19  my $desc = 'scalar context, above';
  20  local $destroyed;
  21  {
  22   my $obj = guard();
  23   my $res = do {
  24    is $destroyed, undef, "$desc: not yet destroyed 1";
  25    yield $obj => HERE;
  26    fail 'not reached 1';
  27   };
  28   is $destroyed, undef, "$desc: not yet destroyed 2";
  29  }
  30  is $destroyed, 1, "$desc: destroyed 1";
  31 }
  32
  33 {
  34  my $desc = 'scalar context, below';
  35  local $destroyed;
  36  {
  37   my $res = do {
  38    my $obj = guard();
  39    is $destroyed, undef, "$desc: not yet destroyed 1";
  40    yield $obj => HERE;
  41    fail 'not reached 1';
  42   };
  43   is $destroyed, undef, "$desc: not yet destroyed 2";
  44  }
  45  is $destroyed, 1, "$desc: destroyed 1";
  46 }
  47
  48 {
  49  my $desc = 'void context, above';
  50  local $destroyed;
  51  {
  52   my $obj = guard();
  53   {
  54    is $destroyed, undef, "$desc: not yet destroyed 1";
  55    yield $obj => HERE;
  56    fail 'not reached 1';
  57   }
  58   is $destroyed, undef, "$desc: not yet destroyed 2";
  59  }
  60  is $destroyed, 1, "$desc: destroyed 1";
  61 }
  62
  63 {
  64  my $desc = 'void context, below';
  65  local $destroyed;
  66  {
  67   {
  68    is $destroyed, undef, "$desc: not yet destroyed 1";
  69    my $obj = guard();
  70    yield $obj => HERE;
  71    fail 'not reached 2';
  72   }
  73   is $destroyed, 1, "$desc: destroyed 1";
  74  }
  75  is $destroyed, 1, "$desc: destroyed 2";
  76 }