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