summaryrefslogtreecommitdiff
path: root/t/pragma/warn/pp_ctl
blob: 5a1c2338ed1991a52c5cef2577fce88783f246c8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
  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
	{
    	goto &fred() if $a++ < 200
	}
	 
	goto &fred()

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

__END__
# pp_ctl.c
use warning 'syntax' ;
format STDOUT =
@<<< @<<<
1
.
write;
EXPECT
Not enough format arguments at - line 5.
1
########
# pp_ctl.c
use warning 'unsafe' ;
$_ = "abc" ;
 
while ($i ++ == 0)
{
    s/ab/last/e ;
}
EXPECT
Exiting substitution via last at - line 7.
########
# pp_ctl.c
use warning 'unsafe' ;
sub fred { last }
{ fred() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
use warning 'unsafe' ;
{ eval "last;" } 
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
use warning 'unsafe' ;
@a = (1,2) ;
@b = sort { last } @a ;
EXPECT
Exiting pseudo-block via last at - line 4.
Can't "last" outside a block at - line 4.
########
# pp_ctl.c
use warning 'unsafe' ;
$_ = "abc" ;
fred: 
while ($i ++ == 0)
{
    s/ab/last fred/e ;
}
EXPECT
Exiting substitution via last at - line 7.
########
# pp_ctl.c
use warning 'unsafe' ;
sub fred { last joe }
joe: { fred() }
EXPECT
Exiting subroutine via last at - line 3.
########
# pp_ctl.c
use warning 'unsafe' ;
joe: { eval "last joe;" }
print STDERR $@ ;
EXPECT
Exiting eval via last at (eval 1) line 1.
########
# pp_ctl.c
use warning 'unsafe' ;
@a = (1,2) ;
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 warning 'recursion' ;
BEGIN { warn "PREFIX\n" ;}
sub fred
{
    goto &fred() if $a++ < 200
}
 
goto &fred()
EXPECT
Deep recursion on subroutine "main::fred" at - line 6.
########
# pp_ctl.c
use warning 'unsafe' ;
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.