Class-AutoDB

 view release on metacpan or  search on metacpan

t/autodb.020.graph/graph.010.01.thaw_nodes.t  view on Meta::CPAN

    my $ename=$edge->name;		# force thaw
    push(@correct_thawed,$edge);
    my($m,$n)=@{$edge->nodes};
    my $mname=$m->name;		# force thaw. should be nop. don't add to correct_thawed!
    my $nname=$n->name;		# force thaw. should be nop. don't add to correct_thawed!
    $ok&&=_cmp_thawed(\@all_actual_objects,\@correct_thawed,
		      "$label thawed edges",__FILE__,__LINE__);
  }
  report_pass($ok,"$label thawed edges");

  # check edges' nodes (aka endpoints) - nodes should all be thawed already
  my @actual_ends=map {@{$_->nodes}} @actual_edges;
  cmp_thawed(\@actual_ends,\@actual_nodes,"$label thawed edge endpoints");

  local $SIG{__WARN__}=sub {warn @_ unless $_[0]=~/^Deep recursion/;};
  local $DB::deep=0;

  # test contents the usual way. 
  # first, recompute transients. NO! test_get is smart enough to remove transients...
  # $actual_graph->init_transients;
  $test->test_get(labelprefix=>"$get_type:",
		  actual_object=>$actual_graph,correct_object=>$correct_graph);
}

t/autodb.020.graph/graph.010.02.thaw_edges.t  view on Meta::CPAN

 # walk edges list
  my $ok=1;
  for my $edge (@actual_edges) {
    my $ename=$edge->name;	# force thaw
    push(@correct_thawed,$edge);
    $ok&&=_cmp_thawed(\@all_actual_objects,\@correct_thawed,
		     "$label thawed edges",__FILE__,__LINE__);
  }
  report_pass($ok,"$label thawed edges");

  # walk edges' nodes (aka endpoints)
  my $ok=1;
  for my $edge (@actual_edges) {
    my($m,$n)=@{$edge->nodes};
    my $mname=$m->name;		# force thaw
    my $nname=$n->name;		# force thaw
    push(@correct_thawed,$m,$n);
    $ok&&=_cmp_thawed(\@all_actual_objects,\@correct_thawed,
		      "$label thawed edge endpoint",__FILE__,__LINE__);
  }
  report_pass($ok,"$label thawed edge endpoints");
  
  # check nodes - should all be thawed already
  cmp_thawed(\@actual_nodes,\@actual_nodes,"$label thawed nodes");

  # check neighbors lists - nodes should all be thawed already
  my @actual_neighbors=map {@{$_->neighbors}} @actual_nodes;
  cmp_thawed(\@actual_neighbors,\@actual_nodes,"$label thawed neighbors");

  local $SIG{__WARN__}=sub {warn @_ unless $_[0]=~/^Deep recursion/;};
  local $DB::deep=0;

t/autodb.020.graph/graph.010.03.thaw_nbrs.t  view on Meta::CPAN

    my $ename=$edge->name;		# force thaw
    push(@correct_thawed,$edge);
    my($m,$n)=@{$edge->nodes};
    my $mname=$m->name;		# force thaw. should be nop. don't add to correct_thawed!
    my $nname=$n->name;		# force thaw. should be nop. don't add to correct_thawed!
    $ok&&=_cmp_thawed(\@all_actual_objects,\@correct_thawed,
		     "$label thawed edges",__FILE__,__LINE__);
  }
  report_pass($ok,"$label thawed edges");

  # check edges' nodes (aka endpoints) - nodes should all be thawed already
  my @actual_ends=map {@{$_->nodes}} @actual_edges;
  cmp_thawed(\@actual_ends,\@actual_nodes,"$label thawed edge endpoints");

  local $SIG{__WARN__}=sub {warn @_ unless $_[0]=~/^Deep recursion/;};
  local $DB::deep=0;

  # test contents the usual way. 
  # first, recompute transients. NO! test_get is smart enough to remove transients...
  # $actual_graph->init_transients;
  $test->test_get(labelprefix=>"$get_type:",
		  actual_object=>$actual_graph,correct_object=>$correct_graph);
}

 view all matches for this distribution
 view release on metacpan -  search on metacpan