t/23_is_X_value.t

   1 use warnings;
   2 use strict;
   3
   4 use Test::More;
   5 use Test::Exception;
   6
   7 use SQL::Abstract qw(is_plain_value is_literal_value);
   8
   9 {
  10   package # hideee
  11     SQLATest::SillyInt;
  12
  13   use overload
  14     # *DELIBERATELY* unspecified
  15     #fallback => 1,
  16     '0+' => sub { ${$_[0]} },
  17   ;
  18
  19   package # hideee
  20     SQLATest::SillyInt::Subclass;
  21
  22   our @ISA = 'SQLATest::SillyInt';
  23 }
  24
  25 {
  26   package # hideee
  27     SQLATest::SillierInt;
  28
  29   use overload
  30     fallback => 0,
  31   ;
  32
  33   package # hideee
  34     SQLATest::SillierInt::Subclass;
  35
  36   use overload
  37     '0+' => sub { ${$_[0]} },
  38     '+' => sub { ${$_[0]} + $_[1] },
  39   ;
  40
  41   our @ISA = 'SQLATest::SillierInt';
  42 }
  43
  44 # make sure we recognize overloaded stuff properly
  45 lives_ok {
  46   my $num = bless( \do { my $foo = 69 }, 'SQLATest::SillyInt::Subclass' );
  47   ok( is_plain_value $num, 'parent-fallback-provided stringification detected' );
  48   is("$num", 69, 'test overloaded object stringifies, without specified fallback');
  49 } 'overload testing lives';
  50
  51 {
  52   my $nummifiable_maybefallback_num = bless( \do { my $foo = 42 }, 'SQLATest::SillierInt::Subclass' );
  53   lives_ok {
  54     ok( ( $nummifiable_maybefallback_num + 1) == 43 )
  55   };
  56
  57   my $can_str = !! eval { "$nummifiable_maybefallback_num" };
  58
  59   lives_ok {
  60     is_deeply(
  61       is_plain_value $nummifiable_maybefallback_num,
  62       ( $can_str ? [ 42 ] : undef ),
  63       'parent-disabled-fallback stringification detected same as perl',
  64     );
  65   };
  66 }
  67
  68 is_deeply
  69   is_plain_value {  -value => [] },
  70   [ [] ],
  71   '-value recognized'
  72 ;
  73
  74 for ([], {}, \'') {
  75   is
  76     is_plain_value $_,
  77     undef,
  78     'nonvalues correctly recognized'
  79   ;
  80 }
  81
  82 for (undef, { -value => undef }) {
  83   is_deeply
  84     is_plain_value $_,
  85     [ undef ],
  86     'NULL -value recognized'
  87   ;
  88 }
  89
  90 is_deeply
  91   is_literal_value { -ident => 'foo' },
  92   [ 'foo' ],
  93   '-ident recognized as literal'
  94 ;
  95
  96 is_deeply
  97   is_literal_value \[ 'sql', 'bind1', [ {} => 'bind2' ] ],
  98   [ 'sql', 'bind1', [ {} => 'bind2' ] ],
  99   'literal correctly unpacked'
 100 ;
 101
 102
 103 for ([], {}, \'', undef) {
 104   is
 105     is_literal_value { -ident => $_ },
 106     undef,
 107     'illegal -ident does not trip up detection'
 108   ;
 109 }
 110
 111 done_testing;