t/TestDriver.pm

   1 # driver.pm - common test driver code
   2
   3 use Test::More ;
   4
   5 BEGIN {
   6         *CORE::GLOBAL::syswrite =
   7         sub(*\$$;$) { my( $h, $b, $s ) = @_; CORE::syswrite $h, $b, $s } ;
   8
   9         *CORE::GLOBAL::sysread =
  10         sub(*\$$;$) { my( $h, $b, $s ) = @_; CORE::sysread $h, $b, $s } ;
  11 }
  12
  13 sub test_driver {
  14
  15         my( $tests ) = @_ ;
  16
  17 use Data::Dumper ;
  18
  19 # plan for one expected ok() call per test
  20
  21         plan( tests => scalar @{$tests} ) ;
  22
  23 # loop over all the tests
  24
  25         foreach my $test ( @{$tests} ) {
  26
  27 #print Dumper $test ;
  28
  29                 if ( $test->{skip} ) {
  30                         ok( 1, "SKIPPING $test->{name}" ) ;
  31                         next ;
  32                 }
  33
  34                 my $override = $test->{override} ;
  35
  36 # run any setup sub before this test. this can is used to modify the
  37 # object for this test (e.g. delete templates from the cache).
  38
  39                 if( my $pretest = $test->{pretest} ) {
  40
  41                         $pretest->($test) ;
  42                 }
  43
  44                 my $sub = $test->{sub} ;
  45                 my $args = $test->{args} ;
  46
  47 local( $^W) ;
  48                 local *{"CORE::GLOBAL::$override"} = sub {} if $override ;
  49
  50                 my $result = eval {
  51                         $sub->( @{$args} ) ;
  52                 } ;
  53
  54 # if we had an error and expected it, we pass this test
  55
  56                 if ( $@ ) {
  57
  58                         if ( $test->{error} && $@ =~ /$test->{error}/ ) {
  59
  60                                 ok( 1, $test->{name} ) ;
  61 #print "ERR [$@]\n" ;
  62                         }
  63                         else {
  64
  65                                 print "unexpected error: $@\n" ;
  66                                 ok( 0, $test->{name} ) ;
  67                         }
  68                 }
  69
  70                 if( my $posttest = $test->{posttest} ) {
  71
  72                         $posttest->($test) ;
  73                 }
  74         }
  75 }
  76
  77 1 ;