1#!/usr/bin/perl 2 3# Formal testing for Class::Inspector 4 5# Do all the tests on ourself, since we know we will be loaded. 6 7 8use strict; 9use lib (); 10use File::Spec::Functions ':ALL'; 11BEGIN { 12 $| = 1; 13 unless ( $ENV{HARNESS_ACTIVE} ) { 14 require FindBin; 15 $FindBin::Bin = $FindBin::Bin; # Avoid a warning 16 chdir catdir( $FindBin::Bin, updir() ); 17 lib->import( 18 catdir('blib', 'arch'), 19 catdir('blib', 'lib' ), 20 catdir('lib'), 21 ); 22 } 23} 24 25use Test::More tests => 54; 26use Class::Inspector (); 27 28# To make maintaining this a little faster, 29# CI is defined as Class::Inspector, and 30# BAD for a class we know doesn't exist. 31use constant CI => 'Class::Inspector'; 32use constant BAD => 'Class::Inspector::Nonexistant'; 33 34# How many functions and public methods are there in Class::Inspector 35my $base_functions = 17; 36my $base_public = 12; 37my $base_private = $base_functions - $base_public; 38 39 40 41 42 43##################################################################### 44# Begin Tests 45 46# Check the good/bad class code 47ok( CI->_class( CI ), 'Class validator works for known valid' ); 48ok( CI->_class( BAD ), 'Class validator works for correctly formatted, but not installed' ); 49ok( CI->_class( 'A::B::C::D::E' ), 'Class validator works for long classes' ); 50ok( CI->_class( '::' ), 'Class validator allows main' ); 51ok( CI->_class( '::Blah' ), 'Class validator works for main aliased' ); 52ok( ! CI->_class(), 'Class validator failed for missing class' ); 53ok( ! CI->_class( '4teen' ), 'Class validator fails for number starting class' ); 54ok( ! CI->_class( 'Blah::%f' ), 'Class validator catches bad characters' ); 55 56 57 58 59 60 61# Check the loaded method 62ok( CI->loaded( CI ), "->loaded detects loaded" ); 63ok( ! CI->loaded( BAD ), "->loaded detects not loaded" ); 64 65 66 67 68 69# Check the file name methods 70my $filename = CI->filename( CI ); 71ok( $filename eq File::Spec->catfile( "Class", "Inspector.pm" ), "->filename works correctly" ); 72my $inc_filename = CI->_inc_filename( CI ); 73ok( $inc_filename eq "Class/Inspector.pm", "->_inc_filename works correctly" ); 74ok( index( CI->loaded_filename(CI), $filename ) >= 0, "->loaded_filename works" ); 75ok( ($filename eq $inc_filename or index( CI->loaded_filename(CI), $inc_filename ) == -1), "->loaded_filename works" ); 76ok( index( CI->resolved_filename(CI), $filename ) >= 0, "->resolved_filename works" ); 77ok( ($filename eq $inc_filename or index( CI->resolved_filename(CI), $inc_filename ) == -1), "->resolved_filename works" ); 78 79 80 81 82 83# Check the installed stuff 84ok( CI->installed( CI ), "->installed detects installed" ); 85ok( ! CI->installed( BAD ), "->installed detects not installed" ); 86 87 88 89 90 91# Check the functions 92my $functions = CI->functions( CI ); 93ok( (ref($functions) eq 'ARRAY' 94 and $functions->[0] eq '_class' 95 and scalar @$functions == $base_functions), 96 "->functions works correctly" ); 97ok( ! CI->functions( BAD ), "->functions fails correctly" ); 98 99 100 101 102 103# Check function refs 104$functions = CI->function_refs( CI ); 105ok( (ref($functions) eq 'ARRAY' 106 and ref $functions->[0] 107 and ref($functions->[0]) eq 'CODE' 108 and scalar @$functions == $base_functions), 109 "->function_refs works correctly" ); 110ok( ! CI->functions( BAD ), "->function_refs fails correctly" ); 111 112 113 114 115 116# Check function_exists 117ok( CI->function_exists( CI, 'installed' ), 118 "->function_exists detects function that exists" ); 119ok( ! CI->function_exists( CI, 'nsfladf' ), 120 "->function_exists fails for bad function" ); 121ok( ! CI->function_exists( CI ), 122 "->function_exists fails for missing function" ); 123ok( ! CI->function_exists( BAD, 'function' ), 124 "->function_exists fails for bad class" ); 125 126 127 128 129 130# Check the methods method. 131# First, defined a new subclass of Class::Inspector with some additional methods 132package Class::Inspector::Dummy; 133 134use strict; 135use base 'Class::Inspector'; 136 137sub _a_first { 1; } 138sub adummy1 { 1; } 139sub _dummy2 { 1; } 140sub dummy3 { 1; } 141sub installed { 1; } 142 143package main; 144 145my $methods = CI->methods( CI ); 146ok( ( ref($methods) eq 'ARRAY' 147 and $methods->[0] eq '_class' 148 and scalar @$methods == $base_functions), 149 "->methods works for non-inheriting class" ); 150$methods = CI->methods( 'Class::Inspector::Dummy' ); 151ok( (ref($methods) eq 'ARRAY' 152 and $methods->[0] eq '_a_first' 153 and scalar @$methods == ($base_functions + 4) 154 and scalar( grep { /dummy/ } @$methods ) == 3), 155 "->methods works for inheriting class" ); 156ok( ! CI->methods( BAD ), "->methods fails correctly" ); 157 158# Check the variety of different possible ->methods options 159 160# Public option 161$methods = CI->methods( CI, 'public' ); 162ok( (ref($methods) eq 'ARRAY' 163 and $methods->[0] eq 'children' 164 and scalar @$methods == $base_public), 165 "Public ->methods works for non-inheriting class" ); 166$methods = CI->methods( 'Class::Inspector::Dummy', 'public' ); 167ok( (ref($methods) eq 'ARRAY' 168 and $methods->[0] eq 'adummy1' 169 and scalar @$methods == ($base_public + 2) 170 and scalar( grep { /dummy/ } @$methods ) == 2), 171 "Public ->methods works for inheriting class" ); 172ok( ! CI->methods( BAD ), "Public ->methods fails correctly" ); 173 174# Private option 175$methods = CI->methods( CI, 'private' ); 176ok( (ref($methods) eq 'ARRAY' 177 and $methods->[0] eq '_class' 178 and scalar @$methods == $base_private), 179 "Private ->methods works for non-inheriting class" ); 180$methods = CI->methods( 'Class::Inspector::Dummy', 'private' ); 181ok( (ref($methods) eq 'ARRAY' 182 and $methods->[0] eq '_a_first' 183 and scalar @$methods == ($base_private + 2) 184 and scalar( grep { /dummy/ } @$methods ) == 1), 185 "Private ->methods works for inheriting class" ); 186ok( ! CI->methods( BAD ), "Private ->methods fails correctly" ); 187 188# Full option 189$methods = CI->methods( CI, 'full' ); 190ok( (ref($methods) eq 'ARRAY' 191 and $methods->[0] eq 'Class::Inspector::_class' 192 and scalar @$methods == $base_functions), 193 "Full ->methods works for non-inheriting class" ); 194$methods = CI->methods( 'Class::Inspector::Dummy', 'full' ); 195ok( (ref($methods) eq 'ARRAY' 196 and $methods->[0] eq 'Class::Inspector::Dummy::_a_first' 197 and scalar @$methods == ($base_functions + 4) 198 and scalar( grep { /dummy/ } @$methods ) == 3), 199 "Full ->methods works for inheriting class" ); 200ok( ! CI->methods( BAD ), "Full ->methods fails correctly" ); 201 202# Expanded option 203$methods = CI->methods( CI, 'expanded' ); 204ok( (ref($methods) eq 'ARRAY' 205 and ref($methods->[0]) eq 'ARRAY' 206 and $methods->[0]->[0] eq 'Class::Inspector::_class' 207 and $methods->[0]->[1] eq 'Class::Inspector' 208 and $methods->[0]->[2] eq '_class' 209 and ref($methods->[0]->[3]) eq 'CODE' 210 and scalar @$methods == $base_functions), 211 "Expanded ->methods works for non-inheriting class" ); 212$methods = CI->methods( 'Class::Inspector::Dummy', 'expanded' ); 213ok( (ref($methods) eq 'ARRAY' 214 and ref($methods->[0]) eq 'ARRAY' 215 and $methods->[0]->[0] eq 'Class::Inspector::Dummy::_a_first' 216 and $methods->[0]->[1] eq 'Class::Inspector::Dummy' 217 and $methods->[0]->[2] eq '_a_first' 218 and ref($methods->[0]->[3]) eq 'CODE' 219 and scalar @$methods == ($base_functions + 4) 220 and scalar( grep { /dummy/ } map { $_->[2] } @$methods ) == 3), 221 "Expanded ->methods works for inheriting class" ); 222ok( ! CI->methods( BAD ), "Expanded ->methods fails correctly" ); 223 224# Check clashing between options 225ok( ! CI->methods( CI, 'public', 'private' ), "Public and private ->methods clash correctly" ); 226ok( ! CI->methods( CI, 'private', 'public' ), "Public and private ->methods clash correctly" ); 227ok( ! CI->methods( CI, 'full', 'expanded' ), "Full and expanded ->methods class correctly" ); 228ok( ! CI->methods( CI, 'expanded', 'full' ), "Full and expanded ->methods class correctly" ); 229 230# Check combining options 231$methods = CI->methods( CI, 'public', 'expanded' ); 232ok( (ref($methods) eq 'ARRAY' 233 and ref($methods->[0]) eq 'ARRAY' 234 and $methods->[0]->[0] eq 'Class::Inspector::children' 235 and $methods->[0]->[1] eq 'Class::Inspector' 236 and $methods->[0]->[2] eq 'children' 237 and ref($methods->[0]->[3]) eq 'CODE' 238 and scalar @$methods == $base_public), 239 "Public + Expanded ->methods works for non-inheriting class" ); 240$methods = CI->methods( 'Class::Inspector::Dummy', 'public', 'expanded' ); 241ok( (ref($methods) eq 'ARRAY' 242 and ref($methods->[0]) eq 'ARRAY' 243 and $methods->[0]->[0] eq 'Class::Inspector::Dummy::adummy1' 244 and $methods->[0]->[1] eq 'Class::Inspector::Dummy' 245 and $methods->[0]->[2] eq 'adummy1' 246 and ref($methods->[0]->[3]) eq 'CODE' 247 and scalar @$methods == ($base_public + 2) 248 and scalar( grep { /dummy/ } map { $_->[2] } @$methods ) == 2), 249 "Public + Expanded ->methods works for inheriting class" ); 250ok( ! CI->methods( BAD ), "Expanded ->methods fails correctly" ); 251 252 253 254 255 256##################################################################### 257# Search Tests 258 259# Create the classes to use 260CLASSES: { 261 package Foo; 262 263 sub foo { 1 }; 264 265 package Foo::Subclass; 266 267 @Foo::Subclass::ISA = 'Foo'; 268 269 package Bar; 270 271 @Bar::ISA = 'Foo'; 272 273 package This; 274 275 sub isa { $_[1] eq 'Foo' ? 1 : undef } 276 277 1; 278} 279 280# Check trivial ->find cases 281{ 282 is( CI->subclasses( '' ), undef, '->subclasses(bad) returns undef' ); 283 is( CI->subclasses( BAD ), '', '->subclasses(none) returns false' ); 284 my $rv = CI->subclasses( CI ); 285 is_deeply( $rv, [ 'Class::Inspector::Dummy' ], '->subclasses(CI) returns just itself' ); 286 287 # Check non-trivial ->subclasses cases 288 $rv = CI->subclasses( 'Foo' ); 289 is_deeply( $rv, [ 'Bar', 'Foo::Subclass', 'This' ], 290 '->subclasses(nontrivial) returns the expected class list' ); 291} 292 293 294 295 296 297##################################################################### 298# Regression Tests 299 300# Discovered in 1.06, fixed in 1.07 301# In some cases, spurious empty GLOB entries can be created in a package. 302# These contain no actual symbols, but were causing ->loaded to return true. 303# An empty namespace with a single spurious empty glob entry (although 304# created in this test with a scalar) should return FALSE for ->loaded 305$Class::Inspector::SpuriousPackage::something = 1; 306$Class::Inspector::SpuriousPackage::something = 1; # Avoid a warning 307ok( ! Class::Inspector->loaded('Class::Inspector::SpuriousPackage'), 308 '->loaded returns false for spurious glob in package' ); 309 310 311 312# Discovered in 1.11, fixed in 1.12 313# With the introduction of ->subclasses, we exposed ourselves to 314# non-local problems with ->isa method implementations. 315PACKAGES: { 316 # The busted package 317 package Class::Inspector::BrokenISA; 318 use vars qw{&isa $VERSION}; 319 $VERSION = '0.01'; 320 # The test packages 321 package My::Foo; 322 use vars qw{$VERSION}; 323 $VERSION = '0.01'; 324 package My::Bar; 325 use vars qw{$VERSION @ISA}; 326 $VERSION = '0.01'; 327 @ISA = 'My::Foo'; 328} 329TESTS: { 330 my $rv = Class::Inspector->subclasses( 'My::Foo' ); 331 is_deeply( $rv, [ 'My::Bar' ], 332 '->subclasses in the presence of an evil ->isa does not crash' ); 333} 334