Commit | Line | Data |
8f6efeb9 |
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 } ; |
4b5a62e4 |
11 | |
12 | *CORE::GLOBAL::rename = |
13 | sub($$) { my( $old, $new ) = @_; CORE::rename $old, $new } ; |
14 | |
15 | *CORE::GLOBAL::sysopen = |
16 | sub(*$$;$) { my( $h, $n, $m, $p ) = @_; CORE::sysopen $h, $n, $m, $p } ; |
8f6efeb9 |
17 | } |
18 | |
19 | sub test_driver { |
20 | |
21 | my( $tests ) = @_ ; |
22 | |
23 | use Data::Dumper ; |
24 | |
25 | # plan for one expected ok() call per test |
26 | |
27 | plan( tests => scalar @{$tests} ) ; |
28 | |
29 | # loop over all the tests |
30 | |
31 | foreach my $test ( @{$tests} ) { |
32 | |
33 | #print Dumper $test ; |
34 | |
35 | if ( $test->{skip} ) { |
36 | ok( 1, "SKIPPING $test->{name}" ) ; |
37 | next ; |
38 | } |
39 | |
40 | my $override = $test->{override} ; |
41 | |
42 | # run any setup sub before this test. this can is used to modify the |
4b5a62e4 |
43 | # object for this test or create test files and data. |
8f6efeb9 |
44 | |
45 | if( my $pretest = $test->{pretest} ) { |
46 | |
47 | $pretest->($test) ; |
48 | } |
49 | |
4b5a62e4 |
50 | if( my $sub = $test->{sub} ) { |
8f6efeb9 |
51 | |
4b5a62e4 |
52 | my $args = $test->{args} ; |
8f6efeb9 |
53 | |
4b5a62e4 |
54 | local( $^W ) ; |
55 | local *{"CORE::GLOBAL::$override"} = sub {} |
56 | if $override ; |
8f6efeb9 |
57 | |
4b5a62e4 |
58 | $test->{result} = eval { $sub->( @{$args} ) } ; |
8f6efeb9 |
59 | |
4b5a62e4 |
60 | if ( $@ ) { |
8f6efeb9 |
61 | |
4b5a62e4 |
62 | # if we had an error and expected it, we pass this test |
8f6efeb9 |
63 | |
4b5a62e4 |
64 | if ( $test->{error} && |
65 | $@ =~ /$test->{error}/ ) { |
8f6efeb9 |
66 | |
4b5a62e4 |
67 | $test->{ok} = 1 ; |
68 | } |
69 | else { |
70 | print "unexpected error: $@\n" ; |
71 | $test->{ok} = 0 ; |
72 | } |
8f6efeb9 |
73 | } |
74 | } |
75 | |
76 | if( my $posttest = $test->{posttest} ) { |
77 | |
78 | $posttest->($test) ; |
79 | } |
4b5a62e4 |
80 | |
81 | ok( $test->{ok}, $test->{name} ) if exists $test->{ok} ; |
82 | is( $test->{result}, $test->{expected}, $test->{name} ) if |
83 | exists $test->{expected} ; |
84 | |
8f6efeb9 |
85 | } |
86 | } |
87 | |
88 | 1 ; |