Commit | Line | Data |
6f4946fb |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; use warnings; |
457b1620 |
4 | use File::Which; |
6f4946fb |
5 | use Test::More; |
6 | use lib 'lib'; |
7 | use Text::Tradition; |
6f4946fb |
8 | use XML::LibXML; |
9 | use XML::LibXML::XPathContext; |
10 | |
11 | my $datafile = 't/data/Collatex-16.xml'; #TODO need other test data |
12 | |
7035e3a6 |
13 | my $tradition = Text::Tradition->new( |
14 | 'name' => 'inline', |
15 | 'input' => 'CollateX', |
16 | 'file' => $datafile, |
17 | ); |
7a7c249c |
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(); |
24 | |
25 | my $stemma = $tradition->add_stemma( 't/data/simple.dot' ); |
6f4946fb |
26 | |
27 | # Test for object creation |
28 | ok( $stemma->isa( 'Text::Tradition::Stemma' ), 'Got the right sort of object' ); |
7a7c249c |
29 | is( $stemma->graph, '1-2,1-A,2-B,2-C', "Got the correct graph" ); |
6f4946fb |
30 | |
31 | # Test for character matrix creation |
7a7c249c |
32 | my $m = $stemma->make_character_matrix(); |
6f4946fb |
33 | ## check number of rows |
7a7c249c |
34 | is( scalar @$m, 3, "Found three witnesses in char matrix" ); |
6f4946fb |
35 | ## check number of columns |
7a7c249c |
36 | is( scalar( @{$m->[0]} ), 19, "Found 18 rows plus sigla in char matrix" ); |
37 | ## check matrix |
38 | my %expected = ( |
39 | 'A' => 'AAAAAAAXAAAAAAAAAA', |
40 | 'B' => 'AXXXAAAAAABABAABAA', |
41 | 'C' => 'AXXXAAAAABAAAAAXBB', |
42 | ); |
43 | my @wits = map { shift @$_; } @$m; |
44 | map { s/\s+//g } @wits; |
45 | foreach my $i ( 0 .. $#wits ) { |
46 | my $w = $wits[$i]; |
47 | is( join( '', @{$m->[$i]} ), $expected{$w}, "Row for witness $w is correct" ); |
48 | } |
6f4946fb |
49 | |
50 | # Test that pars runs |
457b1620 |
51 | SKIP: { |
0f5d05c6 |
52 | skip "pars not in path", 3 unless File::Which::which('pars'); |
457b1620 |
53 | my( $status, $tree ) = $stemma->run_phylip_pars(); |
54 | ok( $status, "pars ran successfully" ); |
55 | print STDERR "Error was $tree\n" unless $status; |
56 | |
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" ); |
63 | } |
7a7c249c |
64 | |
65 | # Test our dot output |
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" ); |
7035e3a6 |
73 | |
457b1620 |
74 | done_testing(); |