view release on metacpan or  search on metacpan

t/autodbUtil.pm  view on Meta::CPAN

# $correct_thawed. subset of $actual_objects expected to be thawed
sub cmp_thawed {
  my($actual_objects,$correct_thawed,$label)=@_;
 my($package,$file,$line)=caller; # for fails
  my $ok=_cmp_thawed($actual_objects,$correct_thawed,$label,$file,$line);
  report_pass($ok,$label);
}
sub _cmp_thawed {
  my($actual_objects,$correct_thawed,$label,$file,$line)=@_;
  my @actual_thawed=grep {'Class::AutoDB::Oid' ne ref $_} @$actual_objects;
  # unthawed objects are fragile and esily thawed. do the cmp this way to avoid thawing
  my @actual_refs=
    uniq map {ref($_).'='.Scalar::Util::reftype($_).sprintf('(%0x)',Scalar::Util::refaddr($_))}
      @actual_thawed;
  my @correct_refs=
    uniq map {ref($_).'='.Scalar::Util::reftype($_).sprintf('(%0x)',Scalar::Util::refaddr($_))}
      @$correct_thawed;
  @actual_refs=sort @actual_refs;
  @correct_refs=sort @correct_refs;
  
  my($ok,$details)=cmp_details(\@actual_refs,\@correct_refs);