t/pragma/warn/pp_ctl

   1   pp_ctl.c      AOK
   2
   3      Not enough format arguments
   4         format STDOUT =
   5         @<<< @<<<
   6         $a
   7         .
   8         write;
   9
  10
  11     Exiting substitution via %s
  12         $_ = "abc" ;
  13         while ($i ++ == 0)
  14         {
  15             s/ab/last/e ;
  16         }
  17
  18     Exiting subroutine via %s
  19         sub fred { last }
  20         { fred() }
  21
  22     Exiting eval via %s
  23         { eval "last" }
  24
  25     Exiting pseudo-block via %s
  26         @a = (1,2) ; @b = sort { last } @a ;
  27
  28     Exiting substitution via %s
  29         $_ = "abc" ;
  30         last fred:
  31         while ($i ++ == 0)
  32         {
  33             s/ab/last fred/e ;
  34         }
  35
  36
  37     Exiting subroutine via %s
  38         sub fred { last joe }
  39         joe: { fred() }
  40
  41     Exiting eval via %s
  42         fred: { eval "last fred" }
  43
  44     Exiting pseudo-block via %s
  45         @a = (1,2) ; fred: @b = sort { last fred } @a ;
  46
  47
  48     Deep recursion on subroutine \"%s\"
  49         sub fred
  50         {
  51         goto &fred() if $a++ < 200
  52         }
  53
  54         goto &fred()
  55
  56       (in cleanup) foo bar
  57         package Foo;
  58         DESTROY { die "foo bar" }
  59         { bless [], 'Foo' for 1..10 }
  60
  61 __END__
  62 # pp_ctl.c
  63 use warning 'syntax' ;
  64 format STDOUT =
  65 @<<< @<<<
  66 1
  67 .
  68 write;
  69 EXPECT
  70 Not enough format arguments at - line 5.
  71 1
  72 ########
  73 # pp_ctl.c
  74 use warning 'unsafe' ;
  75 $_ = "abc" ;
  76
  77 while ($i ++ == 0)
  78 {
  79     s/ab/last/e ;
  80 }
  81 EXPECT
  82 Exiting substitution via last at - line 7.
  83 ########
  84 # pp_ctl.c
  85 use warning 'unsafe' ;
  86 sub fred { last }
  87 { fred() }
  88 EXPECT
  89 Exiting subroutine via last at - line 3.
  90 ########
  91 # pp_ctl.c
  92 use warning 'unsafe' ;
  93 { eval "last;" }
  94 print STDERR $@ ;
  95 EXPECT
  96 Exiting eval via last at (eval 1) line 1.
  97 ########
  98 # pp_ctl.c
  99 use warning 'unsafe' ;
 100 @a = (1,2) ;
 101 @b = sort { last } @a ;
 102 EXPECT
 103 Exiting pseudo-block via last at - line 4.
 104 Can't "last" outside a block at - line 4.
 105 ########
 106 # pp_ctl.c
 107 use warning 'unsafe' ;
 108 $_ = "abc" ;
 109 fred:
 110 while ($i ++ == 0)
 111 {
 112     s/ab/last fred/e ;
 113 }
 114 EXPECT
 115 Exiting substitution via last at - line 7.
 116 ########
 117 # pp_ctl.c
 118 use warning 'unsafe' ;
 119 sub fred { last joe }
 120 joe: { fred() }
 121 EXPECT
 122 Exiting subroutine via last at - line 3.
 123 ########
 124 # pp_ctl.c
 125 use warning 'unsafe' ;
 126 joe: { eval "last joe;" }
 127 print STDERR $@ ;
 128 EXPECT
 129 Exiting eval via last at (eval 1) line 1.
 130 ########
 131 # pp_ctl.c
 132 use warning 'unsafe' ;
 133 @a = (1,2) ;
 134 fred: @b = sort { last fred } @a ;
 135 EXPECT
 136 Exiting pseudo-block via last at - line 4.
 137 Label not found for "last fred" at - line 4.
 138 ########
 139 # pp_ctl.c
 140 use warning 'recursion' ;
 141 BEGIN { warn "PREFIX\n" ;}
 142 sub fred
 143 {
 144     goto &fred() if $a++ < 200
 145 }
 146
 147 goto &fred()
 148 EXPECT
 149 Deep recursion on subroutine "main::fred" at - line 6.
 150 ########
 151 # pp_ctl.c
 152 use warning 'unsafe' ;
 153 package Foo;
 154 DESTROY { die "@{$_[0]} foo bar" }
 155 { bless ['A'], 'Foo' for 1..10 }
 156 EXPECT
 157         (in cleanup) A foo bar at - line 4.