cpan/Test-Harness/t/harness-subclass.t

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4     unshift @INC, 't/lib';
   5 }
   6
   7 use strict;
   8 use TAP::Harness;
   9 use Test::More tests => 13;
  10
  11 my %class_map = (
  12     aggregator_class  => 'My::TAP::Parser::Aggregator',
  13     formatter_class   => 'My::TAP::Formatter::Console',
  14     multiplexer_class => 'My::TAP::Parser::Multiplexer',
  15     parser_class      => 'My::TAP::Parser',
  16     scheduler_class   => 'My::TAP::Parser::Scheduler',
  17 );
  18
  19 my %loaded = ();
  20
  21 # Synthesize our subclasses
  22 for my $class ( values %class_map ) {
  23     ( my $base_class = $class ) =~ s/^My:://;
  24     use_ok($base_class);
  25
  26     no strict 'refs';
  27     @{"${class}::ISA"} = ($base_class);
  28     *{"${class}::new"} = sub {
  29         my $pkg = shift;
  30         $loaded{$pkg} = 1;
  31
  32         # Can't use SUPER outside a package
  33         return $base_class->can('new')->( $pkg, @_ );
  34     };
  35 }
  36
  37 {
  38     ok my $harness = TAP::Harness->new( { %class_map, verbosity => -9 } ),
  39       'created harness';
  40     isa_ok $harness, 'TAP::Harness';
  41
  42     # Test dynamic loading
  43     ok !$INC{'NOP.pm'}, 'NOP not loaded';
  44     ok my $nop = $harness->_construct('NOP'), 'loaded and created';
  45     isa_ok $nop, 'NOP';
  46     ok $INC{'NOP.pm'}, 'NOP loaded';
  47
  48     my $aggregate = $harness->runtests(
  49         File::Spec->catfile(
  50             't',
  51             'sample-tests',
  52             'simple'
  53         )
  54     );
  55
  56     isa_ok $aggregate, 'My::TAP::Parser::Aggregator';
  57
  58     is_deeply \%loaded,
  59       { 'My::TAP::Parser::Aggregator' => 1,
  60         'My::TAP::Formatter::Console' => 1,
  61         'My::TAP::Parser'             => 1,
  62         'My::TAP::Parser::Scheduler'  => 1,
  63       },
  64       'loaded our classes';
  65 }