r1355 - packages/libclass-inspector-perl/branches/upstream/current/t
Gunnar Wolf
gwolf at costa.debian.org
Wed Sep 14 16:25:49 UTC 2005
Author: gwolf
Date: 2005-09-14 16:25:48 +0000 (Wed, 14 Sep 2005)
New Revision: 1355
Added:
packages/libclass-inspector-perl/branches/upstream/current/t/02_main.t
Removed:
packages/libclass-inspector-perl/branches/upstream/current/t/01_main.t
Log:
To prepare to load /tmp/tmp.muF8td/libclass-inspector-perl-1.12 into
packages/libclass-inspector-perl/branches/upstream/current, perform 1
rename.
*
packages/libclass-inspector-perl/branches/upstream/current/t/02_main.
t: Renamed from
packages/libclass-inspector-perl/branches/upstream/current/t/01_main.
t.
Deleted: packages/libclass-inspector-perl/branches/upstream/current/t/01_main.t
===================================================================
--- packages/libclass-inspector-perl/branches/upstream/current/t/01_main.t 2005-09-09 18:00:33 UTC (rev 1354)
+++ packages/libclass-inspector-perl/branches/upstream/current/t/01_main.t 2005-09-14 16:25:48 UTC (rev 1355)
@@ -1,285 +0,0 @@
-#!/usr/bin/perl
-
-# Formal testing for Class::Inspector
-
-# Do all the tests on ourself, since we know we will be loaded.
-
-use strict;
-use lib ();
-use UNIVERSAL 'isa';
-use File::Spec::Functions ':ALL';
-BEGIN {
- $| = 1;
- unless ( $ENV{HARNESS_ACTIVE} ) {
- require FindBin;
- chdir ($FindBin::Bin = $FindBin::Bin); # Avoid a warning
- lib->import( catdir( updir(), updir(), 'modules') );
- }
-}
-
-use Test::More tests => 51;
-
-# Set up any needed globals
-use vars qw{$loaded $ci $bad $base_functions $base_public};
-BEGIN {
- $loaded = 0;
- $| = 1;
-
- # To make maintaining this a little faster,
- # $ci is defined as Class::Inspector, and
- # $bad for a class we know doesn't exist.
- $ci = 'Class::Inspector';
- $bad = 'Class::Inspector::Nonexistant';
-
- # How many functions and public methods are there in Class::Inspector
- $base_functions = 14;
- $base_public = 11;
-}
-
-
-
-
-# Check their perl version
-BEGIN {
- ok( $] >= 5.005, "Your perl is new enough" );
-}
-
-
-
-
-
-# Does the module load
-END { ok( 0, 'Loads' ) unless $loaded; }
-use Class::Inspector;
-$loaded = 1;
-ok( 1, 'Loads' );
-
-
-
-
-
-
-
-
-
-# Check the good/bad class code
-ok( $ci->_class( $ci ), 'Class validator works for known valid' );
-ok( $ci->_class( $bad ), 'Class validator works for correctly formatted, but not installed' );
-ok( $ci->_class( 'A::B::C::D::E' ), 'Class validator works for long classes' );
-ok( $ci->_class( '::' ), 'Class validator allows main' );
-ok( $ci->_class( '::Blah' ), 'Class validator works for main aliased' );
-ok( ! $ci->_class(), 'Class validator failed for missing class' );
-ok( ! $ci->_class( '4teen' ), 'Class validator fails for number starting class' );
-ok( ! $ci->_class( 'Blah::%f' ), 'Class validator catches bad characters' );
-
-
-
-
-
-
-# Check the loaded method
-ok( $ci->loaded( $ci ), "->loaded detects loaded" );
-ok( ! $ci->loaded( $bad ), "->loaded detects not loaded" );
-
-
-
-
-
-# Check the file name methods
-my $filename = $ci->filename( $ci );
-ok( $filename eq File::Spec->catfile( "Class", "Inspector.pm" ), "->filename works correctly" );
-my $inc_filename = $ci->_inc_filename( $ci );
-ok( $inc_filename eq "Class/Inspector.pm", "->_inc_filename works correctly" );
-ok( index( $ci->loaded_filename($ci), $filename ) >= 0, "->loaded_filename works" );
-ok( ($filename eq $inc_filename or index( $ci->loaded_filename($ci), $inc_filename ) == -1), "->loaded_filename works" );
-ok( index( $ci->resolved_filename($ci), $filename ) >= 0, "->resolved_filename works" );
-ok( ($filename eq $inc_filename or index( $ci->resolved_filename($ci), $inc_filename ) == -1), "->resolved_filename works" );
-
-
-
-
-
-# Check the installed stuff
-ok( $ci->installed( $ci ), "->installed detects installed" );
-ok( ! $ci->installed( $bad ), "->installed detects not installed" );
-
-
-
-
-
-# Check the functions
-my $functions = $ci->functions( $ci );
-ok( (isa( $functions, 'ARRAY' )
- and $functions->[0] eq '_class'
- and scalar @$functions == $base_functions),
- "->functions works correctly" );
-ok( ! $ci->functions( $bad ), "->functions fails correctly" );
-
-
-
-
-
-# Check function refs
-$functions = $ci->function_refs( $ci );
-ok( (isa( $functions, 'ARRAY' )
- and ref $functions->[0]
- and isa( $functions->[0], 'CODE' )
- and scalar @$functions == $base_functions),
- "->function_refs works correctly" );
-ok( ! $ci->functions( $bad ), "->function_refs fails correctly" );
-
-
-
-
-
-# Check function_exists
-ok( $ci->function_exists( $ci, 'installed' ),
- "->function_exists detects function that exists" );
-ok( ! $ci->function_exists( $ci, 'nsfladf' ),
- "->function_exists fails for bad function" );
-ok( ! $ci->function_exists( $ci ),
- "->function_exists fails for missing function" );
-ok( ! $ci->function_exists( $bad, 'function' ),
- "->function_exists fails for bad class" );
-
-
-
-
-
-# Check the methods method.
-# First, defined a new subclass of Class::Inspector with some additional methods
-package Class::Inspector::Dummy;
-
-use strict;
-use base 'Class::Inspector';
-
-sub _a_first { 1; }
-sub adummy1 { 1; }
-sub _dummy2 { 1; }
-sub dummy3 { 1; }
-sub installed { 1; }
-
-package main;
-
-my $methods = $ci->methods( $ci );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq '_class'
- and scalar @$methods == $base_functions),
- "->methods works for non-inheriting class" );
-$methods = $ci->methods( 'Class::Inspector::Dummy' );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq '_a_first'
- and scalar @$methods == ($base_functions + 4)
- and scalar( grep { /dummy/ } @$methods ) == 3),
- "->methods works for inheriting class" );
-ok( ! $ci->methods( $bad ), "->methods fails correctly" );
-
-# Check the variety of different possible ->methods options
-
-# Public option
-$methods = $ci->methods( $ci, 'public' );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq 'children'
- and scalar @$methods == $base_public),
- "Public ->methods works for non-inheriting class" );
-$methods = $ci->methods( 'Class::Inspector::Dummy', 'public' );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq 'adummy1'
- and scalar @$methods == ($base_public + 2)
- and scalar( grep { /dummy/ } @$methods ) == 2),
- "Public ->methods works for inheriting class" );
-ok( ! $ci->methods( $bad ), "Public ->methods fails correctly" );
-
-# Private option
-$methods = $ci->methods( $ci, 'private' );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq '_class'
- and scalar @$methods == 3),
- "Private ->methods works for non-inheriting class" );
-$methods = $ci->methods( 'Class::Inspector::Dummy', 'private' );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq '_a_first'
- and scalar @$methods == 5
- and scalar( grep { /dummy/ } @$methods ) == 1),
- "Private ->methods works for inheriting class" );
-ok( ! $ci->methods( $bad ), "Private ->methods fails correctly" );
-
-# Full option
-$methods = $ci->methods( $ci, 'full' );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq 'Class::Inspector::_class'
- and scalar @$methods == $base_functions),
- "Full ->methods works for non-inheriting class" );
-$methods = $ci->methods( 'Class::Inspector::Dummy', 'full' );
-ok( (isa( $methods, 'ARRAY' )
- and $methods->[0] eq 'Class::Inspector::Dummy::_a_first'
- and scalar @$methods == ($base_functions + 4)
- and scalar( grep { /dummy/ } @$methods ) == 3),
- "Full ->methods works for inheriting class" );
-ok( ! $ci->methods( $bad ), "Full ->methods fails correctly" );
-
-# Expanded option
-$methods = $ci->methods( $ci, 'expanded' );
-ok( (isa( $methods, 'ARRAY' )
- and isa( $methods->[0], 'ARRAY' )
- and $methods->[0]->[0] eq 'Class::Inspector::_class'
- and $methods->[0]->[1] eq 'Class::Inspector'
- and $methods->[0]->[2] eq '_class'
- and isa( $methods->[0]->[3], 'CODE' )
- and scalar @$methods == $base_functions),
- "Expanded ->methods works for non-inheriting class" );
-$methods = $ci->methods( 'Class::Inspector::Dummy', 'expanded' );
-ok( (isa( $methods, 'ARRAY' )
- and isa( $methods->[0], 'ARRAY' )
- and $methods->[0]->[0] eq 'Class::Inspector::Dummy::_a_first'
- and $methods->[0]->[1] eq 'Class::Inspector::Dummy'
- and $methods->[0]->[2] eq '_a_first'
- and isa( $methods->[0]->[3], 'CODE' )
- and scalar @$methods == ($base_functions + 4)
- and scalar( grep { /dummy/ } map { $_->[2] } @$methods ) == 3),
- "Expanded ->methods works for inheriting class" );
-ok( ! $ci->methods( $bad ), "Expanded ->methods fails correctly" );
-
-# Check clashing between options
-ok( ! $ci->methods( $ci, 'public', 'private' ), "Public and private ->methods clash correctly" );
-ok( ! $ci->methods( $ci, 'private', 'public' ), "Public and private ->methods clash correctly" );
-ok( ! $ci->methods( $ci, 'full', 'expanded' ), "Full and expanded ->methods class correctly" );
-ok( ! $ci->methods( $ci, 'expanded', 'full' ), "Full and expanded ->methods class correctly" );
-
-# Check combining options
-$methods = $ci->methods( $ci, 'public', 'expanded' );
-ok( (isa( $methods, 'ARRAY' )
- and isa( $methods->[0], 'ARRAY' )
- and $methods->[0]->[0] eq 'Class::Inspector::children'
- and $methods->[0]->[1] eq 'Class::Inspector'
- and $methods->[0]->[2] eq 'children'
- and isa( $methods->[0]->[3], 'CODE' )
- and scalar @$methods == $base_public),
- "Public + Expanded ->methods works for non-inheriting class" );
-$methods = $ci->methods( 'Class::Inspector::Dummy', 'public', 'expanded' );
-ok( (isa( $methods, 'ARRAY' )
- and isa( $methods->[0], 'ARRAY' )
- and $methods->[0]->[0] eq 'Class::Inspector::Dummy::adummy1'
- and $methods->[0]->[1] eq 'Class::Inspector::Dummy'
- and $methods->[0]->[2] eq 'adummy1'
- and isa( $methods->[0]->[3], 'CODE' )
- and scalar @$methods == ($base_public + 2)
- and scalar( grep { /dummy/ } map { $_->[2] } @$methods ) == 2),
- "Public + Expanded ->methods works for inheriting class" );
-ok( ! $ci->methods( $bad ), "Expanded ->methods fails correctly" );
-
-
-
-
-
-#####################################################################
-# Regression Tests
-
-# Discovered in 1.06, fixed in 1.07
-# In some cases, spurious empty GLOB entries can be created in a package.
-# These contain no actual symbols, but were causing ->loaded to return true.
-# An empty namespace with a single spurious empty glob entry (although
-# created in this test with a scalar) should return FALSE for ->loaded
-$Class::Inspector::SpuriousPackage::something = 1;
-ok( ! Class::Inspector->loaded('Class::Inspector::SpuriousPackage'),
- '->loaded returns false for spurious glob in package' );
Copied: packages/libclass-inspector-perl/branches/upstream/current/t/02_main.t (from rev 1354, packages/libclass-inspector-perl/branches/upstream/current/t/01_main.t)
More information about the Pkg-perl-cvs-commits
mailing list