summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/t/pragma/warn/pp_sys
blob: 7c38727e28eb95cbb17d65d9eb597bb1c54bd258 (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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
  pp_sys.c 	AOK

  untie attempted while %d inner references still exist	[pp_untie]
    sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;

  Filehandle %s opened only for input		[pp_leavewrite]
    format STDIN =
    .
    write STDIN;

  write() on closed filehandle %s		[pp_leavewrite]
    format STDIN =
    .
    close STDIN;
    write STDIN ;

  page overflow	 				[pp_leavewrite]

  Filehandle %s never opened			[pp_prtf]
    $a = "abc"; printf $a "fred"

  Filehandle %s opened only for input		[pp_prtf]
    $a = "abc"; 
    printf $a "fred"

  printf() on closed filehandle %s		[pp_prtf]
    close STDIN ;
    printf STDIN "fred"

  syswrite() on closed filehandle %s		[pp_send]
    close STDIN; 
    syswrite STDIN, "fred", 1;

  send() on closed socket %s			[pp_send]
    close STDIN; 
    send STDIN, "fred", 1

  bind() on closed socket %s			[pp_bind]
    close STDIN; 
    bind STDIN, "fred" ;


  connect() on closed socket %s			[pp_connect]
    close STDIN; 
    connect STDIN, "fred" ;

  listen() on closed socket %s			[pp_listen]
    close STDIN; 
    listen STDIN, 2;

  accept() on closed socket %s			[pp_accept]
    close STDIN; 
    accept "fred", STDIN ;

  shutdown() on closed socket %s		[pp_shutdown]
    close STDIN; 
    shutdown STDIN, 0;

  setsockopt() on closed socket %s		[pp_ssockopt]
  getsockopt() on closed socket	%s		[pp_ssockopt]
    close STDIN; 
    setsockopt STDIN, 1,2,3;
    getsockopt STDIN, 1,2;

  getsockname() on closed socket %s		[pp_getpeername]
  getpeername() on closed socket %s		[pp_getpeername]
    close STDIN; 
    getsockname STDIN;
    getpeername STDIN;

  flock() on closed socket %s			[pp_flock]
    close STDIN;
    flock STDIN, 8;

  warn(warn_nl, "stat");			[pp_stat]

  Test on unopened file <%s>
	close STDIN ; -T STDIN ;

  warn(warn_nl, "open");			[pp_fttext]
    -T "abc\ndef" ;

  Filehandle %s opened only for output		[pp_sysread]
	my $file = "./xcv" ;
	open(F, ">$file") ; 
	my $a = sysread(F, $a,10) ;
  
  

__END__
# pp_sys.c [pp_untie]
use warnings 'untie' ;
sub TIESCALAR { bless [] } ; 
$b = tie $a, 'main'; 
untie $a ;
no warnings 'untie' ;
$c = tie $d, 'main'; 
untie $d ;
EXPECT
untie attempted while 1 inner references still exist at - line 5.
########
# pp_sys.c [pp_leavewrite]
use warnings 'io' ;
format STDIN =
.
write STDIN;
no warnings 'io' ;
write STDIN;
EXPECT
Filehandle main::STDIN opened only for input at - line 5.
########
# pp_sys.c [pp_leavewrite]
use warnings 'closed' ;
format STDIN =
.
close STDIN;
write STDIN;
opendir STDIN, ".";
write STDIN;
closedir STDIN;
no warnings 'closed' ;
write STDIN;
opendir STDIN, ".";
write STDIN;
EXPECT
write() on closed filehandle main::STDIN at - line 6.
write() on closed filehandle main::STDIN at - line 8.
	(Are you trying to call write() on dirhandle main::STDIN?)
########
# pp_sys.c [pp_leavewrite]
use warnings 'io' ;
format STDOUT_TOP =
abc
.
format STDOUT =
def
ghi
.
$= = 1 ;
$- =1 ;
open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
write ;
no warnings 'io' ;
write ;
EXPECT
page overflow at - line 13.
########
# pp_sys.c [pp_prtf]
use warnings 'unopened' ;
$a = "abc"; 
printf $a "fred";
no warnings 'unopened' ;
printf $a "fred";
EXPECT
Filehandle main::abc never opened at - line 4.
########
# pp_sys.c [pp_prtf]
use warnings 'closed' ;
close STDIN ;
printf STDIN "fred";
opendir STDIN, ".";
printf STDIN "fred";
closedir STDIN;
no warnings 'closed' ;
printf STDIN "fred";
opendir STDIN, ".";
printf STDIN "fred";
EXPECT
printf() on closed filehandle main::STDIN at - line 4.
printf() on closed filehandle main::STDIN at - line 6.
	(Are you trying to call printf() on dirhandle main::STDIN?)
########
# pp_sys.c [pp_prtf]
use warnings 'io' ;
printf STDIN "fred";
no warnings 'io' ;
printf STDIN "fred";
EXPECT
Filehandle main::STDIN opened only for input at - line 3.
########
# pp_sys.c [pp_send]
use warnings 'closed' ;
close STDIN; 
syswrite STDIN, "fred", 1;
opendir STDIN, ".";
syswrite STDIN, "fred", 1;
closedir STDIN;
no warnings 'closed' ;
syswrite STDIN, "fred", 1;
opendir STDIN, ".";
syswrite STDIN, "fred", 1;
EXPECT
syswrite() on closed filehandle main::STDIN at - line 4.
syswrite() on closed filehandle main::STDIN at - line 6.
	(Are you trying to call syswrite() on dirhandle main::STDIN?)
########
# pp_sys.c [pp_flock]
use Config; 
BEGIN { 
  if ( $^O eq 'VMS' and ! $Config{d_flock}) {
    print <<EOM ;
SKIPPED
# flock not present
EOM
    exit ;
  } 
}
use warnings 'closed' ;
close STDIN;
flock STDIN, 8;
opendir STDIN, ".";
flock STDIN, 8;
no warnings 'closed' ;
flock STDIN, 8;
opendir STDIN, ".";
flock STDIN, 8;
EXPECT
flock() on closed filehandle main::STDIN at - line 14.
flock() on closed filehandle main::STDIN at - line 16.
	(Are you trying to call flock() on dirhandle main::STDIN?)
########
# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
use warnings 'io' ;
use Config; 
BEGIN { 
  if ( $^O ne 'VMS' and ! $Config{d_socket}) {
    print <<EOM ;
SKIPPED
# send not present
# bind not present
# connect not present
# accept not present
# shutdown not present
# setsockopt not present
# getsockopt not present
# getsockname not present
# getpeername not present
EOM
    exit ;
  } 
}
close STDIN; 
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept "fred", STDIN;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
opendir STDIN, ".";
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept "fred", STDIN;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
closedir STDIN;
no warnings 'io' ;
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept STDIN, "fred" ;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
opendir STDIN, ".";
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
accept "fred", STDIN;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
EXPECT
send() on closed socket main::STDIN at - line 22.
bind() on closed socket main::STDIN at - line 23.
connect() on closed socket main::STDIN at - line 24.
listen() on closed socket main::STDIN at - line 25.
accept() on closed socket main::STDIN at - line 26.
shutdown() on closed socket main::STDIN at - line 27.
setsockopt() on closed socket main::STDIN at - line 28.
getsockopt() on closed socket main::STDIN at - line 29.
getsockname() on closed socket main::STDIN at - line 30.
getpeername() on closed socket main::STDIN at - line 31.
send() on closed socket main::STDIN at - line 33.
	(Are you trying to call send() on dirhandle main::STDIN?)
bind() on closed socket main::STDIN at - line 34.
	(Are you trying to call bind() on dirhandle main::STDIN?)
connect() on closed socket main::STDIN at - line 35.
	(Are you trying to call connect() on dirhandle main::STDIN?)
listen() on closed socket main::STDIN at - line 36.
	(Are you trying to call listen() on dirhandle main::STDIN?)
accept() on closed socket main::STDIN at - line 37.
	(Are you trying to call accept() on dirhandle main::STDIN?)
shutdown() on closed socket main::STDIN at - line 38.
	(Are you trying to call shutdown() on dirhandle main::STDIN?)
setsockopt() on closed socket main::STDIN at - line 39.
	(Are you trying to call setsockopt() on dirhandle main::STDIN?)
getsockopt() on closed socket main::STDIN at - line 40.
	(Are you trying to call getsockopt() on dirhandle main::STDIN?)
getsockname() on closed socket main::STDIN at - line 41.
	(Are you trying to call getsockname() on dirhandle main::STDIN?)
getpeername() on closed socket main::STDIN at - line 42.
	(Are you trying to call getpeername() on dirhandle main::STDIN?)
########
# pp_sys.c [pp_stat]
use warnings 'newline' ;
stat "abc\ndef";
no warnings 'newline' ;
stat "abc\ndef";
EXPECT
Unsuccessful stat on filename containing newline at - line 3.
########
# pp_sys.c [pp_fttext]
use warnings 'unopened' ;
close STDIN ; 
-T STDIN ;
no warnings 'unopened' ;
-T STDIN ;
EXPECT
Test on unopened file <STDIN> at - line 4.
########
# pp_sys.c [pp_fttext]
use warnings 'newline' ;
-T "abc\ndef" ;
no warnings 'newline' ;
-T "abc\ndef" ;
EXPECT
Unsuccessful open on filename containing newline at - line 3.
########
# pp_sys.c [pp_sysread]
use warnings 'io' ;
my $file = "./xcv" ;
open(F, ">$file") ; 
my $a = sysread(F, $a,10) ;
no warnings 'io' ;
my $a = sysread(F, $a,10) ;
close F ;
unlink $file ;
EXPECT
Filehandle main::F opened only for output at - line 5.
OpenPOWER on IntegriCloud