t/porting/test_bootstrap.t

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