t/statement.t

   1 use Devel::Declare ();
   2 use Test::More;
   3
   4 {
   5   package FoomHandlers;
   6
   7   use strict;
   8   use warnings;
   9   use B::Hooks::EndOfScope;
  10
  11   our ($Declarator, $Offset);
  12
  13   sub skip_declarator {
  14     $Offset += Devel::Declare::toke_move_past_token($Offset);
  15   }
  16
  17   sub skipspace {
  18     $Offset += Devel::Declare::toke_skipspace($Offset);
  19   }
  20
  21   sub strip_name {
  22     skipspace;
  23     if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) {
  24       my $linestr = Devel::Declare::get_linestr();
  25       my $name = substr($linestr, $Offset, $len);
  26       substr($linestr, $Offset, $len) = '';
  27       Devel::Declare::set_linestr($linestr);
  28       return $name;
  29     }
  30     return;
  31   }
  32
  33   sub strip_proto {
  34     skipspace;
  35
  36     my $linestr = Devel::Declare::get_linestr();
  37     if (substr($linestr, $Offset, 1) eq '(') {
  38       my $length = Devel::Declare::toke_scan_str($Offset);
  39       my $proto = Devel::Declare::get_lex_stuff();
  40       Devel::Declare::clear_lex_stuff();
  41       $linestr = Devel::Declare::get_linestr();
  42       substr($linestr, $Offset, $length) = '';
  43       Devel::Declare::set_linestr($linestr);
  44       return $proto;
  45     }
  46     return;
  47   }
  48
  49   sub shadow {
  50     my $pack = Devel::Declare::get_curstash_name;
  51     Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]);
  52   }
  53
  54   sub inject_str {
  55     my $linestr = Devel::Declare::get_linestr;
  56     substr($linestr, $Offset, 0) = $_[0];
  57     Devel::Declare::set_linestr($linestr);
  58   }
  59
  60   sub strip_str {
  61     my $linestr = Devel::Declare::get_linestr;
  62     if (substr($linestr, $Offset, length($_[0])) eq $_[0]) {
  63       substr($linestr, $Offset, length($_[0])) = '';
  64       Devel::Declare::set_linestr($linestr);
  65       return 1;
  66     }
  67     return 0;
  68   }
  69
  70   sub const {
  71     local ($Declarator, $Offset) = @_;
  72     skip_declarator;
  73     skipspace;
  74     my $linestr = Devel::Declare::get_linestr;
  75     if (substr($linestr, $Offset, 1) eq '{') {
  76       substr($linestr, $Offset+1, 0) = ' BEGIN { FoomHandlers::inject_scope }; ';
  77       Devel::Declare::set_linestr($linestr);
  78     }
  79     shadow(sub (&) { "foom?" });
  80   }
  81
  82   sub inject_scope {
  83     on_scope_end {
  84       my $linestr = Devel::Declare::get_linestr;
  85       my $offset = Devel::Declare::get_linestr_offset;
  86       substr($linestr, $offset, 0) = ';';
  87       Devel::Declare::set_linestr($linestr);
  88     };
  89   }
  90
  91   package Foo;
  92
  93   use strict;
  94   use warnings;
  95
  96   sub foom (&) { }
  97
  98   BEGIN {
  99     Devel::Declare->setup_for(
 100       __PACKAGE__,
 101       { foom => {
 102           const => \&FoomHandlers::const,
 103       } }
 104     );
 105   }
 106
 107   foom {
 108     1;
 109   }
 110
 111   ::ok(1, 'Compiled as statement ok');
 112 }
 113
 114 done_testing;