t/statement.t

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