view release on metacpan or  search on metacpan

lib/Acme/Test.pm  view on Meta::CPAN

                ]       
            },
    SCALAR  => { type   => 'global scalar', 
                 pre    => '$',
                 tests  => [
                    'available',
                    'initialized properly',
                    'content OK',
                ]
            },
    HASH    => { type   => 'global hash',
                 pre    => '%',
                 tests  => [
                    'available',
                    'initialized properly',
                    'contains all expected key/value pairs',
                ]
            },
    ARRAY   => { type   => 'global array',
                 pre    => '@',
                 tests  => [
                    'available',
                    'initialized properly',
                    'contains all expected elements',
                ]
            },
    IO      => { type   => 'global IO/Filehandle',
                 tests  => [
                    'available',
                    'initialized properly',
                ]
            },
    FORMAT  => { type   => 'format',
                 tests  => [
                    'available',
                    'prints ok',               
                ]
            },
  	Regexp	=> { type	=> 'regex',
  				 tests	=> [
  				 	'available',
  				 	'initialized properly',
  				]
 			}, 					 	          
};

sub import {
    my $class = shift;
    
    unless(@_) {
        warn    qq[Useless call to Acme::Test::import!\n] .
                qq[Usage:\tuse Acme::Test qw|Your::Package|\n];
        return;
    }
    
    no strict 'refs';      
    for my $mod ( @_ ) {
        load $mod;
 
 		my $str  = join '/', split '::', $mod;
 		my @pkgs = map { s|/|::|g; s/\.pm$//i; $_ } grep /^$str/, keys %INC;
       
      	for my $pkg (@pkgs) {
      		diag("Testing $pkg");
      	
			my $stash = $pkg . '::';
			for my $name (sort keys %$stash ) {
		   
				for my $type (keys %$href) {
				
					my $x = *{"$stash->{$name}"}{$type};
					next unless defined $x;
					
					### so apparently some entries in the scalar slot
					### are set regardless, but are references to undef
					### let's just skip these...
					next if ref $x eq "SCALAR" and not defined $$x; 
					
					### some hash entries might be other stashes again
					### let's just skip these as well...
					next if ref $x eq "HASH" and $name =~ /::$/;
					
					my $priv    = $name =~/^_/ ? 1 : 0;
					my $status  = $priv ? '[Private]' : '[Public]';
		
					#next if $priv && $NO_PRIVATE;
					
					### add sigils and the like ###
					my $short   = $name;
					my $full    = "${pkg}::$name";
					for my $alias ($short, $full) {
						$alias = $href->{$type}->{pre} . $alias 
														 if $href->{$type}->{pre};
						$alias .= $href->{$type}->{post} if $href->{$type}->{post};
					}
										   
					diag("$status Testing $href->{$type}->{type} $full"); 
					
					for my $test ( @{$href->{$type}->{tests}} ) {
						ok( 1, "    $short $test" );
					}
				}
			}
		}
    }      
}


=pod

=head1 NAME

Acme::Test

=head1 SYNOPSIS

    use Acme::Test qw[Your::Module Your::Other::Module];

=head1 DESCRIPTION

All the latest software craze is about regression tests and XP