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 "surprising len=undef" if !defined($len);
  18   die "surprising len=$len" if $len <= 0;
  19   $content =~ s/(.)/sprintf("\\x{%x}", ord($1))/seg;
  20   substr $linestr, $offset, $len, "(\"$content\")";
  21   Devel::Declare::set_linestr($linestr);
  22 }
  23
  24 BEGIN {
  25   Devel::Declare->setup_for(__PACKAGE__, {
  26     my_quote => { const => \&my_quote_parser },
  27   });
  28 }
  29
  30 my $x;
  31
  32 $x = my_quote[foo];
  33 is $x, "foo";
  34
  35 $x = my_quote[foo
  36 ];
  37 is $x, "foo\n";
  38
  39 $x = my_quote[foo
  40 x];
  41 is $x, "foo\nx";
  42
  43 $x = my_quote[foo
  44 xy];
  45 is $x, "foo\nxy";
  46
  47 $x = my_quote[foo
  48 xyz];
  49 is $x, "foo\nxyz";
  50
  51 $x = my_quote[foo
  52 bar baz quux];
  53 is $x, "foo\nbar baz quux";
  54
  55 $x = my_quote[foo
  56 bar baz quuux];
  57 is $x, "foo\nbar baz quuux";
  58
  59 $x = my_quote[foo
  60 bar baz quuuux];
  61 is $x, "foo\nbar baz quuuux";
  62
  63 $x = my_quote[foo
  64 bar baz quux wibble];
  65 is $x, "foo\nbar baz quux wibble";
  66
  67 $x = my_quote[foo
  68 quux
  69 womble];
  70 is $x, "foo\nquux\nwomble";
  71
  72 1;