source: trunk/essentials/dev-lang/perl/t/lib/warnings/pp_ctl

  pp_ctl.c      AOK
 
     Not enough format arguments        
        format STDOUT =
        @<<< @<<<
        $a
        .
        write;
     

    Exiting substitution via %s
        $_ = "abc" ;
        while ($i ++ == 0)
        {
            s/ab/last/e ;
        }

    Exiting subroutine via %s           
        sub fred { last }
        { fred() }

    Exiting eval via %s 
        { eval "last" }

    Exiting pseudo-block via %s 
        @a = (1,2) ; @b = sort { last } @a ;

    Exiting substitution via %s
        $_ = "abc" ;
        last fred:
        while ($i ++ == 0)
        {
            s/ab/last fred/e ;
        }


    Exiting subroutine via %s
        sub fred { last joe }
        joe: { fred() }

    Exiting eval via %s
        fred: { eval "last fred" }

    Exiting pseudo-block via %s 
        @a = (1,2) ; fred: @b = sort { last fred } @a ;


    Deep recursion on subroutine \"%s\"
        sub fred
        {
          fred() if $a++ < 200
        }
         
        fred()

      (in cleanup) foo bar
        package Foo;
        DESTROY { die "foo bar" }
        { bless [], 'Foo' for 1..10 }

__END__
# pp_ctl.c
use warnings 'syntax' ;
format STDOUT =
@<<< @<<<
1
.
write;
EXPECT
Not enough format arguments at - line 5.
1
########
# pp_ctl.c
no warnings 'syntax' ;
format =
@<<< @<<<
1
.
write ;
EXPECT
1
########
# pp_ctl.c
use warnings 'exiting' ;
$_ = "abc" ;
 
while ($i ++ == 0)
{
    s/ab/last/e ;
}
no warnings 'exiting' ;
while ($i ++ == 0)
{
    s/ab/last/e ;
}
EXPECT
Exiting substitution via last at - line 7.
########
# pp_ctl.c
use warnings 'exiting' ;
sub fred { last }
{ fred() }
no warnings 'exiting' ;
sub joe { last }
{ joe() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
{
  eval "use warnings 'exiting' ; last;" 
}
print STDERR $@ ;
{
  eval "no warnings 'exiting' ;last;" 
} 
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
use warnings 'exiting' ;
@a = (1,2) ;
@b = sort { last } @a ;
no warnings 'exiting' ;
@b = sort { last } @a ;
EXPECT