t/simple.t

   1 use strictures 1;
   2 use Test::More;
   3 use Filter::Keyword;
   4
   5 my $shadowed_called = 0;
   6 sub shadowed ($&) {
   7   my ($name, $sub) = @_;
   8   $shadowed_called++;
   9   is($name, 'fun', 'shadowed sub called with correct name');
  10   is($sub->(), 'OH WHAT FUN', 'shadowed sub called with correct sub');
  11 }
  12
  13 BEGIN {
  14   (our $Kw = Filter::Keyword->new(
  15     target_package => __PACKAGE__,
  16     keyword_name => 'method',
  17     parser => sub {
  18       my $kw = shift;
  19       if (my ($stripped, $matches) = $kw->match_source('', '{')) {
  20         my $name = $kw->current_match;
  21         $stripped =~ s/{/sub ${name} { my \$self = shift;/;
  22         return ($stripped, 1);
  23       }
  24       else {
  25         return ('', 1);
  26       }
  27     },
  28   ))->install;
  29   (our $Kw2 = Filter::Keyword->new(
  30     target_package => __PACKAGE__,
  31     keyword_name => 'shadowed',
  32     parser => sub {
  33       my $kw = shift;
  34       if (my ($stripped, $matches) = $kw->match_source('', '{')) {
  35         my $name = $kw->current_match;
  36         $stripped =~ s/{/shadowed "${name}", sub { BEGIN { Filter::Keyword::inject_after_scope(';') } /;
  37         return ($stripped, 1);
  38       }
  39       else {
  40         return ('', 1);
  41       }
  42     },
  43   ))->install;
  44 }
  45
  46 #line 1
  47 method yay { is(__LINE__, 1, 'line number correct inside keyword' ); "YAY $self" } is(__LINE__, 1, 'line number correct on same line after keyword');
  48 is(__LINE__, 2, 'line number correct after first keyword');
  49
  50 #line 1
  51 my $x = __LINE__ . " @{[ __LINE__ ]} method foo @{[ __LINE__ ]} bar baz " . __LINE__;
  52 is(__LINE__, 2, 'line number correct after string with keyword');
  53 is($x, '1 1 method foo 1 bar baz 1', 'line numbers in constructed string are correct');
  54
  55 is(__PACKAGE__->yay, 'YAY ' . __PACKAGE__, 'result of keyword correct');
  56
  57 #line 1
  58 method spoon {
  59   is(__LINE__, 2, 'line number correct in multiline keyword');
  60   'I HAZ A SPOON'
  61 }
  62
  63 is(__PACKAGE__->spoon, 'I HAZ A SPOON', 'result of second method correct');
  64
  65 #line 1
  66 shadowed fun { is(__LINE__, 1, 'line number correct inside second keyword'); 'OH WHAT FUN' }
  67
  68 is($shadowed_called, 1, 'shadowed sub called only by filter output');
  69
  70 is(__LINE__, 5, 'line number after shadowed correct');
  71
  72 done_testing;