view release on metacpan or  search on metacpan

t/hints.t  view on Meta::CPAN

  {
    local $TODO = 'hints hash from context not available on perl 5.8'
      if "$]" < 5.010_000;

    use ClearHintsHash;
    use UseHintHash;
    is_deeply quote_sub(q{
      our %temp_hints_hash;
      BEGIN { %temp_hints_hash = %^H }
      \%temp_hints_hash;
    })->(), \%hints,
      'hints hash preserved from context';
  }

  is_deeply quote_sub(q{
    our %temp_hints_hash;
    BEGIN { %temp_hints_hash = %^H }
    \%temp_hints_hash;
  }, {}, { hintshash => \%hints })->(), \%hints,
    'hints hash used from options';
}

{
  use ClearHintsHash;
  my $sub = quote_sub(q{
    our %temp_hints_hash;
    BEGIN { %temp_hints_hash = %^H }
    \%temp_hints_hash;
  });
  my $wrap_sub = do {
    use UseHintHash;
    my (undef, $code, $cap) = @{quoted_from_sub($sub)};
    quote_sub $code, $cap||();
  };
  is_deeply $wrap_sub->(), { ClearHintsHash::hints },
    'empty hints maintained when inlined';
}

BEGIN {
  package BetterNumbers;
  $INC{'BetterNumbers.pm'} = 1;
  use overload ();

  sub import {
    my ($class, $add) = @_;
    # closure vs not
    if (defined $add) {
      overload::constant 'integer', sub { $_[0] + $add };
    }
    else {
      overload::constant 'integer', sub { $_[0] + 1 };
    }
  }
}

TODO: {
  my ($options, $context_sub, $direct_val);
  {
    use BetterNumbers;
    BEGIN { $options = { hints => $^H, hintshash => { %^H } } }
    $direct_val = 10;
    $context_sub = quote_sub(q{ 10 });
  }
  my $options_sub = quote_sub(q{ 10 }, {}, $options);

  is $direct_val, 11,
    'integer overload is working';

  todo_skip "refs in hints hash not yet implemented", 4;
  {
    my $context_val;
    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;
    is $context_val, 11,
      'hints hash refs preserved from context';
  }

  {
    my $options_val;
    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';
  }
}

TODO: {
  my ($options, $context_sub, $direct_val);
  {
    use BetterNumbers +2;
    BEGIN { $options = { hints => $^H, hintshash => { %^H } } }
    $direct_val = 10;
    $context_sub = quote_sub(q{ 10 });
  }
  my $options_sub = quote_sub(q{ 10 }, {}, $options);

  is $direct_val, 12,
    'closure integer overload is working';

  todo_skip "refs in hints hash not yet implemented", 4;

  {
    my $context_val;
    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;
    is $context_val, 12,
      'hints hash closure refs preserved from context';
  }

  {
    my $options_val;
    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';
  }
}

done_testing;