The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Regression test: get values of wrong type stored by previous test
use t::lib;
use strict;
use Carp;
use Test::More;
use Test::Deep;
use Class::AutoDB;
use autodbUtil;

use autodb_118;

my $autodb=new Class::AutoDB(database=>'test'); # open database
isa_ok($autodb,'Class::AutoDB','class is Class::AutoDB - sanity check');
my($p)=$autodb->get(collection=>'HasName');
is($p->name,'persistent','persistent object');

# regression test starts here
# make and store some objects
my $r={};			# any ref will do
# my $p=new Persistent(name=>'persistent',id=>id_next());
id_next();			# bump id since we're not making $p
my $np=new NonPersistent(name=>'nonpersistent',id=>id_next());
my @objects=
  (new Test(name=>"test_wrong string values",id=>id_next(),
	    iwrong=>'string', iwrong_list=>[qw(string string string)],
	    swrong=>'string', swrong_list=>[qw(string string string)],
	    fwrong=>'string', fwrong_list=>[qw(string string string)],
	    owrong=>'string', owrong_list=>[qw(string string string)],),
   new Test(name=>"test_wrong integer values",id=>id_next(),
	    iwrong=>123, iwrong_list=>[qw(123 123 123)],
	    swrong=>123, swrong_list=>[qw(123 123 123)],
	    fwrong=>123, fwrong_list=>[qw(123 123 123)],
	    owrong=>123, owrong_list=>[qw(123 123 123)],),
   new Test(name=>"test_wrong float values",id=>id_next(),
	    iwrong=>123.456, iwrong_list=>[qw(123.456 123.456 123.456)],
	    swrong=>123.456, swrong_list=>[qw(123.456 123.456 123.456)],
	    fwrong=>123.456, fwrong_list=>[qw(123.456 123.456 123.456)],
	    owrong=>123.456, owrong_list=>[qw(123.456 123.456 123.456)],),
   new Test(name=>"test_wrong ref values",id=>id_next(),
	    iwrong=>$r, iwrong_list=>[$r,$r,$r],
	    swrong=>$r, swrong_list=>[$r,$r,$r],
	    fwrong=>$r, fwrong_list=>[$r,$r,$r],
	    owrong=>$r, owrong_list=>[$r,$r,$r],),
   new Test(name=>"test_wrong persistent object values",id=>id_next(),
	    iwrong=>$p, iwrong_list=>[$p,$p,$p],
	    swrong=>$p, swrong_list=>[$p,$p,$p],
	    fwrong=>$p, fwrong_list=>[$p,$p,$p],
	    owrong=>$p, owrong_list=>[$p,$p,$p],),
  new Test(name=>"test_wrong nonpersistent object values",id=>id_next(),
	    iwrong=>$np, iwrong_list=>[$np,$np,$np],
	    swrong=>$np, swrong_list=>[$np,$np,$np],
	    fwrong=>$np, fwrong_list=>[$np,$np,$np],
	    owrong=>$np, owrong_list=>[$np,$np,$np],),
  );

my @basekeys=qw(iwrong swrong fwrong owrong);
# my @baseops=qw(= LIKE = =);
my @baseops=qw(= = = =);
my $p_oid=$p->oid;

for my $case (qw(string integer float ref),'persistent object','nonpersistent object') {
  test($case);
}
done_testing();

sub test {
  my($case)=@_;
  my $name="test_wrong $case values";
  my @basevals;			# must be in basekeys order
  if ($case eq 'string') {
    @basevals=(0,'string',0,undef);
  } elsif ($case eq 'integer') {
    @basevals=(123,123,123,undef);
  } elsif ($case eq 'float') {
    @basevals=(123,123.456,123.456,undef);
  } elsif ($case eq 'ref') {
    @basevals=(0,$r,0,undef);
  } elsif ($case eq 'persistent object') {
    @basevals=(0,$p,0,$p);
  } elsif ($case eq 'nonpersistent object') {
    @basevals=(0,$np,0,undef);
  }

  # test using AutoDB
  my @query=(name=>$name,map {$basekeys[$_]=>$basevals[$_]} (0..$#basekeys));
#   my $actual_count=$autodb->count(collection=>'Test',@query);
#   is($actual_count,1,"count via AutoDB: $case base");
  for(my $i=0; $i<@basekeys; $i++) {
    my $basekey=$basekeys[$i];
    my $listkey=$basekey.'_list';
    push(@query,$listkey=>$basevals[$i]);
  }
  my %query=@query;
  # string keys have unusable values in ref cases since they are stringifed refs from 'put' test
  delete $query{swrong} if $query{swrong}=~/HASH/;
  delete $query{swrong_list} if $query{swrong_list}=~/HASH/;
  my $actual_count=$autodb->count(collection=>'Test',%query);
  is($actual_count,1,"count via AutoDB: $case");
  my($actual_object)=$autodb->get(collection=>'Test',%query);
  my($correct_object)=grep {$_->name eq $name} @objects;
  cmp_deeply($actual_object,$correct_object,"contents via AutoDB: $case");
}