base/t/text_tradition_parser_collatex.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More 'no_plan';
   5 $| = 1;
   6
   7
   8
   9 # =begin testing
  10 {
  11 use Text::Tradition;
  12 binmode STDOUT, ":utf8";
  13 binmode STDERR, ":utf8";
  14 eval { no warnings; binmode $DB::OUT, ":utf8"; };
  15
  16 # Test a simple CollateX input
  17 my $cxfile = 't/data/Collatex-16.xml';
  18 my $t = Text::Tradition->new(
  19     'name'  => 'inline',
  20     'input' => 'CollateX',
  21     'file'  => $cxfile,
  22     );
  23
  24 is( ref( $t ), 'Text::Tradition', "Parsed a CollateX input" );
  25 if( $t ) {
  26     is( scalar $t->collation->readings, 26, "Collation has all readings" );
  27     is( scalar $t->collation->paths, 32, "Collation has all paths" );
  28     is( scalar $t->witnesses, 3, "Collation has all witnesses" );
  29
  30     # Check an 'identical' node
  31     my $transposed = $t->collation->reading( 'n15' );
  32     my @related = $transposed->related_readings;
  33     is( scalar @related, 1, "Reading links to transposed version" );
  34     is( $related[0]->id, 'n18', "Correct transposition link" );
  35 }
  36
  37 # Now test a CollateX result with a.c. witnesses
  38
  39 my $ct = Text::Tradition->new(
  40         name => 'florilegium',
  41         input => 'CollateX',
  42         file => 't/data/florilegium_cx.xml' );
  43
  44 is( ref( $ct ), 'Text::Tradition', "Parsed the CollateX input" );
  45 if( $ct ) {
  46     is( scalar $ct->collation->readings, 309, "Collation has all readings" );
  47     is( scalar $ct->collation->paths, 361, "Collation has all paths" );
  48     is( scalar $ct->witnesses, 13, "Collation has correct number of witnesses" );
  49
  50     my %layered = ( E => 1, P => 1, Q => 1, T => 1 );
  51     foreach my $w ( $ct->witnesses ) {
  52         is( $w->is_layered, $layered{$w->sigil},
  53                 "Witness " . $w->sigil . " has correct layered setting" );
  54     }
  55
  56     my $pseq = $ct->witness('P')->text;
  57     my $pseqac = $ct->witness('P')->layertext;
  58     is( scalar @$pseq, 264, "Witness P has correct number of tokens" );
  59     is( scalar @$pseqac, 261, "Witness P (a.c.) has correct number of tokens" );
  60 }
  61
  62 }
  63
  64
  65
  66
  67 1;