Commit | Line | Data |
583a019e |
1 | package V; |
2 | |
3 | use Getopt::Std 'getopts'; |
95667ae4 |
4 | getopts('vp:d:'); |
583a019e |
5 | |
6 | require Exporter; |
7 | @ISA = 'Exporter'; |
8 | |
9 | @EXPORT = qw( dprofpp $opt_v $results $expected report @results ); |
10 | @EXPORT_OK = qw( notok ok $num ); |
11 | |
583a019e |
12 | $num = 0; |
13 | $results = $expected = ''; |
14 | $perl = $opt_p || $^X; |
95667ae4 |
15 | $dpp = $opt_d || '../utils/dprofpp'; |
583a019e |
16 | |
17 | print "\nperl: $perl\n" if $opt_v; |
18 | if( ! -f $perl ){ die "Where's Perl?" } |
95667ae4 |
19 | if( ! -f $dpp ){ die "Where's dprofpp?" } |
583a019e |
20 | |
21 | sub dprofpp { |
22 | my $switches = shift; |
23 | |
95667ae4 |
24 | open( D, "$perl -I../lib $dpp $switches 2> err |" ) || warn "$0: Can't run. $!\n"; |
583a019e |
25 | @results = <D>; |
26 | close D; |
27 | |
28 | open( D, "<err" ) || warn "$0: Can't open: $!\n"; |
29 | @err = <D>; |
30 | close D; |
31 | push( @results, @err ) if @err; |
32 | |
33 | $results = qq{@results}; |
34 | # ignore Loader (Dyna/Auto etc), leave newline |
35 | $results =~ s/^\w+Loader::import//; |
36 | $results =~ s/\n /\n/gm; |
37 | $results; |
38 | } |
39 | |
40 | sub report { |
41 | $num = shift; |
42 | my $sub = shift; |
43 | my $x; |
44 | |
45 | $x = &$sub; |
46 | $x ? &ok : ¬ok; |
47 | } |
48 | |
49 | sub ok { |
95667ae4 |
50 | print "ok $num\n"; |
583a019e |
51 | } |
52 | |
53 | sub notok { |
95667ae4 |
54 | print "not ok $num\n"; |
55 | print "\nResult\n{$results}\n"; |
56 | print "Expected\n{$expected}\n"; |
583a019e |
57 | } |
58 | |
583a019e |
59 | 1; |