3 use strict; use warnings;
9 use XML::LibXML::XPathContext;
11 my $datafile = 't/data/Collatex-16.xml'; #TODO need other test data
13 my $tradition = Text::Tradition->new(
15 'input' => 'CollateX',
18 # Set up some relationships
19 my $c = $tradition->collation;
20 $c->add_relationship( 'n25', 'n26', { 'type' => 'spelling' } );
21 $c->add_relationship( 'n9', 'n23', { 'type' => 'spelling' } );
22 $c->add_relationship( 'n8', 'n13', { 'type' => 'spelling' } );
23 $c->calculate_ranks();
25 my $stemma = $tradition->add_stemma( 't/data/simple.dot' );
27 # Test for object creation
28 ok( $stemma->isa( 'Text::Tradition::Stemma' ), 'Got the right sort of object' );
29 is( $stemma->graph, '1-2,1-A,2-B,2-C', "Got the correct graph" );
31 # Test for character matrix creation
32 my $m = $stemma->make_character_matrix();
33 ## check number of rows
34 is( scalar @$m, 3, "Found three witnesses in char matrix" );
35 ## check number of columns
36 is( scalar( @{$m->[0]} ), 19, "Found 18 rows plus sigla in char matrix" );
39 'A' => 'AAAAAAAXAAAAAAAAAA',
40 'B' => 'AXXXAAAAAABABAABAA',
41 'C' => 'AXXXAAAAABAAAAAXBB',
43 my @wits = map { shift @$_; } @$m;
44 map { s/\s+//g } @wits;
45 foreach my $i ( 0 .. $#wits ) {
47 is( join( '', @{$m->[$i]} ), $expected{$w}, "Row for witness $w is correct" );
52 skip "pars not in path", 3 unless File::Which::which('pars');
53 my( $status, $tree ) = $stemma->run_phylip_pars();
54 ok( $status, "pars ran successfully" );
55 print STDERR "Error was $tree\n" unless $status;
57 # Test that we get a tree
58 is( scalar @{$stemma->distance_trees}, 1, "Got a single tree" );
59 # Test that the tree has all our witnesses
60 $tree = $stemma->distance_trees->[0];
61 my @leaves = grep { $tree->degree( $_ ) == 1 } $tree->vertices;
62 is( scalar @leaves, 3, "All witnesses in the tree" );
66 my $display = $stemma->as_dot();
67 ok( $display =~ /digraph/, "Got a dot display graph" );
68 ok( $display !~ /hypothetical/, "Graph is display rather than edit" );
69 # Test our editable output
70 my $editable = $stemma->editable();
71 ok( $editable =~ /digraph/, "Got a dot edit graph" );
72 ok( $editable =~ /hypothetical/, "Graph contains an edit class" );