6 use Scalar::Util 'refaddr';
7 use Storable 'nfreeze';
9 use SQL::Abstract qw(is_plain_value is_literal_value);
16 # *DELIBERATELY* unspecified
18 '0+' => sub { ${$_[0]} },
22 SQLATest::SillyInt::Subclass;
24 our @ISA = 'SQLATest::SillyInt';
36 SQLATest::SillierInt::Subclass;
39 '0+' => sub { ${$_[0]} },
40 '+' => sub { ${$_[0]} + $_[1] },
43 our @ISA = 'SQLATest::SillierInt';
46 # make sure we recognize overloaded stuff properly
48 my $num = bless( \do { my $foo = 69 }, 'SQLATest::SillyInt::Subclass' );
49 ok( is_plain_value $num, 'parent-fallback-provided stringification detected' );
50 is("$num", 69, 'test overloaded object stringifies, without specified fallback');
51 } 'overload testing lives';
54 my $nummifiable_maybefallback_num = bless( \do { my $foo = 42 }, 'SQLATest::SillierInt::Subclass' );
56 ok( ( $nummifiable_maybefallback_num + 1) == 43 )
59 my $is_pv_res = is_plain_value $nummifiable_maybefallback_num;
61 # this perl can recognize inherited fallback
62 if ( !! eval { "$nummifiable_maybefallback_num" } ) {
63 # we may *not* be able to compare, due to ""-derived-eq fallbacks missing,
64 # but we can always compare the ice
66 ( nfreeze( $is_pv_res ) eq nfreeze( [ $nummifiable_maybefallback_num ] ) ),
67 'parent-disabled-fallback stringification matches that of perl'
71 refaddr($is_pv_res->[0]),
72 refaddr $nummifiable_maybefallback_num,
73 "Same reference (blessed object) returned",
77 is $is_pv_res, undef, 'parent-disabled-fallback stringification matches that of perl';
82 is_plain_value { -value => [] },
91 'nonvalues correctly recognized'
95 for (undef, { -value => undef }) {
99 'NULL -value recognized'
104 is_literal_value { -ident => 'foo' },
106 '-ident recognized as literal'
110 is_literal_value \[ 'sql', 'bind1', [ {} => 'bind2' ] ],
111 [ 'sql', 'bind1', [ {} => 'bind2' ] ],
112 'literal correctly unpacked'
116 for ([], {}, \'', undef) {
118 is_literal_value { -ident => $_ },
120 'illegal -ident does not trip up detection'