t/porting/test_bootstrap.t

   1 #!/perl -w
   2 use strict;
   3
   4 # See "TESTING" in perlhack.pod for the instructions about where test files
   5 # are located and which constructions should be avoided in the early tests.
   6
   7 # This regression tests ensures that the rules aren't accidentally overlooked.
   8
   9 BEGIN {
  10     chdir 't';
  11     require './test.pl';
  12 }
  13
  14 plan('no_plan');
  15
  16 open my $fh, '<', '../MANIFEST' or die "Can't open MANIFEST: $!";
  17
  18 # Some tests in t/comp need to use require or use to get their job done:
  19 my %exceptions = (
  20     filter_exception => "require './test.pl'",
  21     hints => "require './test.pl'",
  22     parser => 'use DieDieDie',
  23     parser_run => "require './test.pl'",
  24     proto => 'use strict',
  25  );
  26
  27 while (my $file = <$fh>) {
  28     next unless $file =~ s!^t/!!;
  29     chomp $file;
  30     $file =~ s/\s+.*//;
  31     next unless $file =~ m!\.t$!;
  32
  33     local $/;
  34     open my $t, '<', $file or die "Can't open $file: $!";
  35     # avoid PERL_UNICODE causing us to read non-UTF-8 files as UTF-8
  36     binmode $t;
  37     my $contents = <$t>;
  38     # Don't 'use' Test::* modules under 't/' --
  39     # but exclude this file from that test.
  40     unlike(
  41         $contents,
  42         qr/use\s+Test::(?:Simple|More)/,
  43         "$file doesn't use Test::Simple or Test::More"
  44     ) unless ($file =~ m|porting/test_bootstrap\.t|);
  45     next unless $file =~ m!^base/! or $file =~ m!^comp!;
  46
  47     # Remove only the excepted constructions for the specific files.
  48     if ($file =~ m!comp/(.*)\.t! && $exceptions{$1}) {
  49         my $allowed = $exceptions{$1};
  50         $contents =~ s/\Q$allowed//gs;
  51     }
  52
  53     # All uses of use are allowed in t/comp/use.t
  54     unlike($contents, qr/^\s*use\s+/m, "$file doesn't use use")
  55         unless $file eq 'comp/use.t';
  56     # All uses of require are allowed in t/comp/require.t
  57     unlike($contents, qr/^\s*require\s+/m, "$file doesn't use require")
  58         unless $file eq 'comp/require.t'
  59 }
  60
  61 # There are regression tests using test.pl that don't want PL_sawampersand
  62 # set.  Or at least that was the case until PL_sawampersand was disabled
  63 # and replaced with copy-on-write.
  64
  65 # We still allow PL_sawampersand to be enabled with
  66 # -Accflags=-DPERL_SAWAMPERSAND, or with -DPERL_NO_COW, so its still worth
  67 # checking.
  68 # There's no portable, reliable way to check whether PL_sawampersand is
  69 # set, so instead we just "grep $`|$&|$' test.pl"
  70
  71 {
  72     my $file = '';
  73     my $fh;
  74     if (ok(open(my $fh, '<', 'test.pl'), "opened test.pl")) {
  75         $file = do { local $/; <$fh> };
  76         $file //= '';
  77     }
  78     else {
  79         diag("error: $!");
  80     }
  81     ok(length($file) > 0, "read test.pl successfully");
  82     ok($file !~ /\$&/, 'Nothing in test.pl mentioned $&');
  83     ok($file !~ /\$`/, 'Nothing in test.pl mentioned $`');
  84     ok($file !~ /\$'/, 'Nothing in test.pl mentioned $\'');
  85 }