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 my ($line1, $line2);
  47 #line 1
  48 method yay { $line1 = __LINE__; "YAY $self" } $line2 = __LINE__;
  49 is(__LINE__, 2, 'line number correct after first keyword');
  50
  51 is(__PACKAGE__->yay, 'YAY ' . __PACKAGE__, 'result of keyword correct');
  52 is($line1, 1, 'line number correct in keyword');
  53 is($line2, 1, 'line number correct on same line as keyword');
  54
  55 #line 1
  56 my $x = __LINE__ . " @{[ __LINE__ ]} method foo @{[ __LINE__ ]} " . __LINE__;
  57 is(__LINE__, 2, 'line number correct after string with keyword');
  58 is($x, '1 1 method foo 1 bar baz 1', 'line numbers in constructed string are correct');
  59
  60 undef $line1;
  61 undef $line2;
  62 #line 1
  63 method spoon {
  64   $line1 = __LINE__;
  65   'I HAZ A SPOON'
  66 }
  67
  68 is(__PACKAGE__->spoon, 'I HAZ A SPOON', 'result of multiline keyword');
  69 is($line1, 2, 'line number correct in multiline keyword');
  70
  71 #line 1
  72 method spoon2 {
  73   $line2 = __LINE__;
  74   'I HAZ A SPOON'
  75 }
  76
  77 is(__PACKAGE__->spoon2, 'I HAZ A SPOON', 'result of second multiline keyword correct');
  78 is($line2, 2, 'line number correct in second multiline keyword');
  79
  80 undef $line1;
  81 undef $line2;
  82 #line 1
  83 shadowed fun { $line1 = __LINE__; 'OH WHAT FUN' }
  84 is($line1, 1, 'line number correct inside second keyword');
  85
  86 shadowed fun { $line2 = __LINE__; 'OH WHAT FUN' }
  87 is($line1, 4, 'line number correct inside second keyword repeat');
  88
  89 undef $line1;
  90 undef $line2;
  91 #line 1
  92 shadowed fun {
  93   $line1 = __LINE__;
  94   'OH WHAT FUN';
  95 }
  96 is($line1, 2, 'line number correct inside second keyword multiline');
  97
  98 shadowed fun {
  99   $line2 = __LINE__;
 100   'OH WHAT FUN';
 101 };
 102 is($line2, 8, 'line number correct inside second keyword multiline');
 103
 104 is($shadowed_called, 4, 'shadowed sub called only by filter output');
 105
 106 is(__LINE__, 15, 'line number after shadowed correct');
 107
 108 done_testing;