The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

#!/usr/bin/env perl
use strict;
use Test::More tests => 16;
my $filename = 'dummy.treex';
my $document = Treex::Core::Document->new();
my $bundle = $document->create_bundle();
my $zone = $bundle->create_zone('en');
my $aroot = $zone->create_atree();
my $nroot = $zone->create_ntree();
my $troot = $zone->create_ttree();
my $anode1 = $aroot->create_child( { lemma => 'New', ord => 1 } );
my $anode2 = $aroot->create_child( { lemma => 'York', ord => 2 } );
my $nnode = $nroot->create_child( { ne_type => 'g_', normalized_name => 'New York' } );
$nnode->set_anodes( $anode1, $anode2 );
is( $nnode->normalized_name, 'New York', 'Normalized name retrieved' );
is_deeply( [ $nnode->get_anodes() ], [ $anode1, $anode2 ], 'a-nodes retrieved' );
is_deeply( $anode1->n_node, $nnode, 'Backward link from a-node to n-node' );
is_deeply( $anode2->n_node, $nnode, 'Backward link from a-node to n-node' );
my $tnode1 = $troot->create_child({t_lemma=>'New'});
my $tnode2 = $troot->create_child({t_lemma=>'York'});
$tnode1->set_lex_anode($anode1);
$tnode2->set_lex_anode($anode2);
is_deeply( $tnode1->get_n_node, $nnode, 'Link from t-node1 to n-node' );
is_deeply( $tnode2->get_n_node, $nnode, 'Link from t-node2 to n-node' );
ok( $document->save($filename), 'Document saved' );
ok( my $d = Treex::Core::Document->new( { 'filename' => $filename } ), 'Document loaded' );
my ($b) = $d->get_bundles();
my $z = $b->get_zone('en');
my $ar = $z->get_atree();
my $nr = $z->get_ntree();
my ($nn) = $nr->get_children();
my ( $a1, $a2 ) = $ar->get_children( { ordered => 1 } );
is( $nn->normalized_name, 'New York', 'Normalized name retrieved' );
is_deeply( [ $nn->get_anodes() ], [ $a1, $a2 ], 'a-nodes retrieved' );
is_deeply( $a1->n_node, $nn, 'Backward link from a-node to n-node' );
is_deeply( $a2->n_node, $nn, 'Backward link from a-node to n-node' );
ok($a1->remove() || 1, 'Deleting the first a-node');
is_deeply( [ $nn->get_anodes() ], [$a2], 'Now, only the second a-node is retrieved' );
is_deeply( $a2->n_node, $nn, 'Backward link from a-node to n-node' );
ok($b->remove_zone('en', '') || 1, 'Removing the whole zone from the bundle');
unlink $filename;
#done_testing();