dslinux/user/perl/t/lib/dprof V.pm test1_t test1_v test2_t test2_v test3_t test3_v test4_t test4_v test5_t test5_v test6_t test6_v test7_t test7_v test8_t test8_v

[cayenne]

Update of /cvsroot/dslinux/dslinux/user/perl/t/lib/dprof
In directory antilope:/tmp/cvs-serv17422/t/lib/dprof

Added Files:
	V.pm test1_t test1_v test2_t test2_v test3_t test3_v test4_t 
	test4_v test5_t test5_v test6_t test6_v test7_t test7_v 
	test8_t test8_v 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: test8_v ---
# perl

use V;

dprofpp( '-t' );
$expected = 
qq{main::foo (2x)
main::bar
};

report 20, sub { $expected eq $results };

--- NEW FILE: test1_v ---
# perl

use V;

dprofpp( '-T' );
$expected = 
qq{main::bar
main::baz
   main::bar
   main::foo
      main::bar
main::foo
   main::bar
};
report 1, sub { $expected eq $results };

dprofpp('-TF');
report 2, sub { $expected eq $results };

dprofpp( '-t' );
report 3, sub { $expected eq $results };

dprofpp('-tF');
report 4, sub { $expected eq $results };

--- NEW FILE: test8_t ---
sub foo {
	print "in sub foo\n";
}

sub bar {
	print "in sub bar\n";
	$^P -= 0x40;
}

foo();
$^P -= 0x40;
foo();
$^P += 0x40;
bar();
$^P += 0x40;

--- NEW FILE: test1_t ---
sub foo {
	print "in sub foo\n";
	bar();
}

sub bar {
	print "in sub bar\n";
}

sub baz {
	print "in sub baz\n";
	bar();
	foo();
}

bar();
baz();
foo();

--- NEW FILE: test5_v ---
# perl

use V;

dprofpp( '-T' );
$expected =
qq{main::foo1
   main::bar
      main::yeppers
main::foo2
   main::bar
      main::yeppers
};
report 17, sub { $expected eq $results };


--- NEW FILE: test5_t ---
# Test that dprof doesn't break
#    &bar;  used as &bar(@_);

sub foo1 {
	print "in foo1(@_)\n";
	bar(@_);
}
sub foo2 {
	print "in foo2(@_)\n";
	&bar;
}
sub bar {
	print "in bar(@_)\n";
	if( @_ > 0 ){
		&yeppers;
	}
}
sub yeppers {
	print "rest easy\n";
}


&foo1( A );
&foo2( B );


--- NEW FILE: test4_v ---
# perl

use V;

dprofpp( '-T' );
$expected =
qq{main::bar
main::bar
main::baz
   main::bar
   main::bar
   main::bar
   main::foo
      main::bar
main::foo
   main::bar
};
report 13, sub { $expected eq $results };

dprofpp('-TF');
report 14, sub { $expected eq $results };

dprofpp( '-t' );
$expected =
qq{main::bar (2x)
main::baz
   main::bar (3x)
   main::foo
      main::bar
main::foo
   main::bar
};
report 15, sub { $expected eq $results };

dprofpp('-tF');
report 16, sub { $expected eq $results };

--- NEW FILE: test3_t ---
sub foo {
	print "in sub foo\n";
	exit(0);
	bar();
}

sub bar {
	print "in sub bar\n";
}

sub baz {
	print "in sub baz\n";
	bar();
	foo();
}

bar();
baz();
foo();

--- NEW FILE: test4_t ---
sub foo {
	print "in sub foo\n";
	bar();
}

sub bar {
	print "in sub bar\n";
}

sub baz {
	print "in sub baz\n";
	bar();
	bar();
	bar();
	foo();
}

bar();

eval { fork };

bar();
baz();
foo();

--- NEW FILE: test3_v ---
# perl

use V;

dprofpp( '-T' );
$e1 = $expected =
qq{main::bar
main::baz
   main::bar
   main::foo
};
report 9, sub { $expected eq $results };

dprofpp('-TF');
$e2 = $expected =
qq{main::bar
main::baz
   main::bar
   main::foo
};
report 10, sub { $expected eq $results };

dprofpp( '-t' );
$expected = $e1;
report 11, sub { 1 };

dprofpp('-tF');
$expected = $e2;
report 12, sub { $expected eq $results };

--- NEW FILE: test7_t ---
BEGIN {
	print "in BEGIN\n";
}

sub foo {
	print "in sub foo\n";
}

foo();

--- NEW FILE: test7_v ---
# perl

use V;

dprofpp( '-T' );
$expected = 
qq{main::BEGIN
main::foo
};
report 19, sub { $expected eq $results };

--- NEW FILE: test2_t ---
sub foo {
	print "in sub foo\n";
	bar();
}

sub bar {
	print "in sub bar\n";
}

sub baz {
	print "in sub baz\n";
	bar();
	bar();
	bar();
	foo();
}

bar();
bar();
baz();
foo();

--- NEW FILE: V.pm ---
package V;

use Getopt::Std 'getopts';
getopts('vp:d:');

require Exporter;
@ISA = 'Exporter';

@EXPORT = qw( dprofpp $opt_v $results $expected report @results );
@EXPORT_OK = qw( notok ok $num );

$num = 0;
$results = $expected = '';
$perl = $opt_p || $^X;
$dpp = $opt_d || '../utils/dprofpp';
$dpp .= '.com' if $^O eq 'VMS';

print "\nperl: $perl\n" if $opt_v;
if( ! -f $perl ){ die "Where's Perl?" }
if( ! -f $dpp ) { 
    ($dpp = $^X) =~ s@(^.*)[/|\\].*@$1/dprofpp@;
    die "Where's dprofpp?" if( ! -f $dpp );
}

sub dprofpp {
	my $switches = shift;

        open( D, "$perl \"-I../lib\" $dpp \"$switches\" 2> err |" ) || warn "$0: Can't run. $!\n";
	@results = <D>;
	close D;

	open( D, "<err" ) || warn "$0: Can't open: $!\n";
	@err = <D>;
	close D;
	push( @results, @err ) if @err;

	$results = qq{@results};
	# ignore Loader (Dyna/Auto etc), leave newline
	$results =~ s/^\w+Loader::import//;
	$results =~ s/\n /\n/gm;
	$results;
}

sub report {
	$num = shift;
	my $sub = shift;
	my $x;

	$x = &$sub;
	$x ? &ok : &notok;
}

sub ok {
	print "ok $num\n";
}

sub notok {
	print "not ok $num\n";
	print "\nResult\n{$results}\n";
	print "Expected\n{$expected}\n";
}

1;

--- NEW FILE: test2_v ---
# perl

use V;

dprofpp( '-T' );
$expected =
qq{main::bar
main::bar
main::baz
   main::bar
   main::bar
   main::bar
   main::foo
      main::bar
main::foo
   main::bar
};
report 5, sub { $expected eq $results };

dprofpp('-TF');
report 6, sub { $expected eq $results };

dprofpp( '-t' );
$expected =
qq{main::bar (2x)
main::baz
   main::bar (3x)
   main::foo
      main::bar
main::foo
   main::bar
};
report 7, sub { $expected eq $results };

dprofpp('-tF');
report 8, sub { $expected eq $results };

--- NEW FILE: test6_t ---
sub foo {
	my $x;
	my $y;
	print "in sub foo\n";
	for( $x = 1; $x < 100; ++$x ){
		bar();
		for( $y = 1; $y < 100; ++$y ){
		}
	}
}

sub bar {
	my $x;
	print "in sub bar\n";
	for( $x = 1; $x < 100; ++$x ){
	}
	die "bar exiting";
}

sub baz {
	print "in sub baz\n";
	eval { bar(); };
	eval { foo(); };
}

eval { bar(); };
baz();
eval { foo(); };


--- NEW FILE: test6_v ---
# perl

use V;

dprofpp( '-T' );
$expected =
qq{main::bar
main::baz
   main::bar
   main::foo
      main::bar
main::foo
   main::bar
};
report 18, sub { $expected eq $results };