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