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