t/lib/strict/subs

   1 Check strict subs functionality
   2
   3 __END__
   4
   5 # no strict, should build & run ok.
   6 Fred ;
   7 my $fred ;
   8 $b = "fred" ;
   9 $a = $$b ;
  10 EXPECT
  11
  12 ########
  13
  14 use strict qw(refs vars);
  15 Fred ;
  16 EXPECT
  17
  18 ########
  19
  20 use strict ;
  21 no strict 'subs' ;
  22 Fred ;
  23 EXPECT
  24
  25 ########
  26
  27 # strict subs - error
  28 use strict 'subs' ;
  29 my @a = (1..2);
  30 my $b = xyz;
  31 EXPECT
  32 Bareword "xyz" not allowed while "strict subs" in use at - line 5.
  33 Execution of - aborted due to compilation errors.
  34 ########
  35
  36 # strict subs - error
  37 use strict 'subs' ;
  38 Fred ;
  39 EXPECT
  40 Bareword "Fred" not allowed while "strict subs" in use at - line 4.
  41 Execution of - aborted due to compilation errors.
  42 ########
  43
  44 # strict subs - error
  45 use strict 'subs' ;
  46 my @a = (A..Z);
  47 EXPECT
  48 Bareword "A" not allowed while "strict subs" in use at - line 4.
  49 Bareword "Z" not allowed while "strict subs" in use at - line 4.
  50 Execution of - aborted due to compilation errors.
  51 ########
  52
  53 # strict subs - error
  54 use strict 'subs' ;
  55 my $a = (B..Y);
  56 EXPECT
  57 Bareword "B" not allowed while "strict subs" in use at - line 4.
  58 Bareword "Y" not allowed while "strict subs" in use at - line 4.
  59 Execution of - aborted due to compilation errors.
  60 ########
  61
  62 # strict subs - error
  63 use strict ;
  64 Fred ;
  65 EXPECT
  66 Bareword "Fred" not allowed while "strict subs" in use at - line 4.
  67 Execution of - aborted due to compilation errors.
  68 ########
  69
  70 # strict subs - no error
  71 use strict 'subs' ;
  72 sub Fred {}
  73 Fred ;
  74 EXPECT
  75
  76 ########
  77
  78 # Check compile time scope of strict subs pragma
  79 use strict 'subs' ;
  80 {
  81     no strict ;
  82     my $a = Fred ;
  83 }
  84 my $a = Fred ;
  85 EXPECT
  86 Bareword "Fred" not allowed while "strict subs" in use at - line 8.
  87 Execution of - aborted due to compilation errors.
  88 ########
  89
  90 # Check compile time scope of strict subs pragma
  91 no strict;
  92 {
  93     use strict 'subs' ;
  94     my $a = Fred ;
  95 }
  96 my $a = Fred ;
  97 EXPECT
  98 Bareword "Fred" not allowed while "strict subs" in use at - line 6.
  99 Execution of - aborted due to compilation errors.
 100 ########
 101
 102 # Check compile time scope of strict vars pragma
 103 use strict 'vars' ;
 104 {
 105     no strict ;
 106     $joe = 1 ;
 107 }
 108 $joe = 1 ;
 109 EXPECT
 110 Variable "$joe" is not imported at - line 8.
 111 Global symbol "$joe" requires explicit package name (did you forget to declare "my $joe"?) at - line 8.
 112 Execution of - aborted due to compilation errors.
 113 ########
 114
 115 # Check compile time scope of strict vars pragma
 116 no strict;
 117 {
 118     use strict 'vars' ;
 119     $joe = 1 ;
 120 }
 121 $joe = 1 ;
 122 EXPECT
 123 Global symbol "$joe" requires explicit package name (did you forget to declare "my $joe"?) at - line 6.
 124 Execution of - aborted due to compilation errors.
 125 ########
 126
 127 # Check runtime scope of strict refs pragma
 128 use strict 'refs';
 129 my $fred ;
 130 my $b = "fred" ;
 131 {
 132     no strict ;
 133     my $a = $$b ;
 134 }
 135 my $a = $$b ;
 136 EXPECT
 137 Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
 138 ########
 139
 140 # Check runtime scope of strict refs pragma
 141 no strict ;
 142 my $fred ;
 143 my $b = "fred" ;
 144 {
 145     use strict 'refs' ;
 146     my $a = $$b ;
 147 }
 148 my $a = $$b ;
 149 EXPECT
 150 Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
 151 ########
 152
 153 # Check runtime scope of strict refs pragma
 154 no strict ;
 155 my $fred ;
 156 my $b = "fred" ;
 157 {
 158     use strict 'refs' ;
 159     $a = sub { my $c = $$b ; }
 160 }
 161 &$a ;
 162 EXPECT
 163 Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
 164 ########
 165
 166 use strict 'subs' ;
 167 my $a = Fred ;
 168 EXPECT
 169 Bareword "Fred" not allowed while "strict subs" in use at - line 3.
 170 Execution of - aborted due to compilation errors.
 171 ########
 172
 173 --FILE-- abc
 174 my $a = Fred ;
 175 1;
 176 --FILE--
 177 use strict 'subs' ;
 178 require "./abc";
 179 EXPECT
 180
 181 ########
 182
 183 --FILE-- abc
 184 use strict 'subs' ;
 185 1;
 186 --FILE--
 187 require "./abc";
 188 my $a = Fred ;
 189 EXPECT
 190
 191 ########
 192
 193 --FILE-- abc
 194 use strict 'subs' ;
 195 my $a = Fred ;
 196 1;
 197 --FILE--
 198 Fred ;
 199 require "./abc";
 200 EXPECT
 201 Bareword "Fred" not allowed while "strict subs" in use at ./abc line 2.
 202 Compilation failed in require at - line 2.
 203 ########
 204
 205 --FILE-- abc.pm
 206 use strict 'subs' ;
 207 my $a = Fred ;
 208 1;
 209 --FILE--
 210 Fred ;
 211 use abc;
 212 EXPECT
 213 Bareword "Fred" not allowed while "strict subs" in use at abc.pm line 2.
 214 Compilation failed in require at - line 2.
 215 BEGIN failed--compilation aborted at - line 2.
 216 ########
 217
 218 # Check scope of pragma with eval
 219 no strict ;
 220 eval {
 221     my $a = Fred ;
 222 };
 223 print STDERR $@;
 224 my $a = Fred ;
 225 EXPECT
 226
 227 ########
 228
 229 # Check scope of pragma with eval
 230 no strict ;
 231 eval {
 232     use strict 'subs' ;
 233     my $a = Fred ;
 234 };
 235 print STDERR $@;
 236 my $a = Fred ;
 237 EXPECT
 238 Bareword "Fred" not allowed while "strict subs" in use at - line 6.
 239 Execution of - aborted due to compilation errors.
 240 ########
 241
 242 # Check scope of pragma with eval
 243 use strict 'subs' ;
 244 eval {
 245     my $a = Fred ;
 246 };
 247 print STDERR $@;
 248 my $a = Fred ;
 249 EXPECT
 250 Bareword "Fred" not allowed while "strict subs" in use at - line 5.
 251 Bareword "Fred" not allowed while "strict subs" in use at - line 8.
 252 Execution of - aborted due to compilation errors.
 253 ########
 254
 255 # Check scope of pragma with eval
 256 use strict 'subs' ;
 257 eval {
 258     no strict ;
 259     my $a = Fred ;
 260 };
 261 print STDERR $@;
 262 my $a = Fred ;
 263 EXPECT
 264 Bareword "Fred" not allowed while "strict subs" in use at - line 9.
 265 Execution of - aborted due to compilation errors.
 266 ########
 267
 268 # Check scope of pragma with eval
 269 no strict ;
 270 eval '
 271     Fred ;
 272 '; print STDERR $@ ;
 273 Fred ;
 274 EXPECT
 275
 276 ########
 277
 278 # Check scope of pragma with eval
 279 no strict ;
 280 eval q[
 281     use strict 'subs' ;
 282     Fred ;
 283 ]; print STDERR $@;
 284 EXPECT
 285 Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 3.
 286 ########
 287
 288 # Check scope of pragma with eval
 289 use strict 'subs' ;
 290 eval '
 291     Fred ;
 292 '; print STDERR $@ ;
 293 EXPECT
 294 Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 2.
 295 ########
 296
 297 # Check scope of pragma with eval
 298 use strict 'subs' ;
 299 eval '
 300     no strict ;
 301     my $a = Fred ;
 302 '; print STDERR $@;
 303 my $a = Fred ;
 304 EXPECT
 305 Bareword "Fred" not allowed while "strict subs" in use at - line 8.
 306 Execution of - aborted due to compilation errors.
 307 ########
 308
 309 # see if Foo->Bar(...) etc work under strictures
 310 use strict;
 311 package Foo; sub Bar { print "@_\n" }
 312 Foo->Bar('a',1);
 313 Bar Foo ('b',2);
 314 Foo->Bar(qw/c 3/);
 315 Bar Foo (qw/d 4/);
 316 Foo::->Bar('A',1);
 317 Bar Foo:: ('B',2);
 318 Foo::->Bar(qw/C 3/);
 319 Bar Foo:: (qw/D 4/);
 320 EXPECT
 321 Foo a 1
 322 Foo b 2
 323 Foo c 3
 324 Foo d 4
 325 Foo A 1
 326 Foo B 2
 327 Foo C 3
 328 Foo D 4
 329 ########
 330
 331 # Check that barewords on the RHS of a regex match are caught
 332 use strict;
 333 "" =~ foo;
 334 EXPECT
 335 Bareword "foo" not allowed while "strict subs" in use at - line 4.
 336 Execution of - aborted due to compilation errors.
 337
 338 ########
 339
 340 # ID 20020703.002 (#10021)
 341 use strict;
 342 use warnings;
 343 my $abc = XYZ ? 1 : 0;
 344 print "$abc\n";
 345 EXPECT
 346 Bareword "XYZ" not allowed while "strict subs" in use at - line 5.
 347 Execution of - aborted due to compilation errors.
 348 ########
 349
 350 # [perl #10021]
 351 use strict;
 352 use warnings;
 353 print "" if BAREWORD;
 354 EXPECT
 355 Bareword "BAREWORD" not allowed while "strict subs" in use at - line 5.
 356 Execution of - aborted due to compilation errors.
 357 ########
 358 # Ticket: 18927
 359 use strict 'subs';
 360 print 1..1, bad;
 361 EXPECT
 362 Bareword "bad" not allowed while "strict subs" in use at - line 3.
 363 Execution of - aborted due to compilation errors.
 364 ########
 365 eval q{ use strict; no strict refs; };
 366 print $@;
 367 EXPECT
 368 Bareword "refs" not allowed while "strict subs" in use at (eval 1) line 1.
 369 ########
 370 # [perl #25147]
 371 use strict;
 372 print "" if BAREWORD;
 373 EXPECT
 374 Bareword "BAREWORD" not allowed while "strict subs" in use at - line 3.
 375 Execution of - aborted due to compilation errors.
 376 ########
 377 # [perl #26910] hints not propagated into (?{...})
 378 use strict 'subs';
 379 qr/(?{my $x=foo})/;
 380 EXPECT
 381 Bareword "foo" not allowed while "strict subs" in use at - line 3.
 382 Execution of - aborted due to compilation errors.
 383 ########
 384 # Regexp compilation errors weren't UTF-8 clean
 385 use strict 'subs';
 386 use utf8;
 387 use open qw( :utf8 :std );
 388 qr/(?{my $x=fòò})/;
 389 EXPECT
 390 Bareword "fòò" not allowed while "strict subs" in use at - line 5.
 391 Execution of - aborted due to compilation errors.
 392 ########
 393 #  [perl #27628] strict 'subs' didn't warn on bareword array index
 394 use strict 'subs';
 395 my $x=$a[FOO];
 396 EXPECT
 397 Bareword "FOO" not allowed while "strict subs" in use at - line 3.
 398 Execution of - aborted due to compilation errors.
 399 ########
 400 use strict 'subs';
 401 my @a;my $x=$a[FOO];
 402 EXPECT
 403 Bareword "FOO" not allowed while "strict subs" in use at - line 2.
 404 Execution of - aborted due to compilation errors.
 405 ########
 406 # [perl #53806] No complain about bareword
 407 use strict 'subs';
 408 print FOO . "\n";
 409 EXPECT
 410 Bareword "FOO" not allowed while "strict subs" in use at - line 3.
 411 Execution of - aborted due to compilation errors.
 412 ########
 413 # [perl #53806] No complain about bareword
 414 use strict 'subs';
 415 $ENV{PATH} = "";
 416 system(FOO . "\n");
 417 EXPECT
 418 Bareword "FOO" not allowed while "strict subs" in use at - line 4.
 419 Execution of - aborted due to compilation errors.
 420 ########
 421 use strict 'subs';
 422 my @players;
 423 eval { @players = sort(_rankCompare @players) };
 424 sub _rankCompare2 { }
 425 @players = sort(_rankCompare2 @players);
 426 EXPECT
 427
 428 ########
 429 use strict;
 430 readline(FOO);
 431 EXPECT
 432
 433 ########
 434 use strict 'subs';
 435 sub sayfoo { print "foo:@_\n" ; "ret\n" }
 436 print sayfoo "bar";
 437 print sayfoo . "bar\n";
 438 EXPECT
 439 foo:bar
 440 ret
 441 foo:
 442 ret
 443 bar
 444 ########
 445 # infinite loop breaks some strict checking
 446 use strict 'subs';
 447 sub foo {
 448     1 while 1;
 449     kill FOO, 1;
 450 }
 451 EXPECT
 452 Bareword "FOO" not allowed while "strict subs" in use at - line 5.
 453 Execution of - aborted due to compilation errors.
 454 ########
 455 # make sure checks are done within (?{})
 456 use strict 'subs';
 457 /(?{FOO})/
 458 EXPECT
 459 Bareword "FOO" not allowed while "strict subs" in use at - line 3.
 460 Execution of - aborted due to compilation errors.
 461 ########
 462 # [perl #126981] Strict subs vs. multideref
 463 my $h;
 464 my $v1 = $h->{+CONST_TYPO};
 465 use strict 'subs';
 466 my $v2 = $h->{+CONST_TYPO};
 467 EXPECT
 468 Bareword "CONST_TYPO" not allowed while "strict subs" in use at - line 5.
 469 Execution of - aborted due to compilation errors.
 470 ########
 471 # NAME constant-folded barewords still trigger stricture
 472 my $x = !BARE1;
 473 use strict 'subs';
 474 my $y = !BARE2;
 475 EXPECT
 476 Bareword "BARE2" not allowed while "strict subs" in use at - line 3.
 477 Execution of - aborted due to compilation errors.