t/op/blocks.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 plan tests => 3;
  10
  11 my @expect = qw(
  12 b1
  13 b2
  14 b3
  15 b4
  16 b6
  17 u5
  18 b7
  19 u6
  20 u1
  21 c3
  22 c2
  23 c1
  24 i1
  25 i2
  26 b5
  27 u2
  28 u3
  29 u4
  30 e2
  31 e1
  32                 );
  33 my $expect = ":" . join(":", @expect);
  34
  35 fresh_perl_is(<<'SCRIPT', $expect,{switches => [''], stdin => '', stderr => 1 },'Order of execution of special blocks');
  36 BEGIN {print ":b1"}
  37 END {print ":e1"}
  38 BEGIN {print ":b2"}
  39 {
  40     BEGIN {BEGIN {print ":b3"}; print ":b4"}
  41 }
  42 CHECK {print ":c1"}
  43 INIT {print ":i1"}
  44 UNITCHECK {print ":u1"}
  45 eval 'BEGIN {print ":b5"}';
  46 eval 'UNITCHECK {print ":u2"}';
  47 eval 'UNITCHECK {print ":u3"; UNITCHECK {print ":u4"}}';
  48 "a" =~ /(?{UNITCHECK {print ":u5"};
  49            CHECK {print ":c2"};
  50            BEGIN {print ":b6"}})/x;
  51 eval {BEGIN {print ":b7"}};
  52 eval {UNITCHECK {print ":u6"}};
  53 eval {INIT {print ":i2"}};
  54 eval {CHECK {print ":c3"}};
  55 END {print ":e2"}
  56 SCRIPT
  57
  58 @expect =(
  59 # BEGIN
  60 qw( main bar myfoo foo ),
  61 # UNITCHECK
  62 qw( foo myfoo bar main ),
  63 # CHECK
  64 qw( foo myfoo bar main ),
  65 # INIT
  66 qw( main bar myfoo foo ),
  67 # END
  68 qw(foo myfoo bar main  ));
  69
  70 $expect = ":" . join(":", @expect);
  71 fresh_perl_is(<<'SCRIPT2', $expect,{switches => [''], stdin => '', stderr => 1 },'blocks interact with packages/scopes');
  72 BEGIN {$f = 'main'; print ":$f"}
  73 UNITCHECK {print ":$f"}
  74 CHECK {print ":$f"}
  75 INIT {print ":$f"}
  76 END {print ":$f"}
  77 package bar;
  78 BEGIN {$f = 'bar';print ":$f"}
  79 UNITCHECK {print ":$f"}
  80 CHECK {print ":$f"}
  81 INIT {print ":$f"}
  82 END {print ":$f"}
  83 package foo;
  84 {
  85     my $f;
  86     BEGIN {$f = 'myfoo'; print ":$f"}
  87     UNITCHECK {print ":$f"}
  88     CHECK {print ":$f"}
  89     INIT {print ":$f"}
  90     END {print ":$f"}
  91 }
  92 BEGIN {$f = "foo";print ":$f"}
  93 UNITCHECK {print ":$f"}
  94 CHECK {print ":$f"}
  95 INIT {print ":$f"}
  96 END {print ":$f"}
  97 SCRIPT2
  98
  99 @expect = qw(begin unitcheck check init end);
 100 $expect = ":" . join(":", @expect);
 101 fresh_perl_is(<<'SCRIPT3', $expect,{switches => [''], stdin => '', stderr => 1 },'can name blocks as sub FOO');
 102 sub BEGIN {print ":begin"}
 103 sub UNITCHECK {print ":unitcheck"}
 104 sub CHECK {print ":check"}
 105 sub INIT {print ":init"}
 106 sub END {print ":end"}
 107 SCRIPT3