lib/ZOOM/IRSpy/x.pl

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