6 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
7 print "1..0 # Skip -- Perl configured without B module\n";
12 use Test::More tests => 16;
16 # indent should return a string indented four spaces times the argument
17 is( B::Terse::indent(2), ' ' x 8, 'indent with an argument' );
18 is( B::Terse::indent(), '', 'indent with no argument' );
20 # this should fail without a reference
21 eval { B::Terse::terse('scalar') };
22 like( $@, qr/not a reference/, 'terse() fed bad parameters' );
24 # now point it at a sub and see what happens
28 eval{ $sub = B::Terse::compile('', 'foo') };
29 is( $@, '', 'compile()' );
30 ok( defined &$sub, 'valid subref back from compile()' );
32 # and point it at a real sub and hope the returned ops look alright
33 my $out = tie *STDOUT, 'TieOut';
34 $sub = B::Terse::compile('', 'bar');
37 # now build some regexes that should match the dumped ops
38 my ($hex, $op) = ('\(0x[a-f0-9]+\)', '\s+\w+');
39 my %ops = map { $_ => qr/$_ $hex$op/ }
40 qw ( OP COP LOOP PMOP UNOP BINOP LOGOP LISTOP PVOP );
42 # split up the output lines into individual ops (terse is, well, terse!)
43 # use an array here so $_ is modifiable
44 my @lines = split(/\n+/, $out->read);
50 next unless exists $ops{$op};
51 like( $_, $ops{$op}, "$op " );
58 warn "# didn't find " . join(' ', keys %ops) if keys %ops;
61 # this tries to get at all tersified optypes in B::Terse
62 # if you can think of a way to produce AV, NULL, PADOP, or SPECIAL,
63 # add it to the regex above too. (PADOPs are currently only produced
64 # under ithreads, though).
68 # OP SVOP COP IV here or in sub definition
77 # this is awful, but it gives a PMOP
78 our @ary = split('', $foo);
88 # make an OP_SUBSTCONT
92 # Schwern's example of finding an RV
93 my $path = join " ", map { qq["-I$_"] } @INC;
94 $path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS';
95 my $redir = $^O eq 'MacOS' ? '' : "2>&1";
96 my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir};
98 like( $items, qr/IV $hex \\42/, 'RV (but now stored in an IV)' );
100 like( $items, qr/RV $hex \\42/, 'RV' );
106 bless( \(my $out), $_[0] );
111 $$self .= join('', @_);
116 $$self .= sprintf(@_);
121 return substr($$self, 0, length($$self), '');