The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
########################################
# this set (20, 21) tests overloaded 'numify' operations, ie, numeric comparisons
#   double quotes, and string comparison ops (cmp, eq, etc)
# scheme is to create a root object pointing to test objects: 
#   2 for each binary op.
#   compare the pairs. check result and make sure not thawed
########################################
use t::lib;
use strict;
use Carp;
use Test::More;
use Test::Deep;
use autodbTestObject;

use Class::AutoDB;
use putgetUtil; use Mechanics;

my($get_type)=@ARGV;
# NG 10-09-17: added bool
my @object_names=qw(root cmp cmp lt lt le le eq eq ge ge gt gt ne ne);
my $num_objects=scalar @object_names;
defined $get_type or $get_type='get';

my $autodb=new Class::AutoDB(database=>'test');  # open database
isa_ok($autodb,'Class::AutoDB','class is Class::AutoDB - sanity check');

# make the objects
my @correct_objects=
  map {new Mechanics (name=>$_,id=>id_next(),
		      num_objects=>$num_objects,list_count=>0)} @object_names;
# connect 'em up. root points to rest
map {$_->object_list(\@correct_objects)} @correct_objects;

# %test_args, exported by putgetUtil, sets class2colls, coll2keys, label
my $test=new autodbTestObject(%test_args,labelprefix=>"$get_type:",get_type=>$get_type);
my $label="$get_type:";
# get root and use it to obtain list of remaining object (but don't 'get' them!)
my($root)=$test->do_get({collection=>'Mechanics',name=>'root'},$get_type,1);
my @actual_objects=@{$root->object_list};
my @test_objects=@actual_objects[1..$num_objects-1];
# face validity. correct number of objects
is(scalar(@actual_objects),scalar(@correct_objects),
   "$label ".(scalar(@correct_objects)).' objects - sanity test');

# confirm that test objects present as Oids
my $ok=1;
map {$ok&&=ok_objcache($_,'Oid','Mechanics',"$label object starts as Oid",
		       __FILE__,__LINE__,'no_report_pass')} @test_objects;
report_pass($ok,"$label objects start as Oids - sanity test");

# CAUTION: @correct_thawed in 'thaw' tests refers to actual objects
my @correct_thawed=($root);
cmp_thawed(\@actual_objects,\@correct_thawed,"$label thawed root");

# main tests
for my $op (qw(<=> < <= == >= > !=)) {
  my($object0,$object1)=splice(@test_objects,0,2);
  eval "\$object0 $op \$object1"; # should not thaw
  my $ok=ok_objcache($object0,'Oid','Mechanics',"$label object0 not thawed",
		     __FILE__,__LINE__,'no_report_pass');
  $ok&&=ok_objcache($object1,'Oid','Mechanics',"$label object1 not thawed",
		    __FILE__,__LINE__,'no_report_pass');
  report_pass($ok,"$label not thawed $op");
}
done_testing();