t/scanstr.t

   1 use warnings;
   2 use strict;
   3
   4 use Devel::Declare ();
   5 use Test::More tests => 10;
   6
   7 sub my_quote($) { $_[0] }
   8
   9 sub my_quote_parser {
  10   my($declarator, $offset) = @_;
  11   $offset += Devel::Declare::toke_move_past_token($offset);
  12   $offset += Devel::Declare::toke_skipspace($offset);
  13   my $len = Devel::Declare::toke_scan_str($offset);
  14   my $content = Devel::Declare::get_lex_stuff();
  15   Devel::Declare::clear_lex_stuff();
  16   my $linestr = Devel::Declare::get_linestr();
  17   die "suprising len=$len" if $len <= 0;
  18   $content =~ s/(.)/sprintf("\\x{%x}", ord($1))/seg;
  19   substr $linestr, $offset, $len, "(\"$content\")";
  20   Devel::Declare::set_linestr($linestr);
  21 }
  22
  23 BEGIN {
  24   Devel::Declare->setup_for(__PACKAGE__, {
  25     my_quote => { const => \&my_quote_parser },
  26   });
  27 }
  28
  29 my $x;
  30
  31 $x = my_quote[foo];
  32 is $x, "foo";
  33
  34 $x = my_quote[foo
  35 ];
  36 is $x, "foo\n";
  37
  38 $x = my_quote[foo
  39 x];
  40 is $x, "foo\nx";
  41
  42 $x = my_quote[foo
  43 xy];
  44 is $x, "foo\nxy";
  45
  46 $x = my_quote[foo
  47 xyz];
  48 is $x, "foo\nxyz";
  49
  50 $x = my_quote[foo
  51 bar baz quux];
  52 is $x, "foo\nbar baz quux";
  53
  54 $x = my_quote[foo
  55 bar baz quuux];
  56 is $x, "foo\nbar baz quuux";
  57
  58 $x = my_quote[foo
  59 bar baz quuuux];
  60 is $x, "foo\nbar baz quuuux";
  61
  62 $x = my_quote[foo
  63 bar baz quux wibble];
  64 is $x, "foo\nbar baz quux wibble";
  65
  66 $x = my_quote[foo
  67 quux
  68 womble];
  69 is $x, "foo\nquux\nwomble";
  70
  71 1;