]> git.vpit.fr Git - perl/modules/Sub-Nary.git/blob - samples/cx.pl
Fix a bug the handling of if (do { return if ; }) { ... }
[perl/modules/Sub-Nary.git] / 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
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);