X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2FTestDriver.pm;h=e802d2dcf9a07711a5fd32cc5f634ff4e3813c16;hb=6f9e0c6929226812bf260b73d011a7f282c7513a;hp=ca7537788bad350cf86bd422aa53f641e56c0efe;hpb=8f6efeb9abadd61fe560bdecf1f99a6c31f22746;p=urisagit%2FPerl-Docs.git diff --git a/t/TestDriver.pm b/t/TestDriver.pm index ca75377..e802d2d 100644 --- a/t/TestDriver.pm +++ b/t/TestDriver.pm @@ -8,6 +8,12 @@ BEGIN { *CORE::GLOBAL::sysread = sub(*\$$;$) { my( $h, $b, $s ) = @_; CORE::sysread $h, $b, $s } ; + + *CORE::GLOBAL::rename = + sub($$) { my( $old, $new ) = @_; CORE::rename $old, $new } ; + + *CORE::GLOBAL::sysopen = + sub(*$$;$) { my( $h, $n, $m, $p ) = @_; CORE::sysopen $h, $n, $m, $p } ; } sub test_driver { @@ -34,36 +40,36 @@ use Data::Dumper ; my $override = $test->{override} ; # run any setup sub before this test. this can is used to modify the -# object for this test (e.g. delete templates from the cache). +# object for this test or create test files and data. if( my $pretest = $test->{pretest} ) { $pretest->($test) ; } - my $sub = $test->{sub} ; - my $args = $test->{args} ; + if( my $sub = $test->{sub} ) { -local( $^W) ; - local *{"CORE::GLOBAL::$override"} = sub {} if $override ; + my $args = $test->{args} ; - my $result = eval { - $sub->( @{$args} ) ; - } ; + local( $^W ) ; + local *{"CORE::GLOBAL::$override"} = sub {} + if $override ; -# if we had an error and expected it, we pass this test + $test->{result} = eval { $sub->( @{$args} ) } ; - if ( $@ ) { + if ( $@ ) { - if ( $test->{error} && $@ =~ /$test->{error}/ ) { +# if we had an error and expected it, we pass this test - ok( 1, $test->{name} ) ; -#print "ERR [$@]\n" ; - } - else { + if ( $test->{error} && + $@ =~ /$test->{error}/ ) { - print "unexpected error: $@\n" ; - ok( 0, $test->{name} ) ; + $test->{ok} = 1 ; + } + else { + print "unexpected error: $@\n" ; + $test->{ok} = 0 ; + } } } @@ -71,6 +77,11 @@ local( $^W) ; $posttest->($test) ; } + + ok( $test->{ok}, $test->{name} ) if exists $test->{ok} ; + is( $test->{result}, $test->{expected}, $test->{name} ) if + exists $test->{expected} ; + } }