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'; |
ef060a86 |
16 | $dpp .= '.com' if $^O eq 'VMS'; |
583a019e |
17 | |
18 | print "\nperl: $perl\n" if $opt_v; |
19 | if( ! -f $perl ){ die "Where's Perl?" } |
95667ae4 |
20 | if( ! -f $dpp ){ die "Where's dprofpp?" } |
583a019e |
21 | |
22 | sub dprofpp { |
23 | my $switches = shift; |
24 | |
ef060a86 |
25 | open( D, "$perl \"-I../lib\" $dpp \"$switches\" 2> err |" ) || warn "$0: Can't run. $!\n"; |
583a019e |
26 | @results = <D>; |
27 | close D; |
28 | |
29 | open( D, "<err" ) || warn "$0: Can't open: $!\n"; |
30 | @err = <D>; |
31 | close D; |
32 | push( @results, @err ) if @err; |
33 | |
34 | $results = qq{@results}; |
35 | # ignore Loader (Dyna/Auto etc), leave newline |
36 | $results =~ s/^\w+Loader::import//; |
37 | $results =~ s/\n /\n/gm; |
38 | $results; |
39 | } |
40 | |
41 | sub report { |
42 | $num = shift; |
43 | my $sub = shift; |
44 | my $x; |
45 | |
46 | $x = &$sub; |
47 | $x ? &ok : ¬ok; |
48 | } |
49 | |
50 | sub ok { |
95667ae4 |
51 | print "ok $num\n"; |
583a019e |
52 | } |
53 | |
54 | sub notok { |
95667ae4 |
55 | print "not ok $num\n"; |
56 | print "\nResult\n{$results}\n"; |
57 | print "Expected\n{$expected}\n"; |
583a019e |
58 | } |
59 | |
583a019e |
60 | 1; |