1#!./perl
2
3BEGIN {
4	chdir 't' if -d 't';
5	@INC = '../lib';
6}
7
8use Test::More tests => 16;
9
10use_ok( 'B::Terse' );
11
12# indent should return a string indented four spaces times the argument
13is( B::Terse::indent(2), ' ' x 8, 'indent with an argument' );
14is( B::Terse::indent(), '', 'indent with no argument' );
15
16# this should fail without a reference
17eval { B::Terse::terse('scalar') };
18like( $@, qr/not a reference/, 'terse() fed bad parameters' );
19
20# now point it at a sub and see what happens
21sub foo {}
22
23my $sub;
24eval{ $sub = B::Terse::compile('', 'foo') };
25is( $@, '', 'compile()' );
26ok( defined &$sub, 'valid subref back from compile()' );
27
28# and point it at a real sub and hope the returned ops look alright
29my $out = tie *STDOUT, 'TieOut';
30$sub = B::Terse::compile('', 'bar');
31$sub->();
32
33# now build some regexes that should match the dumped ops
34my ($hex, $op) = ('\(0x[a-f0-9]+\)', '\s+\w+');
35my %ops = map { $_ => qr/$_ $hex$op/ }
36	qw ( OP	COP LOOP PMOP UNOP BINOP LOGOP LISTOP PVOP );
37
38# split up the output lines into individual ops (terse is, well, terse!)
39# use an array here so $_ is modifiable
40my @lines = split(/\n+/, $out->read);
41foreach (@lines) {
42	next unless /\S/;
43	s/^\s+//;
44	if (/^([A-Z]+)\s+/) {
45		my $op = $1;
46		next unless exists $ops{$op};
47		like( $_, $ops{$op}, "$op " );
48		delete $ops{$op};
49		s/$ops{$op}//;
50		redo if $_;
51	}
52}
53
54warn "# didn't find " . join(' ', keys %ops) if keys %ops;
55
56# XXX:
57# this tries to get at all tersified optypes in B::Terse
58# if you can think of a way to produce AV, NULL, PADOP, or SPECIAL,
59# add it to the regex above too. (PADOPs are currently only produced
60# under ithreads, though).
61#
62use vars qw( $a $b );
63sub bar {
64	# OP SVOP COP IV here or in sub definition
65	my @bar = (1, 2, 3);
66
67	# got a GV here
68	my $foo = $a + $b;
69
70	# NV here
71	$a = 1.234;
72
73	# this is awful, but it gives a PMOP
74	my $boo = split('', $foo);
75
76	# PVOP, LOOP
77	LOOP: for (1 .. 10) {
78		last LOOP if $_ % 2;
79	}
80
81	# make a PV
82	$foo = "a string";
83
84	# make an OP_SUBSTCONT
85	$foo =~ s/(a)/$1/;
86}
87
88# Schwern's example of finding an RV
89my $path = join " ", map { qq["-I$_"] } @INC;
90$path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS';
91my $redir = $^O eq 'MacOS' ? '' : "2>&1";
92my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir};
93like( $items, qr/RV $hex \\42/, 'RV' );
94
95package TieOut;
96
97sub TIEHANDLE {
98	bless( \(my $out), $_[0] );
99}
100
101sub PRINT {
102	my $self = shift;
103	$$self .= join('', @_);
104}
105
106sub PRINTF {
107	my $self = shift;
108	$$self .= sprintf(@_);
109}
110
111sub read {
112	my $self = shift;
113	return substr($$self, 0, length($$self), '');
114}
115