1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More tests => 50; 7use Test::Exception; 8 9BEGIN { 10 use_ok('Tree::Simple::Visitor::LoadClassHierarchy'); 11} 12 13use Tree::Simple; 14 15can_ok("Tree::Simple::Visitor::LoadClassHierarchy", 'new'); 16 17# --------------------------- 18# classic diamond inheritance 19# --------------------------- 20# A B 21# / \ / 22# C D 23# \ / 24# E 25# --------------------------- 26# modeled as this tree 27# --------------------------- 28# A A B 29# \ \ / 30# C D 31# \ / 32# E 33# --------------------------- 34{ 35 package A; 36 package B; 37 package C; @C::ISA = ('A'); 38 package D; @D::ISA = ('A', 'B'); 39 package E; @E::ISA = ('C', 'D'); 40} 41 42{ 43 my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); 44 isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); 45 isa_ok($visitor, 'Tree::Simple::Visitor'); 46 47 can_ok($visitor, 'setClass'); 48 $visitor->setClass('E'); 49 50 my $tree = Tree::Simple->new(Tree::Simple->ROOT); 51 isa_ok($tree, 'Tree::Simple'); 52 53 can_ok($visitor, 'visit'); 54 $tree->accept($visitor); 55 56 my $current = $tree->getChild(0); 57 is($current->getNodeValue(), 'E', '... got the value we expected'); 58 is($current->getChild(0)->getNodeValue(), 'C', '... got the value we expected'); 59 is($current->getChild(0)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); 60 is($current->getChild(1)->getNodeValue(), 'D', '... got the value we expected'); 61 is($current->getChild(1)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); 62 is($current->getChild(1)->getChild(1)->getNodeValue(), 'B', '... got the value we expected'); 63} 64 65{ 66 my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); 67 isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); 68 isa_ok($visitor, 'Tree::Simple::Visitor'); 69 70 can_ok($visitor, 'setClass'); 71 $visitor->setClass('E'); 72 73 my $tree = Tree::Simple->new(Tree::Simple->ROOT); 74 isa_ok($tree, 'Tree::Simple'); 75 76 can_ok($visitor, 'includeTrunk'); 77 $visitor->includeTrunk(1); 78 79 can_ok($visitor, 'visit'); 80 $tree->accept($visitor); 81 82 my $current = $tree; 83 is($current->getNodeValue(), 'E', '... got the value we expected'); 84 is($current->getChild(0)->getNodeValue(), 'C', '... got the value we expected'); 85 is($current->getChild(0)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); 86 is($current->getChild(1)->getNodeValue(), 'D', '... got the value we expected'); 87 is($current->getChild(1)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); 88 is($current->getChild(1)->getChild(1)->getNodeValue(), 'B', '... got the value we expected'); 89} 90 91{ 92 my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); 93 isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); 94 isa_ok($visitor, 'Tree::Simple::Visitor'); 95 96 can_ok($visitor, 'setClass'); 97 $visitor->setClass('E'); 98 99 my $tree = Tree::Simple->new(Tree::Simple->ROOT); 100 isa_ok($tree, 'Tree::Simple'); 101 102 can_ok($visitor, 'setNodeFilter'); 103 $visitor->setNodeFilter(sub { "Package::" . $_[0] }); 104 105 can_ok($visitor, 'visit'); 106 $tree->accept($visitor); 107 108 my $current = $tree->getChild(0); 109 is($current->getNodeValue(), 'Package::E', '... got the value we expected'); 110 is($current->getChild(0)->getNodeValue(), 'Package::C', '... got the value we expected'); 111 is($current->getChild(0)->getChild(0)->getNodeValue(), 'Package::A', '... got the value we expected'); 112 is($current->getChild(1)->getNodeValue(), 'Package::D', '... got the value we expected'); 113 is($current->getChild(1)->getChild(0)->getNodeValue(), 'Package::A', '... got the value we expected'); 114 is($current->getChild(1)->getChild(1)->getNodeValue(), 'Package::B', '... got the value we expected'); 115} 116 117{ 118 package One; 119 sub new {} 120 sub one {} 121 122 package Two; 123 @Two::ISA = ('One'); 124 sub two {} 125 126 package Three; 127 @Three::ISA = ('Two'); 128 sub three {} 129} 130 131{ 132 my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); 133 isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); 134 isa_ok($visitor, 'Tree::Simple::Visitor'); 135 136 can_ok($visitor, 'setClass'); 137 $visitor->setClass('Three'); 138 139 my $tree = Tree::Simple->new(Tree::Simple->ROOT); 140 isa_ok($tree, 'Tree::Simple'); 141 142 can_ok($visitor, 'includeMethods'); 143 $visitor->includeMethods(1); 144 145 can_ok($visitor, 'visit'); 146 $tree->accept($visitor); 147 148 my $current = $tree->getChild(0); 149 is($current->getNodeValue(), 'Three', '... got the value we expected'); 150 is($current->getChild(0)->getNodeValue(), 'three', '... got the value we expected'); 151 152 is($current->getChild(1)->getNodeValue(), 'Two', '... got the value we expected'); 153 is($current->getChild(1)->getChild(0)->getNodeValue(), 'two', '... got the value we expected'); 154 155 is($current->getChild(1)->getChild(1)->getNodeValue(), 'One', '... got the value we expected'); 156 is($current->getChild(1)->getChild(1)->getChild(0)->getNodeValue(), 'new', '... got the value we expected'); 157 is($current->getChild(1)->getChild(1)->getChild(1)->getNodeValue(), 'one', '... got the value we expected'); 158} 159