samples/cx.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib qw<blib/lib blib/arch>;
   7
   8 my $bd;
   9 BEGIN {
  10  if (eval "use B::RecDeparse; 1") {
  11   $bd = B::RecDeparse->new;
  12  } else {
  13   use B::Deparse;
  14   $bd = B::Deparse->new;
  15  }
  16 }
  17 use B::Concise;
  18 use Sub::Nary;
  19
  20 my ($x, $y, @z, %h);
  21
  22 sub wat {
  23  wantarray ? (1, 2) : 1;
  24 }
  25
  26 sub wut {
  27  my $u = wat 3;
  28  if ($x) {
  29   return wat(1), wat(1), wat(1), wat(1);
  30  } elsif ($y) {
  31   sub { qr/wat/ }, %h;
  32  } elsif (@z) {
  33   { wat => 1 }
  34  } elsif (@_) {
  35   return $x, $y;
  36  } else {
  37   1, $x, 4;
  38  }
  39 }
  40
  41 sub foo {
  42  if ($x) {
  43   return 1;
  44  } else {
  45   return 2, 3;
  46  }
  47 }
  48
  49 sub wut2 {
  50  if ($x) {
  51  } elsif ($y) {
  52   sub { qr/wat/ }, %h;
  53  } elsif (@z) {
  54   return [ ];
  55  }
  56 }
  57
  58 sub rr {
  59  return return;
  60 }
  61
  62 sub forr {
  63  return 1, 2 for 1 .. 4;
  64 }
  65
  66 sub ifr {
  67  if (return 1, 2) {
  68   return 1, 2, 3
  69  }
  70  return @_[0 .. 3]
  71 }
  72
  73 my $code = \&wut;
  74
  75 print STDERR $bd->coderef2text($code), "\n";
  76
  77 B::Concise::walk_output(\*STDERR);
  78 B::Concise::concise_subref('basic', $code, 'cx_test');
  79
  80 my $sn = Sub::Nary->new();
  81 my $cx = $sn->nary($code);
  82 use Data::Dumper;
  83 print STDERR Dumper($cx);