lib/ZOOM/IRSpy/x.pl

   1 #!/usr/bin/perl -w
   2
   3
   4 ### This should be massaged into a test-suite script in ../../../t
   5
   6 use strict;
   7 use warnings;
   8 use lib '../..';
   9 use ZOOM::IRSpy::Node;
  10
  11 #my $phylogeny = <<__EOT__;
  12 #Dinosauria
  13 # Saurischia
  14 #  Theropoda
  15 #  Sauropoda
  16 # Ornithischia
  17 #  Thyreophora
  18 #   Stegosauria
  19 #   Ankylosauria
  20 #  Cerapoda
  21 #   Marginocephalia
  22 #    Ceratopsia
  23 #    Pachycephalosauria
  24 #   Ornithopoda
  25 #    Hadrosauria
  26 #__EOT__
  27 #
  28 #my @stack;
  29 #foreach my $line (reverse split /\n/, $phylogeny) {
  30 #    $line =~ s/( *)//;
  31 #    my $level = length($1);
  32 #    print "level $level: $line\n";
  33 #}
  34
  35     my $n1 = new ZOOM::IRSpy::Node("Hadrosauria");
  36    my $n2 = new ZOOM::IRSpy::Node("Ornithopoda", $n1);
  37     my $n3 = new ZOOM::IRSpy::Node("Pachycephalosauria");
  38     my $n4 = new ZOOM::IRSpy::Node("Ceratopsia");
  39    my $n5 = new ZOOM::IRSpy::Node("Marginocephalia", $n3, $n4);
  40   my $n6 = new ZOOM::IRSpy::Node("Cerapoda", $n2, $n5);
  41    my $n7 = new ZOOM::IRSpy::Node("Ankylosauria");
  42    my $n8 = new ZOOM::IRSpy::Node("Stegosauria");
  43   my $n9 = new ZOOM::IRSpy::Node("Thyreophora", $n7, $n8);
  44  my $n10 = new ZOOM::IRSpy::Node("Ornithischia", $n6, $n9);
  45   my $n11 = new ZOOM::IRSpy::Node("Sauropoda");
  46   my $n12 = new ZOOM::IRSpy::Node("Theropoda");
  47  my $n13 = new ZOOM::IRSpy::Node("Saurischia", $n11, $n12);
  48 my $root = new ZOOM::IRSpy::Node("Dinosauria", $n10, $n13);
  49
  50 $root->resolve();
  51 assert(!defined $root->parent());
  52
  53 my $count = 0;
  54 for (my $node = $root; defined $node; $node = $node->{next}) {
  55     print "'", $node->address(), "' = ", $node->name(), "\n";
  56     assert($node eq $root->select($node->address()));
  57     assert($node eq $node->next()->previous())
  58         if defined $node->next();
  59     assert($node eq $node->previous()->next())
  60         if defined $node->previous();
  61     $count++;
  62 }
  63 assert($count == 14);
  64
  65 sub assert {
  66     my($ok) = @_;
  67     die "assert failed" if !$ok;
  68 }