From: Uri Guttman Date: Fri, 5 Jun 2009 05:13:52 +0000 (-0400) Subject: moved some experiment files to experiment X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8f6efeb9abadd61fe560bdecf1f99a6c31f22746;p=urisagit%2FFile-Slurp.git moved some experiment files to experiment rename t/driver.pm to TestDriver.pm fixed bug when slurping pseudofiles in /proc --- diff --git a/t/TestDriver.pm b/t/TestDriver.pm new file mode 100644 index 0000000..ca75377 --- /dev/null +++ b/t/TestDriver.pm @@ -0,0 +1,77 @@ +# driver.pm - common test driver code + +use Test::More ; + +BEGIN { + *CORE::GLOBAL::syswrite = + sub(*\$$;$) { my( $h, $b, $s ) = @_; CORE::syswrite $h, $b, $s } ; + + *CORE::GLOBAL::sysread = + sub(*\$$;$) { my( $h, $b, $s ) = @_; CORE::sysread $h, $b, $s } ; +} + +sub test_driver { + + my( $tests ) = @_ ; + +use Data::Dumper ; + +# plan for one expected ok() call per test + + plan( tests => scalar @{$tests} ) ; + +# loop over all the tests + + foreach my $test ( @{$tests} ) { + +#print Dumper $test ; + + if ( $test->{skip} ) { + ok( 1, "SKIPPING $test->{name}" ) ; + next ; + } + + 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). + + if( my $pretest = $test->{pretest} ) { + + $pretest->($test) ; + } + + my $sub = $test->{sub} ; + my $args = $test->{args} ; + +local( $^W) ; + local *{"CORE::GLOBAL::$override"} = sub {} if $override ; + + my $result = eval { + $sub->( @{$args} ) ; + } ; + +# if we had an error and expected it, we pass this test + + if ( $@ ) { + + if ( $test->{error} && $@ =~ /$test->{error}/ ) { + + ok( 1, $test->{name} ) ; +#print "ERR [$@]\n" ; + } + else { + + print "unexpected error: $@\n" ; + ok( 0, $test->{name} ) ; + } + } + + if( my $posttest = $test->{posttest} ) { + + $posttest->($test) ; + } + } +} + +1 ;