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