t/perl.t

   1 use strictures 1;
   2 use Test::More qw(no_plan);
   3
   4 use Devel::Dwarn;
   5 use Data::Query::Renderer::Perl;
   6 use Data::Query::ExprHelpers qw(perl_scalar_value);
   7 use Data::Query::ExprDeclare;
   8 use Scalar::Util qw(blessed);
   9
  10 my $rend = Data::Query::Renderer::Perl->new;
  11
  12 sub binding { map perl_scalar_value($_), @_ }
  13
  14 sub expr_perl_is (&;@) {
  15   my $sub = shift;
  16   my $e = Data::Query::ExprDeclare::_run_expr($sub);
  17   $e = blessed($e) ? $e->{expr} : $e;
  18   @_
  19     ? is_deeply($rend->render($e), @_)
  20     : ::Dwarn($rend->render($e));
  21 }
  22
  23 expr_perl_is { $_->foo }
  24   [ '$_->foo' ],
  25   'Simple identifier -> Perl';
  26
  27 expr_perl_is { $_->foo->group }
  28   [ '$_->foo->group' ],
  29   'Complex identifier -> Perl';
  30
  31 expr_perl_is { $_->foo == 1 }
  32   [ "( \$_->foo == +shift )", binding(1) ],
  33   "Simple expression -> Perl";
  34
  35 expr_perl_is { ($_->foo == 1) & ($_->bar eq "foo") }
  36   [
  37     "( ( \$_->foo == +shift ) and ( \$_->bar eq +shift ) )",
  38     binding(1, "foo")
  39   ],
  40   "Compound expression -> Perl";
  41
  42 # Skipping flattening test for now
  43
  44 expr_perl_is { !$_->foo }
  45   [ '!( $_->foo )' ],
  46   "Unary expression ok";