diff options
author | markm <markm@FreeBSD.org> | 2000-06-25 11:04:01 +0000 |
---|---|---|
committer | markm <markm@FreeBSD.org> | 2000-06-25 11:04:01 +0000 |
commit | 2618fad5bbb2d0182eb31ed805c41b543c513940 (patch) | |
tree | 52ba93338b13aefd02a0055304a9eccfa0e049f5 /contrib/perl5/t/pragma/warn/pp_ctl | |
parent | 77644ee620b6a79cf8c538abaf7cd301a875528d (diff) | |
download | FreeBSD-src-2618fad5bbb2d0182eb31ed805c41b543c513940.zip FreeBSD-src-2618fad5bbb2d0182eb31ed805c41b543c513940.tar.gz |
Vendor import of Perl 5.006
Diffstat (limited to 'contrib/perl5/t/pragma/warn/pp_ctl')
-rw-r--r-- | contrib/perl5/t/pragma/warn/pp_ctl | 217 |
1 files changed, 217 insertions, 0 deletions
diff --git a/contrib/perl5/t/pragma/warn/pp_ctl b/contrib/perl5/t/pragma/warn/pp_ctl new file mode 100644 index 0000000..0deccd3 --- /dev/null +++ b/contrib/perl5/t/pragma/warn/pp_ctl @@ -0,0 +1,217 @@ + 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 +Exiting pseudo-block via last at - line 4. +Can't "last" outside a loop block at - line 4. +######## +# pp_ctl.c +use warnings 'exiting' ; +$_ = "abc" ; +fred: +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} +no warnings 'exiting' ; +while ($i ++ == 0) +{ + s/ab/last fred/e ; +} +EXPECT +Exiting substitution via last at - line 7. +######## +# pp_ctl.c +use warnings 'exiting' ; +sub fred { last joe } +joe: { fred() } +no warnings 'exiting' ; +sub Fred { last Joe } +Joe: { Fred() } +EXPECT +Exiting subroutine via last at - line 3. +######## +# pp_ctl.c +joe: +{ eval "use warnings 'exiting' ; last joe;" } +print STDERR $@ ; +Joe: +{ eval "no warnings 'exiting' ; last Joe;" } +print STDERR $@ ; +EXPECT +Exiting eval via last at (eval 1) line 1. +######## +# pp_ctl.c +use warnings 'exiting' ; +@a = (1,2) ; +fred: @b = sort { last fred } @a ; +no warnings 'exiting' ; +Fred: @b = sort { last Fred } @a ; +EXPECT +Exiting pseudo-block via last at - line 4. +Label not found for "last fred" at - line 4. +######## +# pp_ctl.c +use warnings 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + fred() if $a++ < 200 +} + +fred() +EXPECT +Deep recursion on subroutine "main::fred" at - line 6. +######## +# pp_ctl.c +no warnings 'recursion' ; +BEGIN { warn "PREFIX\n" ;} +sub fred +{ + fred() if $a++ < 200 +} + +fred() +EXPECT +######## +# pp_ctl.c +use warnings 'misc' ; +package Foo; +DESTROY { die "@{$_[0]} foo bar" } +{ bless ['A'], 'Foo' for 1..10 } +{ bless ['B'], 'Foo' for 1..10 } +EXPECT + (in cleanup) A foo bar at - line 4. + (in cleanup) B foo bar at - line 4. +######## +# pp_ctl.c +no warnings 'misc' ; +package Foo; +DESTROY { die "@{$_[0]} foo bar" } +{ bless ['A'], 'Foo' for 1..10 } +{ bless ['B'], 'Foo' for 1..10 } +EXPECT + |