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