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