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